Changeset 88 for trunk/Forms

Timestamp:

Jun 7, 2024, 2:36:34 PM (5 months ago)

Author:

chronos

Message:

• Fixed: Fullscreen mode was not working on start.
• Added: Step button in AI form to do single step.

Location:

trunk/Forms

Files:

• FormComputer.lfm (modified) (3 diffs)
• FormComputer.lrj (modified) (1 diff)
• FormComputer.pas (modified) (5 diffs)
• FormMain.lfm (modified) (2 diffs)
• FormMain.pas (modified) (3 diffs)

trunk/Forms/FormComputer.lfm

@@ -1 +1 @@
 object FormComputer: TFormComputer
-  Left = 747
+  Left = 1040
   Height = 360
-  Top = 561
+  Top = 540
   Width = 480
   Caption = 'AI'
@@ -21 +21 @@
     OnClick = ButtonStartClick
   end
-  object ButtonStop: TButton
-    Left = 208
+  object ButtonEnd: TButton
+    Left = 296
     Height = 38
     Top = 24
     Width = 113
-    Caption = 'Stop'
+    Caption = 'End'
     Enabled = False
     TabOrder = 1
-    OnClick = ButtonStopClick
+    OnClick = ButtonEndClick
   end
   object TrackBar1: TTrackBar
@@ -49 +49 @@
     ParentColor = False
   end
+  object ButtonStep: TButton
+    Left = 168
+    Height = 38
+    Top = 24
+    Width = 113
+    Caption = 'Step'
+    Enabled = False
+    TabOrder = 3
+    OnClick = ButtonStepClick
+  end
 end

trunk/Forms/FormComputer.lrj

@@ -2 +2 @@
 {"hash":1113,"name":"tformcomputer.caption","sourcebytes":[65,73],"value":"AI"},
 {"hash":5941396,"name":"tformcomputer.buttonstart.caption","sourcebytes":[83,116,97,114,116],"value":"Start"},
-{"hash":371552,"name":"tformcomputer.buttonstop.caption","sourcebytes":[83,116,111,112],"value":"Stop"},
-{"hash":116494394,"name":"tformcomputer.label1.caption","sourcebytes":[68,101,108,97,121,32,112,101,114,32,115,116,101,112,58],"value":"Delay per step:"}
+{"hash":19524,"name":"tformcomputer.buttonend.caption","sourcebytes":[69,110,100],"value":"End"},
+{"hash":116494394,"name":"tformcomputer.label1.caption","sourcebytes":[68,101,108,97,121,32,112,101,114,32,115,116,101,112,58],"value":"Delay per step:"},
+{"hash":371392,"name":"tformcomputer.buttonstep.caption","sourcebytes":[83,116,101,112],"value":"Step"}
 ]}

trunk/Forms/FormComputer.pas

@@ -34 +34 @@
   TFormComputer = class(TFormEx)
     ButtonStart: TButton;
-    ButtonStop: TButton;
+    ButtonEnd: TButton;
+    ButtonStep: TButton;
     Label1: TLabel;
     TrackBar1: TTrackBar;
     procedure ButtonStartClick(Sender: TObject);
-    procedure ButtonStopClick(Sender: TObject);
+    procedure ButtonEndClick(Sender: TObject);
+    procedure ButtonStepClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
-    Stop: Boolean;
+    Running: Boolean;
     GameTries1: TGameTries;
     GameTries2: TGameTries;
     GameTries3: TGameTries;
     GameTries4: TGameTries;
+    procedure Step;
     procedure TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
+    procedure UpdateInterface;
   end;
 
@@ -151 +155 @@
   );
 begin
-  ButtonStopClick(Self);
+  Running := False;
 end;
 
@@ -167 +171 @@
 
 procedure TFormComputer.ButtonStartClick(Sender: TObject);
+begin
+  Running := True;
+  while Core.Core.Game.CanMove and Running do begin
+    Step;
+  end;
+  Running := False;
+end;
+
+procedure TFormComputer.ButtonEndClick(Sender: TObject);
+begin
+  Running := False;
+end;
+
+procedure TFormComputer.ButtonStepClick(Sender: TObject);
+begin
+  Step;
+end;
+
+procedure TFormComputer.FormCreate(Sender: TObject);
+begin
+  GameTries1 := TGameTries.Create;
+  GameTries2 := TGameTries.Create;
+  GameTries3 := TGameTries.Create;
+  GameTries4 := TGameTries.Create;
+  UpdateInterface;
+end;
+
+procedure TFormComputer.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(GameTries1);
+  FreeAndNil(GameTries2);
+  FreeAndNil(GameTries3);
+  FreeAndNil(GameTries4);
+end;
+
+procedure TFormComputer.Step;
 var
   NewTry: TGameTry;
@@ -176 +216 @@
   Delay: Integer;
 begin
-  ButtonStart.Enabled := False;
-  ButtonStop.Enabled := True;
-  Stop := False;
   with Core.Core.Game do begin
-    while CanMove and not Stop do begin
-      NewTry := TGameTry.Create;
-      NewTry.Game.Assign(Core.Core.Game);
-      GameTries1.Clear;
-      TryAllDirections(GameTries1, NewTry);
-      FreeAndNil(NewTry);
-      GameTries2.Clear;
-      for I := 0 to GameTries1.Count - 1 do
-        TryAllDirections(GameTries2, GameTries1[I]);
-      GameTries3.Clear;
-      for I := 0 to GameTries2.Count - 1 do
-        TryAllDirections(GameTries3, GameTries2[I]);
-      GameTries4.Clear;
-      for I := 0 to GameTries3.Count - 1 do
-        TryAllDirections(GameTries4, GameTries3[I]);
-
-      GameTries := GameTries4;
-      GameTryComparer := TGameTryComparer.Create;
-      GameTries.Sort(GameTryComparer);
-      S := '';
-      for I := 0 to GameTries.Count - 1 do begin
-        S := S + FormatFloat('0.000', GameTries[I].GetFitness) + '(';
-        for J := 0 to Length(GameTries[I].Moves) - 1 do
-          S := S + DirectionText[GameTries[I].Moves[J]] + ' ';
-        S := S + '), ';
-      end;
-      MoveAllAndUpdate(GameTries[0].Moves[0], False);
-{      if CanMergeDirection(drDown) then MoveAllAnimate(drDown)
-      else if CanMergeDirection(drRight) then MoveAllAnimate(drRight)
-      else if CanMergeDirection(drLeft) then MoveAllAnimate(drLeft)
-      else if CanMoveDirection(drDown) then MoveAllAnimate(drDown)
-      else if CanMoveDirection(drRight) then MoveAllAnimate(drRight)
-      else if CanMoveDirection(drLeft) then MoveAllAnimate(drLeft)
-      else if CanMoveDirection(drUp) then MoveAllAnimate(drUp)
-      else Break;
-      }
-      Delay := TrackBar1.Position;
-      while Delay > 0 do begin
-        Application.ProcessMessages;
-        Sleep(10);
-        Delay := Delay - 10;
-      end;
-    end;
-  end;
-  ButtonStart.Enabled := True;
-  ButtonStop.Enabled := False;
-end;
-
-procedure TFormComputer.ButtonStopClick(Sender: TObject);
-begin
-  Stop := True;
-end;
-
-procedure TFormComputer.FormCreate(Sender: TObject);
-begin
-  GameTries1 := TGameTries.Create;
-  GameTries2 := TGameTries.Create;
-  GameTries3 := TGameTries.Create;
-  GameTries4 := TGameTries.Create;
-end;
-
-procedure TFormComputer.FormDestroy(Sender: TObject);
-begin
-  FreeAndNil(GameTries1);
-  FreeAndNil(GameTries2);
-  FreeAndNil(GameTries3);
-  FreeAndNil(GameTries4);
+    NewTry := TGameTry.Create;
+    NewTry.Game.Assign(Core.Core.Game);
+    GameTries1.Clear;
+    TryAllDirections(GameTries1, NewTry);
+    FreeAndNil(NewTry);
+    GameTries2.Clear;
+    for I := 0 to GameTries1.Count - 1 do
+      TryAllDirections(GameTries2, GameTries1[I]);
+    GameTries3.Clear;
+    for I := 0 to GameTries2.Count - 1 do
+      TryAllDirections(GameTries3, GameTries2[I]);
+    GameTries4.Clear;
+    for I := 0 to GameTries3.Count - 1 do
+      TryAllDirections(GameTries4, GameTries3[I]);
+
+    GameTries := GameTries4;
+    GameTryComparer := TGameTryComparer.Create;
+    GameTries.Sort(GameTryComparer);
+    S := '';
+    for I := 0 to GameTries.Count - 1 do begin
+      S := S + FormatFloat('0.000', GameTries[I].GetFitness) + '(';
+      for J := 0 to Length(GameTries[I].Moves) - 1 do
+        S := S + DirectionText[GameTries[I].Moves[J]] + ' ';
+      S := S + '), ';
+    end;
+    MoveAllAndUpdate(GameTries[0].Moves[0], False);
+  {      if CanMergeDirection(drDown) then MoveAllAnimate(drDown)
+    else if CanMergeDirection(drRight) then MoveAllAnimate(drRight)
+    else if CanMergeDirection(drLeft) then MoveAllAnimate(drLeft)
+    else if CanMoveDirection(drDown) then MoveAllAnimate(drDown)
+    else if CanMoveDirection(drRight) then MoveAllAnimate(drRight)
+    else if CanMoveDirection(drLeft) then MoveAllAnimate(drLeft)
+    else if CanMoveDirection(drUp) then MoveAllAnimate(drUp)
+    else Break;
+    }
+    Delay := TrackBar1.Position;
+    while Delay > 0 do begin
+      Application.ProcessMessages;
+      Sleep(10);
+      Delay := Delay - 10;
+    end;
+  end;
+  UpdateInterface;
 end;
 
@@ -268 +281 @@
 end;
 
+procedure TFormComputer.UpdateInterface;
+begin
+  ButtonStart.Enabled := not Running;
+  ButtonStep.Enabled := not Running;
+  ButtonEnd.Enabled := Running;
+end;
+
 end.
 

trunk/Forms/FormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
   Left = 534
-  Height = 993
+  Height = 1061
   Top = 223
   Width = 1491
@@ -7 +7 @@
   DesignTimePPI = 144
   Menu = MainMenu1
-  OnClose = FormClose
+  OnActivate = FormActivate
   OnCreate = FormCreate
   OnDestroy = FormDestroy

trunk/Forms/FormMain.pas

@@ -36 +36 @@
     MenuItemGame: TMenuItem;
     TimerDraw: TTimer;
-    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormActivate(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -171 +171 @@
 end;
 
-procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
-begin
-  Core.Core.PersistentForm1.Save(Self);
+procedure TFormMain.FormActivate(Sender: TObject);
+begin
+  FullScreen := Core.Core.PersistentForm1.FormFullScreen;
 end;
 
@@ -194 +194 @@
 procedure TFormMain.FormShow(Sender: TObject);
 begin
-  FullScreen := Core.Core.PersistentForm1.FormFullScreen;
-
   UpdateInterface;
-  if Core.Core.Game.Board.GetEmptyTilesCount > Core.Core.Game.Board.Size.X * Core.Core.Game.Board.Size.Y -
-    InitialTileCount then
+  if Core.Core.Game.Board.GetEmptyTilesCount > Core.Core.Game.Board.Size.X *
+    Core.Core.Game.Board.Size.Y - InitialTileCount then
     Core.Core.Game.New;
 end;