Changeset 103
Legend:
- Unmodified
- Added
- Removed
-
trunk/UCore.pas
r100 r103 130 130 131 131 procedure TCore.Delay(Time: Integer); 132 var133 I: Integer;134 132 const 135 133 Slice = 50; // ms … … 226 224 procedure TCore.AGameEndTurnExecute(Sender: TObject); 227 225 var 228 I: Integer;229 226 Computer: TComputer; 230 227 begin … … 355 352 CommandLineParams; 356 353 357 with Core.ScaleDPI1 do 354 {$IFDEF DEBUG} 355 {with Core.ScaleDPI1 do 358 356 if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin 359 357 //ApplyToAll(DesignDPI); … … 367 365 ScaleImageList(Core.ImageListLarge, DesignDPI); 368 366 end; 367 } 368 {$ENDIF} 369 369 370 370 if Game.FileName = '' then begin -
trunk/UGame.pas
r102 r103 58 58 Neighbors: TCells; 59 59 Mark: Boolean; 60 Links: TCellLinks; 60 61 procedure AreaExtend; 61 62 procedure FixRefId; … … 91 92 TCellLink = class 92 93 Points: array of TPoint; 93 Cell 1: TCell;94 Cell2: TCell;94 Cells: TCells; 95 Map: TMap; 95 96 procedure LoadFromNode(Node: TDOMNode); 96 97 procedure SaveToNode(Node: TDOMNode); 98 constructor Create; 99 destructor Destroy; override; 97 100 end; 98 101 … … 101 104 TCellLinks = class(TObjectList) 102 105 Map: TMap; 106 function FindByCells(Cell1, Cell2: TCell): TCellLink; 103 107 procedure LoadFromNode(Node: TDOMNode); 104 108 procedure SaveToNode(Node: TDOMNode); … … 154 158 155 159 TMapAreas = class(TObjectList) 156 157 160 end; 158 161 … … 544 547 end; 545 548 549 constructor TCellLink.Create; 550 begin 551 Cells := TCells.Create; 552 Cells.OwnsObjects := False; 553 end; 554 555 destructor TCellLink.Destroy; 556 var 557 I: Integer; 558 LastState: Boolean; 559 begin 560 for I := 0 to Cells.Count - 1 do begin 561 if TCell(Cells[I]).Neighbors.Remove(TCell(Cells[1 - I])) = -1 then 562 raise Exception.Create('Can''t remove cell from neighbour cell'); 563 if TCell(Cells[I]).Links.Remove(Self) = -1 then 564 raise Exception.Create('Can''t remove cell from neighbour cell'); 565 end; 566 FreeAndNil(Cells); 567 if Assigned(Map) then begin 568 // To remove itself from list we need disable owning to not be called twice 569 try 570 LastState := Map.CellLinks.OwnsObjects; 571 Map.CellLinks.OwnsObjects := False; 572 Map.CellLinks.Remove(Self); 573 finally 574 Map.CellLinks.OwnsObjects := LastState; 575 end; 576 end; 577 inherited Destroy; 578 end; 579 546 580 { TCellLinks } 581 582 function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink; 583 var 584 I: Integer; 585 begin 586 I := 0; 587 while (I < Count) do begin 588 if (TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2) then 589 Break; 590 if (TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1) then 591 Break; 592 Inc(I); 593 end; 594 if I < Count then Result := TCellLink(Items[I]) 595 else Result := nil; 596 end; 547 597 548 598 procedure TCellLinks.LoadFromNode(Node: TDOMNode); … … 585 635 List.Clear; 586 636 587 // Unset mark for all cells 588 for I := 0 to Map.Cells.Count - 1 do 589 TCell(Map.Cells[I]).Mark := False; 637 Map.Cells.ClearMark; 590 638 591 639 for I := 0 to Cells.Count - 1 do … … 611 659 destructor TMapArea.Destroy; 612 660 begin 613 Cells.Free;661 FreeAndNil(Cells); 614 662 inherited Destroy; 615 663 end; … … 721 769 destructor TPlayerMap.Destroy; 722 770 begin 723 Cells.Free;771 FreeAndNil(Cells); 724 772 inherited Destroy; 725 773 end; … … 1116 1164 DefaultCellSize := Source.DefaultCellSize; 1117 1165 Shape := Source.Shape; 1118 //FSize := Source.Size;1119 1120 // Copy allcells1121 (*1166 Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap); 1167 1168 // TODO: How to copy cells 1169 {// Copy all cells 1122 1170 Cells.Count := 0; 1123 1171 Cells.Count := Source.Cells.Count; 1124 1172 for I := 0 to Cells.Count - 1 do begin 1125 1173 Cells[I] := TCell.Create; 1174 TCell(Cells[I]).Map := Self; 1126 1175 TCell(Cells[I]).Assign(TCell(Source.Cells[I])); 1127 1176 end; 1128 *)1177 } 1129 1178 end; 1130 1179 … … 1315 1364 destructor TMap.Destroy; 1316 1365 begin 1317 Areas.Free;1318 CellLinks.Free;1319 Image.Free;1320 1366 Size := Point(0, 0); 1367 FreeAndNil(Areas); 1368 FreeAndNil(CellLinks); 1369 FreeAndNil(Image); 1321 1370 FreeAndNil(Cells); 1322 1371 inherited Destroy; … … 1575 1624 Terrain := Source.Terrain; 1576 1625 Polygon := Source.Polygon; 1626 Player := Source.Player; 1627 Mark := Source.Mark; 1577 1628 // TODO: How to copy neighbours and moves list 1578 1629 end; … … 1622 1673 MovesTo := TUnitMoves.Create; 1623 1674 MovesTo.OwnsObjects := False; 1675 Links := TCellLinks.Create; 1676 Links.OwnsObjects := False; 1624 1677 end; 1625 1678 … … 1634 1687 TUnitMove(MovesTo[I]).Free; 1635 1688 FreeAndNil(MovesTo); 1689 for I := Links.Count - 1 downto 0 do 1690 TCellLink(Links[I]).Free; 1691 FreeAndNil(Links); 1692 for I := Neighbors.Count - 1 downto 0 do 1693 if TCell(Neighbors[I]).Neighbors.Remove(Self) = -1 then 1694 raise Exception.Create('Can''t remove cell from neighbour cell'); 1636 1695 FreeAndNil(Neighbors); 1637 1696 inherited Destroy; … … 1905 1964 end; 1906 1965 1907 // Unset mark for all cells 1908 for C := 0 to AllCells.Count - 1 do 1909 TCell(AllCells[C]).Mark := False; 1966 Game.Map.Cells.ClearMark; 1910 1967 1911 1968 while TargetCells.Count > 0 do begin … … 2472 2529 var 2473 2530 List: TCells; 2531 BorderList: TCells; 2474 2532 Cell: TCell; 2475 2533 FoundCell1: TCell; … … 2479 2537 NewLink: TCellLink; 2480 2538 begin 2539 List := TCells.Create; 2540 List.OwnsObjects := False; 2541 2542 BorderList := TCells.Create; 2543 BorderList.OwnsObjects := False; 2544 2481 2545 // Build area bridges 2482 2546 if Map.Areas.Count > 1 then 2483 2547 for I := 0 to Map.Areas.Count - 1 do 2484 2548 with TMapArea(Map.Areas[I]) do begin 2485 List := TCells.Create;2486 List.OwnsObjects := False;2487 GetBorderCells(List); 2488 Cell := TCell( List[Random(List.Count)]);2549 GetBorderCells(BorderList); 2550 for J := 0 to 1 do begin 2551 2552 Cell := TCell(BorderList[Random(BorderList.Count)]); 2489 2553 List.Clear; 2490 2554 List.Add(Cell); … … 2502 2566 FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I])); 2503 2567 if Assigned(FoundCell2) then begin 2504 FoundCell1.Neighbors.Add(FoundCell2); 2505 FoundCell2.Neighbors.Add(FoundCell1); 2506 NewLink := TCellLink.Create; 2507 SetLength(NewLink.Points, 2); 2508 NewLink.Cell1 := FoundCell2; 2509 NewLink.Points[0] := FoundCell2.PosPx; 2510 NewLink.Cell2 := FoundCell1; 2511 NewLink.Points[1] := FoundCell1.PosPx; 2512 Map.CellLinks.Add(NewLink); 2513 Inc(BridgeCount); 2568 // Check if link not exists already 2569 if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin 2570 NewLink := TCellLink.Create; 2571 FoundCell1.Neighbors.Add(FoundCell2); 2572 FoundCell1.Links.Add(NewLink); 2573 FoundCell2.Neighbors.Add(FoundCell1); 2574 FoundCell2.Links.Add(NewLink); 2575 SetLength(NewLink.Points, 2); 2576 NewLink.Cells.Add(FoundCell1); 2577 NewLink.Points[0] := FoundCell1.PosPx; 2578 NewLink.Cells.Add(FoundCell2); 2579 NewLink.Points[1] := FoundCell2.PosPx; 2580 NewLink.Map := Map; 2581 Map.CellLinks.Add(NewLink); 2582 Inc(BridgeCount); 2583 end; 2514 2584 end; 2515 2585 end; 2516 2517 List.Free; 2518 end; 2586 end; 2587 2588 end; 2589 List.Free; 2590 BorderList.Free; 2519 2591 end; 2520 2592 … … 2561 2633 2562 2634 procedure TGame.LoadConfig(Config: TXmlConfig; Path: string); 2563 var2564 P: TPoint;2565 2635 begin 2566 2636 with Config do begin … … 2643 2713 Doc: TXMLDocument; 2644 2714 RootNode: TDOMNode; 2645 I: Integer;2646 2715 begin 2647 2716 Self.FileName := FileName; … … 2820 2889 2821 2890 BuildTerrain; 2891 2892 // Build bridges 2893 2822 2894 if BridgeEnabled then begin 2823 // Connect all areas to all cells be accessible2824 for I := 0 to Map.CellLinks.Count - 1 do2825 with TCellLink(Map.CellLinks[I]) do begin2826 Cell1.Neighbors.Remove(Cell2);2827 Cell2.Neighbors.Remove(Cell1);2828 end;2829 2895 Map.CellLinks.Clear; 2830 2896 BuildMapAreas; … … 2836 2902 end; 2837 2903 end; 2904 2838 2905 2839 2906 if SymetricMap then begin -
trunk/xtactics.lpi
r102 r103 18 18 <StringTable ProductVersion=""/> 19 19 </VersionInfo> 20 <MacroValues Count="2"> 21 <Macro2 Name="LCLWidgetType" Value="qt"/> 22 </MacroValues> 20 23 <BuildModes Count="2"> 21 24 <Item1 Name="Debug" Default="True"/> … … 58 61 </CompilerOptions> 59 62 </Item2> 63 <SharedMatrixOptions Count="2"> 64 <Item1 ID="345389164333" Modes="Debug" Type="IDEMacro"/> 65 <Item2 ID="462723536445" Modes="Debug" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt"/> 66 </SharedMatrixOptions> 60 67 </BuildModes> 61 68 <PublishOptions>
Note:
See TracChangeset
for help on using the changeset viewer.