Changeset 125
- Timestamp:
- Jun 17, 2017, 2:24:51 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.lfm
r111 r125 14 14 OnKeyUp = FormKeyUp 15 15 OnShow = FormShow 16 LCLVersion = '1.6. 0.4'16 LCLVersion = '1.6.4.0' 17 17 WindowState = wsMaximized 18 18 object StatusBar1: TStatusBar -
trunk/Forms/UFormMain.pas
r111 r125 131 131 begin 132 132 DrawStart := Now; 133 if Assigned(Core. Player) then134 with Core. Playerdo begin133 if Assigned(Core.CurrentClient) then 134 with Core.CurrentClient do begin 135 135 View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height); 136 136 if csOpaque in PaintBox1.ControlStyle then begin … … 138 138 TempBitmap.Canvas.Brush.Color := clBackground; //PaintBox1.GetColorResolvingParent; 139 139 TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height); 140 Paint(TempBitmap.Canvas); 140 if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View) 141 else Core.Game.Map.Paint(TempBitmap.Canvas, View); 141 142 PaintBox1.Canvas.Draw(0, 0, TempBitmap); 142 143 end else begin … … 145 146 PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height); 146 147 {$endif} 147 Paint(PaintBox1.Canvas); 148 if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View) 149 else Core.Game.Map.Paint(PaintBox1.Canvas, View); 148 150 end; 149 151 end; … … 158 160 procedure TFormMain.PaintBox1Resize(Sender: TObject); 159 161 begin 160 if Assigned(Core. Player) then161 with Core. Playerdo162 if Assigned(Core.CurrentClient) then 163 with Core.CurrentClient do 162 164 View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height); 163 165 Redraw; … … 251 253 NewZoom: Single; 252 254 begin 253 with Core, Game, Player, View do begin255 with Core, Game, CurrentClient, View do begin 254 256 MapRect := Map.GetPixelRect; 255 257 Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left), … … 284 286 procedure TFormMain.AZoomInExecute(Sender: TObject); 285 287 begin 286 with Core. Playerdo begin288 with Core.CurrentClient do begin 287 289 View.Zoom := View.Zoom * ZoomFactor; 288 290 end; … … 294 296 D: TPoint; 295 297 begin 296 with Core. Playerdo begin298 with Core.CurrentClient do begin 297 299 //D := Point(Trunc(MousePos.X - View.Left / ViewZoom), 298 300 // Trunc(MousePos.Y - View.Top / ViewZoom)); … … 323 325 if (Key = 27) or (Key = 17) then 324 326 if Assigned(Core.Game.CurrentPlayer) then begin 325 Core. Game.CurrentPlayer.View.SelectedCell := nil;327 Core.CurrentClient.View.SelectedCell := nil; 326 328 Redraw; 327 329 end; … … 341 343 begin 342 344 if Button = mbLeft then begin 343 if Core.Game.CurrentPlayer.Mode = pmHumanthen begin345 if Assigned(Core.CurrentClient) then begin 344 346 StartMousePoint := Point(X, Y); 345 StartViewPoint := Core. Game.CurrentPlayer.View.SourceRect.TopLeft;347 StartViewPoint := Core.CurrentClient.View.SourceRect.TopLeft; 346 348 MoveActive := True; 347 349 end; … … 361 363 CellPos: TPoint; 362 364 begin 363 if Assigned(Core. Game.CurrentPlayer) then begin365 if Assigned(Core.CurrentClient) then begin 364 366 if MoveActive then 365 367 if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or 366 368 (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then 367 with Core.Game.CurrentPlayer do begin 368 if Mode = pmHuman then begin 369 View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom), 370 Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom), 371 View.SourceRect.Right - View.SourceRect.Left, 372 View.SourceRect.Bottom - View.SourceRect.Top); 373 Redraw; 374 end; 369 with Core.Game.CurrentPlayer, Core.CurrentClient do begin 370 View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom), 371 Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom), 372 View.SourceRect.Right - View.SourceRect.Left, 373 View.SourceRect.Bottom - View.SourceRect.Top); 374 Redraw; 375 375 end; 376 376 Cell := nil; 377 OldCell := Core. Game.CurrentPlayer.View.FocusedCell;377 OldCell := Core.CurrentClient.View.FocusedCell; 378 378 with Core.Game do 379 Cell := Map.PosToCell(C urrentPlayer.View.CanvasToCellPos(Point(X, Y)), CurrentPlayer.View );379 Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(Point(X, Y)), Core.CurrentClient.View ); 380 380 if Assigned(Cell) then begin 381 Core. Game.CurrentPlayer.View.FocusedCell := Cell;381 Core.CurrentClient.View.FocusedCell := Cell; 382 382 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) + 383 383 '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')'; 384 384 end else begin 385 Core. Game.CurrentPlayer.View.FocusedCell := nil;385 Core.CurrentClient.View.FocusedCell := nil; 386 386 StatusBar1.Panels[0].Text := ''; 387 387 end; 388 CellPos := Core. Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));388 CellPos := Core.CurrentClient.View.CanvasToCellPos(Point(X, Y)); 389 389 StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y); 390 390 if Cell <> OldCell then Redraw; … … 398 398 (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin 399 399 if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin 400 Core. Game.CurrentPlayer.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);400 Core.CurrentClient.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift); 401 401 Redraw; 402 402 end; -
trunk/Forms/UFormNew.pas
r102 r125 241 241 ReloadView; 242 242 //Height := Trunc(1.5 * Height); 243 PageControl1.TabIndex := 0; 243 244 end; 244 245 -
trunk/Languages/xtactics.cs.po
r115 r125 104 104 105 105 #: tformabout.labelcontent.caption 106 #, fuzzy107 106 msgctxt "tformabout.labelcontent.caption" 108 107 msgid " " … … 480 479 #: uformabout.slicense 481 480 msgid "License" 482 msgstr " "481 msgstr "Licence" 483 482 484 483 #: uformabout.sreleasedate … … 618 617 msgid "Zero zoom not allowed" 619 618 msgstr "Nulové přiblížení není povoleno" 620 -
trunk/UCore.pas
r122 r125 52 52 StoredDimension: TControlDimension; 53 53 RegistryContext: TRegistryContext; 54 procedure DoPlayerChange(Sender: TObject); 54 55 procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce, 55 56 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean); … … 58 59 procedure GameNewTurnExecute(Sender: TObject); 59 60 procedure AutoSave; 61 function GetPlayer: TPlayer; 60 62 procedure LoadConfig; 61 63 procedure SaveConfig; 62 64 procedure CommandLineParams; 63 65 procedure ScaleDPI; 66 procedure SelectClient; 64 67 public 65 68 Game: TGame; 66 Player: TPlayer;67 69 UseSingleView: Boolean; 68 70 DevelMode: Boolean; … … 70 72 AnimationSpeed: Integer; 71 73 AutoSaveEnabled: Boolean; 74 CurrentClient: TClient; 72 75 procedure UpdateActions; 73 76 procedure Init; … … 160 163 end; 161 164 165 function TCore.GetPlayer: TPlayer; 166 begin 167 Result := Game.CurrentPlayer; 168 end; 169 162 170 procedure TCore.LoadConfig; 163 171 begin … … 196 204 if FileExists(FileName) then begin 197 205 Game.LoadFromFile(FileName); 198 Player := Game.Players.GetFirstHuman;206 SelectClient; 199 207 LastMapFileName := OpenDialog1.FileName; 200 with Core. Game.CurrentPlayerdo208 with Core.CurrentClient do 201 209 View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height); 202 210 FormMain.AZoomAll.Execute; … … 226 234 end; 227 235 {$endif} 236 end; 237 238 procedure TCore.SelectClient; 239 var 240 FirstHuman: TPlayer; 241 begin 242 FirstHuman := Game.Players.GetFirstHuman; 243 if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client 244 else CurrentClient := TClient(Game.Clients.First); 228 245 end; 229 246 … … 289 306 if OpenDialog1.Execute then begin 290 307 Game.LoadFromFile(OpenDialog1.FileName); 291 Player := Game.Players.GetFirstHuman;308 SelectClient; 292 309 LastMapFileName := OpenDialog1.FileName; 293 with Core. Game.CurrentPlayerdo310 with Core.CurrentClient do 294 311 View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height); 295 312 FormMain.AZoomAll.Execute; … … 304 321 FormNew.Save(Game); 305 322 Game.New; 306 Player := Game.Players.GetFirstHuman;323 SelectClient; 307 324 Game.Running := True; 308 325 FormMain.AZoomAll.Execute; … … 365 382 Game.OnWin := DoOnWin; 366 383 Game.OnNewTurn := GameNewTurnExecute; 384 Game.OnPlayerChange := DoPlayerChange; 367 385 StoredDimension := TControlDimension.Create; 368 386 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; … … 376 394 SaveConfig; 377 395 FreeAndNil(Game); 396 end; 397 398 procedure TCore.DoPlayerChange(Sender: TObject); 399 begin 400 if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then 401 CurrentClient := Game.CurrentPlayer.Client; 378 402 end; 379 403 … … 389 413 FInitialized := True; 390 414 LoadConfig; 391 for I := 0 to Game. Players.Count - 1 do392 T Player(Game.Players[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,415 for I := 0 to Game.Clients.Count - 1 do 416 TClient(Game.Clients[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width, 393 417 FormMain.PaintBox1.Height); 394 418 Game.LoadConfig(XMLConfig1, 'Game'); … … 399 423 if Game.FileName = '' then begin 400 424 Game.New; 401 Player := Game.Players.GetFirstHuman;425 SelectClient; 402 426 Game.Running := True; 403 427 FormMain.AZoomAll.Execute; -
trunk/UGame.pas
r115 r125 28 28 TCellLinks = class; 29 29 TMapArea = class; 30 TClient = class; 30 31 31 32 TFloatPoint = record … … 248 249 TPlayer = class 249 250 private 251 FClient: TClient; 250 252 FGame: TGame; 253 procedure SetClient(AValue: TClient); 251 254 procedure SetGame(AValue: TGame); 252 255 public … … 254 257 Name: string; 255 258 Color: TColor; 256 View: TView;257 259 Mode: TPlayerMode; 258 260 TotalUnits: Integer; … … 266 268 procedure LoadFromNode(Node: TDOMNode); 267 269 procedure SaveToNode(Node: TDOMNode); 268 procedure Paint(Canvas: TCanvas );270 procedure Paint(Canvas: TCanvas; View: TView); 269 271 constructor Create; 270 272 destructor Destroy; override; 271 273 procedure Assign(Source: TPlayer); 272 274 property Game: TGame read FGame write SetGame; 275 property Client: TClient read FClient write SetClient; 273 276 end; 274 277 … … 333 336 end; 334 337 338 { TClient } 339 340 TClient = class 341 private 342 FGame: TGame; 343 FControlPlayer: TPlayer; 344 procedure SetControlPlayer(AValue: TPlayer); 345 procedure SetGame(AValue: TGame); 346 public 347 Name: string; 348 View: TView; 349 constructor Create; 350 destructor Destroy; override; 351 property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer; 352 property Game: TGame read FGame write SetGame; 353 end; 354 355 { TClients } 356 357 TClients = class(TObjectList) 358 Game: TGame; 359 procedure New(Name: string); 360 end; 361 335 362 { TGame } 336 363 … … 349 376 FOnMove: TMoveEvent; 350 377 FOnNewTurn: TNotifyEvent; 378 FOnPlayerChange: TNotifyEvent; 351 379 FOnWin: TWinEvent; 352 380 FRunning: Boolean; … … 367 395 public 368 396 Players: TPlayers; 397 Clients: TClients; 369 398 Map: TMap; 370 399 MapImageFileName: string; … … 406 435 property OnWin: TWinEvent read FOnWin write FOnWin; 407 436 property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn; 437 property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange; 408 438 end; 409 439 … … 509 539 ((((Color shr 16) and $ff) shr 1) shl 16) or 510 540 ((((Color shr 24) and $ff) shr 0) shl 24); 541 end; 542 543 { TClients } 544 545 procedure TClients.New(Name: string); 546 var 547 NewClient: TClient; 548 begin 549 NewClient := TClient.Create; 550 NewClient.Game := Game; 551 NewClient.Name := Name; 552 Add(NewClient); 553 end; 554 555 { TClient } 556 557 procedure TClient.SetGame(AValue: TGame); 558 begin 559 if FGame = AValue then Exit; 560 FGame := AValue; 561 View.Game := AValue; 562 end; 563 564 procedure TClient.SetControlPlayer(AValue: TPlayer); 565 begin 566 if FControlPlayer = AValue then Exit; 567 if Assigned(FControlPlayer) then 568 FControlPlayer.FClient := nil; 569 FControlPlayer := AValue; 570 if Assigned(FControlPlayer) then 571 FControlPlayer.FClient := Self; 572 end; 573 574 constructor TClient.Create; 575 begin 576 View := TView.Create; 577 end; 578 579 destructor TClient.Destroy; 580 begin 581 ControlPlayer := nil; 582 FreeAndNil(View); 583 inherited Destroy; 511 584 end; 512 585 … … 1740 1813 if FGame = AValue then Exit; 1741 1814 FGame := AValue; 1742 View.Game := Game; 1815 end; 1816 1817 procedure TPlayer.SetClient(AValue: TClient); 1818 begin 1819 if FClient=AValue then Exit; 1820 if Assigned(FClient) then FClient.FControlPlayer := nil; 1821 FClient := AValue; 1822 if Assigned(FClient) then FClient.FControlPlayer := Self; 1743 1823 end; 1744 1824 … … 2146 2226 end; 2147 2227 2148 procedure TPlayer.Paint(Canvas: TCanvas );2228 procedure TPlayer.Paint(Canvas: TCanvas; View: TView); 2149 2229 begin 2150 2230 PlayerMap.Paint(Canvas, View); … … 2153 2233 constructor TPlayer.Create; 2154 2234 begin 2155 View := TView.Create;2156 2235 StartUnits := DefaultPlayerStartUnits; 2157 2236 StartCell := nil; … … 2163 2242 begin 2164 2243 FreeAndNil(PlayerMap); 2165 FreeAndNil(View);2166 2244 inherited Destroy; 2167 2245 end; … … 2180 2258 Agressivity := Source.Agressivity; 2181 2259 Defensive := Source.Defensive; 2182 View.Assign(Source.View);2183 2260 end; 2184 2261 … … 2432 2509 end else begin 2433 2510 FRunning := AValue; 2434 for I := 0 to Players.Count - 1 do2435 with T Player(Players[I]) do begin2511 for I := 0 to Clients.Count - 1 do 2512 with TClient(Clients[I]) do begin 2436 2513 View.Clear; 2437 2514 end; … … 2811 2888 PrevPlayer: TPlayer; 2812 2889 begin 2813 CurrentPlayer.View.SelectedCell := nil;2890 //TODO CurrentPlayer.View.SelectedCell := nil; 2814 2891 MoveAll(CurrentPlayer); 2815 2892 Map.Grow(CurrentPlayer); … … 2820 2897 repeat 2821 2898 CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]); 2899 if Assigned(FOnPlayerChange) then 2900 FOnPlayerChange(Self); 2822 2901 until CurrentPlayer.TotalCells > 0; 2823 2902 if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then begin … … 2870 2949 Players := TPlayers.Create; 2871 2950 Players.Game := Self; 2951 Clients := TClients.Create; 2952 Clients.Game := Self; 2872 2953 2873 2954 MapImageFileName := 'Images/Maps/WorldMap.png'; … … 2887 2968 destructor TGame.Destroy; 2888 2969 begin 2970 FreeAndNil(Clients); 2889 2971 FreeAndNil(Moves); 2890 2972 FreeAndNil(Players); … … 2918 3000 end; 2919 3001 2920 2921 3002 if SymetricMap then begin 2922 3003 for C := 0 to (Map.Cells.Count div 2) - 1 do begin … … 2931 3012 with TPlayer(Players[I]) do begin 2932 3013 PlayerMap.Update; 2933 View.Clear;2934 3014 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin 2935 3015 // Try to obtain start cell for each player … … 2950 3030 StartCell.Power := TPlayer(Players[I]).StartUnits; 2951 3031 end; 3032 PlayerMap.CheckVisibility; 3033 end; 3034 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0]) 3035 else CurrentPlayer := nil; 3036 3037 Clients.Clear; 3038 Clients.New('Spectator'); 3039 for I := 0 to Players.Count - 1 do 3040 with TPlayer(Players[I]) do 3041 if Mode = pmHuman then begin 3042 Clients.New(TPlayer(Players[I]).Name); 3043 TPlayer(Players[I]).Client := TClient(Clients.Last); 3044 end; 3045 3046 for I := 0 to Clients.Count - 1 do 3047 with TClient(Clients[I]) do begin 3048 View.Clear; 2952 3049 View.Zoom := 1; 2953 3050 View.CenterMap; 2954 PlayerMap.CheckVisibility; 2955 end; 2956 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0]) 2957 else CurrentPlayer := nil; 3051 end; 2958 3052 end; 2959 3053 … … 2985 3079 with TCellLink(CellLinks[C]) do begin 2986 3080 if Length(Points) >= 2 then begin 2987 MoveTo( Points[0]);3081 MoveTo(View.CellToCanvasPos(Points[0])); 2988 3082 for I := 1 to Length(Points) - 1 do 2989 LineTo( Points[I]);3083 LineTo(View.CellToCanvasPos(Points[I])); 2990 3084 end; 2991 3085 end; -
trunk/xtactics.lpi
r113 r125 2 2 <CONFIG> 3 3 <ProjectOptions> 4 <Version Value=" 9"/>4 <Version Value="10"/> 5 5 <General> 6 6 <SessionStorage Value="InProjectDir"/>
Note:
See TracChangeset
for help on using the changeset viewer.