Changeset 2

Timestamp:

Nov 21, 2012, 9:04:27 AM (11 years ago)

Author:

chronos

Message:

• Modified: Delayed screen redrawing using system timer. Request for repaint is signaled by Redraw method. Repaint is limited by minimal period of timer thus unnecessary repainting is avoided.
• Modified: Maze update using system message replaced by direct method call.

Location:

trunk

Files:

• bin (modified) (1 prop)
• src/lazesglobals.pas (modified) (5 diffs)
• src/ufrmmain1.lfm (modified) (4 diffs)
• src/ufrmmain1.pas (modified) (7 diffs)
• src/ufrmscaling.pas (modified) (2 diffs)

trunk/src/lazesglobals.pas

@@ -18 +18 @@
 unit LazesGlobals;
 
-{$mode objfpc}{$H+}
+{$mode delphi}{$H+}
 
 interface
@@ -26 +26 @@
 
 const
-  // Update message when something in the maze config has changed and needs regeneration
-  C_MAZE_UPDATE_MESSAGE = WM_USER + 67122;
-
   // Maximum width/height of the maze
   C_MIN_MAZE_SIZE =  4;
@@ -35 +32 @@
 type
   // Record structure to send messages around with maze metrics
+
+  { TMazeUpdateInfo }
+
   TMazeUpdateInfo = record
     MazeWidth : integer;
@@ -40 +40 @@
     DrawWidth : integer;
     DrawHeight: integer;
+    class operator Equal(A, B: TMazeUpdateInfo): Boolean;
   end;
   PMazeUpdateInfo = ^TMazeUpdateInfo;
@@ -45 +46 @@
 implementation
 
+{ TMazeUpdateInfo }
+
+class operator TMazeUpdateInfo.Equal(A, B: TMazeUpdateInfo): Boolean;
+begin
+  Result := (A.MazeHeight = B.MazeHeight) and (A.MazeWidth = B.MazeWidth) and
+    (A.DrawHeight = B.DrawHeight) and (A.DrawWidth = B.DrawWidth);
+end;
+
 end.
 

trunk/src/ufrmmain1.lfm

@@ -1 +1 @@
 object frmMain1: TfrmMain1
-  Left = 727
+  Left = 497
   Height = 389
-  Top = 186
+  Top = 189
   Width = 459
   Caption = 'Lazes - Lazarus Mazes'
-  ClientHeight = 369
+  ClientHeight = 370
   ClientWidth = 459
   Constraints.MinHeight = 300
@@ -14 +14 @@
   OnMouseWheelDown = FormMouseWheelDown
   OnMouseWheelUp = FormMouseWheelUp
-  LCLVersion = '1.0.2.0'
+  LCLVersion = '1.1'
   object imgBackground: TImage
     Left = 16
@@ -3343 +3343 @@
     Top = 72
     Width = 82
+    Align = alCustom
     BorderSpacing.Around = 10
     OnMouseWheelDown = FormMouseWheelDown
@@ -3400 +3401 @@
     end
   end
+  object TimerDraw: TTimer
+    Interval = 20
+    OnTimer = TimerDrawTimer
+    left = 152
+    top = 8
+  end
 end

trunk/src/ufrmmain1.pas

@@ -46 +46 @@
     MenuItem7: TMenuItem;
     pbMaze: TPaintBox;
+    TimerDraw: TTimer;
 
     procedure acNewMazeExecute(Sender: TObject);
@@ -55 +56 @@
     procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     procedure pbMazePaint(Sender: TObject);
+    procedure TimerDrawTimer(Sender: TObject);
 
   private
+    FMazeMetrics: TMazeUpdateInfo;
     Maze: TMaze;
     MazePainter: TMazePainter;
-    MazeMetrics: TMazeUpdateInfo;
     MazeIsSolved: boolean;
-
-    procedure OnMazeChangeMessage(var Msg: TMessage); message C_MAZE_UPDATE_MESSAGE;
+    RedrawPending: Boolean;
     procedure GenerateNewMaze;
     procedure ResizeMaze(const pdx, pdy: integer);
-
+    procedure SetMazeMetrics(AValue: TMazeUpdateInfo);
   public
+    property MazeMetrics: TMazeUpdateInfo read FMazeMetrics write SetMazeMetrics;
+    procedure Redraw;
   end;
 
@@ -155 +158 @@
               // State := csStart;
               MazePainter.IsDirty := true; // Force repaint with new cell populated
-              pbMaze.Repaint;
+              Redraw;
               Application.ProcessMessages;
-              if Maze.Width < 20 then sleep(10);
+              Sleep(10);
 
               // Start travelling from here
@@ -169 +172 @@
                 // Tag := 0;
                 MazePainter.IsDirty := true; // Force repaint with new cell populated
-                pbMaze.Repaint;
+                Redraw;
                 Application.ProcessMessages;
-                if Maze.Width < 20 then sleep(10);
+                Sleep(10);
               end;
         end;
@@ -224 +227 @@
 end;
 
+procedure TfrmMain1.TimerDrawTimer(Sender: TObject);
+begin
+  if RedrawPending then begin
+    RedrawPending := False;
+    pbMaze.Repaint;
+  end;
+end;
+
 procedure TfrmMain1.GenerateNewMaze;
 var bld: TMazeBuilderDepthFirst;
@@ -246 +257 @@
   MazePainter.CellDrawWidth  := MazeMetrics.DrawWidth;
   MazePainter.CellDrawHeight := MazeMetrics.DrawHeight;
-  pbMaze.Repaint;
+  Redraw;
 end;
 
@@ -262 +273 @@
 end;
 
-procedure TfrmMain1.OnMazeChangeMessage(var Msg: TMessage);
-var NewMetrics: TMazeUpdateInfo;
-begin
+procedure TfrmMain1.SetMazeMetrics(AValue: TMazeUpdateInfo);
+begin
+  if FMazeMetrics = AValue then Exit;
   // Any updates?
-  NewMetrics := PMazeUpdateInfo(Msg.wParam)^;
-  if (NewMetrics.DrawHeight <> MazeMetrics.DrawHeight)
-  or (NewMetrics.DrawWidth  <> MazeMetrics.DrawWidth)
-  or (NewMetrics.MazeHeight <> MazeMetrics.MazeHeight)
-  or (NewMetrics.MazeWidth  <> MazeMetrics.MazeWidth) then
-  begin
-    MazeMetrics := NewMetrics;
+  if (AValue.DrawHeight <> MazeMetrics.DrawHeight)
+  or (AValue.DrawWidth  <> MazeMetrics.DrawWidth)
+  or (AValue.MazeHeight <> MazeMetrics.MazeHeight)
+  or (AValue.MazeWidth  <> MazeMetrics.MazeWidth) then
+  begin
+    FMazeMetrics := AValue;
     GenerateNewMaze;
   end;
 end;
 
+procedure TfrmMain1.Redraw;
+begin
+  RedrawPending := True;
+end;
+
 end.
 

trunk/src/ufrmscaling.pas

@@ -71 +71 @@
 {$R *.lfm}
 
+uses
+  ufrmMain1;
+
 { TfrmScaling }
 
@@ -111 +114 @@
     DrawHeight := tbHeightDrawing.Position;
   end;
-  SendMessage(Application.MainFormHandle, C_MAZE_UPDATE_MESSAGE, LongInt(@MazeMetrics), 0);
+  frmMain1.MazeMetrics := MazeMetrics;
 end;