Changeset 71

Timestamp:

Sep 28, 2014, 8:53:50 PM (10 years ago)

Author:

chronos

Message:

• Modified: Tested csOpaque direct drawing with temporary bitmap buffer. Not significant improvement over non opaque mode.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (2 diffs)
• Forms/UFormMain.pas (modified) (5 diffs)
• UGame.pas (modified) (3 diffs)

trunk/Forms/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
-  Left = 102
+  Left = 278
   Height = 621
-  Top = 0
+  Top = 84
   Width = 775
   Caption = 'xTactics'
@@ -21 +21 @@
     Width = 735
     Align = alClient
+    ParentColor = False
     OnMouseDown = PaintBox1MouseDown
     OnMouseMove = PaintBox1MouseMove

trunk/Forms/UFormMain.pas

@@ -89 +89 @@
     procedure Timer1Timer(Sender: TObject);
   private
+    TempBitmap: TBitmap;
     StartMousePoint: TPoint;
     StartViewPoint: TPoint;
     MoveActive: Boolean;
     RedrawPending: Boolean;
+    DrawDuration: TDateTime;
   public
     procedure LoadConfig(Config: TXmlConfig; Path: string);
@@ -116 +118 @@
 
 procedure TFormMain.PaintBox1Paint(Sender: TObject);
-begin
+var
+  DrawStart: TDateTime;
+begin
+  DrawStart := Now;
   //if Core.Game.Running then
   if Assigned(Core.Game.CurrentPlayer) then
   with Core.Game.CurrentPlayer do begin
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
-    Paint(PaintBox1);
-  end;
+    if csOpaque in PaintBox1.ControlStyle then begin
+      TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
+      TempBitmap.Canvas.Brush.Color := clBackground; //PaintBox1.GetColorResolvingParent;
+      TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
+      Paint(TempBitmap.Canvas);
+      PaintBox1.Canvas.Draw(0, 0, TempBitmap);
+    end else Paint(PaintBox1.Canvas);
+  end;
+  DrawDuration := Now - DrawStart;
 end;
 
 procedure TFormMain.EraseBackground(DC: HDC);
 begin
+  // Do nothing, all background space covered by controls
 end;
 
@@ -144 +157 @@
   if RedrawPending then begin
     RedrawPending := False;
-    DrawStart := Now;
     PaintBox1.Repaint;
-    StatusBar1.Panels[1].Text := IntToStr(Trunc((Now - DrawStart) / OneMillisecond)) + ' ms';
-
+    StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' ms';
     NewCaption := 'xTactics';
     if Assigned(Core.Game.CurrentPlayer) then
@@ -199 +210 @@
 procedure TFormMain.FormCreate(Sender: TObject);
 begin
+  //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
+  //DoubleBuffered := True;
+  TempBitmap := TBitmap.Create;
 end;
 
@@ -274 +288 @@
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
+  TempBitmap.Free;
 end;
 

trunk/UGame.pas

@@ -193 +193 @@
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
-    procedure Paint(PaintBox: TPaintBox);
+    procedure Paint(Canvas: TCanvas);
     constructor Create;
     destructor Destroy; override;
@@ -1393 +1393 @@
 end;
 
-procedure TPlayer.Paint(PaintBox: TPaintBox);
-begin
-  Game.Map.Paint(PaintBox.Canvas, View);
+procedure TPlayer.Paint(Canvas: TCanvas);
+begin
+  Game.Map.Paint(Canvas, View);
 end;
 
@@ -2108 +2108 @@
             Brush.Color := clPurple
           else Brush.Color := Cell.GetColor;
-        Pen.Color := clBlack;
+        //Pen.Color := clBlack;
         PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.GetAvialPower), View, Cell);
       end;