Changeset 281 for trunk/UMapType.pas
- Timestamp:
- Feb 21, 2019, 10:45:41 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.