Changeset 213 for trunk/Forms

Timestamp:

May 24, 2018, 9:25:17 PM (7 years ago)

Author:

chronos

Message:

• Added: Button with action to surrender the game.
• Fixed: Added framing comm component for correct separation of network messages.
• Added: New game protocol command NextPlayer. GUI client will redraw map on this event to see how other players/AI fight each other.

Location:

trunk/Forms

Files:

• UFormClient.lfm (modified) (2 diffs)
• UFormClient.pas (modified) (9 diffs)

trunk/Forms/UFormClient.lfm

@@ -52 +52 @@
     object ToolButton6: TToolButton
       Left = 1
-      Top = 39
+      Top = 71
       Action = AZoomIn
     end
     object ToolButton7: TToolButton
       Left = 1
-      Top = 71
+      Top = 103
       Action = AZoomOut
     end
     object ToolButton8: TToolButton
       Left = 1
-      Top = 103
+      Top = 135
       Action = AZoomAll
     end
     object ToolButton9: TToolButton
       Left = 1
-      Top = 34
+      Top = 66
       Width = 32
       AutoSize = True
       Style = tbsDivider
+    end
+    object ToolButton1: TToolButton
+      Left = 1
+      Top = 34
+      Action = ASurrender
     end
   end
@@ -134 +139 @@
       ShortCut = 16468
     end
+    object ASurrender: TAction
+      Caption = 'Surrender'
+      ImageIndex = 4
+      OnExecute = ASurrenderExecute
+    end
   end
   object PopupMenuToolbar: TPopupMenu

trunk/Forms/UFormClient.pas

@@ -19 +19 @@
 
   TFormClient = class(TForm)
+    ASurrender: TAction;
     AGameEndTurn: TAction;
     AStatusBarVisible: TAction;
@@ -33 +34 @@
     Timer1: TTimer;
     ToolBar1: TToolBar;
+    ToolButton1: TToolButton;
     ToolButton2: TToolButton;
     ToolButton6: TToolButton;
@@ -40 +42 @@
     procedure AGameEndTurnExecute(Sender: TObject);
     procedure AStatusBarVisibleExecute(Sender: TObject);
+    procedure ASurrenderExecute(Sender: TObject);
     procedure AToolBarBigIconsExecute(Sender: TObject);
     procedure AToolBarVisibleExecute(Sender: TObject);
@@ -80 +83 @@
     procedure DoClientChange(Sender: TObject);
     procedure DoGameEnd(Sender: TObject);
+    procedure DoNextPlayer(Sender: TObject);
     procedure DoTurnStart(Sender: TObject);
     procedure DoMove(CellFrom, CellTo: TCell; var CountOnce,
@@ -103 +107 @@
 resourcestring
   STurn = 'turn';
+  SSurrender = 'Surrender';
+  SSurrenderQuestion = 'Do you want to surrender current game?';
 
 {$R *.lfm}
@@ -233 +239 @@
     FClient.OnDestroy := DoClientDestroy;
     FClient.OnGameEnd := DoGameEnd;
+    FClient.OnNextPlayer := DoNextPlayer;
     FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
   end;
@@ -248 +255 @@
 end;
 
+procedure TFormClient.DoNextPlayer(Sender: TObject);
+begin
+  Redraw;
+end;
+
 procedure TFormClient.DoTurnStart(Sender: TObject);
 begin
   TurnActive := True;
-  Synchronize(UpdateInterface);
-  Synchronize(Redraw);
+  UpdateInterface;
+  Redraw;
 end;
 
@@ -290 +302 @@
   ToolBar1.Visible := AToolBarVisible.Checked;
   StatusBar1.Visible := AStatusBarVisible.Checked;
-  AGameEndTurn.Enabled := TurnActive;
+  AGameEndTurn.Enabled := Assigned(Client.ControlPlayer) and
+    Client.ControlPlayer.IsAlive and TurnActive;
+  ASurrender.Enabled := Assigned(Client.ControlPlayer) and
+    Client.ControlPlayer.IsAlive;
 end;
 
@@ -339 +354 @@
   AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
   UpdateInterface;
+end;
+
+procedure TFormClient.ASurrenderExecute(Sender: TObject);
+begin
+  if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) =
+    mrYes then begin
+      Client.Protocol.Surrender;
+      UpdateInterface;
+    end;
 end;