Changeset 211
- Timestamp:
- May 23, 2018, 8:53:58 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormClient.lfm
r206 r211 7 7 ClientHeight = 621 8 8 ClientWidth = 775 9 DesignTimePPI = 1 209 DesignTimePPI = 144 10 10 OnClose = FormClose 11 11 OnCreate = FormCreate … … 17 17 object StatusBar1: TStatusBar 18 18 Left = 0 19 Height = 2820 Top = 59 319 Height = 30 20 Top = 591 21 21 Width = 775 22 22 Panels = < … … 34 34 object ToolBar1: TToolBar 35 35 Left = 0 36 Height = 59 336 Height = 591 37 37 Top = 0 38 38 Width = 32 … … 75 75 object PaintBox1: TPaintBox 76 76 Left = 32 77 Height = 59 377 Height = 591 78 78 Top = 0 79 79 Width = 743 -
trunk/Forms/UFormClient.pas
r207 r211 79 79 procedure SetClient(AValue: TClient); 80 80 procedure DoClientChange(Sender: TObject); 81 procedure DoGameEnd(Sender: TObject); 81 82 procedure DoTurnStart(Sender: TObject); 82 83 procedure DoMove(CellFrom, CellTo: TCell; var CountOnce, … … 231 232 FClient.OnTurnStart := DoTurnStart; 232 233 FClient.OnDestroy := DoClientDestroy; 234 FClient.OnGameEnd := DoGameEnd; 233 235 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height)); 234 236 end; … … 237 239 238 240 procedure TFormClient.DoClientChange(Sender: TObject); 241 begin 242 Redraw; 243 end; 244 245 procedure TFormClient.DoGameEnd(Sender: TObject); 239 246 begin 240 247 Redraw; … … 245 252 TurnActive := True; 246 253 Synchronize(UpdateInterface); 254 Synchronize(Redraw); 247 255 end; 248 256 -
trunk/UCore.lfm
r207 r211 3 3 OnDestroy = DataModuleDestroy 4 4 OldCreateOrder = False 5 Height = 6766 HorizontalOffset = 2627 VerticalOffset = 2 038 Width = 1 0489 PPI = 1 205 Height = 811 6 HorizontalOffset = 314 7 VerticalOffset = 244 8 Width = 1258 9 PPI = 144 10 10 object ActionListMain: TActionList 11 11 Images = ImageListSmall 12 left = 1 1413 top = 5012 left = 137 13 top = 60 14 14 object AExit: TAction 15 15 Caption = 'Exit' … … 101 101 end 102 102 object ImageListSmall: TImageList 103 left = 655104 top = 350103 left = 786 104 top = 420 105 105 Bitmap = { 106 106 4C690C00000010000000100000000000000000000000E3AA4BD6E5B35EFFE3B1 … … 494 494 POFilesFolder = 'Languages' 495 495 OnTranslate = CoolTranslator1Translate 496 left = 1 14497 top = 363496 left = 137 497 top = 436 498 498 end 499 499 object ImageListLarge: TImageList 500 500 Height = 32 501 501 Width = 32 502 left = 655503 top = 2 38502 left = 786 503 top = 286 504 504 Bitmap = { 505 505 4C690C0000002000000020000000000000000000000000000000E2AA4B36E2A9 … … 2046 2046 RootName = 'CONFIG' 2047 2047 ReadOnly = False 2048 left = 1 142049 top = 4632048 left = 137 2049 top = 556 2050 2050 end 2051 2051 object OpenDialog1: TOpenDialog 2052 2052 DefaultExt = '.xtmap' 2053 left = 9382054 top = 2 432053 left = 1126 2054 top = 292 2055 2055 end 2056 2056 object SaveDialog1: TSaveDialog 2057 2057 DefaultExt = '.xtmap' 2058 left = 9382059 top = 1 382058 left = 1126 2059 top = 166 2060 2060 end 2061 2061 object ApplicationInfo: TApplicationInfo … … 2074 2074 RegistryRoot = rrKeyCurrentUser 2075 2075 License = 'CC0' 2076 left = 1 142077 top = 1 502076 left = 137 2077 top = 180 2078 2078 end 2079 2079 object PersistentForm: TPersistentForm 2080 2080 MinVisiblePart = 50 2081 2081 EntireVisible = False 2082 left = 6502083 top = 5002082 left = 780 2083 top = 600 2084 2084 end 2085 2085 object ScaleDPI1: TScaleDPI 2086 2086 AutoDetect = False 2087 left = 1 132088 top = 5632087 left = 136 2088 top = 676 2089 2089 end 2090 2090 object LastOpenedList1: TLastOpenedList 2091 2091 MaxCount = 10 2092 2092 OnChange = LastOpenedList1Change 2093 left = 1 142094 top = 2502093 left = 137 2094 top = 300 2095 2095 end 2096 2096 end -
trunk/UCore.pas
r207 r211 70 70 procedure LoadRecentExecute(Sender: TObject); 71 71 procedure StartNewGame; 72 procedure LoadGame(FileName: string); 72 73 procedure DoPlayerChange(Sender: TObject); 73 74 procedure DoMoveUpdated(UnitMove: TUnitMove); … … 78 79 procedure CommandLineParams; 79 80 procedure SelectClient; 80 procedure LoadGame(FileName: string);81 procedure RedrawClients;82 81 procedure UpdateOtherForms; 83 82 procedure FormClientActions; … … 139 138 I: Integer; 140 139 begin 141 RedrawClients;140 Server.GameEnd; 142 141 if Assigned(Player) then 143 142 ShowMessage(Format(SPlayerWins, [Player.Name])) … … 276 275 if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin 277 276 Game.Running := False; 278 RedrawClients;277 Server.GameEnd; 279 278 UpdateActions; 280 279 end; … … 489 488 TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height)); 490 489 FormClient.AZoomAll.Execute; 491 RedrawClients;492 490 UpdateOtherForms; 493 491 UpdateActions; … … 495 493 if Assigned(ServerClient) then ServerClient.TurnStart 496 494 else raise Exception.Create(SMissingServerClientForPlayer); 497 end;498 499 procedure TCore.RedrawClients;500 var501 Form: TFormClient;502 begin503 for Form in FormClients do504 Form.Redraw;505 FormClient.Redraw;506 495 end; 507 496 … … 579 568 if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True 580 569 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount])); 581 FormClient.AZoomAll.Execute;582 RedrawClients;583 570 UpdateOtherForms; 584 571 UpdateActions; … … 594 581 begin 595 582 if Assigned(Game.CurrentPlayer) then begin 596 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer); 597 if Assigned(PlayerClient) then FormClient.Client := PlayerClient; 583 if Game.CurrentPlayer.Mode = pmHuman then begin 584 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer); 585 if Assigned(PlayerClient) then FormClient.Client := PlayerClient; 586 end; 598 587 599 588 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer); -
trunk/UGame.pas
r210 r211 3176 3176 // Select new player from alive players 3177 3177 AlivePlayers := TPlayers.Create(False); 3178 Players.GetAlivePlayers(AlivePlayers); 3179 NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1; 3180 if NewPlayerIndex >= AlivePlayers.Count then begin 3181 // Start of turn 3182 Inc(TurnCounter); 3183 RecordTurnStats; 3184 if Assigned(FOnNewTurn) then 3185 FOnNewTurn(Self); 3186 NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count; 3187 end; 3188 CurrentPlayer := AlivePlayers[NewPlayerIndex]; 3178 try 3179 Players.GetAlivePlayers(AlivePlayers); 3180 NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1; 3181 if NewPlayerIndex >= AlivePlayers.Count then begin 3182 // Start of turn 3183 Inc(TurnCounter); 3184 RecordTurnStats; 3185 if Assigned(FOnNewTurn) then 3186 FOnNewTurn(Self); 3187 NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count; 3188 end; 3189 CurrentPlayer := AlivePlayers[NewPlayerIndex]; 3190 finally 3191 AlivePlayers.Free; 3192 end; 3189 3193 3190 3194 if Assigned(FOnPlayerChange) then -
trunk/UGameClient.pas
r205 r211 21 21 FOnChange: TNotifyEvent; 22 22 FOnDestroy: TNotifyEvent; 23 FOnGameEnd: TNotifyEvent; 23 24 FOnReceive: TCommandEvent; 24 25 FOnMove: TMoveEvent; … … 35 36 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual; 36 37 procedure DoTurnStart(Sender: TObject); virtual; 38 procedure DoGameEnd(Sender: TObject); 37 39 public 38 40 Name: string; … … 54 56 property OnChange: TNotifyEvent read FOnChange write FOnChange; 55 57 property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart; 58 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd; 56 59 property Active: Boolean read FActive write SetActive; 57 60 end; … … 134 137 if Assigned(FOnTurnStart) then 135 138 FOnTurnStart(Self); 139 end; 140 141 procedure TClient.DoGameEnd(Sender: TObject); 142 begin 143 if Assigned(FOnGameEnd) then 144 FOnGameEnd(Self); 136 145 end; 137 146 … … 191 200 Protocol := TGameProtocolClient.Create; 192 201 Protocol.OnTurnStart := DoTurnStart; 202 Protocol.OnGameEnd := DoGameEnd; 193 203 end; 194 204 -
trunk/UGameServer.pas
r203 r211 25 25 procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream); 26 26 procedure TurnStart; 27 procedure GameEnd; 27 28 property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write 28 29 FOnReceiveCmd; … … 60 61 procedure SaveConfig(Config: TXmlConfig; Path: string); 61 62 procedure InitClients; 63 procedure GameEnd; 62 64 procedure Clear; 63 65 constructor Create; … … 100 102 begin 101 103 Protocol.TurnStart; 104 end; 105 106 procedure TServerClient.GameEnd; 107 begin 108 Protocol.GameEnd; 102 109 end; 103 110 … … 234 241 end; 235 242 243 procedure TServer.GameEnd; 244 var 245 I: Integer; 246 begin 247 for I := 0 to Clients.Count - 1 do 248 Clients[I].GameEnd; 249 end; 250 236 251 procedure TServer.Clear; 237 252 begin
Note:
See TracChangeset
for help on using the changeset viewer.