Changeset 30
- Timestamp:
- Mar 4, 2014, 12:18:22 AM (11 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Languages/xtactics.cs.po
r29 r30 55 55 msgctxt "tformmove.buttoncancel.caption" 56 56 msgid "Cancel" 57 msgstr " "57 msgstr "Zrušit" 58 58 59 59 #: tformmove.buttonok.caption 60 60 msgctxt "tformmove.buttonok.caption" 61 61 msgid "Ok" 62 msgstr " "62 msgstr "Ok" 63 63 64 64 #: tformmove.caption 65 65 msgid "Move" 66 msgstr " "66 msgstr "Přesun" 67 67 68 68 #: tformmove.label1.caption 69 69 msgid "Once:" 70 msgstr " "70 msgstr "Jednou:" 71 71 72 72 #: tformmove.label2.caption 73 73 msgid "Every turn:" 74 msgstr " "74 msgstr "Každý tah:" 75 75 76 76 #: tformnew.buttoncancel.caption 77 77 msgctxt "tformnew.buttoncancel.caption" 78 78 msgid "Cancel" 79 msgstr " "79 msgstr "Zrušit" 80 80 81 81 #: tformnew.buttonok.caption 82 82 msgctxt "tformnew.buttonok.caption" 83 83 msgid "Ok" 84 msgstr " "84 msgstr "Ok" 85 85 86 86 #: tformnew.buttonplayeradd.caption 87 87 msgid "Add" 88 msgstr " "88 msgstr "Přidat" 89 89 90 90 #: tformnew.buttonplayermodify.caption 91 91 msgid "Modify" 92 msgstr " "92 msgstr "Upravit" 93 93 94 94 #: tformnew.buttonplayerremove.caption 95 95 msgid "Remove" 96 msgstr " "96 msgstr "Odebrat" 97 97 98 98 #: tformnew.caption 99 99 msgid "New game" 100 msgstr " "100 msgstr "Nová hra" 101 101 102 102 #: tformnew.checkboxvoid.caption 103 103 msgid "Inaccessible places" 104 msgstr " "104 msgstr "Nepřístupná políčka" 105 105 106 106 #: tformnew.label1.caption 107 107 msgid "Map size:" 108 msgstr " "108 msgstr "Velikost mapy:" 109 109 110 110 #: tformnew.label2.caption 111 111 msgid "x" 112 msgstr " "112 msgstr "x" 113 113 114 114 #: tformnew.listview1.columns[0].caption 115 115 msgid "Name" 116 msgstr " "116 msgstr "Jméno" 117 117 118 118 #: tformnew.listview1.columns[1].caption 119 119 msgid "Type" 120 msgstr " "120 msgstr "Typ" 121 121 122 122 #: tformnew.listview1.columns[2].caption 123 123 msgid "Color" 124 msgstr " "124 msgstr "Barva" 125 125 126 126 #: tformnew.listview1.columns[3].caption 127 127 msgid "Start units" 128 msgstr " "128 msgstr "Počátečních jednotek" 129 129 130 130 #: tformplayer.buttoncancel.caption 131 131 msgctxt "tformplayer.buttoncancel.caption" 132 132 msgid "Cancel" 133 msgstr " "133 msgstr "Zrušit" 134 134 135 135 #: tformplayer.buttonok.caption 136 136 msgctxt "tformplayer.buttonok.caption" 137 137 msgid "Ok" 138 msgstr " "138 msgstr "Ok" 139 139 140 140 #: tformplayer.caption 141 141 msgid "Player" 142 msgstr " "142 msgstr "Hráč" 143 143 144 144 #: tformplayer.combobox1.text 145 145 msgid "Human" 146 msgstr " "146 msgstr "Člověk" 147 147 148 148 #: tformplayer.label1.caption 149 149 msgid "Name:" 150 msgstr " "150 msgstr "Jméno:" 151 151 152 152 #: tformplayer.label2.caption 153 153 msgid "Mode:" 154 msgstr " "154 msgstr "Režim:" 155 155 156 156 #: tformplayer.label3.caption 157 157 msgid "Color:" 158 msgstr " "158 msgstr "Barva:" 159 159 160 160 #: ucore.splayerwins … … 165 165 #: uformmain.sturn 166 166 msgid "turn" 167 msgstr " "167 msgstr "tah" 168 168 169 169 #: ugame.sminimumplayers 170 170 msgid "You need at least two players" 171 171 msgstr "Potřebujete alespoň dva hráče" 172 -
trunk/UCore.lfm
r28 r30 4 4 OldCreateOrder = False 5 5 Height = 542 6 HorizontalOffset = 4857 VerticalOffset = 2846 HorizontalOffset = 738 7 VerticalOffset = 183 8 8 Width = 752 9 9 object ActionList1: TActionList -
trunk/UCore.pas
r29 r30 34 34 public 35 35 Game: TGame; 36 UseSingleView: Boolean; 37 View: TView; 36 38 procedure Init; 37 39 property Initialized: Boolean read FInitialized; … … 80 82 procedure TCore.AExitExecute(Sender: TObject); 81 83 begin 84 Game.Running := False; 82 85 Application.Terminate; 83 86 end; … … 99 102 FormMain.Redraw; 100 103 Application.ProcessMessages; 104 Sleep(1); 101 105 end; 102 106 end; -
trunk/UFormMain.lfm
r28 r30 9 9 Menu = MainMenu1 10 10 OnActivate = FormActivate 11 OnClose = FormClose 11 12 OnCreate = FormCreate 12 13 OnDestroy = FormDestroy -
trunk/UFormMain.pas
r28 r30 34 34 ToolButton4: TToolButton; 35 35 procedure FormActivate(Sender: TObject); 36 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 36 37 procedure FormCreate(Sender: TObject); 37 38 procedure FormDestroy(Sender: TObject); … … 132 133 end; 133 134 135 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 136 begin 137 Core.Game.Running := False; 138 end; 139 134 140 procedure TFormMain.FormDestroy(Sender: TObject); 135 141 begin … … 176 182 end; 177 183 Cell := nil; 178 OldCell := Core.Game.CurrentPlayer. FocusedCell;184 OldCell := Core.Game.CurrentPlayer.View.FocusedCell; 179 185 with Core.Game do 180 186 Cell := Map.PosToCell(CurrentPlayer.View.CanvasToCellPos(Point(X, Y)), CurrentPlayer.View ); 181 187 if Assigned(Cell) then begin 182 Core.Game.CurrentPlayer. FocusedCell := Cell;188 Core.Game.CurrentPlayer.View.FocusedCell := Cell; 183 189 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + ']'; 184 190 end else begin 185 Core.Game.CurrentPlayer. FocusedCell := nil;191 Core.Game.CurrentPlayer.View.FocusedCell := nil; 186 192 StatusBar1.Panels[0].Text := ''; 187 193 end; … … 195 201 if (Abs(StartMousePoint.X - X) < 5) and (Abs(StartMousePoint.Y - Y) < 5) then begin 196 202 if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin 197 Core.Game.CurrentPlayer. SelectCell(Point(X, Y));203 Core.Game.CurrentPlayer.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer); 198 204 Redraw; 199 205 end; -
trunk/UFormNew.pas
r29 r30 106 106 NewPlayer.Name := 'Player ' + IntToStr(Players.Count + 1); 107 107 NewPlayer.Color := PlayerColors[Players.Count]; 108 NewPlayer.Mode := pmComputer; 108 109 Players.Add(NewPlayer); 109 110 ReloadView; -
trunk/UGame.pas
r29 r30 58 58 procedure SetZoom(AValue: Double); 59 59 public 60 Game: TGame; 60 61 SourceRect: TRect; 62 FocusedCell: TCell; 63 SelectedCell: TCell; 64 procedure Clear; 61 65 constructor Create; 62 66 destructor Destroy; override; 67 procedure SelectCell(Pos: TPoint; Player: TPlayer); 63 68 function CanvasToCellPos(Pos: TPoint): TPoint; 64 69 function CellToCanvasPos(Pos: TPoint): TPoint; … … 86 91 function CellToPos(Cell: TCell; View: TView): TPoint; 87 92 function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray; 88 procedure Paint(Canvas: TCanvas; View: TView ; SelectedCell: TCell; FocusedCell: TCell);93 procedure Paint(Canvas: TCanvas; View: TView); 89 94 constructor Create; 90 95 destructor Destroy; override; … … 102 107 103 108 TPlayer = class 104 Game: TGame; 109 private 110 FGame: TGame; 111 procedure SetGame(AValue: TGame); 112 public 105 113 Name: string; 106 114 Color: TColor; 107 115 View: TView; 108 SelectedCell: TCell;109 FocusedCell: TCell;110 116 Mode: TPlayerMode; 111 117 TotalUnits: Integer; … … 113 119 StartUnits: Integer; 114 120 procedure ComputerTurn; 115 procedure SelectCell(Pos: TPoint);116 121 procedure Paint(PaintBox: TPaintBox); 117 122 constructor Create; 118 123 destructor Destroy; override; 119 124 procedure Assign(Source: TPlayer); 125 property Game: TGame read FGame write SetGame; 120 126 end; 121 127 … … 243 249 end; 244 250 251 procedure TView.Clear; 252 begin 253 FocusedCell := nil; 254 SelectedCell := nil; 255 end; 256 245 257 procedure TView.SetDestRect(AValue: TRect); 246 258 begin … … 254 266 constructor TView.Create; 255 267 begin 256 Zoom := 1; 268 Zoom := 1.5; 269 Clear; 257 270 end; 258 271 … … 326 339 DestRect := Source.DestRect; 327 340 Zoom := Source.Zoom; 341 SelectedCell := Source.SelectedCell; 342 FocusedCell := Source.FocusedCell; 343 end; 344 345 procedure TPlayer.SetGame(AValue: TGame); 346 begin 347 if FGame = AValue then Exit; 348 FGame := AValue; 349 View.Game := Game; 328 350 end; 329 351 … … 336 358 TotalAttackPower: Integer; 337 359 I: Integer; 360 CanAttack: Integer; 338 361 begin 339 362 for Y := 0 to Game.Map.Size.Y - 1 do … … 341 364 with TCell(Game.Map.Cells[Y, X]) do begin 342 365 if (Terrain <> ttVoid) and (Player <> Self) then begin 366 // Attack to not owned cell yet 343 367 // Count own possible power 344 368 Cells := Game.Map.GetCellNeighbours(Game.Map.Cells[Y, X]); … … 361 385 end; 362 386 end; 363 end; 364 end; 365 end; 366 367 procedure TPlayer.SelectCell(Pos: TPoint); 387 end else 388 if (Terrain <> ttVoid) and (Player = Self) then begin 389 // Inner moves 390 // We need to move available power to borders to be available for attacks 391 // or defense 392 Cells := Game.Map.GetCellNeighbours(Game.Map.Cells[Y, X]); 393 CanAttack := 0; 394 for I := 0 to Length(Cells) - 1 do 395 if (Cells[I].Player <> Self) then begin 396 Inc(CanAttack); 397 end; 398 if CanAttack = 0 then begin 399 // We cannot attack and should do move 400 // For simplicty just try to balance inner area cells power 401 for I := 0 to Length(Cells) - 1 do 402 if (Cells[I].Player = Self) and (Cells[I].Power < Game.Map.Cells[Y, X].GetAvialPower) then begin 403 Game.SetMove(Game.Map.Cells[Y, X], Cells[I], (Game.Map.Cells[Y, X].GetAvialPower - Cells[I].Power) div 2); 404 end; 405 end; 406 end; 407 end; 408 end; 409 410 procedure TView.SelectCell(Pos: TPoint; Player: TPlayer); 368 411 var 369 412 NewSelectedCell: TCell; … … 371 414 BottomRight: TPoint; 372 415 begin 373 NewSelectedCell := Game.Map.PosToCell( View.CanvasToCellPos(Pos), View);416 NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self); 374 417 if Assigned(NewSelectedCell) then begin 375 418 if Assigned(SelectedCell) and IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin … … 377 420 SelectedCell := nil; 378 421 end else 379 if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.Player = Self) then422 if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.Player = Player) then 380 423 SelectedCell := NewSelectedCell 381 424 else 382 if (NewSelectedCell = SelectedCell) and (NewSelectedCell.Player = Self) then425 if (NewSelectedCell = SelectedCell) and (NewSelectedCell.Player = Player) then 383 426 SelectedCell := nil; 384 427 end; … … 387 430 procedure TPlayer.Paint(PaintBox: TPaintBox); 388 431 begin 389 Game.Map.Paint(PaintBox.Canvas, View , SelectedCell, FocusedCell);432 Game.Map.Paint(PaintBox.Canvas, View); 390 433 end; 391 434 … … 393 436 begin 394 437 View := TView.Create; 395 SelectedCell := nil;396 FocusedCell := nil;397 438 StartUnits := DefaultPlayerStartUnits; 398 439 end; … … 413 454 TotalUnits := Source.TotalUnits; 414 455 StartUnits := Source.StartUnits; 415 SelectedCell := Source.SelectedCell;416 FocusedCell := Source.FocusedCell;417 456 View.Assign(Source.View); 418 457 end; … … 432 471 end else begin 433 472 // Fight 473 //NewPower := CellTo.Power - Trunc(CountOnce / CellTo.Power); 434 474 if CellTo.Power > CountOnce then begin 435 475 // Defender wins … … 519 559 for I := 0 to Players.Count - 1 do 520 560 with TPlayer(Players[I]) do begin 521 SelectedCell := nil; 522 FocusedCell := nil; 561 View.Clear; 523 562 end; 524 563 end; … … 582 621 end; 583 622 UpdateRepeatMoves(CurrentPlayer); 623 // For computers take view from previous human 624 if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View); 584 625 end; 585 626 … … 639 680 for I := 0 to Players.Count - 1 do 640 681 with TPlayer(Players[I]) do begin 641 SelectedCell := nil;682 View.Clear; 642 683 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin 643 684 StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)]; … … 771 812 end; 772 813 773 procedure THexMap.Paint(Canvas: TCanvas; View: TView ; SelectedCell: TCell; FocusedCell: TCell);814 procedure THexMap.Paint(Canvas: TCanvas; View: TView); 774 815 var 775 816 CX, CY: Integer; … … 788 829 begin 789 830 with Canvas do begin 790 if Assigned( FocusedCell) and (FocusedCell = TCell(Cells[CY, CX])) then begin831 if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin 791 832 Pen.Color := clYellow; 792 833 Pen.Style := psSolid;
Note:
See TracChangeset
for help on using the changeset viewer.