Changeset 91 for trunk


Ignore:
Timestamp:
Sep 22, 2022, 10:57:26 PM (2 years ago)
Author:
chronos
Message:
  • Modified: More classes separated from UEngine unit.
Location:
trunk
Files:
2 added
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/BigMetro.lpi

    r90 r91  
    8989      </Item2>
    9090    </RequiredPackages>
    91     <Units Count="9">
     91    <Units Count="11">
    9292      <Unit0>
    9393        <Filename Value="BigMetro.lpr"/>
    … …  
    132132        <IsPartOfProject Value="True"/>
    133133      </Unit8>
     134      <Unit9>
     135        <Filename Value="UView.pas"/>
     136        <IsPartOfProject Value="True"/>
     137      </Unit9>
     138      <Unit10>
     139        <Filename Value="URiver.pas"/>
     140        <IsPartOfProject Value="True"/>
     141      </Unit10>
    134142    </Units>
    135143  </ProjectOptions>

  • trunk/BigMetro.lpr

    r90 r91  
    99  Interfaces, // this includes the LCL widgetset
    1010  Forms, SysUtils, UFormMain, UFormImages, Common, UMenu, UControls,
    11 UMetroPassenger, UColors;
     11UMetroPassenger, UColors, UView, URiver;
    1212
    1313{$R *.res}

  • trunk/Languages/BigMetro.cs.po

    r86 r91  
    2424msgid "Big Metro"
    2525msgstr "Big Metro"
    26 
    27 #: uengine.salreadyconnectedtrackpoint
    28 msgid "Trying to connect already connected track point"
    29 msgstr "Pokus o připojení již připojeného bodu trasy"
    30 
    31 #: uengine.salreadydisconnectedtrackpoint
    32 msgid "Trying to disconnect not connected track point"
    33 msgstr "Pokus o rozpojení již připojeného bodu trasy"
    3426
    3527#: uengine.sday
    … …  
    7062msgid "Station have to have MapStation"
    7163msgstr ""
    72 
    73 #: uengine.strackpointnotfound
    74 #, object-pascal-format
    75 msgid "Track point %d not found"
    76 msgstr ""
    77 
    78 #: uengine.szerozoomnotalowed
    79 msgid "Zero zoom not allowed"
    80 msgstr "Nulové přiblížení není povoleno"
    8164
    8265#: umenu.sautomatic
    … …  
    136119msgstr "Zkusit znovu"
    137120
     121#: utrack.salreadyconnectedtrackpoint
     122#, fuzzy
     123msgctxt "utrack.salreadyconnectedtrackpoint"
     124msgid "Trying to connect already connected track point"
     125msgstr "Pokus o připojení již připojeného bodu trasy"
     126
     127#: utrack.salreadydisconnectedtrackpoint
     128#, fuzzy
     129msgctxt "utrack.salreadydisconnectedtrackpoint"
     130msgid "Trying to disconnect not connected track point"
     131msgstr "Pokus o rozpojení již připojeného bodu trasy"
     132
     133#: utrack.strackpointnotfound
     134#, object-pascal-format
     135msgctxt "utrack.strackpointnotfound"
     136msgid "Track point %d not found"
     137msgstr ""
     138
     139#: uview.szerozoomnotalowed
     140#, fuzzy
     141msgctxt "uview.szerozoomnotalowed"
     142msgid "Zero zoom not allowed"
     143msgstr "Nulové přiblížení není povoleno"
     144

  • trunk/Languages/BigMetro.de.po

    r88 r91  
    1616msgstr ""
    1717
     18#: tformmain.applicationinfo1.description
     19msgid "Enjoyable real-time metro building game."
     20msgstr ""
     21
    1822#: tformmain.caption
    1923msgctxt "tformmain.caption"
    2024msgid "Big Metro"
    2125msgstr "Big Metro"
    22 
    23 #: uengine.salreadyconnectedtrackpoint
    24 msgid "Trying to connect already connected track point"
    25 msgstr "Versuch ein bereits verbundene Line zu verbinden"
    26 
    27 #: uengine.salreadydisconnectedtrackpoint
    28 msgid "Trying to disconnect not connected track point"
    29 msgstr "Versuch einen nicht verbundene Line zu unterbrechen"
    3026
    3127#: uengine.sday
    … …  
    4238
    4339#: uengine.sgameoverstatistic
     40#, object-pascal-format
    4441msgid "%d passengers travelled on your metro over %d days."
    4542msgstr "%d Passagiere fuhren mit deiner Metro über %d Tage."
    … …  
    4946msgstr "Neuer Highscore!"
    5047
     48#: uengine.snooldstationtoconnectnew
     49msgid "No old line station to connect new station"
     50msgstr ""
     51
    5152#: uengine.soldhighscore
     53#, object-pascal-format
    5254msgid "Old high score was %d passengers in %d days."
    5355msgstr "Der alte Highscore war %d passager in %d Tagen."
    5456
    55 #: uengine.szerozoomnotalowed
    56 msgid "Zero zoom not allowed"
    57 msgstr "Diese Zoomstufe ist nicht erlaubt"
     57#: uengine.sstationnotdefined
     58msgid "Station have to be defined"
     59msgstr ""
     60
     61#: uengine.sstationwithoutmapstation
     62msgid "Station have to have MapStation"
     63msgstr ""
    5864
    5965#: umenu.sautomatic
    … …  
    113119msgstr "Neustart"
    114120
     121#: utrack.salreadyconnectedtrackpoint
     122#, fuzzy
     123msgctxt "utrack.salreadyconnectedtrackpoint"
     124msgid "Trying to connect already connected track point"
     125msgstr "Versuch ein bereits verbundene Line zu verbinden"
     126
     127#: utrack.salreadydisconnectedtrackpoint
     128#, fuzzy
     129msgctxt "utrack.salreadydisconnectedtrackpoint"
     130msgid "Trying to disconnect not connected track point"
     131msgstr "Versuch einen nicht verbundene Line zu unterbrechen"
     132
     133#: utrack.strackpointnotfound
     134#, object-pascal-format
     135msgctxt "utrack.strackpointnotfound"
     136msgid "Track point %d not found"
     137msgstr ""
     138
     139#: uview.szerozoomnotalowed
     140#, fuzzy
     141msgctxt "uview.szerozoomnotalowed"
     142msgid "Zero zoom not allowed"
     143msgstr "Diese Zoomstufe ist nicht erlaubt"
     144

  • trunk/Languages/BigMetro.pot

    r86 r91  
    1313msgctxt "tformmain.caption"
    1414msgid "Big Metro"
    15 msgstr ""
    16 
    17 #: uengine.salreadyconnectedtrackpoint
    18 msgid "Trying to connect already connected track point"
    19 msgstr ""
    20 
    21 #: uengine.salreadydisconnectedtrackpoint
    22 msgid "Trying to disconnect not connected track point"
    2315msgstr ""
    2416
    … …  
    5951#: uengine.sstationwithoutmapstation
    6052msgid "Station have to have MapStation"
    61 msgstr ""
    62 
    63 #: uengine.strackpointnotfound
    64 #, object-pascal-format
    65 msgid "Track point %d not found"
    66 msgstr ""
    67 
    68 #: uengine.szerozoomnotalowed
    69 msgid "Zero zoom not allowed"
    7053msgstr ""
    7154
    … …  
    123106msgstr ""
    124107
     108#: utrack.salreadyconnectedtrackpoint
     109msgctxt "utrack.salreadyconnectedtrackpoint"
     110msgid "Trying to connect already connected track point"
     111msgstr ""
     112
     113#: utrack.salreadydisconnectedtrackpoint
     114msgctxt "utrack.salreadydisconnectedtrackpoint"
     115msgid "Trying to disconnect not connected track point"
     116msgstr ""
     117
     118#: utrack.strackpointnotfound
     119#, object-pascal-format
     120msgctxt "utrack.strackpointnotfound"
     121msgid "Track point %d not found"
     122msgstr ""
     123
     124#: uview.szerozoomnotalowed
     125msgctxt "uview.szerozoomnotalowed"
     126msgid "Zero zoom not allowed"
     127msgstr ""
     128

  • trunk/UEngine.pas

    r90 r91  
    99  Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils,
    1010  UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu, UControls,
    11   UMetroPassenger, UColors;
     11  UMetroPassenger, UColors, UView, URiver, UTrack;
    1212
    1313type
    … …  
    1717  TMetroLine = class;
    1818  TMetroTrains = class;
    19   TTrackPoint = class;
    2019  TLineStation = class;
    21   TTrackPoints = class;
    22   TTrack = class;
    23   TTrackLink = class;
    24   TTrackLinks = class;
    2520
    2621  { TMapStation }
    … …  
    5146  end;
    5247
     48  { TLineStation }
     49
    5350  TLineStation = class
    5451    Line: TMetroLine;
    … …  
    6259    Line: TMetroLine;
    6360    function SearchMapStation(Station: TMapStation): TLineStation;
    64   end;
    65 
    66   { TTrackPoint }
    67 
    68   TTrackPoint = class
    69     LineStation: TLineStation;
    70     Position: TPoint;
    71     //PositionShift: TPoint;
    72     PositionDesigned: TPoint;
    73     Pending: Boolean;
    74     Track: TTrack;
    75     NeighPoints: TTrackPoints;
    76     NeighLinks: TTrackLinks;
    77     LinkUp: TTrackLink;
    78     LinkDown: TTrackLink;
    79     procedure Connect(TrackPoint: TTrackPoint);
    80     procedure Disconnect(TrackPoint: TTrackPoint);
    81     function GetDown: TTrackPoint;
    82     function GetUp: TTrackPoint;
    83     function GetNeighDown: TTrackPoint;
    84     function GetNeighUp: TTrackPoint;
    85     function GetLinkDown: TTrackLink;
    86     function GetLinkUp: TTrackLink;
    87     // Move to TTrackLink later
    88     function GetDistance: Integer;
    89     constructor Create;
    90     destructor Destroy; override;
    91   end;
    92 
    93   { TTrackPoints }
    94 
    95   TTrackPoints = class(TObjectList<TTrackPoint>)
    96     Track: TTrack;
    97     function AddNew: TTrackPoint;
    98   end;
    99 
    100   { TTrackLink }
    101 
    102   TTrackLink = class
    103     Points: TTrackPoints;
    104     Shift: TPoint;
    105     Track: TTrack;
    106     constructor Create;
    107     destructor Destroy; override;
    108   end;
    109 
    110   { TTrackLinks }
    111 
    112   TTrackLinks = class(TObjectList<TTrackLink>)
    113     Track: TTrack;
    114     function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
    115     function AddNew: TTrackLink;
    116   end;
    117 
    118   TTrack = class
    119     Points: TTrackPoints;
    120     Links: TTrackLinks;
    121     Line: TMetroLine;
    122     procedure RouteTrack(TP1, TP2: TTrackPoint);
    123     procedure RemoveTrackBetween(TP1, TP2: TTrackPoint);
    124     constructor Create;
    125     destructor Destroy; override;
    126   end;
    127 
    128   { TTracks }
    129 
    130   TTracks = class(TObjectList<TTrackLink>)
    131     function SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
    132     function SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
    133   end;
    134 
    135   { TTrackPointsAngle }
    136 
    137   TTrackPointsAngle = class
    138     Angle: Double;
    139     TrackLinks: TTrackLinks;
    140     constructor Create;
    141     destructor Destroy; override;
    142   end;
    143 
    144   { TTrackPointsAngleGroup }
    145 
    146   TTrackPointsAngleGroup = class(TObjectList<TTrackPointsAngle>)
    147     function SearchAngle(Angle: Double): TTrackPointsAngle;
    14861  end;
    14962
    … …  
    16376    procedure ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
    16477    procedure DisconnectStation(ALineStation: TLineStation);
    165     function GetTrackLength: Integer;
    16678    constructor Create;
    16779    destructor Destroy; override;
    … …  
    17991  TMetroTrain = class;
    18092
     93  { TMetroCarriage }
     94
    18195  TMetroCarriage = class
    18296    Train: TMetroTrain;
    18397  end;
     98
     99  { TMetroCarriages }
    184100
    185101  TMetroCarriages = class(TObjectList<TMetroCarriage>)
    … …  
    219135  end;
    220136
    221   { TRiver }
    222 
    223   TRiver = class
    224     Points: array of TPoint;
    225     procedure Paint(Canvas: TCanvas);
    226   end;
    227 
    228   TRivers = class(TObjectList<TRiver>)
    229   end;
    230 
    231137  TMap = class
    232138    Size: TPoint;
    … …  
    234140    constructor Create;
    235141    destructor Destroy; override;
    236   end;
    237 
    238   { TView }
    239 
    240   TView = class
    241   private
    242     FDestRect: TRect;
    243     FSourceRect: TRect;
    244     FZoom: Double;
    245     procedure SetDestRect(AValue: TRect);
    246     procedure SetSourceRect(AValue: TRect);
    247     procedure SetZoom(AValue: Double);
    248   public
    249     function PointDestToSrc(Pos: TPoint): TPoint;
    250     function PointSrcToDest(Pos: TPoint): TPoint;
    251     constructor Create;
    252     property SourceRect: TRect read FSourceRect write SetSourceRect;
    253     property DestRect: TRect read FDestRect write SetDestRect;
    254     property Zoom: Double read FZoom write SetZoom;
    255142  end;
    256143
    … …  
    408295
    409296resourcestring
    410   SZeroZoomNotAlowed = 'Zero zoom not allowed';
    411   SAlreadyConnectedTrackPoint = 'Trying to connect already connected track point';
    412   SAlreadyDisconnectedTrackPoint = 'Trying to disconnect not connected track point';
    413297  SGameOver = 'Game Over';
    414298  SGameOverReason = 'Overcrowding at this station has forced you to resign as metro manager.';
    … …  
    417301  SNewHighScore = 'New high score!';
    418302  SOldHighScore = 'Old high score was %d passengers in %d days.';
    419   STrackPointNotFound = 'Track point %d not found';
    420303  SStationNotDefined = 'Station have to be defined';
    421304  SNoOldStationToConnectNew = 'No old line station to connect new station';
    422305  SStationWithoutMapStation = 'Station have to have MapStation';
    423306
    424 { TTrackLinks }
    425 
    426 function TTrackLinks.SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
    427 var
    428   I: Integer;
    429 begin
    430   I := 0;
    431   while (I < 0) and
    432     ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2)) and
    433     ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do
    434   Inc(I);
    435   if I < 0 then Result := Items[I]
    436     else Result := nil;
    437 end;
    438 
    439 function TTrackLinks.AddNew: TTrackLink;
    440 begin
    441   Result := TTrackLink.Create;
    442   Result.Track := Track;
    443 end;
    444 
    445 { TTrackPoints }
    446 
    447 function TTrackPoints.AddNew: TTrackPoint;
    448 begin
    449   Result := TTrackPoint.Create;
    450   Result.Track := Track;
    451 end;
    452 
    453 { TTrack }
    454 
    455 constructor TTrack.Create;
    456 begin
    457   Points := TTrackPoints.Create;
    458   Points.Track := Self;
    459   Links := TTrackLinks.Create;
    460   Links.Track := Self;
    461 end;
    462 
    463 destructor TTrack.Destroy;
    464 begin
    465   FreeAndNil(Points);
    466   FreeAndNil(Links);
    467   inherited;
    468 end;
    469 
    470 { TTrackLink }
    471 
    472 constructor TTrackLink.Create;
    473 begin
    474   Points := TTrackPoints.Create;
    475   Points.OwnsObjects := False;
    476 end;
    477 
    478 destructor TTrackLink.Destroy;
    479 begin
    480   FreeAndNil(Points);
    481   inherited;
    482 end;
    483 
    484 { TRiver }
    485 
    486 procedure TRiver.Paint(Canvas: TCanvas);
    487 begin
    488   Canvas.Brush.Color := $ffffe0;
    489   Canvas.Brush.Style := bsSolid;
    490   Canvas.Polygon(Points);
    491 end;
    492 
    493307{ TMap }
    494308
    … …  
    501315begin
    502316  FreeAndNil(Rivers);
    503   inherited;
    504 end;
    505 
    506 { TView }
    507 
    508 procedure TView.SetDestRect(AValue: TRect);
    509 var
    510   Diff: TPoint;
    511 begin
    512   if RectEquals(FDestRect, AValue) then Exit;
    513   Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
    514     Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
    515   FDestRect := AValue;
    516   FSourceRect := Bounds(FSourceRect.Left + Diff.X, FSourceRect.Top + Diff.Y,
    517     Trunc((DestRect.Right - DestRect.Left) / Zoom),
    518     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
    519 end;
    520 
    521 procedure TView.SetSourceRect(AValue: TRect);
    522 var
    523   ZX: Double;
    524   ZY: Double;
    525 begin
    526   if RectEquals(FSourceRect, AValue) then Exit;
    527   FSourceRect := AValue;
    528   ZX := (FDestRect.Right - FDestRect.Left) / (FSourceRect.Right - FSourceRect.Left);
    529   ZY := (FDestRect.Bottom - FDestRect.Top) / (FSourceRect.Bottom - FSourceRect.Top);
    530   if  ZX > ZY then
    531     Zoom := ZY
    532     else Zoom := ZX;
    533 end;
    534 
    535 procedure TView.SetZoom(AValue: Double);
    536 begin
    537   if FZoom = AValue then Exit;
    538   if AValue = 0 then
    539     raise Exception.Create(SZeroZoomNotAlowed);
    540   FZoom := AValue;
    541   FSourceRect := Bounds(Trunc(FSourceRect.Left + (FSourceRect.Right - FSourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
    542     Trunc(FSourceRect.Top +  (FSourceRect.Bottom - FSourceRect.Top) div 2 - (FDestRect.Bottom - DestRect.Top) / Zoom / 2),
    543     Trunc((DestRect.Right - DestRect.Left) / Zoom),
    544     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
    545 end;
    546 
    547 function TView.PointDestToSrc(Pos: TPoint): TPoint;
    548 begin
    549   Result := Point(Trunc(Pos.X / FZoom + FSourceRect.Left),
    550     Trunc(Pos.Y / FZoom + FSourceRect.Top));
    551 end;
    552 
    553 function TView.PointSrcToDest(Pos: TPoint): TPoint;
    554 begin
    555   Result := Point(Trunc((Pos.X - FSourceRect.Left) * FZoom),
    556     Trunc((Pos.Y - FSourceRect.Top) * FZoom));
    557 end;
    558 
    559 constructor TView.Create;
    560 begin
    561   Zoom := 1;
    562 end;
    563 
    564 { TTracks }
    565 
    566 function TTracks.SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
    567 var
    568   I: Integer;
    569 begin
    570   I := 0;
    571   while (I < Count) and (Items[I].Points[1] <> TrackPoint) and (Items[I] <> Skip) do Inc(I);
    572   if I < Count then Result := Items[I]
    573     else Result := nil;
    574 end;
    575 
    576 function TTracks.SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
    577 var
    578   I: Integer;
    579 begin
    580   I := 0;
    581   while (I < Count) and (Items[I].Points[0] <> TrackPoint) and (Items[I] <> Skip) do Inc(I);
    582   if I < Count then Result := Items[I]
    583     else Result := nil;
    584 end;
    585 
    586 { TTrackPointsAngleGroup }
    587 
    588 function TTrackPointsAngleGroup.SearchAngle(Angle: Double): TTrackPointsAngle;
    589 var
    590   I: Integer;
    591 begin
    592   I := 0;
    593   while (I < Count) and (Items[I].Angle <> Angle) do Inc(I);
    594   if I < Count then Result := Items[I]
    595     else Result := nil;
    596 end;
    597 
    598 { TTrackPointsAngle }
    599 
    600 constructor TTrackPointsAngle.Create;
    601 begin
    602   TrackLinks := TTrackLinks.Create;
    603   TrackLinks.OwnsObjects := False;
    604 end;
    605 
    606 destructor TTrackPointsAngle.Destroy;
    607 begin
    608   FreeAndNil(TrackLinks);
    609   inherited;
    610 end;
    611 
    612 { TTrackPoint }
    613 
    614 procedure TTrackPoint.Connect(TrackPoint: TTrackPoint);
    615 var
    616   NewLink: TTrackLink;
    617 begin
    618   if NeighPoints.IndexOf(TrackPoint) = -1 then begin
    619     NeighPoints.Add(TrackPoint);
    620     TrackPoint.NeighPoints.Add(Self);
    621 
    622     // Add new link to both self and connected track point
    623     NewLink := Track.Links.AddNew;
    624     NewLink.Points.Add(TrackPoint);
    625     NewLink.Points.Add(Self);
    626     NeighLinks.Add(NewLink);
    627     TrackPoint.NeighLinks.Add(NewLink);
    628     Track.Links.Add(NewLink);
    629   end else raise Exception.Create(SAlreadyConnectedTrackPoint);
    630 end;
    631 
    632 procedure TTrackPoint.Disconnect(TrackPoint: TTrackPoint);
    633 var
    634   Index: Integer;
    635   Link: TTrackLink;
    636 begin
    637   Index := NeighPoints.IndexOf(TrackPoint);
    638   if NeighPoints.IndexOf(TrackPoint) <> -1 then begin
    639     NeighPoints.Delete(Index);
    640     TrackPoint.NeighPoints.Remove(Self);
    641 
    642     // Remove link from both track points
    643     Link := NeighLinks.SearchPoints(Self, TrackPoint);
    644     NeighLinks.Remove(Link);
    645     TrackPoint.NeighLinks.Remove(Link);
    646     Track.Links.Remove(Link);
    647   end else raise Exception.Create(SAlreadyDisconnectedTrackPoint);
    648 end;
    649 
    650 function TTrackPoint.GetDown: TTrackPoint;
    651 var
    652   I: Integer;
    653 begin
    654   I := Track.Points.IndexOf(Self) - 1;
    655   while (I >= 0) and not Assigned(Track.Points[I].LineStation) do
    656     Dec(I);
    657   if I >= 0 then Result := Track.Points[I]
    658     else Result := nil;
    659 end;
    660 
    661 function TTrackPoint.GetUp: TTrackPoint;
    662 var
    663   I: Integer;
    664 begin
    665   I := Track.Points.IndexOf(Self) + 1;
    666   while (I < Track.Points.Count) and not Assigned(Track.Points[I].LineStation) do
    667     Inc(I);
    668   if I < Track.Points.Count then Result := Track.Points[I]
    669     else Result := nil;
    670 end;
    671 
    672 function TTrackPoint.GetNeighDown: TTrackPoint;
    673 var
    674   NewIndex: Integer;
    675 begin
    676   Result := nil;
    677   NewIndex := Track.Points.IndexOf(Self) - 1;
    678   if NewIndex >= 0 then Result := Track.Points[NewIndex];
    679 end;
    680 
    681 function TTrackPoint.GetNeighUp: TTrackPoint;
    682 var
    683   NewIndex: Integer;
    684 begin
    685   Result := nil;
    686   if Assigned(Track) then begin
    687     NewIndex := Track.Points.IndexOf(Self) + 1;
    688     if NewIndex < Track.Points.Count then Result := Track.Points[NewIndex];
    689   end;
    690 end;
    691 
    692 function TTrackPoint.GetLinkDown: TTrackLink;
    693 begin
    694   if Assigned(LinkDown) then Result := LinkDown
    695     else begin
    696       LinkDown := TTrackLink.Create;
    697       LinkDown.Points.Add(GetNeighDown);
    698       LinkDown.Points.Add(Self);
    699       Result := LinkDown;
    700       GetNeighDown.LinkUp := LinkDown;
    701     end;
    702 end;
    703 
    704 function TTrackPoint.GetLinkUp: TTrackLink;
    705 begin
    706   if Assigned(LinkUp) then Result := LinkUp
    707     else begin
    708       LinkUp := TTrackLink.Create;
    709       LinkUp.Points.Add(Self);
    710       LinkUp.Points.Add(GetNeighUp);
    711       Result := LinkUp;
    712       GetNeighUp.LinkDown := LinkUp;
    713     end;
    714 end;
    715 
    716 function TTrackPoint.GetDistance: Integer;
    717 var
    718   Index: Integer;
    719 begin
    720   Index := Track.Points.IndexOf(Self);
    721   Result := Distance(Track.Points[Index + 1].Position, Track.Points[Index].Position);
    722 end;
    723 
    724 constructor TTrackPoint.Create;
    725 begin
    726   NeighPoints := TTrackPoints.Create;
    727   NeighPoints.OwnsObjects := False;
    728   NeighLinks := TTrackLinks.Create;
    729   NeighLinks.OwnsObjects := False;
    730 end;
    731 
    732 destructor TTrackPoint.Destroy;
    733 begin
    734   FreeAndNil(NeighLinks);
    735   FreeAndNil(NeighPoints);
    736317  inherited;
    737318end;
    … …  
    854435procedure TMetroLine.UpdateEndingLine(EndIndex, Direction: Integer);
    855436var
    856   Index: Integer;
    857   NewTrackPoint: TTrackPoint;
     437  //Index: Integer;
     438  //NewTrackPoint: TTrackPoint;
    858439  Angle: Double;
    859440  EndPoint: TPoint;
    … …  
    922503
    923504  NewTrackPoint := Track.Points.AddNew;
    924   NewTrackPoint.LineStation := NewLineStation;
     505  NewTrackPoint.OwnerPoint := NewLineStation;
    925506  NewTrackPoint.Position := Station.Position;
    926507  NewTrackPoint.PositionDesigned := NewTrackPoint.Position;
    … …  
    986567  // Delete old trackpoints
    987568  Index := Track.Points.IndexOf(ALineStation.TrackPoint) - 1;
    988   while (Index >= 0) and (not Assigned(Track.Points[Index].LineStation)) do begin
     569  while (Index >= 0) and (not Assigned(Track.Points[Index].OwnerPoint)) do begin
    989570    Track.Points.Delete(Index);
    990571    Dec(Index);
    … …  
    992573  Index := Index + 1;
    993574  Track.Points.Delete(Index);
    994   while (Index < Track.Points.Count) and (not Assigned(Track.Points[Index].LineStation)) do
     575  while (Index < Track.Points.Count) and (not Assigned(Track.Points[Index].OwnerPoint)) do
    995576    Track.Points.Delete(Index);
    996577
    … …  
    1020601end;
    1021602
    1022 procedure TTrack.RouteTrack(TP1, TP2: TTrackPoint);
    1023 var
    1024   NewTrackPoint: TTrackPoint;
    1025   Delta: TPoint;
    1026   P1, P2: TPoint;
    1027   Index1, Index2: Integer;
    1028 begin
    1029   RemoveTrackBetween(TP1, TP2);
    1030   Index1 := Points.IndexOf(TP1);
    1031   Index2 := Points.IndexOf(TP2);
    1032   P1 := Points[Index1].PositionDesigned;
    1033   P2 := Points[Index2].PositionDesigned;
    1034   NewTrackPoint := Points.AddNew;
    1035   Delta := Point(P2.X - P1.X, P2.Y - P1.Y);
    1036   if Abs(Delta.X) > Abs(Delta.Y) then begin
    1037     NewTrackPoint.PositionDesigned := Point(P2.X - Sign(Delta.X) * Abs(Delta.Y), P1.Y);
    1038     NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
    1039   end else begin
    1040     NewTrackPoint.PositionDesigned := Point(P1.X, P2.Y - Sign(Delta.Y) * Abs(Delta.X));
    1041     NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
    1042   end;
    1043   Points.Insert(Index1 + 1, NewTrackPoint);
    1044 end;
    1045 
    1046 procedure TTrack.RemoveTrackBetween(TP1, TP2: TTrackPoint);
    1047 var
    1048   Index1, Index2: Integer;
    1049   Temp: Integer;
    1050   I: Integer;
    1051 begin
    1052   Index1 := Points.IndexOf(TP1);
    1053   Index2 := Points.IndexOf(TP2);
    1054   if (Index1 = -1) then
    1055     raise Exception.Create(Format(STrackPointNotFound, [1]));
    1056   if (Index2 = -1) then
    1057     raise Exception.Create(Format(STrackPointNotFound, [2]));
    1058   if Index1 > Index2 then begin
    1059     Temp := Index1;
    1060     Index1 := Index2;
    1061     Index2 := Temp;
    1062   end;
    1063   for I := 1 to Index2 - Index1 - 1 do
    1064     Points.Delete(Index1 + 1);
    1065 end;
    1066 
    1067 function TMetroLine.GetTrackLength: Integer;
    1068 var
    1069   I: Integer;
    1070 begin
    1071   Result := 0;
    1072   for I := 0 to Track.Points.Count - 1 do
    1073   if I > 0 then
    1074     Result := Result + Distance(Track.Points[I].Position, Track.Points[I - 1].Position);
    1075 end;
    1076 
    1077603constructor TMetroLine.Create;
    1078604begin
    … …  
    1082608  Trains.OwnsObjects := False;
    1083609  Track := TTrack.Create;
    1084   Track.Line := Self;
     610  Track.Owner := Self;
    1085611end;
    1086612
    … …  
    17051231        else Direction := -Direction;
    17061232      TP := BaseTrackPoint.GetUp;
    1707       if Assigned(TP) then TargetStation := TP.LineStation
     1233      if Assigned(TP) then TargetStation := TLineStation(TP.OwnerPoint)
    17081234      else begin
    17091235        TP := BaseTrackPoint.GetDown;
    1710         if Assigned(TP) then TargetStation := TP.LineStation;
     1236        if Assigned(TP) then TargetStation := TLineStation(TP.OwnerPoint);
    17111237      end;
    17121238    end;
    … …  
    23441870
    23451871  // Draw design time lines
    2346   if Assigned(TrackStationDown) and Assigned(TrackStationDown.LineStation) then begin
    2347     Canvas.Pen.Color := TrackStationDown.Track.Line.Color;
    2348     Canvas.MoveTo(TrackStationDown.LineStation.TrackPoint.Position);
     1872  if Assigned(TrackStationDown) and Assigned(TrackStationDown.OwnerPoint) then begin
     1873    Canvas.Pen.Color := TMetroLine(TrackStationDown.Track.Owner).Color;
     1874    Canvas.MoveTo(TLineStation(TrackStationDown.OwnerPoint).TrackPoint.Position);
    23491875    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
    23501876  end;
    2351   if Assigned(TrackStationUp) and Assigned(TrackStationUp.LineStation) then begin
    2352     Canvas.Pen.Color := TrackStationUp.Track.Line.Color;
    2353     Canvas.MoveTo(TrackStationUp.LineStation.TrackPoint.Position);
     1877  if Assigned(TrackStationUp) and Assigned(TrackStationUp.OwnerPoint) then begin
     1878    Canvas.Pen.Color := TMetroLine(TrackStationUp.Track.Owner).Color;
     1879    Canvas.MoveTo(TLineStation(TrackStationUp.OwnerPoint).TrackPoint.Position);
    23541880    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
    23551881  end;
    … …  
    25892115      Line := nil;
    25902116      if Assigned(TrackStationDown) then begin
    2591         Line := TrackStationDown.Track.Line;
     2117        Line := TMetroLine(TrackStationDown.Track.Owner);
    25922118        Redraw;
    25932119      end;
    25942120      if Assigned(TrackStationUp) then begin
    2595         Line := TrackStationUp.Track.Line;
     2121        Line := TMetroLine(TrackStationUp.Track.Owner);
    25962122        Redraw;
    25972123      end;
    25982124      if Assigned(Line) and not Assigned(LastFocusedStation) and Assigned(FocusedStation) then begin
    2599         if Assigned(TrackStationDown) and (TrackStationDown.LineStation.MapStation = FocusedStation) then begin
     2125        if Assigned(TrackStationDown) and (TLineStation(TrackStationDown.OwnerPoint).MapStation = FocusedStation) then begin
    26002126          // Disconnect down
    26012127          CurrentTrackPoint := TrackStationDown;
    26022128          TrackStationDown := TrackStationDown.GetDown;
    2603           Line.DisconnectStation(CurrentTrackPoint.LineStation);
     2129          Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
    26042130        end else
    2605         if Assigned(TrackStationUp) and (TrackStationUp.LineStation.MapStation = FocusedStation) then begin
     2131        if Assigned(TrackStationUp) and (TLineStation(TrackStationUp.OwnerPoint).MapStation = FocusedStation) then begin
    26062132          // Disconnect up
    26072133          CurrentTrackPoint := TrackStationUp;
    26082134          if Assigned(TrackStationUp) then
    26092135            TrackStationUp := TrackStationUp.GetUp;
    2610           Line.DisconnectStation(CurrentTrackPoint.LineStation);
     2136          Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
    26112137        end else
    26122138        if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
    … …  
    26172143        ((TrackStationDown = nil) or (TrackStationUp = nil)) and
    26182144        (not Line.IsCircular))) then begin
    2619           if Assigned(TrackStationDown) then LineStationDown := TrackStationDown.LineStation
     2145          if Assigned(TrackStationDown) then LineStationDown := TLineStation(TrackStationDown.OwnerPoint)
    26202146            else LineStationDown := nil;
    2621           if Assigned(TrackStationUp) then LineStationUp := TrackStationUp.LineStation
     2147          if Assigned(TrackStationUp) then LineStationUp := TLineStation(TrackStationUp.OwnerPoint)
    26222148            else LineStationUp := nil;
    26232149          Line.ConnectStation(FocusedStation, LineStationDown, LineStationUp);
    … …  
    26742200        FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position));
    26752201        if Assigned(FocusedTrack.Points[0]) then begin
    2676           SelectedTrain.Line := FocusedTrack.Points[0].Track.Line;
     2202          SelectedTrain.Line := TMetroLine(FocusedTrack.Points[0].Track.Owner);
    26772203          SelectedTrain.Line.Trains.Add(SelectedTrain);
    26782204          SelectedTrain.BaseTrackPoint := FocusedTrack.Points[0];
    26792205        end else
    26802206        if Assigned(FocusedTrack.Points[1]) then begin
    2681           SelectedTrain.Line := FocusedTrack.Points[1].Track.Line;
     2207          SelectedTrain.Line := TMetroLine(FocusedTrack.Points[1].Track.Owner);
    26822208          SelectedTrain.Line.Trains.Add(SelectedTrain);
    26832209          SelectedTrain.BaseTrackPoint := FocusedTrack.Points[1];
    … …  
    26952221
    26962222      // Remove single line station on line
    2697       if Assigned(TrackStationDown) and (TrackStationDown.Track.Line.LineStations.Count = 1) then begin
    2698         TrackStationDown.Track.Line.DisconnectStation(TrackStationDown.Track.Line.LineStations.First);
    2699       end;
    2700       if Assigned(TrackStationUp) and (TrackStationUp.Track.Line.LineStations.Count = 1) then begin
    2701         TrackStationUp.Track.Line.DisconnectStation(TrackStationUp.Track.Line.LineStations.First);
     2223      if Assigned(TrackStationDown) and (TMetroLine(TrackStationDown.Track.Owner).LineStations.Count = 1) then begin
     2224        TMetroLine(TrackStationDown.Track.Owner).DisconnectStation(
     2225          TMetroLine(TrackStationDown.Track.Owner).LineStations.First);
     2226      end;
     2227      if Assigned(TrackStationUp) and (TMetroLine(TrackStationUp.Track.Owner).LineStations.Count = 1) then begin
     2228        TMetroLine(TrackStationUp.Track.Owner).DisconnectStation(
     2229          TMetroLine(TrackStationUp.Track.Owner).LineStations.First);
    27022230      end;
    27032231    end;
    … …  
    27562284    Track := GetTrackOnPos(View.PointDestToSrc(Position));
    27572285    if Assigned(Track) and Assigned(Track.Points[0]) and Assigned(Track.Points[1]) then begin
    2758       SelectedLine := Track.Points[0].Track.Line;
     2286      SelectedLine := TMetroLine(Track.Points[0].Track.Owner);
    27592287
    27602288      TrackStationDown := Track.Points[0];
    27612289      NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown);
    2762       while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.LineStation)) do begin
     2290      while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.OwnerPoint)) do begin
    27632291        NewIndex := NewIndex - 1;
    27642292        if NewIndex >= 0 then TrackStationDown := TrackStationDown.Track.Points[NewIndex]
    … …  
    27672295      TrackStationUp := Track.Points[1];
    27682296      NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown);
    2769       while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.LineStation)) do begin
     2297      while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.OwnerPoint)) do begin
    27702298        NewIndex := NewIndex + 1;
    27712299        if NewIndex < TrackStationUp.Track.Points.Count then

  • trunk/UTrack.pas

    r86 r91  
    44
    55uses
    6   Classes, SysUtils, Generics.Collections;
     6  Classes, SysUtils, Math, Generics.Collections;
    77
    88type
    99  TTrack = class;
    1010  TTrackPoints = class;
     11  TTrackLink = class;
    1112  TTrackLinks = class;
    1213
    … …  
    1415
    1516  TTrackPoint = class
     17    OwnerPoint: TObject;
     18    Position: TPoint;
     19    //PositionShift: TPoint;
     20    PositionDesigned: TPoint;
     21    Pending: Boolean;
    1622    Track: TTrack;
    17     Position: TPoint;
    1823    NeighPoints: TTrackPoints;
    1924    NeighLinks: TTrackLinks;
     25    LinkUp: TTrackLink;
     26    LinkDown: TTrackLink;
    2027    procedure Connect(TrackPoint: TTrackPoint);
    2128    procedure Disconnect(TrackPoint: TTrackPoint);
     29    function GetDown: TTrackPoint;
     30    function GetUp: TTrackPoint;
     31    function GetNeighDown: TTrackPoint;
     32    function GetNeighUp: TTrackPoint;
     33    function GetLinkDown: TTrackLink;
     34    function GetLinkUp: TTrackLink;
     35    // Move to TTrackLink later
     36    function GetDistance: Integer;
    2237    constructor Create;
    2338    destructor Destroy; override;
    … …  
    2742
    2843  TTrackPoints = class(TObjectList<TTrackPoint>)
     44    Track: TTrack;
     45    function AddNew: TTrackPoint;
    2946  end;
    3047
    … …  
    3249
    3350  TTrackLink = class
    34     Track: TTrack;
    3551    Points: TTrackPoints;
     52    Shift: TPoint;
    3653    constructor Create;
    3754    destructor Destroy; override;
    … …  
    4259  TTrackLinks = class(TObjectList<TTrackLink>)
    4360    function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
     61    function AddNew: TTrackLink;
    4462  end;
    4563
    … …  
    4765
    4866  TTrack = class
    49   public
    5067    Points: TTrackPoints;
    5168    Links: TTrackLinks;
    52     function AddNew: TTrackPoint;
     69    Owner: TObject;
     70    function GetLength: Integer;
     71    procedure RouteTrack(TP1, TP2: TTrackPoint);
     72    procedure RemoveTrackBetween(TP1, TP2: TTrackPoint);
    5373    constructor Create;
    5474    destructor Destroy; override;
    55     procedure RemoveTrackBetween(TP1, TP2: TTrackPoint);
     75  end;
     76
     77  { TTrackPointsAngle }
     78
     79  TTrackPointsAngle = class
     80    Angle: Double;
     81    TrackLinks: TTrackLinks;
     82    constructor Create;
     83    destructor Destroy; override;
     84  end;
     85
     86  { TTrackPointsAngleGroup }
     87
     88  TTrackPointsAngleGroup = class(TObjectList<TTrackPointsAngle>)
     89    function SearchAngle(Angle: Double): TTrackPointsAngle;
    5690  end;
    5791
    5892
    5993implementation
     94
     95uses
     96  UGeometric;
     97
     98resourcestring
     99  SAlreadyConnectedTrackPoint = 'Trying to connect already connected track point';
     100  SAlreadyDisconnectedTrackPoint = 'Trying to disconnect not connected track point';
     101  STrackPointNotFound = 'Track point %d not found';
    60102
    61103{ TTrackLinks }
    … …  
    67109  I := 0;
    68110  while (I < 0) and
    69   ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2))
    70   and ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do
     111    ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2)) and
     112    ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do
    71113  Inc(I);
    72114  if I < 0 then Result := Items[I]
    … …  
    74116end;
    75117
     118function TTrackLinks.AddNew: TTrackLink;
     119begin
     120  Result := TTrackLink.Create;
     121end;
     122
     123{ TTrackPoints }
     124
     125function TTrackPoints.AddNew: TTrackPoint;
     126begin
     127  Result := TTrackPoint.Create;
     128  Result.Track := Track;
     129end;
     130
     131{ TTrack }
     132
     133constructor TTrack.Create;
     134begin
     135  Points := TTrackPoints.Create;
     136  Points.Track := Self;
     137  Links := TTrackLinks.Create;
     138end;
     139
     140destructor TTrack.Destroy;
     141begin
     142  FreeAndNil(Points);
     143  FreeAndNil(Links);
     144  inherited;
     145end;
     146
     147function TTrack.GetLength: Integer;
     148var
     149  I: Integer;
     150begin
     151  Result := 0;
     152  for I := 0 to Points.Count - 1 do
     153  if I > 0 then
     154    Result := Result + Distance(Points[I].Position, Points[I - 1].Position);
     155end;
     156
     157procedure TTrack.RouteTrack(TP1, TP2: TTrackPoint);
     158var
     159  NewTrackPoint: TTrackPoint;
     160  Delta: TPoint;
     161  P1, P2: TPoint;
     162  Index1, Index2: Integer;
     163begin
     164  RemoveTrackBetween(TP1, TP2);
     165  Index1 := Points.IndexOf(TP1);
     166  Index2 := Points.IndexOf(TP2);
     167  P1 := Points[Index1].PositionDesigned;
     168  P2 := Points[Index2].PositionDesigned;
     169  NewTrackPoint := Points.AddNew;
     170  Delta := Point(P2.X - P1.X, P2.Y - P1.Y);
     171  if Abs(Delta.X) > Abs(Delta.Y) then begin
     172    NewTrackPoint.PositionDesigned := Point(P2.X - Sign(Delta.X) * Abs(Delta.Y), P1.Y);
     173    NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
     174  end else begin
     175    NewTrackPoint.PositionDesigned := Point(P1.X, P2.Y - Sign(Delta.Y) * Abs(Delta.X));
     176    NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
     177  end;
     178  Points.Insert(Index1 + 1, NewTrackPoint);
     179end;
     180
     181procedure TTrack.RemoveTrackBetween(TP1, TP2: TTrackPoint);
     182var
     183  Index1, Index2: Integer;
     184  Temp: Integer;
     185  I: Integer;
     186begin
     187  Index1 := Points.IndexOf(TP1);
     188  Index2 := Points.IndexOf(TP2);
     189  if (Index1 = -1) then
     190    raise Exception.Create(Format(STrackPointNotFound, [1]));
     191  if (Index2 = -1) then
     192    raise Exception.Create(Format(STrackPointNotFound, [2]));
     193  if Index1 > Index2 then begin
     194    Temp := Index1;
     195    Index1 := Index2;
     196    Index2 := Temp;
     197  end;
     198  for I := 1 to Index2 - Index1 - 1 do
     199    Points.Delete(Index1 + 1);
     200end;
     201
    76202{ TTrackLink }
    77203
    … …  
    84210destructor TTrackLink.Destroy;
    85211begin
    86   Points.Free;
     212  FreeAndNil(Points);
    87213  inherited;
    88214end;
    89215
    90 { TTrackPoints }
    91 
    92 function TTrack.AddNew: TTrackPoint;
    93 begin
    94   Result := TTrackPoint.Create;
    95   Result.Track := Self;
    96   Points.Add(Result);
     216{ TTrackPointsAngleGroup }
     217
     218function TTrackPointsAngleGroup.SearchAngle(Angle: Double): TTrackPointsAngle;
     219var
     220  I: Integer;
     221begin
     222  I := 0;
     223  while (I < Count) and (Items[I].Angle <> Angle) do Inc(I);
     224  if I < Count then Result := Items[I]
     225    else Result := nil;
     226end;
     227
     228{ TTrackPointsAngle }
     229
     230constructor TTrackPointsAngle.Create;
     231begin
     232  TrackLinks := TTrackLinks.Create;
     233  TrackLinks.OwnsObjects := False;
     234end;
     235
     236destructor TTrackPointsAngle.Destroy;
     237begin
     238  FreeAndNil(TrackLinks);
     239  inherited;
    97240end;
    98241
    … …  
    106249    NeighPoints.Add(TrackPoint);
    107250    TrackPoint.NeighPoints.Add(Self);
    108     // Add new link
    109     NewLink := TTrackLink.Create;
     251
     252    // Add new link to both self and connected track point
     253    NewLink := Track.Links.AddNew;
    110254    NewLink.Points.Add(TrackPoint);
    111255    NewLink.Points.Add(Self);
    … …  
    113257    TrackPoint.NeighLinks.Add(NewLink);
    114258    Track.Links.Add(NewLink);
    115   end;
     259  end else raise Exception.Create(SAlreadyConnectedTrackPoint);
    116260end;
    117261
    … …  
    125269    NeighPoints.Delete(Index);
    126270    TrackPoint.NeighPoints.Remove(Self);
    127     // Remove link
     271
     272    // Remove link from both track points
    128273    Link := NeighLinks.SearchPoints(Self, TrackPoint);
    129274    NeighLinks.Remove(Link);
    130275    TrackPoint.NeighLinks.Remove(Link);
    131276    Track.Links.Remove(Link);
    132   end;
     277  end else raise Exception.Create(SAlreadyDisconnectedTrackPoint);
     278end;
     279
     280function TTrackPoint.GetDown: TTrackPoint;
     281var
     282  I: Integer;
     283begin
     284  I := Track.Points.IndexOf(Self) - 1;
     285  while (I >= 0) and not Assigned(Track.Points[I].OwnerPoint) do
     286    Dec(I);
     287  if I >= 0 then Result := Track.Points[I]
     288    else Result := nil;
     289end;
     290
     291function TTrackPoint.GetUp: TTrackPoint;
     292var
     293  I: Integer;
     294begin
     295  I := Track.Points.IndexOf(Self) + 1;
     296  while (I < Track.Points.Count) and not Assigned(Track.Points[I].OwnerPoint) do
     297    Inc(I);
     298  if I < Track.Points.Count then Result := Track.Points[I]
     299    else Result := nil;
     300end;
     301
     302function TTrackPoint.GetNeighDown: TTrackPoint;
     303var
     304  NewIndex: Integer;
     305begin
     306  Result := nil;
     307  NewIndex := Track.Points.IndexOf(Self) - 1;
     308  if NewIndex >= 0 then Result := Track.Points[NewIndex];
     309end;
     310
     311function TTrackPoint.GetNeighUp: TTrackPoint;
     312var
     313  NewIndex: Integer;
     314begin
     315  Result := nil;
     316  if Assigned(Track) then begin
     317    NewIndex := Track.Points.IndexOf(Self) + 1;
     318    if NewIndex < Track.Points.Count then Result := Track.Points[NewIndex];
     319  end;
     320end;
     321
     322function TTrackPoint.GetLinkDown: TTrackLink;
     323begin
     324  if Assigned(LinkDown) then Result := LinkDown
     325    else begin
     326      LinkDown := TTrackLink.Create;
     327      LinkDown.Points.Add(GetNeighDown);
     328      LinkDown.Points.Add(Self);
     329      Result := LinkDown;
     330      GetNeighDown.LinkUp := LinkDown;
     331    end;
     332end;
     333
     334function TTrackPoint.GetLinkUp: TTrackLink;
     335begin
     336  if Assigned(LinkUp) then Result := LinkUp
     337    else begin
     338      LinkUp := TTrackLink.Create;
     339      LinkUp.Points.Add(Self);
     340      LinkUp.Points.Add(GetNeighUp);
     341      Result := LinkUp;
     342      GetNeighUp.LinkDown := LinkUp;
     343    end;
     344end;
     345
     346function TTrackPoint.GetDistance: Integer;
     347var
     348  Index: Integer;
     349begin
     350  Index := Track.Points.IndexOf(Self);
     351  Result := Distance(Track.Points[Index + 1].Position, Track.Points[Index].Position);
    133352end;
    134353
    … …  
    137356  NeighPoints := TTrackPoints.Create;
    138357  NeighPoints.OwnsObjects := False;
     358  NeighLinks := TTrackLinks.Create;
     359  NeighLinks.OwnsObjects := False;
    139360end;
    140361
    141362destructor TTrackPoint.Destroy;
    142 var
    143   I: Integer;
    144 begin
    145   // Disconnect from all before destruction
    146   for I := NeighPoints.Count - 1 downto 0 do
    147     NeighPoints[I].Disconnect(Self);
    148   if Assigned(Track) then Track.Points.Remove(Self);
    149   NeighPoints.Free;
     363begin
     364  FreeAndNil(NeighLinks);
     365  FreeAndNil(NeighPoints);
    150366  inherited;
    151367end;
    152368
    153 { TTrack }
    154 
    155 constructor TTrack.Create;
    156 begin
    157   Points := TTrackPoints.Create;
    158 end;
    159 
    160 destructor TTrack.Destroy;
    161 begin
    162   Points.Free;
    163   inherited;
    164 end;
    165 
    166 procedure TTrack.RemoveTrackBetween(TP1, TP2: TTrackPoint);
    167 var
    168   Index1, Index2: Integer;
    169   Temp: Integer;
    170   I: Integer;
    171 begin
    172   Index1 := Points.IndexOf(TP1);
    173   Index2 := Points.IndexOf(TP2);
    174   if (Index1 = -1) then
    175     raise Exception.Create('TrackPoint1 not found');
    176   if (Index2 = -1) then
    177     raise Exception.Create('TrackPoint2 not found');
    178   if Index1 > Index2 then begin
    179     Temp := Index1;
    180     Index1 := Index2;
    181     Index2 := Temp;
    182   end;
    183   for I := 1 to Index2 - Index1 - 1 do
    184     Points.Delete(Index1 + 1);
    185 end;
    186 
    187 
    188369end.
    189370
Note: See TracChangeset for help on using the changeset viewer.