Changeset 213
- Timestamp:
- May 24, 2018, 9:25:17 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormClient.lfm
r211 r213 52 52 object ToolButton6: TToolButton 53 53 Left = 1 54 Top = 3954 Top = 71 55 55 Action = AZoomIn 56 56 end 57 57 object ToolButton7: TToolButton 58 58 Left = 1 59 Top = 7159 Top = 103 60 60 Action = AZoomOut 61 61 end 62 62 object ToolButton8: TToolButton 63 63 Left = 1 64 Top = 1 0364 Top = 135 65 65 Action = AZoomAll 66 66 end 67 67 object ToolButton9: TToolButton 68 68 Left = 1 69 Top = 3469 Top = 66 70 70 Width = 32 71 71 AutoSize = True 72 72 Style = tbsDivider 73 end 74 object ToolButton1: TToolButton 75 Left = 1 76 Top = 34 77 Action = ASurrender 73 78 end 74 79 end … … 134 139 ShortCut = 16468 135 140 end 141 object ASurrender: TAction 142 Caption = 'Surrender' 143 ImageIndex = 4 144 OnExecute = ASurrenderExecute 145 end 136 146 end 137 147 object PopupMenuToolbar: TPopupMenu -
trunk/Forms/UFormClient.pas
r211 r213 19 19 20 20 TFormClient = class(TForm) 21 ASurrender: TAction; 21 22 AGameEndTurn: TAction; 22 23 AStatusBarVisible: TAction; … … 33 34 Timer1: TTimer; 34 35 ToolBar1: TToolBar; 36 ToolButton1: TToolButton; 35 37 ToolButton2: TToolButton; 36 38 ToolButton6: TToolButton; … … 40 42 procedure AGameEndTurnExecute(Sender: TObject); 41 43 procedure AStatusBarVisibleExecute(Sender: TObject); 44 procedure ASurrenderExecute(Sender: TObject); 42 45 procedure AToolBarBigIconsExecute(Sender: TObject); 43 46 procedure AToolBarVisibleExecute(Sender: TObject); … … 80 83 procedure DoClientChange(Sender: TObject); 81 84 procedure DoGameEnd(Sender: TObject); 85 procedure DoNextPlayer(Sender: TObject); 82 86 procedure DoTurnStart(Sender: TObject); 83 87 procedure DoMove(CellFrom, CellTo: TCell; var CountOnce, … … 103 107 resourcestring 104 108 STurn = 'turn'; 109 SSurrender = 'Surrender'; 110 SSurrenderQuestion = 'Do you want to surrender current game?'; 105 111 106 112 {$R *.lfm} … … 233 239 FClient.OnDestroy := DoClientDestroy; 234 240 FClient.OnGameEnd := DoGameEnd; 241 FClient.OnNextPlayer := DoNextPlayer; 235 242 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height)); 236 243 end; … … 248 255 end; 249 256 257 procedure TFormClient.DoNextPlayer(Sender: TObject); 258 begin 259 Redraw; 260 end; 261 250 262 procedure TFormClient.DoTurnStart(Sender: TObject); 251 263 begin 252 264 TurnActive := True; 253 Synchronize(UpdateInterface);254 Synchronize(Redraw);265 UpdateInterface; 266 Redraw; 255 267 end; 256 268 … … 290 302 ToolBar1.Visible := AToolBarVisible.Checked; 291 303 StatusBar1.Visible := AStatusBarVisible.Checked; 292 AGameEndTurn.Enabled := TurnActive; 304 AGameEndTurn.Enabled := Assigned(Client.ControlPlayer) and 305 Client.ControlPlayer.IsAlive and TurnActive; 306 ASurrender.Enabled := Assigned(Client.ControlPlayer) and 307 Client.ControlPlayer.IsAlive; 293 308 end; 294 309 … … 339 354 AStatusBarVisible.Checked := not AStatusBarVisible.Checked; 340 355 UpdateInterface; 356 end; 357 358 procedure TFormClient.ASurrenderExecute(Sender: TObject); 359 begin 360 if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) = 361 mrYes then begin 362 Client.Protocol.Surrender; 363 UpdateInterface; 364 end; 341 365 end; 342 366 -
trunk/Languages/xtactics.cs.po
r208 r213 9 9 "MIME-Version: 1.0\n" 10 10 "Content-Transfer-Encoding: 8bit\n" 11 "X-Generator: Poedit 1.8.8\n"11 "X-Generator: Poedit 2.0.6\n" 12 12 "Language: cs\n" 13 13 … … 161 161 msgid "Statusbar visible" 162 162 msgstr "Viditelná stavová lišta" 163 164 #: tformclient.asurrender.caption 165 msgctxt "tformclient.asurrender.caption" 166 msgid "Surrender" 167 msgstr "Vzdát se" 163 168 164 169 #: tformclient.atoolbarbigicons.caption … … 804 809 msgid "Win objective cells" 805 810 msgstr "Buňky cíle vítězství" 811 812 #: uformclient.ssurrender 813 msgctxt "uformclient.ssurrender" 814 msgid "Surrender" 815 msgstr "Vzdát se" 816 817 #: uformclient.ssurrenderquestion 818 msgid "Do you want to surrender current game?" 819 msgstr "Chcete vzdát aktuální hru?" 806 820 807 821 #: uformclient.sturn -
trunk/Languages/xtactics.po
r208 r213 152 152 msgstr "" 153 153 154 #: tformclient.asurrender.caption 155 msgctxt "tformclient.asurrender.caption" 156 msgid "Surrender" 157 msgstr "" 158 154 159 #: tformclient.atoolbarbigicons.caption 155 160 msgctxt "tformclient.atoolbarbigicons.caption" … … 788 793 msgctxt "uformcharts.swinobjectivecells" 789 794 msgid "Win objective cells" 795 msgstr "" 796 797 #: uformclient.ssurrender 798 msgctxt "uformclient.ssurrender" 799 msgid "Surrender" 800 msgstr "" 801 802 #: uformclient.ssurrenderquestion 803 msgid "Do you want to surrender current game?" 790 804 msgstr "" 791 805 -
trunk/UClientAI.pas
r203 r213 13 13 TComputer = class(TClient) 14 14 protected 15 procedure DoTurnStart (Sender: TObject); override;15 procedure DoTurnStart; override; 16 16 public 17 17 //Targets: TFPGObjectList<TPlayer>; … … 31 31 { TComputer } 32 32 33 procedure TComputer.DoTurnStart (Sender: TObject);33 procedure TComputer.DoTurnStart; 34 34 begin 35 35 Process; -
trunk/UCore.lfm
r211 r213 4 4 OldCreateOrder = False 5 5 Height = 811 6 HorizontalOffset = 3147 VerticalOffset = 2446 HorizontalOffset = 423 7 VerticalOffset = 374 8 8 Width = 1258 9 9 PPI = 144 -
trunk/UCore.pas
r211 r213 45 45 procedure AExitExecute(Sender: TObject); 46 46 procedure AGameEndExecute(Sender: TObject); 47 procedure AGameEndTurnExecute(Sender: TObject);48 47 procedure AGameLoadExecute(Sender: TObject); 49 48 procedure AGameNewExecute(Sender: TObject); … … 96 95 procedure SaveConfig; 97 96 procedure Spectate(Player: TPlayer); 98 procedure Update Actions;97 procedure UpdateInterface; 99 98 procedure ScaleDPI; 100 99 procedure Init; … … 250 249 end; 251 250 252 procedure TCore.Update Actions;251 procedure TCore.UpdateInterface; 253 252 begin 254 253 Core.AGameEnd.Enabled := Core.Game.Running; … … 276 275 Game.Running := False; 277 276 Server.GameEnd; 278 UpdateActions; 279 end; 280 end; 281 282 procedure TCore.AGameEndTurnExecute(Sender: TObject); 283 begin 284 277 UpdateInterface; 278 end; 285 279 end; 286 280 … … 302 296 FormNew.PageControl1.TabIndex := FormNewTabIndex; 303 297 if FormNew.ShowModal = mrOk then begin 298 Game.Running := False; 304 299 FormNew.Save(Server); 305 300 Game.Assign(GameSettings); … … 369 364 Game.SaveConfig(XMLConfig1, 'Game'); 370 365 Server.SaveConfig(XMLConfig1, 'Server'); 366 XMLConfig1.Flush; 371 367 end; 372 368 finally … … 457 453 // Create local LocalClients for human players 458 454 LocalClients.Clear; 455 FormClient.Client := nil; 459 456 for Player in Game.Players do 460 457 with Player do … … 484 481 SelectClient; 485 482 LastOpenedList1.AddItem(FileName); 486 with FormClient.Client do487 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0),488 TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height));489 483 FormClient.AZoomAll.Execute; 490 484 UpdateOtherForms; 491 Update Actions;485 UpdateInterface; 492 486 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer); 493 487 if Assigned(ServerClient) then ServerClient.TurnStart … … 507 501 I: Integer; 508 502 begin 503 // Copy all actions from docked form to main form so keyboard shortcuts will be active 509 504 for I := 0 to FormClient.ActionList1.ActionCount - 1 do begin 510 505 Action := TAction.Create(FormMain); … … 539 534 // Create local LocalClients for human players 540 535 LocalClients.Clear; 536 FormClient.Client := nil; 541 537 for Player in Game.Players do 542 538 with Player do … … 569 565 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount])); 570 566 UpdateOtherForms; 571 Update Actions;567 UpdateInterface; 572 568 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer); 573 569 if Assigned(ServerClient) then ServerClient.TurnStart … … 580 576 ServerClient: TServerClient; 581 577 begin 578 Application.ProcessMessages; 579 Server.NextPlayer; 582 580 if Assigned(Game.CurrentPlayer) then begin 583 581 if Game.CurrentPlayer.Mode = pmHuman then begin -
trunk/UGame.pas
r211 r213 331 331 function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove; 332 332 procedure Reset; 333 procedure Surrender; 333 334 function IsAlive: Boolean; 334 335 procedure Clear; … … 2526 2527 end; 2527 2528 2529 procedure TPlayer.Surrender; 2530 var 2531 I: Integer; 2532 begin 2533 Moves.Clear; 2534 for I := 0 to PlayerMap.Cells.Count - 1 do 2535 if PlayerMap.Cells[I].MapCell.Player = Self then 2536 PlayerMap.Cells[I].MapCell.Player := nil; 2537 end; 2538 2528 2539 function TPlayer.IsAlive: Boolean; 2529 2540 begin -
trunk/UGameClient.pas
r211 r213 6 6 7 7 uses 8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread; 8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread, 9 UThreading, UCommFrame; 9 10 10 11 type … … 22 23 FOnDestroy: TNotifyEvent; 23 24 FOnGameEnd: TNotifyEvent; 25 FOnNextPlayer: TNotifyEvent; 24 26 FOnReceive: TCommandEvent; 25 27 FOnMove: TMoveEvent; 26 28 FOnTurnStart: TNotifyEvent; 27 29 CommThread: TCommThread; 30 CommFrame: TCommFrame; 28 31 procedure SetActive(AValue: Boolean); 29 32 procedure SetControlPlayer(AValue: TPlayer); … … 35 38 protected 36 39 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual; 37 procedure DoTurnStart(Sender: TObject); virtual; 38 procedure DoGameEnd(Sender: TObject); 40 procedure DoTurnStartHandler(Sender: TObject); virtual; 41 procedure DoTurnStart; virtual; 42 procedure DoGameEndHandler(Sender: TObject); 43 procedure DoGameEnd; 44 procedure DoNextPlayerHandler(Sender: TObject); 45 procedure DoNextPlayer; 39 46 public 40 47 Name: string; … … 51 58 property Game: TGame read FGame write SetGame; 52 59 property Form: TForm read FForm write SetForm; 60 property Active: Boolean read FActive write SetActive; 53 61 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; 54 62 property OnMove: TMoveEvent read FOnMove write SetOnMove; … … 57 65 property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart; 58 66 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd; 59 property Active: Boolean read FActive write SetActive;67 property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer; 60 68 end; 61 69 … … 133 141 end; 134 142 135 procedure TClient.DoTurnStart(Sender: TObject); 143 procedure TClient.DoTurnStartHandler(Sender: TObject); 144 begin 145 Synchronize(DoTurnStart); 146 end; 147 148 procedure TClient.DoTurnStart; 136 149 begin 137 150 if Assigned(FOnTurnStart) then … … 139 152 end; 140 153 141 procedure TClient.DoGameEnd(Sender: TObject); 142 begin 143 if Assigned(FOnGameEnd) then 144 FOnGameEnd(Self); 154 procedure TClient.DoGameEndHandler(Sender: TObject); 155 begin 156 Synchronize(DoGameEnd); 157 end; 158 159 procedure TClient.DoGameEnd; 160 begin 161 if Assigned(FOnGameEnd) then FOnGameEnd(Self); 162 end; 163 164 procedure TClient.DoNextPlayerHandler(Sender: TObject); 165 begin 166 Synchronize(DoNextPlayer); 167 end; 168 169 procedure TClient.DoNextPlayer; 170 begin 171 if Assigned(FOnNextPlayer) then FOnNextPlayer(Self); 145 172 end; 146 173 … … 174 201 case ConnectType of 175 202 ctLocal: if LocalServer.Active then begin 203 CommFrame.FrameDataPin.Connect(Protocol.Pin); 204 CommFrame.RawDataPin.Connect(CommThread.Pin); 176 205 CommThread.Active := True; 177 Comm Thread.Pin.Connect(Protocol.Pin);206 CommFrame.Active := True; 178 207 ServerClient := LocalServer.GetNewServerClient; 179 208 ServerClient.Player := ControlPlayer; 180 ServerClient. Protocol.Pin.Connect(CommThread.Ext);209 ServerClient.CommFrame.RawDataPin.Connect(CommThread.Ext); 181 210 end else raise Exception.Create('Local server is not active'); 182 211 //ctNetwork: ; … … 196 225 begin 197 226 CommThread := TCommThread.Create(nil); 227 CommFrame := TCommFrame.Create(nil); 198 228 FControlPlayer := nil; 199 229 View := TView.Create; 200 230 Protocol := TGameProtocolClient.Create; 201 Protocol.OnTurnStart := DoTurnStart; 202 Protocol.OnGameEnd := DoGameEnd; 231 Protocol.OnTurnStart := DoTurnStartHandler; 232 Protocol.OnGameEnd := DoGameEndHandler; 233 Protocol.OnNextPlayer := DoNextPlayerHandler; 203 234 end; 204 235 … … 210 241 FreeAndNil(Protocol); 211 242 FreeAndNil(CommThread); 243 FreeAndNil(CommFrame); 212 244 inherited Destroy; 213 245 end; -
trunk/UGameProtocol.pas
r203 r213 6 6 7 7 uses 8 Classes, SysUtils, UGame, UVarBlockSerializer, UCommPin, SpecializedList; 8 Classes, SysUtils, UGame, UVarBlockSerializer, UCommPin, SpecializedList, 9 UCommFrame; 9 10 10 11 type 11 TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd); 12 TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd, 13 cmdSurrender, cmdNextPlayer); 12 14 TCommandEvent = procedure (Command: TCommand; DataIn, DataOut: TStream); 13 15 … … 22 24 FOnGameEnd: TNotifyEvent; 23 25 FOnGameStart: TNotifyEvent; 26 FOnNextPlayer: TNotifyEvent; 24 27 FOnTurnStart: TNotifyEvent; 25 28 procedure Receive(Sender: TCommPin; Stream: TListByte); … … 28 31 Pin: TCommPin; 29 32 procedure TurnEnd; 33 procedure Surrender; 30 34 procedure SendMessage(Text: string); 31 35 constructor Create; 32 36 destructor Destroy; override; 33 property OnGameStart: TNotifyEvent read FOnGameStart 34 write FOnGameStart; 35 property OnGameEnd: TNotifyEvent read FOnGameEnd 36 write FOnGameEnd; 37 property OnTurnStart: TNotifyEvent read FOnTurnStart 38 write FOnTurnStart; 37 property OnGameStart: TNotifyEvent read FOnGameStart write FOnGameStart; 38 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd; 39 property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart; 40 property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer; 39 41 end; 40 42 … … 46 48 private 47 49 FOnSendMessage: TSendMessageEvent; 50 FOnSurrender: TNotifyEvent; 48 51 FOnTurnEnd: TNotifyEvent; 52 CommFrame: TCommFrame; 49 53 procedure Receive(Sender: TCommPin; Stream: TListByte); 50 54 procedure SendCmd(Command: TCommand); … … 56 60 procedure GameEnd; 57 61 procedure TurnStart; 62 procedure NextPlayer; 58 63 property OnSendMessage: TSendMessageEvent read FOnSendMessage 59 64 write FOnSendMessage; 60 property OnTurnEnd: TNotifyEvent read FOnTurnEnd 61 write FOnTurnEnd;65 property OnTurnEnd: TNotifyEvent read FOnTurnEnd write FOnTurnEnd; 66 property OnSurrender: TNotifyEvent read FOnSurrender write FOnSurrender; 62 67 end; 63 68 … … 82 87 if Command = Integer(cmdTurnEnd) then begin 83 88 if Assigned(FOnTurnEnd) then FOnTurnEnd(Self); 89 end else 90 if Command = Integer(cmdSurrender) then begin 91 if Assigned(FOnSurrender) then FOnSurrender(Self); 84 92 end; 85 93 finally … … 133 141 end; 134 142 143 procedure TGameProtocolServer.NextPlayer; 144 begin 145 SendCmd(cmdNextPlayer); 146 end; 147 135 148 { TGameProtocol } 136 149 … … 153 166 if Command = Integer(cmdTurnStart) then begin 154 167 if Assigned(FOnTurnStart) then FOnTurnStart(Self); 168 end else 169 if Command = Integer(cmdNextPlayer) then begin 170 if Assigned(FOnNextPlayer) then FOnNextPlayer(Self); 155 171 end; 156 172 finally … … 180 196 begin 181 197 SendCmd(cmdTurnEnd); 198 end; 199 200 procedure TGameProtocolClient.Surrender; 201 begin 202 SendCmd(cmdSurrender); 182 203 end; 183 204 -
trunk/UGameServer.pas
r211 r213 6 6 7 7 uses 8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol ;8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame; 9 9 10 10 type … … 15 15 TServerClient = class 16 16 private 17 FOnReceiveCmd: TCommandEvent;18 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);19 17 procedure DoTurnEnd(Sender: TObject); 18 procedure DoSurrender(Sender: TObject); 20 19 public 21 20 Game: TGame; 22 21 Protocol: TGameProtocolServer; 23 22 Player: TPlayer; 23 CommFrame: TCommFrame; 24 24 procedure DoChange; 25 procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream);26 25 procedure TurnStart; 27 26 procedure GameEnd; 28 property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write 29 FOnReceiveCmd; 27 procedure NextPlayer; 30 28 constructor Create; 31 29 destructor Destroy; override; … … 62 60 procedure InitClients; 63 61 procedure GameEnd; 62 procedure NextPlayer; 64 63 procedure Clear; 65 64 constructor Create; … … 94 93 end; 95 94 96 procedure TServerClient.SendCmd(Command: TCommand; DataOut, DataIn: TStream);97 begin98 99 end;100 101 95 procedure TServerClient.TurnStart; 102 96 begin … … 109 103 end; 110 104 105 procedure TServerClient.NextPlayer; 106 begin 107 Protocol.NextPlayer; 108 end; 109 111 110 constructor TServerClient.Create; 112 111 begin 112 CommFrame := TCommFrame.Create(nil); 113 113 Protocol := TGameProtocolServer.Create; 114 114 Protocol.OnTurnEnd := DoTurnEnd; 115 Protocol.OnSurrender := DoSurrender; 116 Protocol.Pin.Connect(CommFrame.FrameDataPin); 115 117 end; 116 118 … … 118 120 begin 119 121 Protocol.Free; 122 CommFrame.Free; 120 123 inherited Destroy; 121 124 end; 122 125 123 procedure TServerClient.ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);124 begin125 if Assigned(FOnReceiveCmd) then126 FOnReceiveCmd(Command, DataOut, DataIn);127 end;128 129 126 procedure TServerClient.DoTurnEnd(Sender: TObject); 130 127 begin 128 if Game.Running then Game.NextPlayer; 129 end; 130 131 procedure TServerClient.DoSurrender(Sender: TObject); 132 begin 133 Player.Surrender; 131 134 if Game.Running then Game.NextPlayer; 132 135 end; … … 249 252 end; 250 253 254 procedure TServer.NextPlayer; 255 var 256 I: Integer; 257 begin 258 for I := 0 to Clients.Count - 1 do 259 Clients[I].NextPlayer; 260 end; 261 251 262 procedure TServer.Clear; 252 263 begin -
trunk/xtactics.lpi
r206 r213 104 104 </Item7> 105 105 </RequiredPackages> 106 <Units Count=" 29">106 <Units Count="30"> 107 107 <Unit0> 108 108 <Filename Value="xtactics.lpr"/> … … 266 266 <ResourceBaseClass Value="Form"/> 267 267 </Unit28> 268 <Unit29> 269 <Filename Value="Packages/PinConnection/UCommFrame.pas"/> 270 <IsPartOfProject Value="True"/> 271 </Unit29> 268 272 </Units> 269 273 </ProjectOptions>
Note:
See TracChangeset
for help on using the changeset viewer.