Changeset 128


Ignore:
Timestamp:
May 1, 2023, 11:21:30 AM (12 months ago)
Author:
chronos
Message:
  • Added: Ability to save and load a game.
Location:
trunk
Files:
1 added
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/Languages/TransLines.cs.po

    r127 r128  
    157157msgstr "Lineární"
    158158
     159#: uengine.sload
     160msgid "Load"
     161msgstr "Načíst"
     162
    159163#: uengine.slondon
    160164msgid "London"
     
    217221msgstr "Řím"
    218222
     223#: uengine.ssave
     224msgid "Save"
     225msgstr "Uložit"
     226
    219227#: uengine.sseoul
    220228msgid "Seoul"
     
    311319msgstr "St"
    312320
     321#: uitems.sreferencenotfound
     322#, object-pascal-format
     323msgid "Reference %s to class %s not found."
     324msgstr "Reference %s na třídu %s nenalezena."
     325
    313326#: utrack.salreadyconnectedtrackpoint
    314327msgctxt "utrack.salreadyconnectedtrackpoint"
  • trunk/Languages/TransLines.de.po

    r127 r128  
    161161msgstr ""
    162162
     163#: uengine.sload
     164msgid "Load"
     165msgstr ""
     166
    163167#: uengine.slondon
    164168msgid "London"
     
    221225msgstr ""
    222226
     227#: uengine.ssave
     228msgid "Save"
     229msgstr ""
     230
    223231#: uengine.sseoul
    224232msgid "Seoul"
     
    313321#: uformmain.swednesdayshort
    314322msgid "WED"
     323msgstr ""
     324
     325#: uitems.sreferencenotfound
     326#, object-pascal-format
     327msgid "Reference %s to class %s not found."
    315328msgstr ""
    316329
  • trunk/Languages/TransLines.fr.po

    r127 r128  
    162162msgstr ""
    163163
     164#: uengine.sload
     165msgid "Load"
     166msgstr ""
     167
    164168#: uengine.slondon
    165169msgid "London"
     
    222226msgstr "Rome"
    223227
     228#: uengine.ssave
     229msgid "Save"
     230msgstr ""
     231
    224232#: uengine.sseoul
    225233msgid "Seoul"
     
    315323msgid "WED"
    316324msgstr "MER"
     325
     326#: uitems.sreferencenotfound
     327#, object-pascal-format
     328msgid "Reference %s to class %s not found."
     329msgstr ""
    317330
    318331#: utrack.salreadyconnectedtrackpoint
  • trunk/Languages/TransLines.pot

    r127 r128  
    147147msgstr ""
    148148
     149#: uengine.sload
     150msgid "Load"
     151msgstr ""
     152
    149153#: uengine.slondon
    150154msgid "London"
     
    207211msgstr ""
    208212
     213#: uengine.ssave
     214msgid "Save"
     215msgstr ""
     216
    209217#: uengine.sseoul
    210218msgid "Seoul"
     
    301309msgstr ""
    302310
     311#: uitems.sreferencenotfound
     312#, object-pascal-format
     313msgid "Reference %s to class %s not found."
     314msgstr ""
     315
    303316#: utrack.salreadyconnectedtrackpoint
    304317msgctxt "utrack.salreadyconnectedtrackpoint"
  • trunk/Packages/Common/UXMLUtils.pas

    r86 r128  
    1414procedure WriteString(Node: TDOMNode; Name: string; Value: string);
    1515procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     16procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double);
    1617function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
    1718function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     
    1920function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
    2021function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
     22function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double;
    2123procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
    2224
    2325
    2426implementation
     27
     28function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double;
     29var
     30  NewNode: TDOMNode;
     31begin
     32  Result := DefaultValue;
     33  NewNode := Node.FindNode(DOMString(Name));
     34  if Assigned(NewNode) then
     35    Result := StrToFloat(string(NewNode.TextContent));
     36end;
    2537
    2638procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
     
    200212end;
    201213
     214procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double);
     215var
     216  NewNode: TDOMNode;
     217begin
     218  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     219  NewNode.TextContent := DOMString(FloatToStr(Value));
     220  Node.AppendChild(NewNode);
     221end;
     222
    202223function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
    203224var
  • trunk/TransLines.lpi

    r125 r128  
    8989      </Item2>
    9090    </RequiredPackages>
    91     <Units Count="16">
     91    <Units Count="17">
    9292      <Unit0>
    9393        <Filename Value="TransLines.lpr"/>
     
    169169        <IsPartOfProject Value="True"/>
    170170      </Unit15>
     171      <Unit16>
     172        <Filename Value="UItems.pas"/>
     173        <IsPartOfProject Value="True"/>
     174      </Unit16>
    171175    </Units>
    172176  </ProjectOptions>
  • trunk/TransLines.lpr

    r125 r128  
    1010  Forms, SysUtils, UFormMain, UFormImages, UFormTestCase, UFormTest, Common,
    1111  UMenu, UControls, UMetroPassenger, UColors, UView, URiver, UCity, UCore,
    12   UTestCases;
     12  UTestCases, UItems;
    1313
    1414{$R *.res}
  • trunk/UEngine.pas

    r127 r128  
    1010  URegistry, UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu,
    1111  UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric,
    12   UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils;
     12  UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils, UItems;
    1313
    1414type
     
    2424  { TMapStation }
    2525
    26   TMapStation = class
     26  TMapStation = class(TItem)
    2727  private
    2828    procedure ShiftTrackPoints;
     
    3939    function GetMaxPassengers: Integer;
    4040    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;
    4344    constructor Create;
    4445    destructor Destroy; override;
     
    4748  { TMapStations }
    4849
    49   TMapStations = class(TObjectList<TMapStation>)
     50  TMapStations = class(TItems<TMapStation>)
    5051    Engine: TEngine;
     52    function CreateItem: TMapStation; override;
    5153    function GetRect: TRect;
    5254    function AddNew: TMapStation;
    53     procedure LoadFromXmlNode(Node: TDOMNode);
    54     procedure SaveToXmlNode(Node: TDOMNode);
     55    class function GetClassSysName: string; override;
    5556  end;
    5657
    5758  { TLineStation }
    5859
    59   TLineStation = class
     60  TLineStation = class(TItem)
    6061    Line: TMetroLine;
    6162    MapStation: TMapStation;
    6263    TrackPoint: TTrackPoint;
     64    class function GetClassSysName: string; override;
     65    procedure LoadFromXmlNode(Node: TDOMNode); override;
     66    procedure SaveToXmlNode(Node: TDOMNode); override;
    6367  end;
    6468
    6569  { TLineStations }
    6670
    67   TLineStations = class(TObjectList<TLineStation>)
     71  TLineStations = class(TItems<TLineStation>)
    6872    Line: TMetroLine;
     73    function CreateItem: TLineStation; override;
    6974    function SearchMapStation(Station: TMapStation): TLineStation;
     75    class function GetClassSysName: string; override;
    7076  end;
    7177
    7278  { TMetroLine }
    7379
    74   TMetroLine = class
     80  TMetroLine = class(TItem)
    7581  private
    7682    procedure UpdateEndingLine(EndIndex, Direction: Integer);
    7783    procedure UpdateEndingLines;
    7884  public
    79     Id: Integer;
    8085    Index: Integer;
    8186    Engine: TEngine;
     
    8994    destructor Destroy; override;
    9095    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;
    9399  end;
    94100
    95101  { TMetroLines }
    96102
    97   TMetroLines = class(TObjectList<TMetroLine>)
     103  TMetroLines = class(TItems<TMetroLine>)
    98104    Engine: TEngine;
     105    function CreateItem: TMetroLine; override;
    99106    function AddNew(Color: TColor): TMetroLine;
    100     function FindById(Id: Integer): TMetroLine;
    101107    function SearchByColor(Color: TColor): TMetroLine;
    102     procedure LoadFromXmlNode(Node: TDOMNode);
    103     procedure SaveToXmlNode(Node: TDOMNode);
     108    class function GetClassSysName: string; override;
    104109  end;
    105110
    106111  { TMetroCarriage }
    107112
    108   TMetroCarriage = class
     113  TMetroCarriage = class(TItem)
    109114    Train: TMetroTrain;
    110115    Passengers: TMetroPassengers;
     
    113118    constructor Create;
    114119    destructor Destroy; override;
     120    class function GetClassSysName: string; override;
     121    procedure LoadFromXmlNode(Node: TDOMNode); override;
     122    procedure SaveToXmlNode(Node: TDOMNode); override;
    115123  end;
    116124
    117125  { TMetroCarriages }
    118126
    119   TMetroCarriages = class(TObjectList<TMetroCarriage>)
     127  TMetroCarriages = class(TItems<TMetroCarriage>)
    120128    function GetUnused: TMetroCarriage;
    121129    function GetUnusedCount: Integer;
    122     function AddNew: TMetroCarriage;
     130    class function GetClassSysName: string; override;
    123131  end;
    124132
    125133  { TMetroTrain }
    126134
    127   TMetroTrain = class
     135  TMetroTrain = class(TItem)
    128136  private
    129137    FLine: TMetroLine;
     
    140148    TargetStation: TLineStation;
    141149    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;
    144153    procedure FindTargetStation;
    145154    function GetTargetStationDistance: Integer;
     
    151160  { TMetroTrains }
    152161
    153   TMetroTrains = class(TObjectList<TMetroTrain>)
     162  TMetroTrains = class(TItems<TMetroTrain>)
     163    Engine: TEngine;
    154164    function GetUnused: TMetroTrain;
    155165    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;
    159168  end;
    160169
     
    228237    GrabbedTrainDirection: Integer;
    229238    LastGrabbedTrain: TMetroTrain;
     239    SavedGameFileName: string;
    230240    function GetMetroLineThickness: Integer;
    231241    function GetServedDaysCount: Integer;
     
    274284    procedure MenuItemGameExit(Sender: TObject);
    275285    procedure MenuItemGameRestart(Sender: TObject);
     286    procedure MenuItemGameLoad(Sender: TObject);
     287    procedure MenuItemGameSave(Sender: TObject);
    276288    procedure MenuItemBack(Sender: TObject);
    277289    procedure ButtonPlay(Sender: TObject);
     
    350362    procedure LoadFromRegistry;
    351363    procedure SaveToRegistry;
     364    procedure LoadFromXmlNode(Node: TDOMNode);
     365    procedure SaveToXmlNode(Node: TDOMNode);
    352366    procedure LoadFromFile(FileName: string);
    353367    procedure SaveToFile(FileName: string);
     
    399413  NewPassengerProbability = 0.003;
    400414  VisiblePassengersPerLine = 6;
     415  TransLinesExt = '.tlg';
    401416
    402417
     
    421436  STrain = 'Train';
    422437  SPlay = 'Play';
     438  SLoad = 'Load';
     439  SSave = 'Save';
    423440  SCustomGame = 'Custom game';
    424441  SOptions = 'Options';
     
    468485  VisualStyleText: array[TVisualStyle] of string = (SLondon, SPrague);
    469486
     487const
     488  GameXmlName = 'TransLinesGame';
     489
     490{ TLineStation }
     491
     492class function TLineStation.GetClassSysName: string;
     493begin
     494  Result := 'LineStation';
     495end;
     496
     497procedure TLineStation.LoadFromXmlNode(Node: TDOMNode);
     498begin
     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;
     503end;
     504
     505procedure TLineStation.SaveToXmlNode(Node: TDOMNode);
     506begin
     507  inherited;
     508  WriteInteger(Node, 'MapStation', MapStation.Id);
     509  WriteInteger(Node, 'TrackPoint', TrackPoint.Id);
     510end;
     511
    470512{ TClock }
    471513
     
    538580end;
    539581
     582class function TMetroCarriage.GetClassSysName: string;
     583begin
     584  Result := 'Carriage';
     585end;
     586
     587procedure TMetroCarriage.LoadFromXmlNode(Node: TDOMNode);
     588var
     589  Node2: TDOMNode;
     590begin
     591  inherited;
     592
     593  Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
     594  if Assigned(Node2) then
     595    Passengers.LoadFromXmlNodeRef(Node2, Train.Engine.Passengers);
     596end;
     597
     598procedure TMetroCarriage.SaveToXmlNode(Node: TDOMNode);
     599var
     600  NewNode: TDOMNode;
     601begin
     602  inherited;
     603
     604  NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
     605  Node.AppendChild(NewNode);
     606  Passengers.SaveToXmlNodeRef(NewNode);
     607end;
     608
    540609{ TMetroCarriages }
    541610
     
    559628end;
    560629
    561 function TMetroCarriages.AddNew: TMetroCarriage;
    562 begin
    563   Result := TMetroCarriage.Create;
    564   Add(Result);
     630class function TMetroCarriages.GetClassSysName: string;
     631begin
     632  Result := 'Carriages';
    565633end;
    566634
     
    579647
    580648{ TLineStations }
     649
     650function TLineStations.CreateItem: TLineStation;
     651begin
     652  Result := inherited;
     653  Result.Line := Line;
     654end;
    581655
    582656function TLineStations.SearchMapStation(Station: TMapStation): TLineStation;
     
    590664end;
    591665
     666class function TLineStations.GetClassSysName: string;
     667begin
     668  Result := 'LineStations';
     669end;
     670
    592671{ TMetroTrains }
    593672
     
    611690end;
    612691
    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;
     692function TMetroTrains.CreateItem: TMetroTrain;
     693begin
     694  Result := inherited;
     695  Result.Engine := Engine;
     696end;
     697
     698class function TMetroTrains.GetClassSysName: string;
     699begin
     700  Result := 'Trains';
    643701end;
    644702
    645703{ TMapStations }
     704
     705function TMapStations.CreateItem: TMapStation;
     706begin
     707  Result := inherited;
     708  Result.Engine := Engine;
     709end;
    646710
    647711function TMapStations.GetRect: TRect;
     
    673737  Step = 20;
    674738begin
    675   Result := TMapStation.Create;
    676   Result.Engine := Engine;
     739  Result := CreateItem;
    677740  Angle := Random * 2 * Pi;
    678741  // Ensure minimum distance between stations
     
    696759end;
    697760
    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;
     761class function TMapStations.GetClassSysName: string;
     762begin
     763  Result := 'MapStations';
    722764end;
    723765
    724766{ TMetroLines }
    725767
     768function TMetroLines.CreateItem: TMetroLine;
     769begin
     770  Result := inherited;
     771  Result.Engine := Engine;
     772end;
     773
    726774function TMetroLines.AddNew(Color: TColor): TMetroLine;
    727775begin
    728   Result := TMetroLine.Create;
    729   Result.Engine := Engine;
     776  Result := AddItem;
    730777  Result.Index := Count;
    731778  Result.Color := Color;
    732   Add(Result);
    733 end;
    734 
    735 function TMetroLines.FindById(Id: Integer): TMetroLine;
    736 var
    737   I: Integer;
    738 begin
    739   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;
    743779end;
    744780
     
    753789end;
    754790
    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;
     791class function TMetroLines.GetClassSysName: string;
     792begin
     793  Result := 'Lines';
    779794end;
    780795
     
    817832    Index := Track.Points.IndexOf(LineStations.First.TrackPoint);
    818833    if Index = 0 then begin
    819       NewTrackPoint := Track.Points.AddNew;
     834      NewTrackPoint := Track.Points.CreateItem;
    820835      Track.Points.Insert(0, NewTrackPoint);
    821836    end;
    822837    Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
    823838    if Index = Track.Points.Count - 1 then begin
    824       NewTrackPoint := Track.Points.AddNew;
     839      NewTrackPoint := Track.Points.CreateItem;
    825840      Track.Points.Insert(Track.Points.Count, NewTrackPoint);
    826841    end;
     
    850865  Station.Lines.Add(Self);
    851866
    852   NewTrackPoint := Track.Points.AddNew;
     867  NewTrackPoint := Track.Points.CreateItem;
    853868  NewTrackPoint.OwnerPoint := NewLineStation;
    854869  NewTrackPoint.Position := Station.Position;
     
    955970  LineStations := TLineStations.Create;
    956971  LineStations.OwnsObjects := True;
     972  LineStations.Line := Self;
    957973  Trains := TMetroTrains.Create;
    958974  Trains.OwnsObjects := False;
     
    976992end;
    977993
     994class function TMetroLine.GetClassSysName: string;
     995begin
     996  Result := 'Line';
     997end;
     998
    978999procedure TMetroLine.LoadFromXmlNode(Node: TDOMNode);
    9791000var
    9801001  Node2: TDOMNode;
    9811002begin
    982   Id := ReadInteger(Node, 'Id', Id);
     1003  inherited;
    9831004  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));
    9861008  if Assigned(Node2) then
    9871009    Track.LoadFromXmlNode(Node2);
     1010
     1011  Node2 := Node.FindNode(DOMString(TLineStations.GetClassSysName));
     1012  if Assigned(Node2) then
     1013    LineStations.LoadFromXmlNode(Node2);
    9881014end;
    9891015
     
    9921018  Node2: TDOMNode;
    9931019begin
    994   WriteInteger(Node, 'Id', Id);
     1020  inherited;
    9951021  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));
    9981027  Node.AppendChild(Node2);
    9991028  Track.SaveToXmlNode(Node2);
     1029
     1030  Node2 := Node.OwnerDocument.CreateElement(DOMString(TLineStations.GetClassSysName));
     1031  Node.AppendChild(Node2);
     1032  LineStations.SaveToXmlNode(Node2);
    10001033end;
    10011034
     
    10131046end;
    10141047
     1048class function TMetroTrain.GetClassSysName: string;
     1049begin
     1050  Result := 'Train';
     1051end;
     1052
    10151053procedure TMetroTrain.LoadFromXmlNode(Node: TDOMNode);
    1016 begin
     1054var
     1055  Node2: TDOMNode;
     1056begin
     1057  inherited;
    10171058  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);
    10181073end;
    10191074
    10201075procedure TMetroTrain.SaveToXmlNode(Node: TDOMNode);
    1021 begin
     1076var
     1077  NewNode: TDOMNode;
     1078begin
     1079  inherited;
    10221080  if Assigned(Line) then WriteInteger(Node, 'Line', Line.Id)
    10231081    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);
    10241094end;
    10251095
     
    12581328end;
    12591329
     1330class function TMapStation.GetClassSysName: string;
     1331begin
     1332  Result := 'MapStation';
     1333end;
     1334
    12601335procedure TMapStation.LoadFromXmlNode(Node: TDOMNode);
    1261 begin
     1336var
     1337  Node2: TDOMNode;
     1338begin
     1339  inherited;
    12621340  Position.X := ReadInteger(Node, 'PositionX', Position.X);
    12631341  Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
    12641342  DestinationIndex := ReadInteger(Node, 'DestinationIndex', Integer(DestinationIndex));
    12651343  IsTerminal := ReadBoolean(Node, 'IsTerminal', IsTerminal);
     1344
     1345  Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
     1346  if Assigned(Node2) then
     1347    Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers);
    12661348end;
    12671349
    12681350procedure TMapStation.SaveToXmlNode(Node: TDOMNode);
    1269 begin
     1351var
     1352  NewNode: TDOMNode;
     1353begin
     1354  inherited;
    12701355  WriteInteger(Node, 'PositionX', Position.X);
    12711356  WriteInteger(Node, 'PositionY', Position.Y);
    12721357  WriteInteger(Node, 'DestinationIndex', DestinationIndex);
    12731358  WriteBoolean(Node, 'IsTerminal', IsTerminal);
     1359
     1360  NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
     1361  Node.AppendChild(NewNode);
     1362  Passengers.SaveToXmlNodeRef(NewNode);
    12741363end;
    12751364
     
    15851674  Station: TMapStation;
    15861675begin
    1587   // NewGame all distances
     1676  // Reset all distances
    15881677  for Station in Stations do
    15891678  with Station do begin
     
    18551944  MapStation: TMapStation;
    18561945begin
    1857   // NewGame all trackpoints position shift
     1946  // Reset all trackpoints position shift
    18581947  for MetroLine in Lines do
    18591948    for TrackPoint in MetroLine.Track.Points do
     
    18661955  // Compute track points from track shift
    18671956  for MetroLine in Lines do
    1868   with MetroLine do begin
     1957  with MetroLine, Track do begin
    18691958    // Update start
    1870     if Track.Points.Count > 1 then begin
    1871       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 do
    1876     with Track.Points[I] do
    1877     if Assigned(Track.Points[I].LinkDown) and Assigned(Track.Points[I].LinkUp) then begin
     1959    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
    18781967      {
    18791968      Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) -
     
    18901979      end else begin}
    18911980        // 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 begin
    1896             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;
    18971986          end else begin
    18981987            // 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;
    19011990          end;
    19021991//      end;
    19031992
    19041993      // 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;
    19081999      end;
    19092000    end;
    19102001
    19112002    // 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;
    19152008    end;
    19162009  end;
     
    19182011  // Remove all temporal links
    19192012  for MetroLine in Lines do
    1920   with MetroLine do begin
    1921     for J := 0 to Track.Points.Count - 1 do
    1922     if Assigned(Track.Points[J].LinkUp) then begin
    1923       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;
    19262019    end;
    19272020  end;
     
    20592152
    20602153procedure TEngine.MenuItemCustomGame(Sender: TObject);
    2061 var
    2062   VisualStyleIndex: TVisualStyle;
    2063   StationStyleIndex: TStationStyle;
    20642154begin
    20652155  MenuCustomGame.Parent := MenuMain;
     
    21272217  Index: Integer;
    21282218begin
    2129   Trains.AddNew;
     2219  Trains.AddItem;
    21302220  State := gsNewImprovement;
    21312221  if Lines.Count <= (High(LineColors) - Low(LineColors)) then
     
    21962286end;
    21972287
     2288procedure TEngine.MenuItemGameLoad(Sender: TObject);
     2289begin
     2290  LoadFromFile(SavedGameFileName);
     2291  State := gsRunning;
     2292end;
     2293
     2294procedure TEngine.MenuItemGameSave(Sender: TObject);
     2295begin
     2296  SaveToFile(SavedGameFileName);
     2297  State := LastState;
     2298end;
     2299
    21982300procedure TEngine.DarkModeChanged(Sender: TObject);
    21992301begin
     
    23212423  case Improvement of
    23222424    miLine: Lines.AddNew(LineColors[Lines.Count]);
    2323     miCarriage: Carriages.AddNew;
     2425    miCarriage: Carriages.AddItem;
    23242426    //miTunnel: Tunnels.AddNew;
    23252427    miTerminal: Inc(AvailableTerminals);
     
    23682470      BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
    23692471    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;
    23702480    {
    23712481    with AddButton(SCustomGame, MenuItemCustomGame) do begin
     
    24112521    end;
    24122522    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
    24132538      TextSize := 40;
    24142539      TextColor := Colors.MenuItemText;
     
    33043429      with MapStation do
    33053430      if Random < NewPassengerProbability then begin
    3306         Passenger := Self.Passengers.AddNew;
     3431        Passenger := Self.Passengers.AddItem;
    33073432        Passenger.DestinationIndex := Random(DestinationCount);
    33083433        Passengers.Add(Passenger);
     
    35383663  Station: TMapStation;
    35393664  NewLine: TMetroLine;
    3540   Track: TTrackLink;
     3665  TrackLink: TTrackLink;
    35413666  NewIndex: Integer;
    35423667  Intersection: TPoint;
     
    35813706      end;
    35823707
    3583       // New track creation from selected station as start
     3708      // New TrackLink creation from selected station as start
    35843709      Station := GetStationOnPos(View.PointDestToSrc(Position));
    35853710      if Assigned(Station) then begin
     
    35963721
    35973722      // Line selection
    3598       Track := GetTrackOnPos(View.PointDestToSrc(Position), Intersection);
    3599       if Assigned(Track) and Assigned(Track.Points[0]) and Assigned(Track.Points[1]) then begin
    3600         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];
    36033728        NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown);
    36043729        while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.OwnerPoint)) do begin
     
    36073732            else TrackStationDown := nil;
    36083733        end;
    3609         TrackStationUp := Track.Points[1];
     3734        TrackStationUp := TrackLink.Points[1];
    36103735        NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown);
    36113736        while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.OwnerPoint)) do begin
     
    36223747        end;
    36233748
    3624         Track.Free;
     3749        TrackLink.Free;
    36253750        Exit;
    36263751      end;
    3627       if Assigned(Track) then Track.Free;
     3752      if Assigned(TrackLink) then TrackLink.Free;
    36283753    end;
    36293754  end;
     
    36823807    end;
    36833808    if Key = KeyF3 then begin
    3684       Trains.AddNew;
     3809      Trains.AddItem;
    36853810      Redraw;
    36863811    end;
    36873812    if Key = KeyF4 then begin
    3688       Carriages.AddNew;
     3813      Carriages.AddItem;
    36893814      Redraw;
    36903815    end;
     
    38223947end;
    38233948
     3949procedure TEngine.LoadFromXmlNode(Node: TDOMNode);
     3950var
     3951  NewNode: TDOMNode;
     3952  Node2: TDOMNode;
     3953begin
     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);
     3995end;
     3996
     3997procedure TEngine.SaveToXmlNode(Node: TDOMNode);
     3998var
     3999  I: Integer;
     4000  NewNode: TDOMNode;
     4001begin
     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);
     4040end;
     4041
    38244042procedure TEngine.LoadFromFile(FileName: string);
    38254043var
    3826   NewNode: TDOMNode;
    38274044  Doc: TXMLDocument;
    38284045  RootNode: TDOMNode;
     
    38314048  Clear;
    38324049  with Doc do try
    3833     if (Doc.DocumentElement.NodeName <> 'BigMetroGame') and
    3834       (Doc.DocumentElement.NodeName <> 'TransLinesGame') then
     4050    if Doc.DocumentElement.NodeName <> GameXmlName then
    38354051      raise Exception.Create(SWrongFileFormat);
    38364052    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);
    38494054  finally
    38504055    FreeAndNil(Doc);
     
    38544059procedure TEngine.SaveToFile(FileName: string);
    38554060var
    3856   NewNode: TDOMNode;
    38574061  Doc: TXMLDocument;
    38584062  RootNode: TDOMNode;
    3859   I: Integer;
    38604063begin
    38614064  Doc := TXMLDocument.Create;
    38624065  with Doc do try
    3863     RootNode := CreateElement('TransLinesGame');
     4066    RootNode := CreateElement(GameXmlName);
    38644067    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);
    38834069    if ExtractFileDir(FileName) <> '' then
    38844070      ForceDirectories(ExtractFileDir(FileName));
     
    38924078begin
    38934079  inherited;
     4080  SavedGameFileName := GetAppConfigDir(False) + 'LastGameState' + TransLinesExt;
    38944081  MovableTracks := True;
    38954082  Colors := TColors.Create;
     
    39184105  View := TView.Create;
    39194106  Trains := TMetroTrains.Create;
     4107  Trains.Engine := Self;
    39204108  Carriages := TMetroCarriages.Create;
    39214109  ImageTunnel := TImage.Create;
  • trunk/UMetroPassenger.pas

    r127 r128  
    44
    55uses
    6   Classes, SysUtils, Generics.Collections;
     6  Classes, SysUtils, Generics.Collections, UItems, DOM, UXMLUtils;
    77
    88type
     
    1515  { TMetroPassenger }
    1616
    17   TMetroPassenger = class
     17  TMetroPassenger = class(TItem)
    1818    DestinationIndex: TDestinationIndex;
     19    class function GetClassSysName: string; override;
     20    procedure LoadFromXmlNode(Node: TDOMNode); override;
     21    procedure SaveToXmlNode(Node: TDOMNode); override;
    1922  end;
    2023
    2124  { TMetroPassengers }
    2225
    23   TMetroPassengers = class(TObjectList<TMetroPassenger>)
    24     function AddNew: TMetroPassenger;
     26  TMetroPassengers = class(TItems<TMetroPassenger>)
     27    class function GetClassSysName: string; override;
    2528  end;
    2629
     
    3033{ TMetroPassengers }
    3134
    32 function TMetroPassengers.AddNew: TMetroPassenger;
     35class function TMetroPassengers.GetClassSysName: string;
    3336begin
    34   Result := TMetroPassenger.Create;
    35   Add(Result);
     37  Result := 'MetroPassengers';
     38end;
     39
     40{ TMetroPassengers }
     41
     42class function TMetroPassenger.GetClassSysName: string;
     43begin
     44  Result := 'MetroPassenger';
     45end;
     46
     47procedure TMetroPassenger.LoadFromXmlNode(Node: TDOMNode);
     48begin
     49  inherited;
     50  DestinationIndex := ReadInteger(Node, 'DestinationIndex', DestinationIndex);
     51end;
     52
     53procedure TMetroPassenger.SaveToXmlNode(Node: TDOMNode);
     54begin
     55  inherited;
     56  WriteInteger(Node, 'DestinationIndex', DestinationIndex);
    3657end;
    3758
  • trunk/UTrack.pas

    r122 r128  
    55uses
    66  Classes, SysUtils, Math, Generics.Collections, UGeometric, DOM, XMLRead,
    7   XMLWrite, UXMLUtils;
     7  XMLWrite, UXMLUtils, UItems;
    88
    99type
     
    2222    function GetVector: TVector;
    2323    procedure Move(Distance: Double);
     24    procedure LoadFromXmlNode(Node: TDOMNode; Points: TTrackPoints);
     25    procedure SaveToXmlNode(Node: TDOMNode);
    2426  end;
    2527
    2628  { TTrackPoint }
    2729
    28   TTrackPoint = class
     30  TTrackPoint = class(TItem)
    2931    OwnerPoint: TObject;
    3032    Position: TPoint;
    31     //PositionShift: TPoint;
    3233    PositionDesigned: TPoint;
    3334    Pending: Boolean;
     
    5051    function GetDistance: Integer;
    5152
    52     procedure LoadFromXmlNode(Node: TDOMNode);
    53     procedure SaveToXmlNode(Node: TDOMNode);
     53    class function GetClassSysName: string; override;
     54    procedure LoadFromXmlNode(Node: TDOMNode); override;
     55    procedure SaveToXmlNode(Node: TDOMNode); override;
    5456    constructor Create;
    5557    destructor Destroy; override;
     
    5860  { TTrackPoints }
    5961
    60   TTrackPoints = class(TObjectList<TTrackPoint>)
     62  TTrackPoints = class(TItems<TTrackPoint>)
    6163    Track: TTrack;
    62     function AddNew: TTrackPoint;
    63     procedure LoadFromXmlNode(Node: TDOMNode);
    64     procedure SaveToXmlNode(Node: TDOMNode);
     64    class function GetClassSysName: string; override;
     65    function CreateItem: TTrackPoint; override;
    6566  end;
    6667
    6768  { TTrackLink }
    6869
    69   TTrackLink = class
     70  TTrackLink = class(TItem)
    7071    Points: TTrackPoints;
    7172    Shift: TPoint;
    72     procedure LoadFromXmlNode(Node: TDOMNode);
    73     procedure SaveToXmlNode(Node: TDOMNode);
     73    class function GetClassSysName: string; override;
     74    procedure LoadFromXmlNode(Node: TDOMNode); override;
     75    procedure SaveToXmlNode(Node: TDOMNode); override;
    7476    constructor Create;
    7577    destructor Destroy; override;
     
    7880  { TTrackLinks }
    7981
    80   TTrackLinks = class(TObjectList<TTrackLink>)
     82  TTrackLinks = class(TItems<TTrackLink>)
     83    class function GetClassSysName: string; override;
    8184    function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
    82     function AddNew: TTrackLink;
    83     procedure LoadFromXmlNode(Node: TDOMNode);
    84     procedure SaveToXmlNode(Node: TDOMNode);
    8585  end;
    8686
    8787  { TTrack }
    8888
    89   TTrack = class
     89  TTrack = class(TItem)
    9090    Points: TTrackPoints;
    9191    Links: TTrackLinks;
     
    9696    constructor Create;
    9797    destructor Destroy; override;
    98     procedure LoadFromXmlNode(Node: TDOMNode);
    99     procedure SaveToXmlNode(Node: TDOMNode);
     98    class function GetClassSysName: string; override;
     99    procedure LoadFromXmlNode(Node: TDOMNode); override;
     100    procedure SaveToXmlNode(Node: TDOMNode); override;
    100101  end;
    101102
     
    192193end;
    193194
     195procedure TTrackPosition.LoadFromXmlNode(Node: TDOMNode; Points: TTrackPoints);
     196begin
     197  RelPos := ReadDouble(Node, 'RelPos', RelPos);
     198  BaseTrackPoint := Points.FindById(ReadInteger(Node, 'BaseTrackPoint', 0));
     199end;
     200
     201procedure TTrackPosition.SaveToXmlNode(Node: TDOMNode);
     202begin
     203  WriteDouble(Node, 'RelPos', RelPos);
     204  if Assigned(BaseTrackPoint) then
     205    WriteInteger(Node, 'BaseTrackPoint', BaseTrackPoint.Id)
     206    else WriteInteger(Node, 'BaseTrackPoint', 0)
     207end;
     208
    194209{ TTrackLinks }
     210
     211class function TTrackLinks.GetClassSysName: string;
     212begin
     213  Result := 'Links';
     214end;
    195215
    196216function TTrackLinks.SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
     
    207227end;
    208228
    209 function TTrackLinks.AddNew: TTrackLink;
    210 begin
    211   Result := TTrackLink.Create;
    212 end;
    213 
    214 procedure TTrackLinks.LoadFromXmlNode(Node: TDOMNode);
    215 var
    216   Node2: TDOMNode;
    217   NewItem: TTrackLink;
    218 begin
    219   Node2 := Node.FirstChild;
    220   while Assigned(Node2) and (Node2.NodeName = 'Link') do begin
    221     NewItem := TTrackLink.Create;
    222     NewItem.LoadFromXmlNode(Node2);
    223     Add(NewItem);
    224     Node2 := Node2.NextSibling;
    225   end;
    226 end;
    227 
    228 procedure TTrackLinks.SaveToXmlNode(Node: TDOMNode);
    229 var
    230   I: Integer;
    231   Node2: TDOMNode;
    232 begin
    233   for I := 0 to Count - 1 do begin;
    234     Node2 := Node.OwnerDocument.CreateElement('Link');
    235     Node.AppendChild(Node2);
    236     Items[I].SaveToXmlNode(Node2);
    237   end;
    238 end;
    239 
    240229{ TTrackPoints }
    241230
    242 function TTrackPoints.AddNew: TTrackPoint;
    243 begin
    244   Result := TTrackPoint.Create;
     231class function TTrackPoints.GetClassSysName: string;
     232begin
     233  Result := 'Points';
     234end;
     235
     236function TTrackPoints.CreateItem: TTrackPoint;
     237begin
     238  Result := inherited;
    245239  Result.Track := Track;
    246 end;
    247 
    248 procedure TTrackPoints.LoadFromXmlNode(Node: TDOMNode);
    249 var
    250   Node2: TDOMNode;
    251   NewItem: TTrackPoint;
    252 begin
    253   Node2 := Node.FirstChild;
    254   while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
    255     NewItem := TTrackPoint.Create;
    256     NewItem.LoadFromXmlNode(Node2);
    257     Add(NewItem);
    258     Node2 := Node2.NextSibling;
    259   end;
    260 end;
    261 
    262 procedure TTrackPoints.SaveToXmlNode(Node: TDOMNode);
    263 var
    264   I: Integer;
    265   Node2: TDOMNode;
    266 begin
    267   for I := 0 to Count - 1 do begin;
    268     Node2 := Node.OwnerDocument.CreateElement('Point');
    269     Node.AppendChild(Node2);
    270     Items[I].SaveToXmlNode(Node2);
    271   end;
    272240end;
    273241
     
    288256end;
    289257
     258class function TTrack.GetClassSysName: string;
     259begin
     260  Result := 'Track';
     261end;
     262
    290263procedure TTrack.LoadFromXmlNode(Node: TDOMNode);
    291 begin
    292   Points.LoadFromXmlNode(Node);
    293   Links.LoadFromXmlNode(Node);
     264var
     265  NewNode: TDOMNode;
     266begin
     267  NewNode := Node.FindNode(DOMString(TTrackPoints.GetClassSysName));
     268  if Assigned(NewNode) then
     269    Points.LoadFromXmlNode(NewNode);
     270
     271  NewNode := Node.FindNode(DOMString(TTrackLinks.GetClassSysName));
     272  if Assigned(NewNode) then
     273    Links.LoadFromXmlNode(NewNode);
    294274end;
    295275
    296276procedure TTrack.SaveToXmlNode(Node: TDOMNode);
    297 begin
    298   Points.SaveToXmlNode(Node);
    299   Links.SaveToXmlNode(Node);
     277var
     278  NewNode: TDOMNode;
     279begin
     280  Points.RebuildItemsId;
     281  Links.RebuildItemsId;
     282
     283  NewNode := Node.OwnerDocument.CreateElement(DOMString(TTrackPoints.GetClassSysName));
     284  Node.AppendChild(NewNode);
     285  Points.SaveToXmlNode(NewNode);
     286
     287  NewNode := Node.OwnerDocument.CreateElement(DOMString(TTrackLinks.GetClassSysName));
     288  Node.AppendChild(NewNode);
     289  Links.SaveToXmlNode(NewNode);
    300290end;
    301291
     
    322312  P1 := Points[Index1].PositionDesigned;
    323313  P2 := Points[Index2].PositionDesigned;
    324   NewTrackPoint := Points.AddNew;
     314  NewTrackPoint := Points.CreateItem;
    325315  Delta := Point(P2.X - P1.X, P2.Y - P1.Y);
    326316  if Abs(Delta.X) > Abs(Delta.Y) then begin
     
    357347{ TTrackLink }
    358348
     349class function TTrackLink.GetClassSysName: string;
     350begin
     351  Result := 'Link';
     352end;
     353
    359354procedure TTrackLink.LoadFromXmlNode(Node: TDOMNode);
    360355begin
    361 
     356  inherited;
    362357end;
    363358
    364359procedure TTrackLink.SaveToXmlNode(Node: TDOMNode);
    365360begin
    366 
     361  inherited;
    367362end;
    368363
     
    416411
    417412    // Add new link to both self and connected track point
    418     NewLink := Track.Links.AddNew;
     413    NewLink := Track.Links.CreateItem;
    419414    NewLink.Points.Add(TrackPoint);
    420415    NewLink.Points.Add(Self);
     
    530525end;
    531526
     527class function TTrackPoint.GetClassSysName: string;
     528begin
     529  Result := 'Point';
     530end;
     531
    532532procedure TTrackPoint.LoadFromXmlNode(Node: TDOMNode);
    533533begin
     534  inherited;
    534535  Position.X := ReadInteger(Node, 'PositionX', Position.X);
    535536  Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
     537  PositionDesigned.X := ReadInteger(Node, 'PositionDesignedX', PositionDesigned.X);
     538  PositionDesigned.Y := ReadInteger(Node, 'PositionDesignedY', PositionDesigned.Y);
    536539end;
    537540
    538541procedure TTrackPoint.SaveToXmlNode(Node: TDOMNode);
    539542begin
     543  inherited;
    540544  WriteInteger(Node, 'PositionX', Position.X);
    541545  WriteInteger(Node, 'PositionY', Position.Y);
     546  WriteInteger(Node, 'PositionDesignedX', PositionDesigned.X);
     547  WriteInteger(Node, 'PositionDesignedY', PositionDesigned.Y);
    542548end;
    543549
     
    554560  FreeAndNil(NeighLinks);
    555561  FreeAndNil(NeighPoints);
     562  Track := nil;
     563  OwnerPoint := nil;
    556564  inherited;
    557565end;
  • trunk/UView.pas

    r103 r128  
    44
    55uses
    6   Classes, SysUtils;
     6  Classes, SysUtils, UItems, DOM;
    77
    88type
    99  { TView }
    1010
    11   TView = class
     11  TView = class(TItem)
    1212  private
    1313    FDestRect: TRect;
     
    1818    procedure SetZoom(AValue: Double);
    1919  public
    20     procedure Assign(Source: TView);
     20    procedure Assign(Source: TItem); override;
    2121    function PointDestToSrc(Pos: TPoint): TPoint;
    2222    function PointSrcToDest(Pos: TPoint): TPoint;
    2323    constructor Create;
     24    procedure LoadFromXmlNode(Node: TDOMNode); override;
     25    procedure SaveToXmlNode(Node: TDOMNode); override;
    2426    property SourceRect: TRect read FSourceRect write SetSourceRect;
    2527    property DestRect: TRect read FDestRect write SetDestRect;
     
    3133
    3234uses
    33   UGeometric;
     35  UGeometric, UXMLUtils;
    3436
    3537resourcestring
     
    8082end;
    8183
    82 procedure TView.Assign(Source: TView);
     84procedure TView.Assign(Source: TItem);
    8385begin
    84   FDestRect := Source.FDestRect;
    85   FSourceRect := Source.FSourceRect;
    86   FZoom := Source.FZoom;
     86  if Source is TView then begin
     87    FDestRect := TView(Source).FDestRect;
     88    FSourceRect := TView(Source).FSourceRect;
     89    FZoom := TView(Source).FZoom;
     90  end;
    8791end;
    8892
     
    104108end;
    105109
     110procedure TView.LoadFromXmlNode(Node: TDOMNode);
     111begin
     112  inherited;
     113  FZoom := ReadDouble(Node, 'Zoom', 0);
     114  FSourceRect.Left := ReadInteger(Node, 'SourceRectLeft', 0);
     115  FSourceRect.Top := ReadInteger(Node, 'SourceRectTop', 0);
     116  FSourceRect.Right := ReadInteger(Node, 'SourceRectRight', 0);
     117  FSourceRect.Bottom := ReadInteger(Node, 'SourceRectBottom', 0);
     118  FDestRect.Left := ReadInteger(Node, 'DestRectLeft', 0);
     119  FDestRect.Top := ReadInteger(Node, 'DestRectTop', 0);
     120  FDestRect.Right := ReadInteger(Node, 'DestRectRight', 0);
     121  FDestRect.Bottom := ReadInteger(Node, 'DestRectBottom', 0);
     122end;
     123
     124procedure TView.SaveToXmlNode(Node: TDOMNode);
     125begin
     126  inherited;
     127  WriteDouble(Node, 'Zoom', FZoom);
     128  WriteInteger(Node, 'SourceRectLeft', FSourceRect.Left);
     129  WriteInteger(Node, 'SourceRectTop', FSourceRect.Top);
     130  WriteInteger(Node, 'SourceRectRight', FSourceRect.Right);
     131  WriteInteger(Node, 'SourceRectBottom', FSourceRect.Bottom);
     132  WriteInteger(Node, 'DestRectLeft', FDestRect.Left);
     133  WriteInteger(Node, 'DestRectTop', FDestRect.Top);
     134  WriteInteger(Node, 'DestRectRight', FDestRect.Right);
     135  WriteInteger(Node, 'DestRectBottom', FDestRect.Bottom);
     136end;
     137
    106138end.
    107139
Note: See TracChangeset for help on using the changeset viewer.