Changeset 281
- Timestamp:
- Feb 21, 2019, 10:45:41 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormNew.lfm
r279 r281 21 21 Top = 60 22 22 Width = 806 23 ActivePage = TabSheet Players23 ActivePage = TabSheetMap 24 24 Align = alClient 25 25 BorderSpacing.Around = 4 26 TabIndex = 126 TabIndex = 2 27 27 TabOrder = 0 28 28 OnChange = PageControl1Change … … 178 178 object Panel1: TPanel 179 179 Left = 0 180 Height = 652180 Height = 596 181 181 Top = 0 182 182 Width = 796 183 183 Align = alClient 184 184 BevelOuter = bvNone 185 ClientHeight = 652185 ClientHeight = 596 186 186 ClientWidth = 796 187 187 TabOrder = 0 … … 260 260 Height = 38 261 261 Top = 104 262 Width = 208262 Width = 304 263 263 ItemHeight = 0 264 264 Items.Strings = ( … … 277 277 Height = 38 278 278 Top = 144 279 Width = 208279 Width = 304 280 280 ItemHeight = 0 281 281 Items.Strings = ( … … 579 579 object TabSheetCaptureCells: TTabSheet 580 580 ClientHeight = 74 581 ClientWidth = 76 3581 ClientWidth = 769 582 582 object Label14: TLabel 583 583 Left = 8 … … 601 601 object TabSheetStayAliveTurns: TTabSheet 602 602 ClientHeight = 74 603 ClientWidth = 76 3603 ClientWidth = 769 604 604 object Label13: TLabel 605 605 Left = 8 … … 701 701 Width = 254 702 702 ItemHeight = 0 703 OnChange = ComboBoxGameSystemChange 703 704 Style = csDropDownList 704 705 TabOrder = 0 -
trunk/Forms/UFormNew.pas
r279 r281 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 9 ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry, UPlayer, 10 UGameServer, UServerList, UMap, UFormPlayers ;10 UGameServer, UServerList, UMap, UFormPlayers, UGameSystem; 11 11 12 12 type … … 111 111 procedure CheckBoxSymetricMapChange(Sender: TObject); 112 112 procedure CheckBoxVoidChange(Sender: TObject); 113 procedure ComboBoxGameSystemChange(Sender: TObject); 113 114 procedure ComboBoxGridTypeChange(Sender: TObject); 114 115 procedure ComboBoxMapShapeChange(Sender: TObject); … … 143 144 NewRandSeed: Cardinal; 144 145 FormPlayers: TFormPlayers; 146 GameSystem: TGameSystem; 145 147 procedure LoadGame(Game: TGame); 146 148 procedure SaveGame(Game: TGame); … … 165 167 166 168 uses 167 UForm Player, UFormChat, UCore, UFormServer, UClientGUI, UFormClient,168 UFormGameSystems, U GameSystem;169 UFormChat, UCore, UFormServer, UClientGUI, UFormClient, 170 UFormGameSystems, UMapType; 169 171 170 172 resourcestring 171 SGridTypeHexagon = 'Hexagonal';172 SGridTypeSquare = 'Square';173 SGridTypeTriangle = 'Triangural';174 SGridTypeRandom = 'Random';175 SGridTypeIsometric = 'Isometric';176 173 SWinObjectiveNone = 'None'; 177 174 SWinObjectiveDefeatAllOponents = 'Defeat all oponents'; … … 296 293 RadioGroupGrowAmount.ItemIndex := Integer(GrowAmount); 297 294 RadioGroupGrowCells.ItemIndex := Integer(GrowCells); 298 ComboBoxGridType.ItemIndex := Integer(MapType) - 1;295 ComboBoxGridType.ItemIndex := ComboBoxGridType.Items.IndexOfObject(TObject(MapType)); 299 296 ComboBoxWinObjective.ItemIndex := Integer(WinObjective); 300 297 SpinEditNeutralUnits.Value := MaxNeutralUnits; … … 325 322 GrowAmount := TGrowAmount(RadioGroupGrowAmount.ItemIndex); 326 323 GrowCells := TGrowCells(RadioGroupGrowCells.ItemIndex); 327 MapType := TMapType(ComboBoxGridType.Item Index + 1);324 MapType := TMapType(ComboBoxGridType.Items.Objects[ComboBoxGridType.ItemIndex]); 328 325 WinObjective := TWinObjective(ComboBoxWinObjective.ItemIndex); 329 326 MaxNeutralUnits := SpinEditNeutralUnits.Value; … … 406 403 LastIndex := ItemIndex; 407 404 Clear; 408 Items.Add(SGridTypeHexagon); 409 Items.Add(SGridTypeSquare); 410 Items.Add(SGridTypeTriangle); 411 Items.Add(SGridTypeRandom); 412 Items.Add(SGridTypeIsometric); 405 Items.AddObject(SGridTypeHexagonVertical, TObject(mtHexagonVertical)); 406 Items.AddObject(SGridTypeHexagonHorizontal, TObject(mtHexagonHorizontal)); 407 Items.AddObject(SGridTypeSquare, TObject(mtSquare)); 408 Items.AddObject(SGridTypeTriangle, TObject(mtTriangle)); 409 Items.AddObject(SGridTypeRandom, TObject(mtRandom)); 410 Items.AddObject(SGridTypeIsometric, TObject(mtIsometric)); 413 411 ItemIndex := LastIndex; 414 412 end; … … 462 460 WinObjective: TWinObjective; 463 461 begin 462 GameSystem := TGameSystem(ComboBoxGameSystem.Items.Objects[ComboBoxGameSystem.ItemIndex]); 463 ComboBoxGridType.Enabled := GameSystem.PreferedMapType = mtNone; 464 if GameSystem.PreferedMapType <> mtNone then 465 ComboBoxGridType.ItemIndex := ComboBoxGridType.Items.IndexOfObject(TObject(GameSystem.PreferedMapType)); 464 466 EditImageFile.Enabled := ComboBoxMapShape.ItemIndex = Integer(msImage); 465 467 ButtonImageBrowse.Enabled := ComboBoxMapShape.ItemIndex = Integer(msImage); … … 544 546 end; 545 547 548 procedure TFormNew.ComboBoxGameSystemChange(Sender: TObject); 549 begin 550 UpdateInterface; 551 MapPreviewRedraw; 552 end; 553 546 554 procedure TFormNew.ComboBoxGridTypeChange(Sender: TObject); 547 555 begin -
trunk/Languages/xtactics.cs.po
r280 r281 1093 1093 msgstr "Obrázek ze souboru" 1094 1094 1095 #: uformnew.sgridtypehexagon1096 msgid "Hexagonal"1097 msgstr "Hexagonální"1098 1099 #: uformnew.sgridtypeisometric1100 msgid "Isometric"1101 msgstr "Izometrická"1102 1103 #: uformnew.sgridtyperandom1104 msgid "Random"1105 msgstr "Náhodná"1106 1107 #: uformnew.sgridtypesquare1108 msgid "Square"1109 msgstr "Čtvercová"1110 1111 #: uformnew.sgridtypetriangle1112 msgid "Triangural"1113 msgstr "Trojúhelníková"1114 1115 1095 #: uformnew.sgrowamountbyone 1116 1096 msgid "By one" … … 1272 1252 msgstr "Není povoleno odečíst sílu pod nulu do záporné hodnoty" 1273 1253 1254 #: umaptype.sgridtypehexagonhorizontal 1255 msgid "Hexagonal horizontal" 1256 msgstr "Hexagonální vodorovná" 1257 1258 #: umaptype.sgridtypehexagonvertical 1259 msgid "Hexagonal vertical" 1260 msgstr "Hexagonální svislá" 1261 1262 #: umaptype.sgridtypeisometric 1263 msgctxt "umaptype.sgridtypeisometric" 1264 msgid "Isometric" 1265 msgstr "Izometrická" 1266 1267 #: umaptype.sgridtyperandom 1268 msgctxt "umaptype.sgridtyperandom" 1269 msgid "Random" 1270 msgstr "Náhodná" 1271 1272 #: umaptype.sgridtypesquare 1273 msgctxt "umaptype.sgridtypesquare" 1274 msgid "Square" 1275 msgstr "Čtvercová" 1276 1277 #: umaptype.sgridtypetriangle 1278 msgctxt "umaptype.sgridtypetriangle" 1279 msgid "Triangural" 1280 msgstr "Trojúhelníková" 1281 1274 1282 #: uplayer.sattackerpowerpositive 1275 1283 msgctxt "uplayer.sattackerpowerpositive" -
trunk/Languages/xtactics.po
r279 r281 1069 1069 msgstr "" 1070 1070 1071 #: uformnew.sgridtypehexagon1072 msgid "Hexagonal"1073 msgstr ""1074 1075 #: uformnew.sgridtypeisometric1076 msgid "Isometric"1077 msgstr ""1078 1079 #: uformnew.sgridtyperandom1080 msgid "Random"1081 msgstr ""1082 1083 #: uformnew.sgridtypesquare1084 msgid "Square"1085 msgstr ""1086 1087 #: uformnew.sgridtypetriangle1088 msgid "Triangural"1089 msgstr ""1090 1091 1071 #: uformnew.sgrowamountbyone 1092 1072 msgid "By one" … … 1246 1226 msgstr "" 1247 1227 1228 #: umaptype.sgridtypehexagonhorizontal 1229 msgid "Hexagonal horizontal" 1230 msgstr "" 1231 1232 #: umaptype.sgridtypehexagonvertical 1233 msgid "Hexagonal vertical" 1234 msgstr "" 1235 1236 #: umaptype.sgridtypeisometric 1237 msgid "Isometric" 1238 msgstr "" 1239 1240 #: umaptype.sgridtyperandom 1241 msgid "Random" 1242 msgstr "" 1243 1244 #: umaptype.sgridtypesquare 1245 msgid "Square" 1246 msgstr "" 1247 1248 #: umaptype.sgridtypetriangle 1249 msgid "Triangural" 1250 msgstr "" 1251 1248 1252 #: uplayer.sattackerpowerpositive 1249 1253 msgid "Attacker power have to be higher then 0." -
trunk/UCore.pas
r277 r281 125 125 uses 126 126 UFormMain, UFormNew, UFormSettings, UFormAbout, UClientAI, UFormKeyShortcuts, 127 UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI ;127 UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI, UMapType; 128 128 129 129 const … … 514 514 procedure TCore.InitGameSystems; 515 515 begin 516 with GameSystems.AddNew('HexWars') do begin 516 with GameSystems.AddNew('Custom') do begin 517 PreferedMapType := mtNone; 517 518 MaxPlayerCount := 3; 518 519 with UnitKinds.AddNew('Unit') do begin … … 522 523 end; 523 524 524 with GameSystems.AddNew('Civilization') do begin 525 with GameSystems.AddNew('HexWars') do begin 526 PreferedMapType := mtHexagonVertical; 527 MaxPlayerCount := 3; 528 with UnitKinds.AddNew('Unit') do begin 529 Moves := 1; 530 Power := 99; 531 end; 532 end; 533 534 with GameSystems.AddNew('Civilization I') do begin 535 PreferedMapType := mtSquare; 525 536 MaxPlayerCount := 3; 526 537 with UnitKinds.AddNew('Scout') do begin … … 534 545 end; 535 546 547 with GameSystems.AddNew('Civilization II') do begin 548 PreferedMapType := mtIsometric; 549 MaxPlayerCount := 3; 550 with UnitKinds.AddNew('Scout') do begin 551 Moves := 1; 552 Power := 1; 553 end; 554 with UnitKinds.AddNew('Settler') do begin 555 Moves := 1; 556 Power := 1; 557 end; 558 end; 559 560 with GameSystems.AddNew('Civilization III') do begin 561 PreferedMapType := mtIsometric; 562 MaxPlayerCount := 3; 563 with UnitKinds.AddNew('Scout') do begin 564 Moves := 1; 565 Power := 1; 566 end; 567 with UnitKinds.AddNew('Settler') do begin 568 Moves := 1; 569 Power := 1; 570 end; 571 end; 572 573 with GameSystems.AddNew('Civilization IV') do begin 574 PreferedMapType := mtIsometric; 575 MaxPlayerCount := 3; 576 with UnitKinds.AddNew('Scout') do begin 577 Moves := 1; 578 Power := 1; 579 end; 580 with UnitKinds.AddNew('Settler') do begin 581 Moves := 1; 582 Power := 1; 583 end; 584 end; 585 586 with GameSystems.AddNew('Civilization V') do begin 587 PreferedMapType := mtHexagonHorizontal; 588 MaxPlayerCount := 3; 589 with UnitKinds.AddNew('Scout') do begin 590 Moves := 1; 591 Power := 1; 592 end; 593 with UnitKinds.AddNew('Settler') do begin 594 Moves := 1; 595 Power := 1; 596 end; 597 end; 598 599 with GameSystems.AddNew('Civilization VI') do begin 600 PreferedMapType := mtHexagonHorizontal; 601 MaxPlayerCount := 3; 602 with UnitKinds.AddNew('Scout') do begin 603 Moves := 1; 604 Power := 1; 605 end; 606 with UnitKinds.AddNew('Settler') do begin 607 Moves := 1; 608 Power := 1; 609 end; 610 end; 611 536 612 with GameSystems.AddNew('Dune 2') do begin 613 PreferedMapType := mtSquare; 537 614 MaxPlayerCount := 3; 538 615 with UnitKinds.AddNew('Light Infantry') do begin … … 551 628 552 629 with GameSystems.AddNew('Battle Isle 2') do begin 630 PreferedMapType := mtHexagonHorizontal; 553 631 MaxPlayerCount := 8; 554 632 with UnitKinds.AddNew('Demon 132') do begin … … 567 645 Moves := 10; 568 646 Power := 10; 647 end; 648 end; 649 650 with GameSystems.AddNew('Panzer General') do begin 651 PreferedMapType := mtHexagonHorizontal; 652 MaxPlayerCount := 2; 653 with UnitKinds.AddNew('Rifle Team') do begin 654 Moves := 1; 655 end; 656 with UnitKinds.AddNew('Machine Gun') do begin 657 Moves := 1; 658 end; 659 with UnitKinds.AddNew('Heavy Infantry') do begin 660 Moves := 1; 661 end; 662 with UnitKinds.AddNew('Granadiers') do begin 663 Moves := 1; 569 664 end; 570 665 end; -
trunk/UGame.pas
r277 r281 30 30 TGrowAmount = (gaByOne, gaBySquareRoot); 31 31 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll); 32 TMapType = (mtNone, mtHexagon, mtSquare, mtTriangle, mtRandom, mtIsometric);33 32 TWinObjective = (woNone, woDefeatAllOponents, woDefeatAllOponentsCities, 34 33 woSpecialCaptureCell, woStayAliveForDefinedTurns, woCaptureEntireMap); … … 268 267 case AValue of 269 268 mtNone: Map := TMap.Create; 270 mtHexagon : Map := THexMap.Create;269 mtHexagonVertical: Map := THexMapVertical.Create; 271 270 mtSquare: Map := TSquareMap.Create; 272 271 mtTriangle: Map := TTriangleMap.Create; 273 272 mtRandom: Map := TVoronoiMap.Create; 274 273 mtIsometric: Map := TIsometricMap.Create; 274 mtHexagonHorizontal: Map := THexMapHorizontal.Create; 275 275 else raise Exception.Create(SUnsupportedMapType); 276 276 end; … … 537 537 with Config do begin 538 538 StoredRandSeed := GetValue(DOMString(Path + '/RandSeed'), 0); 539 MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon )));539 MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagonVertical))); 540 540 Map.Size := TPoint.Create(GetValue(DOMString(Path + '/MapSizeX'), 10), 541 541 GetValue(DOMString(Path + '/MapSizeY'), 10)); -
trunk/UGameSystem.pas
r277 r281 7 7 uses 8 8 Classes, SysUtils, fgl, UUnit, DOM, XMLRead, XMLWrite, UXMLUtils, XMLConf, 9 FileUtil ;9 FileUtil, UMapType; 10 10 11 11 type … … 21 21 EmptyCellsNeutral: Boolean; 22 22 UnitsMoveImmediately: Boolean; 23 PreferedMapType: TMapType; 23 24 constructor Create; 24 25 destructor Destroy; override; … … 99 100 UnitsSplitMerge := Source.UnitsSplitMerge; 100 101 EmptyCellsNeutral := Source.EmptyCellsNeutral; 102 PreferedMapType := Source.PreferedMapType; 101 103 UnitKinds.Assign(Source.UnitKinds); 102 104 end; … … 109 111 EmptyCellsNeutral := ReadBoolean(Node, 'EmptyCellsNeutral', False); 110 112 UnitsMoveImmediately := ReadBoolean(Node, 'UnitsMoveImmediately', False); 113 PreferedMapType := TMapType(ReadInteger(Node, 'PreferedMapType', Integer(mtNone))); 111 114 112 115 NewNode := Node.FindNode('UnitKinds'); … … 122 125 WriteBoolean(Node, 'EmptyCellsNeutral', EmptyCellsNeutral); 123 126 WriteBoolean(Node, 'UnitsMoveImmediately', UnitsMoveImmediately); 127 WriteInteger(Node, 'PreferedMapType', Integer(PreferedMapType)); 124 128 125 129 NewNode := Node.OwnerDocument.CreateElement('UnitKinds'); … … 171 175 EmptyCellsNeutral := GetValue(DOMString(Path + '/EmptyCellsNeutral'), False); 172 176 UnitsMoveImmediately := GetValue(DOMString(Path + '/UnitsMoveImmediately'), False); 177 PreferedMapType := TMapType(GetValue(DOMString(Path + '/PreferedMapType'), Integer(mtNone))); 173 178 end; 174 179 end; … … 180 185 SetValue(DOMString(Path + '/EmptyCellsNeutral'), EmptyCellsNeutral); 181 186 SetValue(DOMString(Path + '/UnitsMoveImmediately'), UnitsMoveImmediately); 187 SetValue(DOMString(Path + '/PreferedMapType'), Integer(PreferedMapType)); 182 188 end; 183 189 end; -
trunk/UMapType.pas
r268 r281 9 9 10 10 type 11 TMapType = (mtNone, mtHexagonVertical, mtSquare, mtTriangle, mtRandom, mtIsometric, 12 mtHexagonHorizontal); 13 11 14 TCellsDistance = class 12 15 Cell1: TCell; … … 15 18 end; 16 19 17 { THexMap }18 19 THexMap = class(TMap)20 { THexMapVertical } 21 22 THexMapVertical = class(TMap) 20 23 private 21 24 const … … 34 37 end; 35 38 39 { THexMapHorizontal } 40 41 THexMapHorizontal = class(TMap) 42 private 43 const 44 CellMulX = 1.292 * 1.03; 45 CellMulY = 1.12 * 1.028; 46 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 47 procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell); 48 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon; 49 protected 50 procedure SetSize(AValue: TPoint); override; 51 public 52 function CalculatePixelRect: TRect; override; 53 procedure LoadFromFile(FileName: string); override; 54 procedure SaveToFile(FileName: string); override; 55 procedure Generate; override; 56 end; 57 36 58 { TSquareMap } 37 59 … … 82 104 end; 83 105 106 resourcestring 107 SGridTypeHexagonVertical = 'Hexagonal vertical'; 108 SGridTypeHexagonHorizontal = 'Hexagonal horizontal'; 109 SGridTypeSquare = 'Square'; 110 SGridTypeTriangle = 'Triangural'; 111 SGridTypeRandom = 'Random'; 112 SGridTypeIsometric = 'Isometric'; 113 84 114 85 115 implementation 86 116 87 { TIsometricMap } 88 89 function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon; 90 begin 91 SetLength(Result.Points, 4); 92 Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5)); 93 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y); 94 Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5)); 95 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y); 96 end; 97 98 procedure TIsometricMap.SetSize(AValue: TPoint); 99 begin 100 inherited; 101 if Cyclic then 102 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2); 103 end; 104 105 procedure TIsometricMap.Generate; 106 var 107 X, Y: Integer; 108 NewCell: TCell; 109 PX, PY: Double; 110 P: TPoint; 111 Cell: TCell; 112 begin 113 Clear; 114 115 // Allocate and init new 116 Cells.Count := Size.Y * Size.X; 117 for Y := 0 to Size.Y - 1 do 118 for X := 0 to Size.X - 1 do begin 119 NewCell := TCell.Create; 120 NewCell.Map := Self; 121 PX := X; 122 PY := Y; 123 if (Y and 1) = 1 then begin 124 PX := PX + 0.5; 125 //Y := Y + 0.5; 126 end; 127 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX), 128 Trunc(PY * DefaultCellSize.Y / CellMulY)); 129 NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize); 130 NewCell.Id := GetNewCellId; 131 Cells[Y * Size.X + X] := NewCell; 132 end; 133 134 // Generate neightbours 135 for Y := 0 to Size.Y - 1 do 136 for X := 0 to Size.X - 1 do 137 with Cells[Y * Size.X + X] do begin 138 Cell := Cells[Y * Size.X + X]; 139 if Cyclic then begin 140 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1); 141 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 142 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 143 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1); 144 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 145 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 146 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1); 147 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 148 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 149 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1); 150 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 151 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 152 end else begin 153 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1); 154 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 155 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1); 156 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 157 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1); 158 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 159 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1); 160 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 161 end; 162 end; 163 164 FPixelRect := CalculatePixelRect; 165 end; 166 167 function TIsometricMap.CalculatePixelRect: TRect; 168 begin 169 Result := inherited CalculatePixelRect; 170 Result.P2 := Result.P2 - TPoint.Create( 171 Trunc(0.5 * DefaultCellSize.X / CellMulX), 172 Trunc(DefaultCellSize.Y / CellMulY) 173 ); 174 end; 175 176 { THexMap } 177 178 function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon; 179 var 180 Shift: TPointF; 181 Angle: Double; 182 begin 183 Angle := 30 / 180 * Pi; 184 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 185 SetLength(Result.Points, 6); 186 Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y)); 187 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 188 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 189 Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y)); 190 Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 191 Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 192 end; 193 194 procedure THexMap.SetSize(AValue: TPoint); 195 begin 196 inherited; 197 if Cyclic then 198 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2); 199 end; 200 201 function THexMap.CalculatePixelRect: TRect; 202 var 203 Shift: TPointF; 204 Angle: Double; 205 begin 206 Result := inherited CalculatePixelRect; 207 Angle := 30 / 180 * Pi; 208 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 209 Result.P2 := Result.P2 - TPoint.Create( 210 Trunc(0.5 * DefaultCellSize.X / CellMulX), 211 Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY) 212 ); 213 end; 214 215 function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 117 { THexMapHorizontal } 118 119 function THexMapHorizontal.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint 120 ): Boolean; 216 121 var 217 122 DX: Integer; … … 233 138 end; 234 139 235 procedure THexMap.LoadFromFile(FileName: string); 236 var 237 Doc: TXMLDocument; 238 begin 239 try 240 ReadXMLFile(Doc, FileName); 241 if Doc.DocumentElement.TagName <> 'Map' then 242 raise Exception.Create('Invalid map format'); 243 finally 244 Doc.Free; 245 end; 246 inherited LoadFromFile(FileName); 247 end; 248 249 procedure THexMap.SaveToFile(FileName: string); 250 var 251 Doc: TXMLDocument; 252 RootNode: TDOMNode; 253 begin 254 try 255 Doc := TXMLDocument.Create; 256 RootNode := Doc.CreateElement('Map'); 257 Doc.Appendchild(RootNode); 258 WriteXMLFile(Doc, FileName); 259 finally 260 Doc.Free; 261 end; 262 inherited SaveToFile(FileName); 263 end; 264 265 procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell); 140 procedure THexMapHorizontal.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell); 266 141 var 267 142 X, Y: Integer; … … 285 160 end; 286 161 287 procedure THexMap.Generate; 162 function THexMapHorizontal.GetHexagonPolygon(Pos: TPoint; Size: TPoint 163 ): TPolygon; 164 var 165 Shift: TPointF; 166 Angle: Double; 167 begin 168 Angle := 60 / 180 * Pi; 169 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 170 SetLength(Result.Points, 6); 171 Result.Points[0] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 172 Result.Points[1] := TPoint.Create(Trunc(Pos.X + 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y)); 173 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 174 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 175 Result.Points[4] := TPoint.Create(Trunc(Pos.X - 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y)); 176 Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 177 end; 178 179 procedure THexMapHorizontal.SetSize(AValue: TPoint); 180 begin 181 inherited; 182 if Cyclic then 183 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2); 184 end; 185 186 function THexMapHorizontal.CalculatePixelRect: TRect; 187 var 188 Shift: TPointF; 189 Angle: Double; 190 begin 191 Result := inherited CalculatePixelRect; 192 Angle := 60 / 180 * Pi; 193 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 194 Result.P2 := Result.P2 - TPoint.Create( 195 Trunc(1.35 * Shift.X * DefaultCellSize.X / CellMulX), 196 Trunc(0.5 * DefaultCellSize.Y / CellMulY) 197 ); 198 end; 199 200 procedure THexMapHorizontal.LoadFromFile(FileName: string); 201 var 202 Doc: TXMLDocument; 203 begin 204 try 205 ReadXMLFile(Doc, FileName); 206 if Doc.DocumentElement.TagName <> 'Map' then 207 raise Exception.Create('Invalid map format'); 208 finally 209 Doc.Free; 210 end; 211 inherited LoadFromFile(FileName); 212 end; 213 214 procedure THexMapHorizontal.SaveToFile(FileName: string); 215 var 216 Doc: TXMLDocument; 217 RootNode: TDOMNode; 218 begin 219 try 220 Doc := TXMLDocument.Create; 221 RootNode := Doc.CreateElement('Map'); 222 Doc.Appendchild(RootNode); 223 WriteXMLFile(Doc, FileName); 224 finally 225 Doc.Free; 226 end; 227 inherited SaveToFile(FileName); 228 end; 229 230 procedure THexMapHorizontal.Generate; 288 231 var 289 232 X, Y: Integer; 290 233 NewCell: TCell; 291 234 PX, PY: Double; 235 begin 236 Clear; 237 238 // Allocate and init new 239 Cells.Count := Size.Y * Size.X; 240 for Y := 0 to Size.Y - 1 do 241 for X := 0 to Size.X - 1 do begin 242 NewCell := TCell.Create; 243 NewCell.Map := Self; 244 PX := X; 245 PY := Y; 246 if (X and 1) = 1 then begin 247 PY := PY + 0.5; 248 end; 249 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX), 250 Trunc(PY * DefaultCellSize.Y / CellMulY)); 251 NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize); 252 NewCell.Id := GetNewCellId; 253 Cells[Y * Size.X + X] := NewCell; 254 end; 255 256 // Generate neightbours 257 for Y := 0 to Size.Y - 1 do 258 for X := 0 to Size.X - 1 do 259 with Cells[Y * Size.X + X] do begin 260 GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]); 261 end; 262 263 FPixelRect := CalculatePixelRect; 264 end; 265 266 { TIsometricMap } 267 268 function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon; 269 begin 270 SetLength(Result.Points, 4); 271 Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5)); 272 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y); 273 Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5)); 274 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y); 275 end; 276 277 procedure TIsometricMap.SetSize(AValue: TPoint); 278 begin 279 inherited; 280 if Cyclic then 281 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2); 282 end; 283 284 procedure TIsometricMap.Generate; 285 var 286 X, Y: Integer; 287 NewCell: TCell; 288 PX, PY: Double; 289 P: TPoint; 290 Cell: TCell; 292 291 begin 293 292 Clear; … … 304 303 PX := PX + 0.5; 305 304 //Y := Y + 0.5; 305 end; 306 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX), 307 Trunc(PY * DefaultCellSize.Y / CellMulY)); 308 NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize); 309 NewCell.Id := GetNewCellId; 310 Cells[Y * Size.X + X] := NewCell; 311 end; 312 313 // Generate neightbours 314 for Y := 0 to Size.Y - 1 do 315 for X := 0 to Size.X - 1 do 316 with Cells[Y * Size.X + X] do begin 317 Cell := Cells[Y * Size.X + X]; 318 if Cyclic then begin 319 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1); 320 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 321 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 322 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1); 323 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 324 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 325 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1); 326 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 327 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 328 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1); 329 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 330 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 331 end else begin 332 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1); 333 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 334 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1); 335 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 336 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1); 337 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 338 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1); 339 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 340 end; 341 end; 342 343 FPixelRect := CalculatePixelRect; 344 end; 345 346 function TIsometricMap.CalculatePixelRect: TRect; 347 begin 348 Result := inherited CalculatePixelRect; 349 Result.P2 := Result.P2 - TPoint.Create( 350 Trunc(0.5 * DefaultCellSize.X / CellMulX), 351 Trunc(DefaultCellSize.Y / CellMulY) 352 ); 353 end; 354 355 { THexMapVertical } 356 357 function THexMapVertical.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon; 358 var 359 Shift: TPointF; 360 Angle: Double; 361 begin 362 Angle := 30 / 180 * Pi; 363 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 364 SetLength(Result.Points, 6); 365 Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y)); 366 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 367 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 368 Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y)); 369 Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y)); 370 Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y)); 371 end; 372 373 procedure THexMapVertical.SetSize(AValue: TPoint); 374 begin 375 inherited; 376 if Cyclic then 377 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2); 378 end; 379 380 function THexMapVertical.CalculatePixelRect: TRect; 381 var 382 Shift: TPointF; 383 Angle: Double; 384 begin 385 Result := inherited CalculatePixelRect; 386 Angle := 30 / 180 * Pi; 387 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 388 Result.P2 := Result.P2 - TPoint.Create( 389 Trunc(0.5 * DefaultCellSize.X / CellMulX), 390 Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY) 391 ); 392 end; 393 394 function THexMapVertical.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 395 var 396 DX: Integer; 397 DY: Integer; 398 MinY: Integer; 399 begin 400 if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y 401 else MinY := CellPos2.Y; 402 DX := CellPos2.X - CellPos1.X; 403 DY := CellPos2.Y - CellPos1.Y; 404 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and 405 ((((MinY mod 2) = 1) and 406 not ((DX = 1) and (DY = -1)) and 407 not ((DX = -1) and (DY = 1))) or 408 (((MinY mod 2) = 0) and 409 not ((DX = -1) and (DY = -1)) and 410 not ((DX = 1) and (DY = 1)))); 411 Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y)); 412 end; 413 414 procedure THexMapVertical.LoadFromFile(FileName: string); 415 var 416 Doc: TXMLDocument; 417 begin 418 try 419 ReadXMLFile(Doc, FileName); 420 if Doc.DocumentElement.TagName <> 'Map' then 421 raise Exception.Create('Invalid map format'); 422 finally 423 Doc.Free; 424 end; 425 inherited LoadFromFile(FileName); 426 end; 427 428 procedure THexMapVertical.SaveToFile(FileName: string); 429 var 430 Doc: TXMLDocument; 431 RootNode: TDOMNode; 432 begin 433 try 434 Doc := TXMLDocument.Create; 435 RootNode := Doc.CreateElement('Map'); 436 Doc.Appendchild(RootNode); 437 WriteXMLFile(Doc, FileName); 438 finally 439 Doc.Free; 440 end; 441 inherited SaveToFile(FileName); 442 end; 443 444 procedure THexMapVertical.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell); 445 var 446 X, Y: Integer; 447 P: TPoint; 448 PMod: TPoint; 449 begin 450 for Y := -1 to 1 do 451 for X := -1 to 1 do begin 452 P := TPoint.Create(CellPos.X + X, CellPos.Y + Y); 453 PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y); 454 if Cyclic then begin 455 if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin 456 Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]); 457 end; 458 end else begin 459 if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin 460 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]); 461 end; 462 end; 463 end; 464 end; 465 466 procedure THexMapVertical.Generate; 467 var 468 X, Y: Integer; 469 NewCell: TCell; 470 PX, PY: Double; 471 begin 472 Clear; 473 474 // Allocate and init new 475 Cells.Count := Size.Y * Size.X; 476 for Y := 0 to Size.Y - 1 do 477 for X := 0 to Size.X - 1 do begin 478 NewCell := TCell.Create; 479 NewCell.Map := Self; 480 PX := X; 481 PY := Y; 482 if (Y and 1) = 1 then begin 483 PX := PX + 0.5; 306 484 end; 307 485 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
Note:
See TracChangeset
for help on using the changeset viewer.