Changeset 7 for trunk/Forms


Ignore:
Timestamp:
Nov 22, 2012, 7:09:17 AM (12 years ago)
Author:
chronos
Message:
  • Added: Allow terminate solving process.
  • Fixed: Disable actions which can change maze during solving.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        33Lazes.lps
        44Lazes.dbg
         5Lazes

  • trunk/Forms/ufrmmain1.lfm

    r6 r7  
    55  Width = 459
    66  Caption = 'Lazes - Lazarus Mazes'
    7   ClientHeight = 370
     7  ClientHeight = 366
    88  ClientWidth = 459
    99  Constraints.MinHeight = 300
    1010  Constraints.MinWidth = 300
    1111  Menu = MainMenu1
     12  OnClose = FormClose
    1213  OnCreate = FormCreate
    1314  OnDestroy = FormDestroy
    … …  
    33373338    }
    33383339    Stretch = True
    3339     Visible = False
    33403340  end
    33413341  object pbMaze: TPaintBox
    … …  
    33563356      Caption = '&File'
    33573357      object MenuItem2: TMenuItem
    3358         Action = FileExit1
     3358        Action = AFileExit
    33593359      end
    33603360    end
    … …  
    33623362      Caption = '&Maze'
    33633363      object MenuItem7: TMenuItem
    3364         Action = acNewMaze
     3364        Action = AMazeNew
    33653365      end
    33663366      object MenuItem4: TMenuItem
    3367         Action = actMetricsPopUp
     3367        Action = AMetricsPopUp
     3368      end
     3369      object MenuItem9: TMenuItem
     3370        Action = AMazeEnlarge
     3371      end
     3372      object MenuItem10: TMenuItem
     3373        Action = AMazeShrink
    33683374      end
    33693375      object MenuItem5: TMenuItem
    … …  
    33713377      end
    33723378      object MenuItem6: TMenuItem
    3373         Action = acSolve
     3379        Action = AMazeSolve
     3380      end
     3381      object MenuItem8: TMenuItem
     3382        Action = ATerminate
    33743383      end
    33753384    end
    33763385  end
    33773386  object ActionList1: TActionList
    3378     left = 88
     3387    left = 96
    33793388    top = 8
    3380     object FileExit1: TFileExit
     3389    object AFileExit: TFileExit
    33813390      Category = 'File'
    33823391      Caption = 'E&xit'
    33833392      Hint = 'Exit'
    33843393    end
    3385     object actMetricsPopUp: TAction
     3394    object AMetricsPopUp: TAction
    33863395      Category = 'Maze'
    33873396      Caption = '&Change maze metrics'
    3388       OnExecute = actMetricsPopUpExecute
     3397      OnExecute = AMetricsPopUpExecute
    33893398      ShortCut = 113
    33903399    end
    3391     object acSolve: TAction
     3400    object AMazeSolve: TAction
    33923401      Category = 'Maze'
    33933402      Caption = '&Solve maze'
    3394       OnExecute = acSolveExecute
     3403      OnExecute = AMazeSolveExecute
    33953404      ShortCut = 112
    33963405    end
    3397     object acNewMaze: TAction
     3406    object AMazeNew: TAction
    33983407      Category = 'Maze'
    33993408      Caption = '&Generate new maze'
    3400       OnExecute = acNewMazeExecute
     3409      OnExecute = AMazeNewExecute
    34013410      ShortCut = 116
     3411    end
     3412    object AMazeEnlarge: TAction
     3413      Category = 'Maze'
     3414      Caption = '&Enlarge'
     3415      OnExecute = AMazeEnlargeExecute
     3416      ShortCut = 114
     3417    end
     3418    object AMazeShrink: TAction
     3419      Category = 'Maze'
     3420      Caption = '&Shrink'
     3421      OnExecute = AMazeShrinkExecute
     3422      ShortCut = 115
     3423    end
     3424    object ATerminate: TAction
     3425      Category = 'Maze'
     3426      Caption = 'Terminate'
     3427      OnExecute = ATerminateExecute
     3428      ShortCut = 27
    34023429    end
    34033430  end
    … …  
    34053432    Interval = 10
    34063433    OnTimer = TimerDrawTimer
    3407     left = 152
     3434    left = 176
    34083435    top = 8
    34093436  end

  • trunk/Forms/ufrmmain1.pas

    r6 r7  
    3131
    3232  TfrmMain1 = class(TForm)
    33     acSolve: TAction;
    34     acNewMaze: TAction;
    35     actMetricsPopUp: TAction;
     33    ATerminate: TAction;
     34    AMazeEnlarge: TAction;
     35    AMazeShrink: TAction;
     36    AMazeSolve: TAction;
     37    AMazeNew: TAction;
     38    AMetricsPopUp: TAction;
    3639    ActionList1: TActionList;
    37     FileExit1: TFileExit;
     40    AFileExit: TFileExit;
    3841    imgBackground: TImage;
    3942    MainMenu1: TMainMenu;
    4043    MenuItem1: TMenuItem;
     44    MenuItem10: TMenuItem;
    4145    MenuItem2: TMenuItem;
    4246    MenuItem3: TMenuItem;
    … …  
    4549    MenuItem6: TMenuItem;
    4650    MenuItem7: TMenuItem;
     51    MenuItem8: TMenuItem;
     52    MenuItem9: TMenuItem;
    4753    pbMaze: TPaintBox;
    4854    TimerDraw: TTimer;
    4955
    50     procedure acNewMazeExecute(Sender: TObject);
    51     procedure acSolveExecute(Sender: TObject);
    52     procedure actMetricsPopUpExecute(Sender: TObject);
     56    procedure AMazeEnlargeExecute(Sender: TObject);
     57    procedure AMazeNewExecute(Sender: TObject);
     58    procedure AMazeShrinkExecute(Sender: TObject);
     59    procedure AMazeSolveExecute(Sender: TObject);
     60    procedure AMetricsPopUpExecute(Sender: TObject);
     61    procedure ATerminateExecute(Sender: TObject);
     62    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    5363    procedure FormCreate(Sender: TObject);
    5464    procedure FormDestroy(Sender: TObject);
    … …  
    6474    MazeIsSolved: boolean;
    6575    RedrawPending: Boolean;
     76    DisableActions: Boolean;
     77    Solved: boolean;
     78    TerminateAction: Boolean;
    6679    procedure GenerateNewMaze;
    6780    procedure ResizeMaze(const pdx, pdy: integer);
    6881    procedure SetMazeMetrics(AValue: TMazeUpdateInfo);
     82    procedure TravelMaze(CurPos: TCellPoint);
     83    procedure TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
    6984  public
    7085    property MazeMetrics: TMazeUpdateInfo read FMazeMetrics write SetMazeMetrics;
    7186    procedure Redraw;
     87    procedure UpdateInterface;
    7288  end;
    7389
    … …  
    104120  // And generate a demo maze
    105121  GenerateNewMaze;
     122
     123  UpdateInterface;
    106124end;
    107125
    … …  
    114132procedure TfrmMain1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    115133begin
    116   ResizeMaze(-1,-1);
     134  AMazeShrink.Execute;
    117135end;
    118136
    119137procedure TfrmMain1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    120138begin
    121   ResizeMaze(1,1);
    122 end;
    123 
    124 procedure TfrmMain1.acSolveExecute(Sender: TObject);
    125 
    126 var Solved: boolean;
    127 
    128   procedure TravelMaze(CurPos: TCellPoint);
    129 
    130     procedure TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
    131     const DirMoves: array[TDirection] of TPoint = ((x: 0; y:-1),  // North
    132                                                    (x: 0; y:+1),  // South
    133                                                    (x:+1; y:0 ),  // East
    134                                                    (x:-1; y:0 )); // West
    135     var NewPos: TCellPoint;
     139  AMazeEnlarge.Execute;
     140end;
     141
     142procedure TfrmMain1.TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
     143const
     144  DirMoves: array[TDirection] of TPoint =
     145    ((x: 0; y:-1),  // North
     146    (x: 0; y:+1),  // South
     147    (x:+1; y:0 ),  // East
     148    (x:-1; y:0 )); // West
     149var
     150  NewPos: TCellPoint;
     151begin
     152  if TerminateAction then Exit;
     153
     154  // Direction at all possible?
     155  with Maze.GetCell(pFrom) do
     156    if not CanGo[pDirection] then Exit;
     157
     158  // Movement is possible!
     159  NewPos.Row := pFrom.Row + DirMoves[pDirection].y;
     160  NewPos.Col := pFrom.Col + DirMoves[pDirection].x;
     161
     162  // Check if the next cell is not visited before.
     163  with Maze.GetCell(NewPos) do
     164    if State = csExit then
     165      begin
     166        Solved := true;
     167        Exit;
     168      end
     169    else if State = csVisited then
     170      Exit
     171  else
    136172    begin
    137       // Direction at all possible?
    138       with Maze.GetCell(pFrom) do
    139         if not CanGo[pDirection] then EXIT;
    140 
    141       // Movement is possible!
    142       NewPos.Row := pFrom.Row + DirMoves[pDirection].y;
    143       NewPos.Col := pFrom.Col + DirMoves[pDirection].x;
    144 
    145       // Check if the next cell is not visited before.
    146       with Maze.GetCell(NewPos) do
    147         if State = csExit then
     173      State := csVisited;     // Been here
     174      // Tag := 1;               // Visited
     175          // State := csStart;
     176          MazePainter.IsDirty := true; // Force repaint with new cell populated
     177          Redraw;
     178          Application.ProcessMessages;
     179          Sleep(10);
     180
     181          // Start travelling from here
     182          if not Solved then
     183            TravelMaze(NewPos);
     184
     185          if TerminateAction then Exit;
     186
     187          // If still not solved, backtrack
     188          if not Solved then
    148189          begin
    149             Solved := true;
    150             Exit
    151           end
    152         else if State = csVisited then
    153           Exit
    154       else
    155         begin
    156           State := csVisited;     // Been here
    157           // Tag := 1;               // Visited
    158               // State := csStart;
    159               MazePainter.IsDirty := true; // Force repaint with new cell populated
    160               Redraw;
    161               Application.ProcessMessages;
    162               Sleep(10);
    163 
    164               // Start travelling from here
    165               if not Solved then
    166                 TravelMaze(NewPos);
    167 
    168               // If still not solved, backtrack
    169               if not Solved then
    170               begin
    171                 State := csEmpty;
    172                 // Tag := 0;
    173                 MazePainter.IsDirty := true; // Force repaint with new cell populated
    174                 Redraw;
    175                 Application.ProcessMessages;
    176                 Sleep(10);
    177               end;
    178         end;
     190            State := csEmpty;
     191            // Tag := 0;
     192            MazePainter.IsDirty := true; // Force repaint with new cell populated
     193            Redraw;
     194            Application.ProcessMessages;
     195            Sleep(10);
     196          end;
    179197    end;
    180 
    181   begin
    182     // Check all 4 directions for possible moves
    183     if not Solved then TryMove(CurPos, dirEast);
    184     if not Solved then TryMove(CurPos, dirSouth);
    185     if not Solved then TryMove(CurPos, dirWest);
    186     if not Solved then TryMove(CurPos, dirNorth);
    187   end;
    188 
     198end;
     199
     200procedure TfrmMain1.TravelMaze(CurPos: TCellPoint);
     201begin
     202  // Check all 4 directions for possible moves
     203  if not Solved then TryMove(CurPos, dirEast);
     204  if not Solved then TryMove(CurPos, dirSouth);
     205  if not Solved then TryMove(CurPos, dirWest);
     206  if not Solved then TryMove(CurPos, dirNorth);
     207end;
     208
     209procedure TfrmMain1.AMazeSolveExecute(Sender: TObject);
    189210begin
    190211  // If the maze was already solved, dont do it again
    … …  
    195216  end;
    196217
    197   // Reset the tags, they will be used for backtracking
    198   Maze.ResetTags;
    199 
    200   // Not done yet...
    201   Solved := false;
    202 
    203   // Travel all cells until the end is found
    204   TravelMaze(Maze.GetStartPosition);
    205   MazeIsSolved := true;
    206 
    207   // Found, so give a victorious message!
    208   MessageDlg('Hurrah! Found the exit!!!!', mtInformation, [mbOK], 0);
    209 end;
    210 
    211 procedure TfrmMain1.acNewMazeExecute(Sender: TObject);
     218  try
     219    DisableActions := True;
     220    TerminateAction := False;
     221    UpdateInterface;
     222
     223    Maze.SetStartCell(0, 0);
     224
     225    // Reset the tags, they will be used for backtracking
     226    Maze.ResetTags;
     227    Maze.ResetState;
     228
     229    // Not done yet...
     230    Solved := false;
     231
     232    // Travel all cells until the end is found
     233    TravelMaze(Maze.GetStartPosition);
     234    if not TerminateAction then begin
     235      MazeIsSolved := true;
     236
     237      // Found, so give a victorious message!
     238      MessageDlg('Hurrah! Found the exit!!!!', mtInformation, [mbOK], 0);
     239    end;
     240  finally
     241    DisableActions := False;
     242    UpdateInterface;
     243  end;
     244end;
     245
     246procedure TfrmMain1.AMazeNewExecute(Sender: TObject);
    212247begin
    213248  GenerateNewMaze;
    214249end;
    215250
    216 procedure TfrmMain1.actMetricsPopUpExecute(Sender: TObject);
     251procedure TfrmMain1.AMazeShrinkExecute(Sender: TObject);
     252begin
     253  ResizeMaze(-1,-1);
     254end;
     255
     256procedure TfrmMain1.AMazeEnlargeExecute(Sender: TObject);
     257begin
     258  ResizeMaze(1,1);
     259end;
     260
     261procedure TfrmMain1.AMetricsPopUpExecute(Sender: TObject);
    217262begin
    218263  frmScaling.Show;
     264end;
     265
     266procedure TfrmMain1.ATerminateExecute(Sender: TObject);
     267begin
     268  TerminateAction := True;
     269end;
     270
     271procedure TfrmMain1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     272begin
     273  ATerminate.Execute;
    219274end;
    220275
    … …  
    254309
    255310  // Set lower right hand corner as exit (top left is start by default)
    256   Maze.Cell[ Maze.Height-1, Maze.Width-1 ].State := csExit;
     311  Maze.Cell[Maze.Height - 1, Maze.Width - 1].State := csExit;
    257312
    258313  // Paint the maze
    … …  
    295350end;
    296351
     352procedure TfrmMain1.UpdateInterface;
     353begin
     354  AMazeNew.Enabled := not DisableActions;
     355  AMazeSolve.Enabled := not DisableActions;
     356  AMetricsPopUp.Enabled := not DisableActions;
     357  if DisableActions then frmScaling.Hide;
     358  AMazeEnlarge.Enabled := not DisableActions;
     359  AMazeShrink.Enabled := not DisableActions;
     360  ATerminate.Enabled := DisableActions;
     361end;
     362
    297363end.
    298364
Note: See TracChangeset for help on using the changeset viewer.