- Timestamp:
- Sep 26, 2022, 10:39:03 PM (2 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/BigMetro.lpi
r91 r93 89 89 </Item2> 90 90 </RequiredPackages> 91 <Units Count="1 1">91 <Units Count="12"> 92 92 <Unit0> 93 93 <Filename Value="BigMetro.lpr"/> … … 140 140 <IsPartOfProject Value="True"/> 141 141 </Unit10> 142 <Unit11> 143 <Filename Value="UCity.pas"/> 144 <IsPartOfProject Value="True"/> 145 </Unit11> 142 146 </Units> 143 147 </ProjectOptions> -
trunk/BigMetro.lpr
r91 r93 9 9 Interfaces, // this includes the LCL widgetset 10 10 Forms, SysUtils, UFormMain, UFormImages, Common, UMenu, UControls, 11 UMetroPassenger, UColors, UView, URiver ;11 UMetroPassenger, UColors, UView, URiver, UCity; 12 12 13 13 {$R *.res} -
trunk/Forms/UFormImages.lfm
r86 r93 85 85 object ImageTunnel: TImage 86 86 Left = 48 87 Height = 7687 Height = 52 88 88 Top = 156 89 Width = 8489 Width = 48 90 90 Picture.Data = { 91 91 1754506F727461626C654E6574776F726B47726170686963E40E000089504E47 … … 654 654 Stretch = True 655 655 end 656 object ImageCarriage: TImage 657 Left = 51 658 Height = 34 659 Top = 326 660 Width = 37 661 Picture.Data = { 662 1754506F727461626C654E6574776F726B47726170686963D100000089504E47 663 0D0A1A0A0000000D494844520000002000000020080300000044A48AC6000000 664 1B504C5445000000000000010101020202030303050505070707080808090909 665 2516B4820000000174524E530040E6D8660000006449444154789CED91DB0AC0 666 3008434D6CD7FDFF17AF17A43A287D1B1BEC3C04A251B015F931B062D747B600 667 55D51455696A81A61C6E4C8DD2BB029B877828A022C935CCCECFB86D72D54EC2 668 BCB0A2D1F670F113C01117886490482BDB38C9E22CA2FD3E176AF201C23336DB 669 110000000049454E44AE426082 670 } 671 end 656 672 end -
trunk/Forms/UFormImages.pas
r86 r93 11 11 12 12 TFormImages = class(TForm) 13 ImageCarriage: TImage; 13 14 ImageFastForward: TImage; 14 15 ImagePause: TImage; -
trunk/Forms/UFormMain.pas
r86 r93 196 196 Translator1.Language := Translator1.Languages.SearchByCode(LangCode); 197 197 end else Translator1.Language := Translator1.Languages.SearchByCode(''); 198 Engine.DarkMode := ReadBoolWithDefault('DarkMode', False); 199 Engine.HighestServedPassengerCount := ReadIntegerWithDefault('HighestPassengers', 0); 200 Engine.HighestServedDaysCount := ReadIntegerWithDefault('HighestDays', 0); 198 Engine.LoadFromRegistry(CurrentContext); 201 199 finally 202 200 Free; … … 213 211 WriteString('LanguageCode', Translator1.Language.Code) 214 212 else DeleteValue('LanguageCode'); 215 WriteBool('DarkMode', Engine.DarkMode); 216 WriteInteger('HighestPassengers', Engine.HighestServedPassengerCount); 217 WriteInteger('HighestDays', Engine.HighestServedDaysCount); 213 Engine.SaveToRegistry(CurrentContext); 218 214 finally 219 215 Free; … … 227 223 CopyImage(Engine.ImageLocomotive.Bitmap, FormImages.ImageLocomotive.Picture.Bitmap); 228 224 CopyImage(Engine.ImageLocomotive.BitmapDisabled, FormImages.ImageLocomotive.Picture.Bitmap, True); 225 CopyImage(Engine.ImageCarriage.Bitmap, FormImages.ImageCarriage.Picture.Bitmap); 226 CopyImage(Engine.ImageCarriage.BitmapDisabled, FormImages.ImageCarriage.Picture.Bitmap, True); 229 227 CopyImage(Engine.ButtonBack.Bitmap, FormImages.ImageLeftArrow.Picture.Bitmap); 230 228 CopyImage(Engine.ButtonBack.BitmapDisabled, FormImages.ImageLeftArrow.Picture.Bitmap, True); … … 240 238 BitmapInvert(Engine.ImageLocomotive.Bitmap); 241 239 BitmapInvert(Engine.ImageLocomotive.BitmapDisabled); 240 BitmapInvert(Engine.ImageCarriage.Bitmap); 241 BitmapInvert(Engine.ImageCarriage.BitmapDisabled); 242 242 BitmapInvert(Engine.ButtonBack.Bitmap); 243 243 BitmapInvert(Engine.ButtonBack.BitmapDisabled); -
trunk/Languages/BigMetro.cs.po
r91 r93 1 1 msgid "" 2 2 msgstr "" 3 "Content-Type: text/plain; charset=UTF-8\n"4 3 "Project-Id-Version: \n" 5 4 "POT-Creation-Date: \n" … … 7 6 "Last-Translator: Chronos <robie@centrum.cz>\n" 8 7 "Language-Team: \n" 8 "Language: cs\n" 9 9 "MIME-Version: 1.0\n" 10 "Content-Type: text/plain; charset=UTF-8\n" 10 11 "Content-Transfer-Encoding: 8bit\n" 11 "Language: cs\n" 12 "X-Generator: Poedit 2.4.1\n" 12 "X-Generator: Poedit 3.0.1\n" 13 13 14 14 #: tformimages.caption 15 15 msgid "FormImages" 16 msgstr " "16 msgstr "FormImages" 17 17 18 18 #: tformmain.applicationinfo1.description 19 19 msgid "Enjoyable real-time metro building game." 20 msgstr " "20 msgstr "Zábavná stavitelská hra metra v reálném čase." 21 21 22 22 #: tformmain.caption … … 42 42 msgstr "%d cestujících cestovalo ve vašem metru během %d dnů." 43 43 44 #: uengine.slondon 45 msgid "London" 46 msgstr "Londýn" 47 44 48 #: uengine.snewhighscore 45 49 msgid "New high score!" 46 50 msgstr "Nové vysoké skóre!" 47 51 52 #: uengine.snewyork 53 msgid "New York" 54 msgstr "New York" 55 48 56 #: uengine.snooldstationtoconnectnew 49 57 msgid "No old line station to connect new station" 50 msgstr " "58 msgstr "Není stará stanice linky k připojení k nové stanici" 51 59 52 60 #: uengine.soldhighscore … … 55 63 msgstr "Dřívější vysoké skóre bylo %d cestujících v %d dnech." 56 64 65 #: uengine.sparis 66 msgid "Paris" 67 msgstr "Paříž" 68 69 #: uengine.sprague 70 msgid "Prague" 71 msgstr "Praha" 72 57 73 #: uengine.sstationnotdefined 58 74 msgid "Station have to be defined" 59 msgstr " "75 msgstr "Stanice musí být určena" 60 76 61 77 #: uengine.sstationwithoutmapstation 62 78 msgid "Station have to have MapStation" 63 msgstr "" 79 msgstr "Stanice musí mít MapStation" 80 81 #: uengine.stokyo 82 msgid "Tokyo" 83 msgstr "Tokyo" 64 84 65 85 #: umenu.sautomatic … … 120 140 121 141 #: utrack.salreadyconnectedtrackpoint 122 #, fuzzy123 142 msgctxt "utrack.salreadyconnectedtrackpoint" 124 143 msgid "Trying to connect already connected track point" … … 126 145 127 146 #: utrack.salreadydisconnectedtrackpoint 128 #, fuzzy129 147 msgctxt "utrack.salreadydisconnectedtrackpoint" 130 148 msgid "Trying to disconnect not connected track point" … … 135 153 msgctxt "utrack.strackpointnotfound" 136 154 msgid "Track point %d not found" 137 msgstr " "155 msgstr "Bod trasy %d nebyl nalezen" 138 156 139 157 #: uview.szerozoomnotalowed 140 #, fuzzy141 158 msgctxt "uview.szerozoomnotalowed" 142 159 msgid "Zero zoom not allowed" 143 160 msgstr "Nulové přiblížení není povoleno" 144 -
trunk/Languages/BigMetro.de.po
r91 r93 42 42 msgstr "%d Passagiere fuhren mit deiner Metro über %d Tage." 43 43 44 #: uengine.slondon 45 msgid "London" 46 msgstr "" 47 44 48 #: uengine.snewhighscore 45 49 msgid "New high score!" 46 50 msgstr "Neuer Highscore!" 51 52 #: uengine.snewyork 53 msgid "New York" 54 msgstr "" 47 55 48 56 #: uengine.snooldstationtoconnectnew … … 55 63 msgstr "Der alte Highscore war %d passager in %d Tagen." 56 64 65 #: uengine.sparis 66 msgid "Paris" 67 msgstr "" 68 69 #: uengine.sprague 70 msgid "Prague" 71 msgstr "" 72 57 73 #: uengine.sstationnotdefined 58 74 msgid "Station have to be defined" … … 61 77 #: uengine.sstationwithoutmapstation 62 78 msgid "Station have to have MapStation" 79 msgstr "" 80 81 #: uengine.stokyo 82 msgid "Tokyo" 63 83 msgstr "" 64 84 -
trunk/Languages/BigMetro.fr.po
r92 r93 42 42 msgstr "%d passagers ont pris votre métro pendant %d jours." 43 43 44 #: uengine.slondon 45 msgid "London" 46 msgstr "" 47 44 48 #: uengine.snewhighscore 45 49 msgid "New high score!" 46 50 msgstr "Nouveau highscore!" 51 52 #: uengine.snewyork 53 msgid "New York" 54 msgstr "" 47 55 48 56 #: uengine.snooldstationtoconnectnew … … 55 63 msgstr "Le vieux highscore était %d passagers pendant %d jours." 56 64 65 #: uengine.sparis 66 msgid "Paris" 67 msgstr "" 68 69 #: uengine.sprague 70 msgid "Prague" 71 msgstr "" 72 57 73 #: uengine.sstationnotdefined 58 74 msgid "Station have to be defined" … … 61 77 #: uengine.sstationwithoutmapstation 62 78 msgid "Station have to have MapStation" 79 msgstr "" 80 81 #: uengine.stokyo 82 msgid "Tokyo" 63 83 msgstr "" 64 84 -
trunk/Languages/BigMetro.pot
r91 r93 32 32 msgstr "" 33 33 34 #: uengine.slondon 35 msgid "London" 36 msgstr "" 37 34 38 #: uengine.snewhighscore 35 39 msgid "New high score!" 40 msgstr "" 41 42 #: uengine.snewyork 43 msgid "New York" 36 44 msgstr "" 37 45 … … 45 53 msgstr "" 46 54 55 #: uengine.sparis 56 msgid "Paris" 57 msgstr "" 58 59 #: uengine.sprague 60 msgid "Prague" 61 msgstr "" 62 47 63 #: uengine.sstationnotdefined 48 64 msgid "Station have to be defined" … … 51 67 #: uengine.sstationwithoutmapstation 52 68 msgid "Station have to have MapStation" 69 msgstr "" 70 71 #: uengine.stokyo 72 msgid "Tokyo" 53 73 msgstr "" 54 74 -
trunk/Packages/Common/UGeometric.pas
r86 r93 8 8 type 9 9 TPointArray = array of TPoint; 10 11 { TVector } 12 13 TVector = record 14 Position: TPoint; 15 Direction: TPoint; 16 function GetLength: Integer; 17 function GetAngle: Double; 18 end; 10 19 11 20 function Distance(P1, P2: TPoint): Integer; … … 162 171 end; 163 172 173 { TVector } 174 175 function TVector.GetLength: Integer; 176 begin 177 Result := Trunc(Sqrt(Sqr(Direction.X) + Sqr(Direction.Y))); 178 end; 179 180 function TVector.GetAngle: Double; 181 begin 182 Result := ArcTan2(Direction.Y, Direction.X); 183 end; 164 184 165 185 end. -
trunk/UEngine.pas
r91 r93 7 7 uses 8 8 {$IFDEF DARWIN}MacOSAll, CocoaAll, CocoaUtils,{$ENDIF} 9 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, 9 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, URegistry, 10 10 UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu, UControls, 11 UMetroPassenger, UColors, UView, URiver, UTrack ;11 UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric; 12 12 13 13 type 14 TStationShapeSet = set of TStationShape;15 14 TEngine = class; 16 15 TMetroLines = class; … … 18 17 TMetroTrains = class; 19 18 TLineStation = class; 19 TMetroTrain = class; 20 20 21 21 { TMapStation } … … 89 89 end; 90 90 91 TMetroTrain = class;92 93 91 { TMetroCarriage } 94 92 95 93 TMetroCarriage = class 96 94 Train: TMetroTrain; 95 Passengers: TMetroPassengers; 96 function GetTrackPosition: TTrackPosition; 97 function GetVector: TVector; 98 constructor Create; 99 destructor Destroy; override; 97 100 end; 98 101 … … 100 103 101 104 TMetroCarriages = class(TObjectList<TMetroCarriage>) 105 function GetUnused: TMetroCarriage; 106 function GetUnusedCount: Integer; 107 function AddNew: TMetroCarriage; 102 108 end; 103 109 … … 113 119 public 114 120 Passengers: TMetroPassengers; 115 BaseTrackPoint: TTrackPoint; 116 RelPos: Double; 121 TrackPosition: TTrackPosition; 117 122 Direction: Integer; 118 123 InStation: Boolean; … … 122 127 function GetPosition: TPoint; 123 128 function GetAngle: Double; 129 function GetVector: TVector; 124 130 constructor Create; 125 131 destructor Destroy; override; … … 130 136 131 137 TMetroTrains = class(TObjectList<TMetroTrain>) 132 function GetUnused Train: TMetroTrain;138 function GetUnused: TMetroTrain; 133 139 function GetUnusedCount: Integer; 134 140 function AddNew: TMetroTrain; … … 174 180 function GetTrackOnPos(Pos: TPoint): TTrackLink; 175 181 function GetTrainOnPos(Pos: TPoint): TMetroTrain; 182 function GetCarriageOnPos(Pos: TPoint): TMetroCarriage; 176 183 procedure DrawLine(Canvas: TCanvas; Pos: TPoint); 177 184 procedure DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape; … … 207 214 procedure FullScreenChanged(Sender: TObject); 208 215 procedure UpdateInterface; 216 procedure InitCities; 209 217 public 210 218 Colors: TColors; … … 213 221 Lines: TMetroLines; 214 222 Trains: TMetroTrains; 223 Carriages: TMetroCarriages; 215 224 ShapeCount: Integer; 216 225 Map: TMap; 217 226 View: TView; 227 Cities: TCities; 218 228 SelectedLine: TMetroLine; 219 229 SelectedTrain: TMetroTrain; 230 SelectedCarriage: TMetroCarriage; 220 231 TrackStationDown: TTrackPoint; 221 232 TrackStationUp: TTrackPoint; … … 228 239 ImagePause: TImage; 229 240 ImageFastForward: TImage; 241 ImageCarriage: TImage; 230 242 HighestServedPassengerCount: Integer; 231 243 HighestServedDaysCount: Integer; … … 239 251 procedure NewGame; 240 252 procedure Redraw; 253 procedure LoadFromRegistry(Context: TRegistryContext); 254 procedure SaveToRegistry(Context: TRegistryContext); 241 255 constructor Create; 242 256 destructor Destroy; override; … … 262 276 PassengerSize = 15; 263 277 TrainSize = 40; 278 TrainGap = 5; 264 279 LineColorsDist = 50; 265 280 TrainSpeed = 2000; … … 292 307 293 308 uses 294 U Geometric, UFormMain, ULanguages;309 UFormMain, ULanguages; 295 310 296 311 resourcestring … … 305 320 SStationWithoutMapStation = 'Station have to have MapStation'; 306 321 322 // Cities 323 SPrague = 'Prague'; 324 SLondon = 'London'; 325 SParis = 'Paris'; 326 SNewYork = 'New York'; 327 STokyo = 'Tokyo'; 328 329 { TMetroCarriage } 330 331 function TMetroCarriage.GetTrackPosition: TTrackPosition; 332 begin 333 if Assigned(Train) then begin 334 Result := Train.TrackPosition; 335 Result.Move(-Train.Direction * (TrainSize + TrainGap) * (Train.Carriages.IndexOf(Self) + 1)); 336 end; 337 end; 338 339 function TMetroCarriage.GetVector: TVector; 340 begin 341 Result := Train.GetVector; 342 Result.Position := AddPoint(Result.Position, Point(TrainSize, TrainSize)); 343 end; 344 345 constructor TMetroCarriage.Create; 346 begin 347 Passengers := TMetroPassengers.Create; 348 Passengers.OwnsObjects := False; 349 end; 350 351 destructor TMetroCarriage.Destroy; 352 begin 353 FreeAndNil(Passengers); 354 inherited; 355 end; 356 357 { TMetroCarriages } 358 359 function TMetroCarriages.GetUnused: TMetroCarriage; 360 var 361 I: Integer; 362 begin 363 I := 0; 364 while (I < Count) and (Assigned(Items[I].Train)) do Inc(I); 365 if I < Count then Result := Items[I] 366 else Result := nil; 367 end; 368 369 function TMetroCarriages.GetUnusedCount: Integer; 370 var 371 I: Integer; 372 begin 373 Result := 0; 374 for I := 0 to Count - 1 do 375 if not Assigned(Items[I].Train) then Inc(Result); 376 end; 377 378 function TMetroCarriages.AddNew: TMetroCarriage; 379 begin 380 Result := TMetroCarriage.Create; 381 Add(Result); 382 end; 383 307 384 { TMap } 308 385 … … 332 409 { TMetroTrains } 333 410 334 function TMetroTrains.GetUnused Train: TMetroTrain;411 function TMetroTrains.GetUnused: TMetroTrain; 335 412 var 336 413 I: Integer; … … 519 596 // Place one train if at least two stations present 520 597 if (LineStations.Count = 2) then begin 521 Train := Engine.Trains.GetUnused Train;598 Train := Engine.Trains.GetUnused; 522 599 if Assigned(Train) then begin 523 600 Train.Line := Self; 524 601 Train.TargetStation := LineStations[0]; 525 Train. BaseTrackPoint := Track.Points.First;602 Train.TrackPosition.BaseTrackPoint := Track.Points.First; 526 603 Trains.Add(Train); 527 604 end; … … 551 628 IsOnTrack := False; 552 629 for J := Track.Points.IndexOf(TP1) to Track.Points.IndexOf(TP2) do 553 if Track.Points[J] = BaseTrackPoint then begin630 if Track.Points[J] = TrackPosition.BaseTrackPoint then begin 554 631 IsOnTrack := True; 555 632 Break; 556 633 end; 557 634 if IsOnTrack then begin 558 if Assigned(BaseTrackPoint) and Assigned(BaseTrackPoint.GetUp) and (BaseTrackPoint.GetUp <> ALineStation.TrackPoint) then 559 BaseTrackPoint := BaseTrackPoint.GetUp 635 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetUp) and 636 (TrackPosition.BaseTrackPoint.GetUp <> ALineStation.TrackPoint) then 637 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetUp 560 638 else 561 if Assigned(BaseTrackPoint) and Assigned(BaseTrackPoint.GetDown) and (BaseTrackPoint.GetDown <> ALineStation.TrackPoint) then 562 BaseTrackPoint := BaseTrackPoint.GetDown 563 else BaseTrackPoint := nil; 639 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetDown) and 640 (TrackPosition.BaseTrackPoint.GetDown <> ALineStation.TrackPoint) then 641 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetDown 642 else TrackPosition.BaseTrackPoint := nil; 564 643 end; 565 644 end; … … 633 712 FLine := AValue; 634 713 if AValue = nil then begin 635 RelPos := 0;636 BaseTrackPoint := nil;714 TrackPosition.RelPos := 0; 715 TrackPosition.BaseTrackPoint := nil; 637 716 TargetStation := nil; 638 717 end; … … 646 725 begin 647 726 Result := 0; 648 if Assigned( BaseTrackPoint) and Assigned(TargetStation) then begin649 Current := Line.Track.Points.IndexOf( BaseTrackPoint);727 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TargetStation) then begin 728 Current := Line.Track.Points.IndexOf(TrackPosition.BaseTrackPoint); 650 729 Target := Line.Track.Points.IndexOf(TargetStation.TrackPoint); 651 730 if Current < Target then begin 652 731 for I := Current to Target - 1 do 653 732 Result := Result + Line.Track.Points[I].GetDistance; 654 Result := Result - Trunc( RelPos);733 Result := Result - Trunc(TrackPosition.RelPos); 655 734 end else 656 735 if Current > Target then begin 657 736 for I := Current - 1 downto Target do 658 737 Result := Result + Line.Track.Points[I].GetDistance; 659 Result := Result + Trunc( RelPos);660 end else Result := Trunc( RelPos);738 Result := Result + Trunc(TrackPosition.RelPos); 739 end else Result := Trunc(TrackPosition.RelPos); 661 740 end; 662 741 end; … … 669 748 begin 670 749 Result := Point(0, 0); 671 if Assigned( BaseTrackPoint) then672 with BaseTrackPoint do begin673 UpPoint := BaseTrackPoint.GetNeighUp;750 if Assigned(TrackPosition.BaseTrackPoint) then 751 with TrackPosition.BaseTrackPoint do begin 752 UpPoint := TrackPosition.BaseTrackPoint.GetNeighUp; 674 753 if Assigned(UpPoint) then begin 675 754 D := Distance(UpPoint.Position, Position); 676 755 if D > 0 then begin 677 756 Delta := SubPoint(UpPoint.Position, Position); 678 Result := Point(Trunc(Position.X + Delta.X * RelPos / D),679 Trunc(Position.Y + Delta.Y * RelPos / D));757 Result := Point(Trunc(Position.X + Delta.X * TrackPosition.RelPos / D), 758 Trunc(Position.Y + Delta.Y * TrackPosition.RelPos / D)); 680 759 end; 681 760 end; … … 688 767 begin 689 768 Result := 0; 690 if Assigned( BaseTrackPoint) then691 with BaseTrackPoint do begin692 UpPoint := BaseTrackPoint.GetNeighUp;769 if Assigned(TrackPosition.BaseTrackPoint) then 770 with TrackPosition.BaseTrackPoint do begin 771 UpPoint := TrackPosition.BaseTrackPoint.GetNeighUp; 693 772 if Assigned(UpPoint) then begin 694 773 Result := ArcTan2(UpPoint.Position.Y - Position.Y, … … 698 777 end; 699 778 779 function TMetroTrain.GetVector: TVector; 780 var 781 D: Integer; 782 UpPoint: TTrackPoint; 783 begin 784 Result.Position := Point(0, 0); 785 if Assigned(TrackPosition.BaseTrackPoint) then 786 with TrackPosition.BaseTrackPoint do begin 787 UpPoint := TrackPosition.BaseTrackPoint.GetNeighUp; 788 if Assigned(UpPoint) then begin 789 D := Distance(UpPoint.Position, Position); 790 if D > 0 then begin 791 Result.Direction := SubPoint(UpPoint.Position, Position); 792 Result.Position := Point(Trunc(Position.X + Result.Direction.X * TrackPosition.RelPos / D), 793 Trunc(Position.Y + Result.Direction.Y * TrackPosition.RelPos / D)); 794 end; 795 end; 796 end; 797 end; 798 700 799 constructor TMetroTrain.Create; 701 800 begin … … 703 802 Passengers.OwnsObjects := False; 704 803 Carriages := TMetroCarriages.Create; 804 Carriages.OwnsObjects := False; 705 805 Direction := 1; 706 806 Line := nil; … … 976 1076 Result := Trains[I]; 977 1077 MinDistance := D; 1078 end; 1079 end; 1080 end; 1081 1082 function TEngine.GetCarriageOnPos(Pos: TPoint): TMetroCarriage; 1083 var 1084 I: Integer; 1085 J: Integer; 1086 MinDistance: Integer; 1087 D: Integer; 1088 begin 1089 Result := nil; 1090 MinDistance := High(Integer); 1091 for I := 0 to Trains.Count - 1 do 1092 with TMetroTrain(Trains[I]) do begin 1093 for J := 0 to Carriages.Count - 1 do 1094 with TMetroCarriage(Carriages[J]) do begin 1095 D := Distance(GetTrackPosition.GetVector.Position, Pos); 1096 if (D < (TrainSize div 2)) and (D < MinDistance) then begin 1097 Result := Carriages[J]; 1098 MinDistance := D; 1099 end; 978 1100 end; 979 1101 end; … … 1216 1338 var 1217 1339 I: Integer; 1340 J: Integer; 1218 1341 CurrentStation: TLineStation; 1219 1342 P: Integer; … … 1223 1346 PosChange: Double; 1224 1347 TP: TTrackPoint; 1348 Done: Boolean; 1225 1349 begin 1226 1350 // Move trains 1227 1351 for I := 0 to Trains.Count - 1 do 1228 1352 with TMetroTrain(Trains[I]) do begin 1229 if not Assigned(TargetStation) and Assigned( BaseTrackPoint) then begin1353 if not Assigned(TargetStation) and Assigned(TrackPosition.BaseTrackPoint) then begin 1230 1354 if (Direction <> 1) and (Direction <> -1) then Direction := 1 1231 1355 else Direction := -Direction; 1232 TP := BaseTrackPoint.GetUp;1356 TP := TrackPosition.BaseTrackPoint.GetUp; 1233 1357 if Assigned(TP) then TargetStation := TLineStation(TP.OwnerPoint) 1234 1358 else begin 1235 TP := BaseTrackPoint.GetDown;1359 TP := TrackPosition.BaseTrackPoint.GetDown; 1236 1360 if Assigned(TP) then TargetStation := TLineStation(TP.OwnerPoint); 1237 1361 end; … … 1247 1371 if Line.IsCircular then begin 1248 1372 TargetStationIndex := Line.LineStations.Count - 2; 1249 BaseTrackPoint := Line.LineStations.Last.TrackPoint;1250 RelPos := 0;1373 TrackPosition.BaseTrackPoint := Line.LineStations.Last.TrackPoint; 1374 TrackPosition.RelPos := 0; 1251 1375 end else begin 1252 1376 TargetStationIndex := 1; … … 1257 1381 if Line.IsCircular then begin 1258 1382 TargetStationIndex := 1; 1259 BaseTrackPoint := Line.LineStations.First.TrackPoint;1260 RelPos := 0;1383 TrackPosition.BaseTrackPoint := Line.LineStations.First.TrackPoint; 1384 TrackPosition.RelPos := 0; 1261 1385 end else begin 1262 1386 TargetStationIndex := Line.LineStations.Count - 2; … … 1267 1391 1268 1392 // Unload passengers in target station 1269 if Assigned(CurrentStation) then 1270 for P := Passengers.Count - 1 downto 0 do begin 1271 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin 1272 Passenger := Passengers[P]; 1273 Passengers.Delete(P); 1274 Self.Passengers.Remove(Passenger); 1275 Inc(ServedPassengerCount); 1393 if Assigned(CurrentStation) then begin 1394 for P := Passengers.Count - 1 downto 0 do begin 1395 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin 1396 Passenger := Passengers[P]; 1397 Passengers.Delete(P); 1398 Self.Passengers.Remove(Passenger); 1399 Inc(ServedPassengerCount); 1400 end; 1401 end; 1402 for J := 0 to Carriages.Count - 1 do 1403 with Carriages[J] do begin 1404 for P := Passengers.Count - 1 downto 0 do begin 1405 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin 1406 Passenger := Passengers[P]; 1407 Passengers.Delete(P); 1408 Self.Passengers.Remove(Passenger); 1409 Inc(ServedPassengerCount); 1410 end; 1411 end; 1276 1412 end; 1277 1413 end; 1414 1278 1415 // Unload passengers to change line 1279 if Assigned(CurrentStation) then 1280 for P := Passengers.Count - 1 downto 0 do begin 1281 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape, 1282 TargetStation, CurrentStation) then begin 1283 Passenger := Passengers[P]; 1284 Passengers.Delete(P); 1285 CurrentStation.MapStation.Passengers.Add(Passenger); 1416 if Assigned(CurrentStation) then begin 1417 for P := Passengers.Count - 1 downto 0 do begin 1418 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape, 1419 TargetStation, CurrentStation) then begin 1420 Passenger := Passengers[P]; 1421 Passengers.Delete(P); 1422 CurrentStation.MapStation.Passengers.Add(Passenger); 1423 end; 1424 end; 1425 for J := 0 to Carriages.Count - 1 do 1426 with Carriages[J] do begin 1427 for P := Passengers.Count - 1 downto 0 do begin 1428 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape, 1429 TargetStation, CurrentStation) then begin 1430 Passenger := Passengers[P]; 1431 Passengers.Delete(P); 1432 CurrentStation.MapStation.Passengers.Add(Passenger); 1433 end; 1434 end; 1286 1435 end; 1287 1436 end; … … 1299 1448 Passengers.Add(Passenger); 1300 1449 end; 1301 end else Break; // No more space 1450 end else begin 1451 Done := False; 1452 for J := 0 to Carriages.Count - 1 do 1453 with Carriages[J] do begin 1454 if (Passengers.Count < TrainPassengerCount) then begin 1455 Passenger := CurrentStation.MapStation.Passengers[P]; 1456 if CurrentStation.MapStation.IsBestStationForShape(Passenger.Shape, 1457 TargetStation, CurrentStation) then begin 1458 CurrentStation.MapStation.Passengers.Delete(P); 1459 Passengers.Add(Passenger); 1460 Done := True; 1461 Break; 1462 end; 1463 end; 1464 end; 1465 if not Done then Break; 1466 end; 1302 1467 end; 1303 1468 … … 1308 1473 end else begin 1309 1474 PosChange := Direction + Trunc(Direction * TrainSpeed * (Time - LastTrainMoveTime)); 1310 RelPos :=RelPos + PosChange;1475 TrackPosition.RelPos := TrackPosition.RelPos + PosChange; 1311 1476 LastTrainMoveTime := Time; 1312 1477 Redraw; 1313 if Assigned( BaseTrackPoint) then1314 while (Direction = -1) and ( RelPos < 0) do begin1315 if BaseTrackPoint <> Line.LineStations.First.TrackPoint then begin1316 BaseTrackPoint :=BaseTrackPoint.GetNeighDown;1317 if Assigned( BaseTrackPoint) then1318 RelPos := RelPos +BaseTrackPoint.GetDistance1478 if Assigned(TrackPosition.BaseTrackPoint) then 1479 while (Direction = -1) and (TrackPosition.RelPos < 0) do begin 1480 if TrackPosition.BaseTrackPoint <> Line.LineStations.First.TrackPoint then begin 1481 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetNeighDown; 1482 if Assigned(TrackPosition.BaseTrackPoint) then 1483 TrackPosition.RelPos := TrackPosition.RelPos + TrackPosition.BaseTrackPoint.GetDistance 1319 1484 else begin 1320 BaseTrackPoint := Line.LineStations.First.TrackPoint;1321 RelPos := 0;1485 TrackPosition.BaseTrackPoint := Line.LineStations.First.TrackPoint; 1486 TrackPosition.RelPos := 0; 1322 1487 end; 1323 1488 end else 1324 1489 if Line.IsCircular then begin 1325 BaseTrackPoint := Line.LineStations.Last.TrackPoint;1326 RelPos := RelPos +BaseTrackPoint.GetDistance;1490 TrackPosition.BaseTrackPoint := Line.LineStations.Last.TrackPoint; 1491 TrackPosition.RelPos := TrackPosition.RelPos + TrackPosition.BaseTrackPoint.GetDistance; 1327 1492 end else begin 1328 RelPos := 0;1493 TrackPosition.RelPos := 0; 1329 1494 Break; 1330 1495 end; 1331 1496 end; 1332 if Assigned( BaseTrackPoint) then1333 while (Direction = 1) and ( RelPos >BaseTrackPoint.GetDistance) do begin1334 if BaseTrackPoint <> Line.LineStations.Last.TrackPoint then begin1335 RelPos := RelPos -BaseTrackPoint.GetDistance;1336 BaseTrackPoint :=BaseTrackPoint.GetNeighUp;1337 if not Assigned( BaseTrackPoint) then begin1338 BaseTrackPoint := Line.LineStations.Last.TrackPoint;1339 RelPos := 0;1497 if Assigned(TrackPosition.BaseTrackPoint) then 1498 while (Direction = 1) and (TrackPosition.RelPos > TrackPosition.BaseTrackPoint.GetDistance) do begin 1499 if TrackPosition.BaseTrackPoint <> Line.LineStations.Last.TrackPoint then begin 1500 TrackPosition.RelPos := TrackPosition.RelPos - TrackPosition.BaseTrackPoint.GetDistance; 1501 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetNeighUp; 1502 if not Assigned(TrackPosition.BaseTrackPoint) then begin 1503 TrackPosition.BaseTrackPoint := Line.LineStations.Last.TrackPoint; 1504 TrackPosition.RelPos := 0; 1340 1505 end; 1341 1506 end else 1342 1507 if Line.IsCircular then begin 1343 RelPos := RelPos -BaseTrackPoint.GetDistance;1344 BaseTrackPoint := Line.LineStations.First.TrackPoint;1508 TrackPosition.RelPos := TrackPosition.RelPos - TrackPosition.BaseTrackPoint.GetDistance; 1509 TrackPosition.BaseTrackPoint := Line.LineStations.First.TrackPoint; 1345 1510 end else begin 1346 RelPos :=BaseTrackPoint.GetDistance;1511 TrackPosition.RelPos := TrackPosition.BaseTrackPoint.GetDistance; 1347 1512 Break; 1348 1513 end; … … 1351 1516 if PosDelta >= LastPosDelta then begin 1352 1517 // We are getting far from station, stop at station 1353 BaseTrackPoint := TargetStation.TrackPoint;1354 RelPos := 0;1518 TrackPosition.BaseTrackPoint := TargetStation.TrackPoint; 1519 TrackPosition.RelPos := 0; 1355 1520 InStation := True; 1356 1521 StationStopTime := Time; … … 1549 1714 end; 1550 1715 1716 procedure TEngine.InitCities; 1717 begin 1718 with Cities do begin 1719 AddNew(SLondon); 1720 AddNew(SNewYork); 1721 AddNew(SPrague); 1722 AddNew(SParis); 1723 AddNew(STokyo); 1724 end; 1725 end; 1726 1551 1727 procedure TEngine.InitMenus; 1552 1728 begin … … 1704 1880 procedure TEngine.DrawTrains(Canvas: TCanvas); 1705 1881 var 1882 I: Integer; 1706 1883 P: Integer; 1707 1884 Pos: TPoint; … … 1711 1888 Train: TMetroTrain; 1712 1889 Passenger: TMetroPassenger; 1890 Carriage: TMetroCarriage; 1891 Vector: TVector; 1713 1892 begin 1714 1893 for Train in Trains do … … 1718 1897 Canvas.Brush.Style := bsSolid; 1719 1898 Canvas.Pen.Style := psClear; 1720 Pos := GetPosition; 1721 Angle := GetAngle; 1899 Vector := GetVector; 1900 Pos := Vector.Position; 1901 Angle := Vector.GetAngle; 1722 1902 1723 1903 SetLength(Points, 4); … … 1736 1916 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2); 1737 1917 Inc(P); 1918 end; 1919 1920 // Draw carriages 1921 for Carriage in Train.Carriages do 1922 with Carriage do begin 1923 Canvas.Brush.Color := Line.Color; 1924 Canvas.Brush.Style := bsSolid; 1925 Canvas.Pen.Style := psClear; 1926 Vector := GetTrackPosition.GetVector; 1927 Pos := Vector.Position; 1928 Angle := Vector.GetAngle; 1929 1930 SetLength(Points, 4); 1931 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle); 1932 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle); 1933 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle); 1934 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle); 1935 Canvas.Polygon(Points); 1936 Canvas.Brush.Color := clWhite; 1937 P := 0; 1938 for Passenger in Passengers do 1939 with Passenger do begin 1940 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3, 1941 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3); 1942 ShapePos := RotatePoint(Pos, ShapePos, Angle); 1943 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2); 1944 Inc(P); 1945 end; 1738 1946 end; 1739 1947 end; … … 1977 2185 CanvasSize.Y - LineColorsDist - Canvas.TextHeight(Text) div 2, Text); 1978 2186 2187 // Draw unused carriages 2188 Text := IntToStr(Carriages.GetUnusedCount); 2189 Canvas.Draw(CanvasSize.X div 2 - Length(LineColors) div 2 * LineColorsDist - 200, 2190 CanvasSize.Y - LineColorsDist - ImageCarriage.Bitmap.Height div 2, ImageCarriage.Bitmap); 2191 Canvas.Brush.Style := bsClear; 2192 Canvas.Font.Size := 14; 2193 Canvas.Font.Color := Colors.Text; 2194 Canvas.TextOut(CanvasSize.X div 2 - Length(LineColors) div 2 * LineColorsDist - 150 - Canvas.TextWidth(Text), 2195 CanvasSize.Y - LineColorsDist - Canvas.TextHeight(Text) div 2, Text); 2196 1979 2197 // Status interface 1980 2198 Text := IntToStr(ServedPassengerCount); … … 2011 2229 ]); 2012 2230 end; 2231 2232 // Show carriage grabbed by mouse 2233 if Assigned(SelectedCarriage) then begin 2234 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color; 2235 Canvas.Brush.Style := bsSolid; 2236 Canvas.Pen.Style := psClear; 2237 Pos := LastMousePos; 2238 Angle := 0; 2239 2240 Canvas.Polygon([ 2241 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle), 2242 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle), 2243 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle), 2244 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle) 2245 ]); 2246 end; 2013 2247 end; 2014 2248 … … 2026 2260 LastNewWeekTime := Time; 2027 2261 Trains.AddNew; 2262 if Random < 0.2 then Carriages.AddNew; 2028 2263 // TODO: Show notification screen with confirmation 2029 2264 Redraw; … … 2160 2395 I: Integer; 2161 2396 FocusedTrack: TTrackLink; 2397 FocusedTrain: TMetroTrain; 2162 2398 begin 2163 2399 if Button = mbLeft then begin … … 2193 2429 if Assigned(SelectedTrain) then begin 2194 2430 SelectedTrain.TargetStation := nil; 2195 SelectedTrain. BaseTrackPoint := nil;2431 SelectedTrain.TrackPosition.BaseTrackPoint := nil; 2196 2432 if Assigned(SelectedTrain.Line) then begin 2197 2433 SelectedTrain.Line.Trains.Remove(SelectedTrain); 2198 2434 SelectedTrain.Line := nil; 2435 2436 // Remove train carriages 2437 for I := SelectedTrain.Carriages.Count - 1 downto 0 do begin 2438 SelectedTrain.Carriages[I].Train := nil; 2439 SelectedTrain.Carriages.Delete(I); 2440 end; 2199 2441 end; 2200 2442 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position)); … … 2202 2444 SelectedTrain.Line := TMetroLine(FocusedTrack.Points[0].Track.Owner); 2203 2445 SelectedTrain.Line.Trains.Add(SelectedTrain); 2204 SelectedTrain. BaseTrackPoint := FocusedTrack.Points[0];2446 SelectedTrain.TrackPosition.BaseTrackPoint := FocusedTrack.Points[0]; 2205 2447 end else 2206 2448 if Assigned(FocusedTrack.Points[1]) then begin 2207 2449 SelectedTrain.Line := TMetroLine(FocusedTrack.Points[1].Track.Owner); 2208 2450 SelectedTrain.Line.Trains.Add(SelectedTrain); 2209 SelectedTrain. BaseTrackPoint := FocusedTrack.Points[1];2451 SelectedTrain.TrackPosition.BaseTrackPoint := FocusedTrack.Points[1]; 2210 2452 end; 2211 2453 FocusedTrack.Free; 2454 end; 2455 2456 // Place selected carriage if focused train 2457 if Assigned(SelectedCarriage) then begin 2458 if Assigned(SelectedCarriage.Train) then begin 2459 SelectedCarriage.Train.Carriages.Remove(SelectedCarriage); 2460 SelectedCarriage.Train := nil; 2461 end; 2462 FocusedTrain := GetTrainOnPos(View.PointDestToSrc(Position)); 2463 if Assigned(FocusedTrain) then begin 2464 SelectedCarriage.Train := FocusedTrain; 2465 FocusedTrain.Carriages.Add(SelectedCarriage); 2466 end; 2212 2467 end; 2213 2468 … … 2238 2493 TrackStationUp := nil; 2239 2494 SelectedTrain := nil; 2495 SelectedCarriage := nil; 2240 2496 Redraw; 2241 2497 end; … … 2258 2514 end; 2259 2515 2516 // Carriage selection 2517 SelectedCarriage := GetCarriageOnPos(View.PointDestToSrc(Position)); 2518 if Assigned(SelectedCarriage) then begin 2519 Exit; 2520 end; 2521 2260 2522 // Select unused train 2261 2523 if (Distance(Position, Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist - 100, 2262 2524 View.DestRect.Bottom - LineColorsDist)) < 30) and 2263 2525 (Trains.GetUnusedCount > 0) then begin 2264 SelectedTrain := Trains.GetUnusedTrain; 2526 SelectedTrain := Trains.GetUnused; 2527 Exit; 2528 end; 2529 2530 // Select unused carriage 2531 if (Distance(Position, Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist - 200, 2532 View.DestRect.Bottom - LineColorsDist)) < 30) and 2533 (Carriages.GetUnusedCount > 0) then begin 2534 SelectedCarriage := Carriages.GetUnused; 2265 2535 Exit; 2266 2536 end; … … 2312 2582 KeyEsc = 27; 2313 2583 KeyF2 = 113; 2584 KeyF3 = 114; 2585 KeyF4 = 115; 2314 2586 begin 2315 2587 if Key = KeyEsc then begin … … 2325 2597 if State = gsRunning then begin 2326 2598 State := gsGameOver; 2599 Redraw; 2600 end; 2601 end else 2602 if Key = KeyF3 then begin 2603 if State = gsRunning then begin 2604 Trains.AddNew; 2605 Redraw; 2606 end; 2607 end else 2608 if Key = KeyF4 then begin 2609 if State = gsRunning then begin 2610 Carriages.AddNew; 2327 2611 Redraw; 2328 2612 end; … … 2388 2672 begin 2389 2673 RedrawPending := True; 2674 end; 2675 2676 procedure TEngine.LoadFromRegistry(Context: TRegistryContext); 2677 begin 2678 with TRegistryEx.Create do 2679 try 2680 CurrentContext := Context; 2681 DarkMode := ReadBoolWithDefault('DarkMode', False); 2682 HighestServedPassengerCount := ReadIntegerWithDefault('HighestPassengers', 0); 2683 HighestServedDaysCount := ReadIntegerWithDefault('HighestDays', 0); 2684 finally 2685 Free; 2686 end; 2687 end; 2688 2689 procedure TEngine.SaveToRegistry(Context: TRegistryContext); 2690 begin 2691 with TRegistryEx.Create do 2692 try 2693 CurrentContext := Context; 2694 2695 WriteBool('DarkMode', DarkMode); 2696 WriteInteger('HighestPassengers', HighestServedPassengerCount); 2697 WriteInteger('HighestDays', HighestServedDaysCount); 2698 finally 2699 Free; 2700 end; 2390 2701 end; 2391 2702 … … 2409 2720 View := TView.Create; 2410 2721 Trains := TMetroTrains.Create; 2722 Carriages := TMetroCarriages.Create; 2411 2723 ImagePassenger := TImage.Create; 2412 2724 ImageLocomotive := TImage.Create; 2725 ImageCarriage := TImage.Create; 2413 2726 ImagePlay := TImage.Create; 2414 2727 ImagePlay.OnClick := ButtonPlay; … … 2422 2735 // ImageLocomotive.Picture.LoadFromFile(ImageLocomotiveName); 2423 2736 MetaCanvas := TMetaCanvas.Create; 2737 Cities := TCities.Create; 2738 InitCities; 2424 2739 Colors.Init(FDarkMode); 2425 2740 end; … … 2427 2742 destructor TEngine.Destroy; 2428 2743 begin 2744 FreeAndNil(Cities); 2429 2745 FreeAndNil(MetaCanvas); 2430 2746 FreeAndNil(Trains); 2747 FreeAndNil(Carriages); 2431 2748 FreeAndNil(ImagePlay); 2432 2749 FreeAndNil(ImageFastForward); 2433 2750 FreeAndNil(ImagePause); 2751 FreeAndNil(ImageCarriage); 2434 2752 FreeAndNil(ImageLocomotive); 2435 2753 FreeAndNil(ImagePassenger); -
trunk/UMetroPassenger.pas
r89 r93 9 9 TStationShape = (ssCircle, ssSquare, ssTriangle, ssStar, ssPlus, ssPentagon, 10 10 ssDiamond, ssQuarterCircle, ssHexagon, ssCross, ssHalfCircle, ssHeptagon); 11 TStationShapeSet = set of TStationShape; 11 12 12 13 { TMetroPassenger } -
trunk/UTrack.pas
r91 r93 4 4 5 5 uses 6 Classes, SysUtils, Math, Generics.Collections ;6 Classes, SysUtils, Math, Generics.Collections, UGeometric; 7 7 8 8 type 9 9 TTrack = class; 10 TTrackPoint = class; 10 11 TTrackPoints = class; 11 12 TTrackLink = class; 12 13 TTrackLinks = class; 14 15 { TTrackPosition } 16 17 TTrackPosition = record 18 BaseTrackPoint: TTrackPoint; 19 RelPos: Double; 20 function GetVector: TVector; 21 procedure Move(Distance: Double); 22 end; 13 23 14 24 { TTrackPoint } … … 93 103 implementation 94 104 95 uses96 UGeometric;97 98 105 resourcestring 99 106 SAlreadyConnectedTrackPoint = 'Trying to connect already connected track point'; 100 107 SAlreadyDisconnectedTrackPoint = 'Trying to disconnect not connected track point'; 101 108 STrackPointNotFound = 'Track point %d not found'; 109 110 { TTrackPosition } 111 112 function TTrackPosition.GetVector: TVector; 113 var 114 D: Integer; 115 UpPoint: TTrackPoint; 116 begin 117 Result.Position := Point(0, 0); 118 if Assigned(BaseTrackPoint) then 119 with BaseTrackPoint do begin 120 UpPoint := BaseTrackPoint.GetNeighUp; 121 if Assigned(UpPoint) then begin 122 D := Distance(UpPoint.Position, Position); 123 if D > 0 then begin 124 Result.Direction := SubPoint(UpPoint.Position, Position); 125 Result.Position := Point(Trunc(Position.X + Result.Direction.X * RelPos / D), 126 Trunc(Position.Y + Result.Direction.Y * RelPos / D)); 127 end; 128 end; 129 end; 130 end; 131 132 procedure TTrackPosition.Move(Distance: Double); 133 var 134 Direction: Integer; 135 begin 136 Direction := Sign(Distance); 137 Distance := Abs(Distance); 138 while Distance > 0 do begin 139 if Direction > 0 then begin 140 if RelPos + Distance < BaseTrackPoint.GetDistance then begin 141 RelPos := RelPos + Distance; 142 Distance := 0; 143 end else begin 144 if Assigned(BaseTrackPoint.GetNeighUp) then begin 145 Distance := Distance - (BaseTrackPoint.GetDistance - RelPos); 146 BaseTrackPoint := BaseTrackPoint.GetNeighUp; 147 RelPos := 0; 148 end else 149 // Reverse direction at the end of track 150 Direction := -Direction; 151 end; 152 end else 153 if Direction < 0 then begin 154 if RelPos - Distance >= 0 then begin 155 RelPos := RelPos - Distance; 156 Distance := 0; 157 end else begin 158 if Assigned(BaseTrackPoint.GetNeighDown) then begin 159 Distance := Distance - RelPos; 160 BaseTrackPoint := BaseTrackPoint.GetNeighDown; 161 RelPos := BaseTrackPoint.GetDistance; 162 end else 163 // Reverse direction at the end of track 164 Direction := -Direction; 165 end; 166 end; 167 end; 168 end; 102 169 103 170 { TTrackLinks } … … 349 416 begin 350 417 Index := Track.Points.IndexOf(Self); 351 Result := Distance(Track.Points[Index + 1].Position, Track.Points[Index].Position); 418 if Index + 1 < Track.Points.Count then begin 419 Result := Distance(Track.Points[Index + 1].Position, Track.Points[Index].Position); 420 end else Result := 0; 352 421 end; 353 422
Note:
See TracChangeset
for help on using the changeset viewer.