Changeset 128 for trunk/UEngine.pas
- Timestamp:
- May 1, 2023, 11:21:30 AM (13 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UEngine.pas
r127 r128 10 10 URegistry, UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu, 11 11 UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric, 12 UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils ;12 UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils, UItems; 13 13 14 14 type … … 24 24 { TMapStation } 25 25 26 TMapStation = class 26 TMapStation = class(TItem) 27 27 private 28 28 procedure ShiftTrackPoints; … … 39 39 function GetMaxPassengers: Integer; 40 40 function IsBestStationForShape(DestinationIndex: TDestinationIndex; Check, Current: TLineStation): Boolean; 41 procedure LoadFromXmlNode(Node: TDOMNode); 42 procedure SaveToXmlNode(Node: TDOMNode); 41 class function GetClassSysName: string; override; 42 procedure LoadFromXmlNode(Node: TDOMNode); override; 43 procedure SaveToXmlNode(Node: TDOMNode); override; 43 44 constructor Create; 44 45 destructor Destroy; override; … … 47 48 { TMapStations } 48 49 49 TMapStations = class(T ObjectList<TMapStation>)50 TMapStations = class(TItems<TMapStation>) 50 51 Engine: TEngine; 52 function CreateItem: TMapStation; override; 51 53 function GetRect: TRect; 52 54 function AddNew: TMapStation; 53 procedure LoadFromXmlNode(Node: TDOMNode); 54 procedure SaveToXmlNode(Node: TDOMNode); 55 class function GetClassSysName: string; override; 55 56 end; 56 57 57 58 { TLineStation } 58 59 59 TLineStation = class 60 TLineStation = class(TItem) 60 61 Line: TMetroLine; 61 62 MapStation: TMapStation; 62 63 TrackPoint: TTrackPoint; 64 class function GetClassSysName: string; override; 65 procedure LoadFromXmlNode(Node: TDOMNode); override; 66 procedure SaveToXmlNode(Node: TDOMNode); override; 63 67 end; 64 68 65 69 { TLineStations } 66 70 67 TLineStations = class(T ObjectList<TLineStation>)71 TLineStations = class(TItems<TLineStation>) 68 72 Line: TMetroLine; 73 function CreateItem: TLineStation; override; 69 74 function SearchMapStation(Station: TMapStation): TLineStation; 75 class function GetClassSysName: string; override; 70 76 end; 71 77 72 78 { TMetroLine } 73 79 74 TMetroLine = class 80 TMetroLine = class(TItem) 75 81 private 76 82 procedure UpdateEndingLine(EndIndex, Direction: Integer); 77 83 procedure UpdateEndingLines; 78 84 public 79 Id: Integer;80 85 Index: Integer; 81 86 Engine: TEngine; … … 89 94 destructor Destroy; override; 90 95 function IsCircular: Boolean; 91 procedure LoadFromXmlNode(Node: TDOMNode); 92 procedure SaveToXmlNode(Node: TDOMNode); 96 class function GetClassSysName: string; override; 97 procedure LoadFromXmlNode(Node: TDOMNode); override; 98 procedure SaveToXmlNode(Node: TDOMNode); override; 93 99 end; 94 100 95 101 { TMetroLines } 96 102 97 TMetroLines = class(T ObjectList<TMetroLine>)103 TMetroLines = class(TItems<TMetroLine>) 98 104 Engine: TEngine; 105 function CreateItem: TMetroLine; override; 99 106 function AddNew(Color: TColor): TMetroLine; 100 function FindById(Id: Integer): TMetroLine;101 107 function SearchByColor(Color: TColor): TMetroLine; 102 procedure LoadFromXmlNode(Node: TDOMNode); 103 procedure SaveToXmlNode(Node: TDOMNode); 108 class function GetClassSysName: string; override; 104 109 end; 105 110 106 111 { TMetroCarriage } 107 112 108 TMetroCarriage = class 113 TMetroCarriage = class(TItem) 109 114 Train: TMetroTrain; 110 115 Passengers: TMetroPassengers; … … 113 118 constructor Create; 114 119 destructor Destroy; override; 120 class function GetClassSysName: string; override; 121 procedure LoadFromXmlNode(Node: TDOMNode); override; 122 procedure SaveToXmlNode(Node: TDOMNode); override; 115 123 end; 116 124 117 125 { TMetroCarriages } 118 126 119 TMetroCarriages = class(T ObjectList<TMetroCarriage>)127 TMetroCarriages = class(TItems<TMetroCarriage>) 120 128 function GetUnused: TMetroCarriage; 121 129 function GetUnusedCount: Integer; 122 function AddNew: TMetroCarriage;130 class function GetClassSysName: string; override; 123 131 end; 124 132 125 133 { TMetroTrain } 126 134 127 TMetroTrain = class 135 TMetroTrain = class(TItem) 128 136 private 129 137 FLine: TMetroLine; … … 140 148 TargetStation: TLineStation; 141 149 Carriages: TMetroCarriages; 142 procedure LoadFromXmlNode(Node: TDOMNode); 143 procedure SaveToXmlNode(Node: TDOMNode); 150 class function GetClassSysName: string; override; 151 procedure LoadFromXmlNode(Node: TDOMNode); override; 152 procedure SaveToXmlNode(Node: TDOMNode); override; 144 153 procedure FindTargetStation; 145 154 function GetTargetStationDistance: Integer; … … 151 160 { TMetroTrains } 152 161 153 TMetroTrains = class(TObjectList<TMetroTrain>) 162 TMetroTrains = class(TItems<TMetroTrain>) 163 Engine: TEngine; 154 164 function GetUnused: TMetroTrain; 155 165 function GetUnusedCount: Integer; 156 function AddNew: TMetroTrain; 157 procedure LoadFromXmlNode(Node: TDOMNode); 158 procedure SaveToXmlNode(Node: TDOMNode); 166 function CreateItem: TMetroTrain; override; 167 class function GetClassSysName: string; override; 159 168 end; 160 169 … … 228 237 GrabbedTrainDirection: Integer; 229 238 LastGrabbedTrain: TMetroTrain; 239 SavedGameFileName: string; 230 240 function GetMetroLineThickness: Integer; 231 241 function GetServedDaysCount: Integer; … … 274 284 procedure MenuItemGameExit(Sender: TObject); 275 285 procedure MenuItemGameRestart(Sender: TObject); 286 procedure MenuItemGameLoad(Sender: TObject); 287 procedure MenuItemGameSave(Sender: TObject); 276 288 procedure MenuItemBack(Sender: TObject); 277 289 procedure ButtonPlay(Sender: TObject); … … 350 362 procedure LoadFromRegistry; 351 363 procedure SaveToRegistry; 364 procedure LoadFromXmlNode(Node: TDOMNode); 365 procedure SaveToXmlNode(Node: TDOMNode); 352 366 procedure LoadFromFile(FileName: string); 353 367 procedure SaveToFile(FileName: string); … … 399 413 NewPassengerProbability = 0.003; 400 414 VisiblePassengersPerLine = 6; 415 TransLinesExt = '.tlg'; 401 416 402 417 … … 421 436 STrain = 'Train'; 422 437 SPlay = 'Play'; 438 SLoad = 'Load'; 439 SSave = 'Save'; 423 440 SCustomGame = 'Custom game'; 424 441 SOptions = 'Options'; … … 468 485 VisualStyleText: array[TVisualStyle] of string = (SLondon, SPrague); 469 486 487 const 488 GameXmlName = 'TransLinesGame'; 489 490 { TLineStation } 491 492 class function TLineStation.GetClassSysName: string; 493 begin 494 Result := 'LineStation'; 495 end; 496 497 procedure TLineStation.LoadFromXmlNode(Node: TDOMNode); 498 begin 499 inherited; 500 MapStation := Line.Engine.Stations.FindById(ReadInteger(Node, 'MapStation', 0)); 501 TrackPoint := Line.Track.Points.FindById(ReadInteger(Node, 'TrackPoint', 0)); 502 TrackPoint.OwnerPoint := Self; 503 end; 504 505 procedure TLineStation.SaveToXmlNode(Node: TDOMNode); 506 begin 507 inherited; 508 WriteInteger(Node, 'MapStation', MapStation.Id); 509 WriteInteger(Node, 'TrackPoint', TrackPoint.Id); 510 end; 511 470 512 { TClock } 471 513 … … 538 580 end; 539 581 582 class function TMetroCarriage.GetClassSysName: string; 583 begin 584 Result := 'Carriage'; 585 end; 586 587 procedure TMetroCarriage.LoadFromXmlNode(Node: TDOMNode); 588 var 589 Node2: TDOMNode; 590 begin 591 inherited; 592 593 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName)); 594 if Assigned(Node2) then 595 Passengers.LoadFromXmlNodeRef(Node2, Train.Engine.Passengers); 596 end; 597 598 procedure TMetroCarriage.SaveToXmlNode(Node: TDOMNode); 599 var 600 NewNode: TDOMNode; 601 begin 602 inherited; 603 604 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName)); 605 Node.AppendChild(NewNode); 606 Passengers.SaveToXmlNodeRef(NewNode); 607 end; 608 540 609 { TMetroCarriages } 541 610 … … 559 628 end; 560 629 561 function TMetroCarriages.AddNew: TMetroCarriage; 562 begin 563 Result := TMetroCarriage.Create; 564 Add(Result); 630 class function TMetroCarriages.GetClassSysName: string; 631 begin 632 Result := 'Carriages'; 565 633 end; 566 634 … … 579 647 580 648 { TLineStations } 649 650 function TLineStations.CreateItem: TLineStation; 651 begin 652 Result := inherited; 653 Result.Line := Line; 654 end; 581 655 582 656 function TLineStations.SearchMapStation(Station: TMapStation): TLineStation; … … 590 664 end; 591 665 666 class function TLineStations.GetClassSysName: string; 667 begin 668 Result := 'LineStations'; 669 end; 670 592 671 { TMetroTrains } 593 672 … … 611 690 end; 612 691 613 function TMetroTrains.AddNew: TMetroTrain; 614 begin 615 Result := TMetroTrain.Create; 616 Add(Result); 617 end; 618 619 procedure TMetroTrains.LoadFromXmlNode(Node: TDOMNode); 620 var 621 Node2: TDOMNode; 622 NewItem: TMetroTrain; 623 begin 624 Node2 := Node.FirstChild; 625 while Assigned(Node2) and (Node2.NodeName = 'Train') do begin 626 NewItem := TMetroTrain.Create; 627 NewItem.LoadFromXmlNode(Node2); 628 Add(NewItem); 629 Node2 := Node2.NextSibling; 630 end; 631 end; 632 633 procedure TMetroTrains.SaveToXmlNode(Node: TDOMNode); 634 var 635 I: Integer; 636 NewNode: TDOMNode; 637 begin 638 for I := 0 to Count - 1 do begin; 639 NewNode := Node.OwnerDocument.CreateElement('Train'); 640 Node.AppendChild(NewNode); 641 Items[I].SaveToXmlNode(NewNode); 642 end; 692 function TMetroTrains.CreateItem: TMetroTrain; 693 begin 694 Result := inherited; 695 Result.Engine := Engine; 696 end; 697 698 class function TMetroTrains.GetClassSysName: string; 699 begin 700 Result := 'Trains'; 643 701 end; 644 702 645 703 { TMapStations } 704 705 function TMapStations.CreateItem: TMapStation; 706 begin 707 Result := inherited; 708 Result.Engine := Engine; 709 end; 646 710 647 711 function TMapStations.GetRect: TRect; … … 673 737 Step = 20; 674 738 begin 675 Result := TMapStation.Create; 676 Result.Engine := Engine; 739 Result := CreateItem; 677 740 Angle := Random * 2 * Pi; 678 741 // Ensure minimum distance between stations … … 696 759 end; 697 760 698 procedure TMapStations.LoadFromXmlNode(Node: TDOMNode); 699 var 700 Node2: TDOMNode; 701 NewItem: TMapStation; 702 begin 703 Node2 := Node.FirstChild; 704 while Assigned(Node2) and (Node2.NodeName = 'Line') do begin 705 NewItem := TMapStation.Create; 706 NewItem.LoadFromXmlNode(Node2); 707 Add(NewItem); 708 Node2 := Node2.NextSibling; 709 end; 710 end; 711 712 procedure TMapStations.SaveToXmlNode(Node: TDOMNode); 713 var 714 I: Integer; 715 NewNode: TDOMNode; 716 begin 717 for I := 0 to Count - 1 do begin; 718 NewNode := Node.OwnerDocument.CreateElement('Station'); 719 Node.AppendChild(NewNode); 720 Items[I].SaveToXmlNode(NewNode); 721 end; 761 class function TMapStations.GetClassSysName: string; 762 begin 763 Result := 'MapStations'; 722 764 end; 723 765 724 766 { TMetroLines } 725 767 768 function TMetroLines.CreateItem: TMetroLine; 769 begin 770 Result := inherited; 771 Result.Engine := Engine; 772 end; 773 726 774 function TMetroLines.AddNew(Color: TColor): TMetroLine; 727 775 begin 728 Result := TMetroLine.Create; 729 Result.Engine := Engine; 776 Result := AddItem; 730 777 Result.Index := Count; 731 778 Result.Color := Color; 732 Add(Result);733 end;734 735 function TMetroLines.FindById(Id: Integer): TMetroLine;736 var737 I: Integer;738 begin739 I := 0;740 while (I < Count) and (Items[I].Id <> Id) do Inc(I);741 if I < Count then Result := Items[I]742 else Result := nil;743 779 end; 744 780 … … 753 789 end; 754 790 755 procedure TMetroLines.LoadFromXmlNode(Node: TDOMNode); 756 var 757 Node2: TDOMNode; 758 NewItem: TMetroLine; 759 begin 760 Node2 := Node.FirstChild; 761 while Assigned(Node2) and (Node2.NodeName = 'Line') do begin 762 NewItem := TMetroLine.Create; 763 NewItem.LoadFromXmlNode(Node2); 764 Add(NewItem); 765 Node2 := Node2.NextSibling; 766 end; 767 end; 768 769 procedure TMetroLines.SaveToXmlNode(Node: TDOMNode); 770 var 771 I: Integer; 772 NewNode: TDOMNode; 773 begin 774 for I := 0 to Count - 1 do begin; 775 NewNode := Node.OwnerDocument.CreateElement('Line'); 776 Node.AppendChild(NewNode); 777 Items[I].SaveToXmlNode(NewNode); 778 end; 791 class function TMetroLines.GetClassSysName: string; 792 begin 793 Result := 'Lines'; 779 794 end; 780 795 … … 817 832 Index := Track.Points.IndexOf(LineStations.First.TrackPoint); 818 833 if Index = 0 then begin 819 NewTrackPoint := Track.Points. AddNew;834 NewTrackPoint := Track.Points.CreateItem; 820 835 Track.Points.Insert(0, NewTrackPoint); 821 836 end; 822 837 Index := Track.Points.IndexOf(LineStations.Last.TrackPoint); 823 838 if Index = Track.Points.Count - 1 then begin 824 NewTrackPoint := Track.Points. AddNew;839 NewTrackPoint := Track.Points.CreateItem; 825 840 Track.Points.Insert(Track.Points.Count, NewTrackPoint); 826 841 end; … … 850 865 Station.Lines.Add(Self); 851 866 852 NewTrackPoint := Track.Points. AddNew;867 NewTrackPoint := Track.Points.CreateItem; 853 868 NewTrackPoint.OwnerPoint := NewLineStation; 854 869 NewTrackPoint.Position := Station.Position; … … 955 970 LineStations := TLineStations.Create; 956 971 LineStations.OwnsObjects := True; 972 LineStations.Line := Self; 957 973 Trains := TMetroTrains.Create; 958 974 Trains.OwnsObjects := False; … … 976 992 end; 977 993 994 class function TMetroLine.GetClassSysName: string; 995 begin 996 Result := 'Line'; 997 end; 998 978 999 procedure TMetroLine.LoadFromXmlNode(Node: TDOMNode); 979 1000 var 980 1001 Node2: TDOMNode; 981 1002 begin 982 Id := ReadInteger(Node, 'Id', Id);1003 inherited; 983 1004 Color := TColor(ReadInteger(Node, 'Color', Color)); 984 985 Node2 := Node.FindNode('Track'); 1005 Index := TColor(ReadInteger(Node, 'Index', Index)); 1006 1007 Node2 := Node.FindNode(DOMString(TTrack.GetClassSysName)); 986 1008 if Assigned(Node2) then 987 1009 Track.LoadFromXmlNode(Node2); 1010 1011 Node2 := Node.FindNode(DOMString(TLineStations.GetClassSysName)); 1012 if Assigned(Node2) then 1013 LineStations.LoadFromXmlNode(Node2); 988 1014 end; 989 1015 … … 992 1018 Node2: TDOMNode; 993 1019 begin 994 WriteInteger(Node, 'Id', Id);1020 inherited; 995 1021 WriteInteger(Node, 'Color', Color); 996 997 Node2 := Node.OwnerDocument.CreateElement('Track'); 1022 WriteInteger(Node, 'Index', Index); 1023 1024 LineStations.RebuildItemsId; 1025 1026 Node2 := Node.OwnerDocument.CreateElement(DOMString(TTrack.GetClassSysName)); 998 1027 Node.AppendChild(Node2); 999 1028 Track.SaveToXmlNode(Node2); 1029 1030 Node2 := Node.OwnerDocument.CreateElement(DOMString(TLineStations.GetClassSysName)); 1031 Node.AppendChild(Node2); 1032 LineStations.SaveToXmlNode(Node2); 1000 1033 end; 1001 1034 … … 1013 1046 end; 1014 1047 1048 class function TMetroTrain.GetClassSysName: string; 1049 begin 1050 Result := 'Train'; 1051 end; 1052 1015 1053 procedure TMetroTrain.LoadFromXmlNode(Node: TDOMNode); 1016 begin 1054 var 1055 Node2: TDOMNode; 1056 begin 1057 inherited; 1017 1058 Line := Engine.Lines.FindById(ReadInteger(Node, 'Line', 0)); 1059 Direction := ReadInteger(Node, 'Direction', Direction); 1060 if Assigned(Line) then begin 1061 Line.Trains.Add(Self); 1062 TargetStation := Line.LineStations.FindById(ReadInteger(Node, 'TargetStation', 0)); 1063 TrackPosition.LoadFromXmlNode(Node, Line.Track.Points); 1064 end; 1065 1066 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName)); 1067 if Assigned(Node2) then 1068 Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers); 1069 1070 Node2 := Node.FindNode(DOMString(TMetroCarriages.GetClassSysName)); 1071 if Assigned(Node2) then 1072 Carriages.LoadFromXmlNodeRef(Node2, Engine.Carriages); 1018 1073 end; 1019 1074 1020 1075 procedure TMetroTrain.SaveToXmlNode(Node: TDOMNode); 1021 begin 1076 var 1077 NewNode: TDOMNode; 1078 begin 1079 inherited; 1022 1080 if Assigned(Line) then WriteInteger(Node, 'Line', Line.Id) 1023 1081 else WriteInteger(Node, 'Line', 0); 1082 WriteInteger(Node, 'Direction', Direction); 1083 if Assigned(TargetStation) then WriteInteger(Node, 'TargetStation', TargetStation.Id) 1084 else WriteInteger(Node, 'TargetStation', 0); 1085 TrackPosition.SaveToXmlNode(Node); 1086 1087 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName)); 1088 Node.AppendChild(NewNode); 1089 Passengers.SaveToXmlNodeRef(NewNode); 1090 1091 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroCarriages.GetClassSysName)); 1092 Node.AppendChild(NewNode); 1093 Carriages.SaveToXmlNodeRef(NewNode); 1024 1094 end; 1025 1095 … … 1258 1328 end; 1259 1329 1330 class function TMapStation.GetClassSysName: string; 1331 begin 1332 Result := 'MapStation'; 1333 end; 1334 1260 1335 procedure TMapStation.LoadFromXmlNode(Node: TDOMNode); 1261 begin 1336 var 1337 Node2: TDOMNode; 1338 begin 1339 inherited; 1262 1340 Position.X := ReadInteger(Node, 'PositionX', Position.X); 1263 1341 Position.Y := ReadInteger(Node, 'PositionY', Position.Y); 1264 1342 DestinationIndex := ReadInteger(Node, 'DestinationIndex', Integer(DestinationIndex)); 1265 1343 IsTerminal := ReadBoolean(Node, 'IsTerminal', IsTerminal); 1344 1345 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName)); 1346 if Assigned(Node2) then 1347 Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers); 1266 1348 end; 1267 1349 1268 1350 procedure TMapStation.SaveToXmlNode(Node: TDOMNode); 1269 begin 1351 var 1352 NewNode: TDOMNode; 1353 begin 1354 inherited; 1270 1355 WriteInteger(Node, 'PositionX', Position.X); 1271 1356 WriteInteger(Node, 'PositionY', Position.Y); 1272 1357 WriteInteger(Node, 'DestinationIndex', DestinationIndex); 1273 1358 WriteBoolean(Node, 'IsTerminal', IsTerminal); 1359 1360 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName)); 1361 Node.AppendChild(NewNode); 1362 Passengers.SaveToXmlNodeRef(NewNode); 1274 1363 end; 1275 1364 … … 1585 1674 Station: TMapStation; 1586 1675 begin 1587 // NewGameall distances1676 // Reset all distances 1588 1677 for Station in Stations do 1589 1678 with Station do begin … … 1855 1944 MapStation: TMapStation; 1856 1945 begin 1857 // NewGameall trackpoints position shift1946 // Reset all trackpoints position shift 1858 1947 for MetroLine in Lines do 1859 1948 for TrackPoint in MetroLine.Track.Points do … … 1866 1955 // Compute track points from track shift 1867 1956 for MetroLine in Lines do 1868 with MetroLine do begin1957 with MetroLine, Track do begin 1869 1958 // Update start 1870 if Track.Points.Count > 1 then begin1871 Track.Points[0].Position := Track.Points[0].PositionDesigned +1872 Track.Points[0].LinkUp.Shift;1873 end; 1874 1875 for I := 1 to Track.Points.Count - 1 do1876 with T rack.Points[I]do1877 if Assigned( Track.Points[I].LinkDown) and Assigned(Track.Points[I].LinkUp) then begin1959 if Points.Count > 1 then begin 1960 if not Assigned(Points[0].LinkUp) then Points[0].GetLinkUp; 1961 Points[0].Position := Points[0].PositionDesigned + Points[0].LinkUp.Shift; 1962 end; 1963 1964 for I := 1 to Points.Count - 1 do 1965 with TTrackPoint(Points[I]) do 1966 if Assigned(Points[I].LinkDown) and Assigned(Points[I].LinkUp) then begin 1878 1967 { 1879 1968 Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) - … … 1890 1979 end else begin} 1891 1980 // Intersected lines 1892 if LineIntersect( Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift,1893 Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift,1894 Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift,1895 Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift, NewPoint) then begin1896 Track.Points[I].Position := NewPoint;1981 if LineIntersect(Points[I - 1].PositionDesigned + Points[I].LinkDown.Shift, 1982 Points[I].PositionDesigned + Points[I].LinkDown.Shift, 1983 Points[I].PositionDesigned + Points[I].LinkUp.Shift, 1984 Points[I + 1].PositionDesigned + Points[I].LinkUp.Shift, NewPoint) then begin 1985 Points[I].Position := NewPoint; 1897 1986 end else begin 1898 1987 // Parallel lines 1899 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;1900 Track.Points[I].Position := NewPoint;1988 NewPoint := Points[I].PositionDesigned + Points[I].LinkDown.Shift; 1989 Points[I].Position := NewPoint; 1901 1990 end; 1902 1991 // end; 1903 1992 1904 1993 // Update ending 1905 if Track.Points.Count > 1 then begin 1906 Track.Points[Track.Points.Count - 1].Position := Track.Points[Track.Points.Count - 1].PositionDesigned - 1907 Track.Points[Track.Points.Count - 1].LinkDown.Shift; 1994 if Points.Count > 1 then begin 1995 if not Assigned(Points[Points.Count - 1].LinkDown) then 1996 Points[Points.Count - 1].GetLinkDown; 1997 Points[Points.Count - 1].Position := Points[Points.Count - 1].PositionDesigned - 1998 Points[Points.Count - 1].LinkDown.Shift; 1908 1999 end; 1909 2000 end; 1910 2001 1911 2002 // Update ending 1912 if Track.Points.Count > 1 then begin 1913 Track.Points[Track.Points.Count - 1].Position := Track.Points[Track.Points.Count - 1].PositionDesigned - 1914 Track.Points[Track.Points.Count - 1].LinkDown.Shift; 2003 if Points.Count > 1 then begin 2004 if not Assigned(Points[Points.Count - 1].LinkDown) then 2005 Points[Points.Count - 1].GetLinkDown; 2006 Points[Points.Count - 1].Position := Points[Points.Count - 1].PositionDesigned - 2007 Points[Points.Count - 1].LinkDown.Shift; 1915 2008 end; 1916 2009 end; … … 1918 2011 // Remove all temporal links 1919 2012 for MetroLine in Lines do 1920 with MetroLine do begin1921 for J := 0 to Track.Points.Count - 1 do1922 if Assigned( Track.Points[J].LinkUp) then begin1923 Track.Points[J].LinkUp.Free;1924 Track.Points[J].LinkUp := nil;1925 Track.Points[J + 1].LinkDown := nil;2013 with MetroLine, Track do begin 2014 for J := 0 to Points.Count - 1 do 2015 if Assigned(Points[J].LinkUp) then begin 2016 Points[J].LinkUp.Free; 2017 Points[J].LinkUp := nil; 2018 Points[J + 1].LinkDown := nil; 1926 2019 end; 1927 2020 end; … … 2059 2152 2060 2153 procedure TEngine.MenuItemCustomGame(Sender: TObject); 2061 var2062 VisualStyleIndex: TVisualStyle;2063 StationStyleIndex: TStationStyle;2064 2154 begin 2065 2155 MenuCustomGame.Parent := MenuMain; … … 2127 2217 Index: Integer; 2128 2218 begin 2129 Trains.Add New;2219 Trains.AddItem; 2130 2220 State := gsNewImprovement; 2131 2221 if Lines.Count <= (High(LineColors) - Low(LineColors)) then … … 2196 2286 end; 2197 2287 2288 procedure TEngine.MenuItemGameLoad(Sender: TObject); 2289 begin 2290 LoadFromFile(SavedGameFileName); 2291 State := gsRunning; 2292 end; 2293 2294 procedure TEngine.MenuItemGameSave(Sender: TObject); 2295 begin 2296 SaveToFile(SavedGameFileName); 2297 State := LastState; 2298 end; 2299 2198 2300 procedure TEngine.DarkModeChanged(Sender: TObject); 2199 2301 begin … … 2321 2423 case Improvement of 2322 2424 miLine: Lines.AddNew(LineColors[Lines.Count]); 2323 miCarriage: Carriages.Add New;2425 miCarriage: Carriages.AddItem; 2324 2426 //miTunnel: Tunnels.AddNew; 2325 2427 miTerminal: Inc(AvailableTerminals); … … 2368 2470 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2369 2471 end; 2472 with AddButton(SLoad, MenuItemGameLoad) do begin 2473 Enabled := FileExists(SavedGameFileName); 2474 TextSize := 40; 2475 TextColor := Colors.MenuItemText; 2476 TextDisabledColor := Colors.MenuItemDisabledText; 2477 BackgroundColor := Colors.MenuItemBackground; 2478 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2479 end; 2370 2480 { 2371 2481 with AddButton(SCustomGame, MenuItemCustomGame) do begin … … 2411 2521 end; 2412 2522 with AddButton(SRestart, MenuItemGameRestart) do begin 2523 TextSize := 40; 2524 TextColor := Colors.MenuItemText; 2525 TextDisabledColor := Colors.MenuItemDisabledText; 2526 BackgroundColor := Colors.MenuItemBackground; 2527 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2528 end; 2529 with AddButton(SLoad, MenuItemGameLoad) do begin 2530 Enabled := FileExists(SavedGameFileName); 2531 TextSize := 40; 2532 TextColor := Colors.MenuItemText; 2533 TextDisabledColor := Colors.MenuItemDisabledText; 2534 BackgroundColor := Colors.MenuItemBackground; 2535 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected; 2536 end; 2537 with AddButton(SSave, MenuItemGameSave) do begin 2413 2538 TextSize := 40; 2414 2539 TextColor := Colors.MenuItemText; … … 3304 3429 with MapStation do 3305 3430 if Random < NewPassengerProbability then begin 3306 Passenger := Self.Passengers.Add New;3431 Passenger := Self.Passengers.AddItem; 3307 3432 Passenger.DestinationIndex := Random(DestinationCount); 3308 3433 Passengers.Add(Passenger); … … 3538 3663 Station: TMapStation; 3539 3664 NewLine: TMetroLine; 3540 Track : TTrackLink;3665 TrackLink: TTrackLink; 3541 3666 NewIndex: Integer; 3542 3667 Intersection: TPoint; … … 3581 3706 end; 3582 3707 3583 // New track creation from selected station as start3708 // New TrackLink creation from selected station as start 3584 3709 Station := GetStationOnPos(View.PointDestToSrc(Position)); 3585 3710 if Assigned(Station) then begin … … 3596 3721 3597 3722 // Line selection 3598 Track := GetTrackOnPos(View.PointDestToSrc(Position), Intersection);3599 if Assigned(Track ) and Assigned(Track.Points[0]) and Assigned(Track.Points[1]) then begin3600 SelectedLine := TMetroLine(Track .Points[0].Track.Owner);3601 3602 TrackStationDown := Track .Points[0];3723 TrackLink := GetTrackOnPos(View.PointDestToSrc(Position), Intersection); 3724 if Assigned(TrackLink) and Assigned(TrackLink.Points[0]) and Assigned(TrackLink.Points[1]) then begin 3725 SelectedLine := TMetroLine(TrackLink.Points[0].Track.Owner); 3726 3727 TrackStationDown := TrackLink.Points[0]; 3603 3728 NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown); 3604 3729 while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.OwnerPoint)) do begin … … 3607 3732 else TrackStationDown := nil; 3608 3733 end; 3609 TrackStationUp := Track .Points[1];3734 TrackStationUp := TrackLink.Points[1]; 3610 3735 NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown); 3611 3736 while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.OwnerPoint)) do begin … … 3622 3747 end; 3623 3748 3624 Track .Free;3749 TrackLink.Free; 3625 3750 Exit; 3626 3751 end; 3627 if Assigned(Track ) then Track.Free;3752 if Assigned(TrackLink) then TrackLink.Free; 3628 3753 end; 3629 3754 end; … … 3682 3807 end; 3683 3808 if Key = KeyF3 then begin 3684 Trains.Add New;3809 Trains.AddItem; 3685 3810 Redraw; 3686 3811 end; 3687 3812 if Key = KeyF4 then begin 3688 Carriages.Add New;3813 Carriages.AddItem; 3689 3814 Redraw; 3690 3815 end; … … 3822 3947 end; 3823 3948 3949 procedure TEngine.LoadFromXmlNode(Node: TDOMNode); 3950 var 3951 NewNode: TDOMNode; 3952 Node2: TDOMNode; 3953 begin 3954 Clear; 3955 ServedPassengerCount := ReadInteger(Node, 'ServedPassengerCount', ServedPassengerCount); 3956 DestinationCount := ReadInteger(Node, 'DestinationCount', DestinationCount); 3957 State := TGameState(ReadInteger(Node, 'State', Integer(gsNotStarted))); 3958 FTime := ReadDateTime(Node, 'Time', 0); 3959 FLastTime := FTime; 3960 3961 NewNode := Node.FindNode(DOMString(TView.GetClassSysName)); 3962 if Assigned(NewNode) then 3963 View.LoadFromXmlNode(NewNode); 3964 3965 SetLength(LineColors, 0); 3966 NewNode := Node.FindNode('LineColors'); 3967 if Assigned(NewNode) then begin 3968 Node2 := NewNode.FirstChild; 3969 while Assigned(Node2) and (Node2.NodeName = 'LineColor') do begin 3970 SetLength(LineColors, Length(LineColors) + 1); 3971 LineColors[Length(LineColors) - 1] := TColor(StrToInt(string(Node2.TextContent))); 3972 Node2 := Node2.NextSibling; 3973 end; 3974 end; 3975 3976 NewNode := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName)); 3977 if Assigned(NewNode) then 3978 Passengers.LoadFromXmlNode(NewNode); 3979 3980 NewNode := Node.FindNode(DOMString(TMapStations.GetClassSysName)); 3981 if Assigned(NewNode) then 3982 Stations.LoadFromXmlNode(NewNode); 3983 3984 NewNode := Node.FindNode(DOMString(TMetroLines.GetClassSysName)); 3985 if Assigned(NewNode) then 3986 Lines.LoadFromXmlNode(NewNode); 3987 3988 NewNode := Node.FindNode(DOMString(TMetroTrains.GetClassSysName)); 3989 if Assigned(NewNode) then 3990 Trains.LoadFromXmlNode(NewNode); 3991 3992 NewNode := Node.FindNode(DOMString(TMetroCarriages.GetClassSysName)); 3993 if Assigned(NewNode) then 3994 Carriages.LoadFromXmlNode(NewNode); 3995 end; 3996 3997 procedure TEngine.SaveToXmlNode(Node: TDOMNode); 3998 var 3999 I: Integer; 4000 NewNode: TDOMNode; 4001 begin 4002 Lines.RebuildItemsId; 4003 Stations.RebuildItemsId; 4004 Passengers.RebuildItemsId; 4005 4006 WriteInteger(Node, 'ServedPassengerCount', ServedPassengerCount); 4007 WriteInteger(Node, 'DestinationCount', DestinationCount); 4008 WriteInteger(Node, 'State', Integer(State)); 4009 WriteDateTime(Node, 'Time', FTime); 4010 4011 NewNode := Node.OwnerDocument.CreateElement(DOMString(TView.GetClassSysName)); 4012 Node.AppendChild(NewNode); 4013 View.SaveToXmlNode(NewNode); 4014 4015 NewNode := Node.OwnerDocument.CreateElement('LineColors'); 4016 Node.AppendChild(NewNode); 4017 for I := 0 to Length(LineColors) - 1 do begin 4018 WriteInteger(NewNode, 'LineColor', Integer(LineColors[I])); 4019 end; 4020 4021 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName)); 4022 Node.AppendChild(NewNode); 4023 Passengers.SaveToXmlNode(NewNode); 4024 4025 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMapStations.GetClassSysName)); 4026 Node.AppendChild(NewNode); 4027 Stations.SaveToXmlNode(NewNode); 4028 4029 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroLines.GetClassSysName)); 4030 Node.AppendChild(NewNode); 4031 Lines.SaveToXmlNode(NewNode); 4032 4033 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroTrains.GetClassSysName)); 4034 Node.AppendChild(NewNode); 4035 Trains.SaveToXmlNode(NewNode); 4036 4037 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroCarriages.GetClassSysName)); 4038 Node.AppendChild(NewNode); 4039 Carriages.SaveToXmlNode(NewNode); 4040 end; 4041 3824 4042 procedure TEngine.LoadFromFile(FileName: string); 3825 4043 var 3826 NewNode: TDOMNode;3827 4044 Doc: TXMLDocument; 3828 4045 RootNode: TDOMNode; … … 3831 4048 Clear; 3832 4049 with Doc do try 3833 if (Doc.DocumentElement.NodeName <> 'BigMetroGame') and 3834 (Doc.DocumentElement.NodeName <> 'TransLinesGame') then 4050 if Doc.DocumentElement.NodeName <> GameXmlName then 3835 4051 raise Exception.Create(SWrongFileFormat); 3836 4052 RootNode := Doc.DocumentElement; 3837 with RootNode do begin 3838 ServedPassengerCount := ReadInteger(RootNode, 'ServedPassengerCount', ServedPassengerCount); 3839 3840 NewNode := FindNode('Stations'); 3841 Stations.LoadFromXmlNode(NewNode); 3842 3843 NewNode := FindNode('Lines'); 3844 Lines.LoadFromXmlNode(NewNode); 3845 3846 NewNode := FindNode('Trains'); 3847 Trains.LoadFromXmlNode(NewNode); 3848 end; 4053 LoadFromXmlNode(RootNode); 3849 4054 finally 3850 4055 FreeAndNil(Doc); … … 3854 4059 procedure TEngine.SaveToFile(FileName: string); 3855 4060 var 3856 NewNode: TDOMNode;3857 4061 Doc: TXMLDocument; 3858 4062 RootNode: TDOMNode; 3859 I: Integer;3860 4063 begin 3861 4064 Doc := TXMLDocument.Create; 3862 4065 with Doc do try 3863 RootNode := CreateElement( 'TransLinesGame');4066 RootNode := CreateElement(GameXmlName); 3864 4067 AppendChild(RootNode); 3865 with RootNode do begin 3866 WriteInteger(RootNode, 'ServedPassengerCount', ServedPassengerCount); 3867 3868 for I := 0 to Lines.Count - 1 do 3869 Lines[I].Id := I + 1; 3870 3871 NewNode := OwnerDocument.CreateElement('Stations'); 3872 AppendChild(NewNode); 3873 Stations.SaveToXmlNode(NewNode); 3874 3875 NewNode := OwnerDocument.CreateElement('Lines'); 3876 AppendChild(NewNode); 3877 Lines.SaveToXmlNode(NewNode); 3878 3879 NewNode := OwnerDocument.CreateElement('Trains'); 3880 AppendChild(NewNode); 3881 Trains.SaveToXmlNode(NewNode); 3882 end; 4068 SaveToXmlNode(RootNode); 3883 4069 if ExtractFileDir(FileName) <> '' then 3884 4070 ForceDirectories(ExtractFileDir(FileName)); … … 3892 4078 begin 3893 4079 inherited; 4080 SavedGameFileName := GetAppConfigDir(False) + 'LastGameState' + TransLinesExt; 3894 4081 MovableTracks := True; 3895 4082 Colors := TColors.Create; … … 3918 4105 View := TView.Create; 3919 4106 Trains := TMetroTrains.Create; 4107 Trains.Engine := Self; 3920 4108 Carriages := TMetroCarriages.Create; 3921 4109 ImageTunnel := TImage.Create;
Note:
See TracChangeset
for help on using the changeset viewer.