Changeset 2 for trunk/src


Ignore:
Timestamp:
Nov 21, 2012, 9:04:27 AM (12 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/src
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/src/lazesglobals.pas

    r1 r2  
    1818unit LazesGlobals;
    1919
    20 {$mode objfpc}{$H+}
     20{$mode delphi}{$H+}
    2121
    2222interface
     
    2626
    2727const
    28   // Update message when something in the maze config has changed and needs regeneration
    29   C_MAZE_UPDATE_MESSAGE = WM_USER + 67122;
    30 
    3128  // Maximum width/height of the maze
    3229  C_MIN_MAZE_SIZE =  4;
     
    3532type
    3633  // Record structure to send messages around with maze metrics
     34
     35  { TMazeUpdateInfo }
     36
    3737  TMazeUpdateInfo = record
    3838    MazeWidth : integer;
     
    4040    DrawWidth : integer;
    4141    DrawHeight: integer;
     42    class operator Equal(A, B: TMazeUpdateInfo): Boolean;
    4243  end;
    4344  PMazeUpdateInfo = ^TMazeUpdateInfo;
     
    4546implementation
    4647
     48{ TMazeUpdateInfo }
     49
     50class operator TMazeUpdateInfo.Equal(A, B: TMazeUpdateInfo): Boolean;
     51begin
     52  Result := (A.MazeHeight = B.MazeHeight) and (A.MazeWidth = B.MazeWidth) and
     53    (A.DrawHeight = B.DrawHeight) and (A.DrawWidth = B.DrawWidth);
     54end;
     55
    4756end.
    4857
  • trunk/src/ufrmmain1.lfm

    r1 r2  
    11object frmMain1: TfrmMain1
    2   Left = 727
     2  Left = 497
    33  Height = 389
    4   Top = 186
     4  Top = 189
    55  Width = 459
    66  Caption = 'Lazes - Lazarus Mazes'
    7   ClientHeight = 369
     7  ClientHeight = 370
    88  ClientWidth = 459
    99  Constraints.MinHeight = 300
     
    1414  OnMouseWheelDown = FormMouseWheelDown
    1515  OnMouseWheelUp = FormMouseWheelUp
    16   LCLVersion = '1.0.2.0'
     16  LCLVersion = '1.1'
    1717  object imgBackground: TImage
    1818    Left = 16
     
    33433343    Top = 72
    33443344    Width = 82
     3345    Align = alCustom
    33453346    BorderSpacing.Around = 10
    33463347    OnMouseWheelDown = FormMouseWheelDown
     
    34003401    end
    34013402  end
     3403  object TimerDraw: TTimer
     3404    Interval = 20
     3405    OnTimer = TimerDrawTimer
     3406    left = 152
     3407    top = 8
     3408  end
    34023409end
  • trunk/src/ufrmmain1.pas

    r1 r2  
    4646    MenuItem7: TMenuItem;
    4747    pbMaze: TPaintBox;
     48    TimerDraw: TTimer;
    4849
    4950    procedure acNewMazeExecute(Sender: TObject);
     
    5556    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    5657    procedure pbMazePaint(Sender: TObject);
     58    procedure TimerDrawTimer(Sender: TObject);
    5759
    5860  private
     61    FMazeMetrics: TMazeUpdateInfo;
    5962    Maze: TMaze;
    6063    MazePainter: TMazePainter;
    61     MazeMetrics: TMazeUpdateInfo;
    6264    MazeIsSolved: boolean;
    63 
    64     procedure OnMazeChangeMessage(var Msg: TMessage); message C_MAZE_UPDATE_MESSAGE;
     65    RedrawPending: Boolean;
    6566    procedure GenerateNewMaze;
    6667    procedure ResizeMaze(const pdx, pdy: integer);
    67 
     68    procedure SetMazeMetrics(AValue: TMazeUpdateInfo);
    6869  public
     70    property MazeMetrics: TMazeUpdateInfo read FMazeMetrics write SetMazeMetrics;
     71    procedure Redraw;
    6972  end;
    7073
     
    155158              // State := csStart;
    156159              MazePainter.IsDirty := true; // Force repaint with new cell populated
    157               pbMaze.Repaint;
     160              Redraw;
    158161              Application.ProcessMessages;
    159               if Maze.Width < 20 then sleep(10);
     162              Sleep(10);
    160163
    161164              // Start travelling from here
     
    169172                // Tag := 0;
    170173                MazePainter.IsDirty := true; // Force repaint with new cell populated
    171                 pbMaze.Repaint;
     174                Redraw;
    172175                Application.ProcessMessages;
    173                 if Maze.Width < 20 then sleep(10);
     176                Sleep(10);
    174177              end;
    175178        end;
     
    224227end;
    225228
     229procedure TfrmMain1.TimerDrawTimer(Sender: TObject);
     230begin
     231  if RedrawPending then begin
     232    RedrawPending := False;
     233    pbMaze.Repaint;
     234  end;
     235end;
     236
    226237procedure TfrmMain1.GenerateNewMaze;
    227238var bld: TMazeBuilderDepthFirst;
     
    246257  MazePainter.CellDrawWidth  := MazeMetrics.DrawWidth;
    247258  MazePainter.CellDrawHeight := MazeMetrics.DrawHeight;
    248   pbMaze.Repaint;
     259  Redraw;
    249260end;
    250261
     
    262273end;
    263274
    264 procedure TfrmMain1.OnMazeChangeMessage(var Msg: TMessage);
    265 var NewMetrics: TMazeUpdateInfo;
    266 begin
     275procedure TfrmMain1.SetMazeMetrics(AValue: TMazeUpdateInfo);
     276begin
     277  if FMazeMetrics = AValue then Exit;
    267278  // Any updates?
    268   NewMetrics := PMazeUpdateInfo(Msg.wParam)^;
    269   if (NewMetrics.DrawHeight <> MazeMetrics.DrawHeight)
    270   or (NewMetrics.DrawWidth  <> MazeMetrics.DrawWidth)
    271   or (NewMetrics.MazeHeight <> MazeMetrics.MazeHeight)
    272   or (NewMetrics.MazeWidth  <> MazeMetrics.MazeWidth) then
    273   begin
    274     MazeMetrics := NewMetrics;
     279  if (AValue.DrawHeight <> MazeMetrics.DrawHeight)
     280  or (AValue.DrawWidth  <> MazeMetrics.DrawWidth)
     281  or (AValue.MazeHeight <> MazeMetrics.MazeHeight)
     282  or (AValue.MazeWidth  <> MazeMetrics.MazeWidth) then
     283  begin
     284    FMazeMetrics := AValue;
    275285    GenerateNewMaze;
    276286  end;
    277287end;
    278288
     289procedure TfrmMain1.Redraw;
     290begin
     291  RedrawPending := True;
     292end;
     293
    279294end.
    280295
  • trunk/src/ufrmscaling.pas

    r1 r2  
    7171{$R *.lfm}
    7272
     73uses
     74  ufrmMain1;
     75
    7376{ TfrmScaling }
    7477
     
    111114    DrawHeight := tbHeightDrawing.Position;
    112115  end;
    113   SendMessage(Application.MainFormHandle, C_MAZE_UPDATE_MESSAGE, LongInt(@MazeMetrics), 0);
     116  frmMain1.MazeMetrics := MazeMetrics;
    114117end;
    115118
Note: See TracChangeset for help on using the changeset viewer.