- Timestamp:
- Apr 18, 2015, 11:28:16 AM (10 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/BigMetro.lpi
r25 r29 69 69 </Item1> 70 70 </RequiredPackages> 71 <Units Count=" 5">71 <Units Count="6"> 72 72 <Unit0> 73 73 <Filename Value="BigMetro.lpr"/> … … 97 97 <UnitName Value="UTrack"/> 98 98 </Unit4> 99 <Unit5> 100 <Filename Value="UMetaCanvas.pas"/> 101 <IsPartOfProject Value="True"/> 102 <UnitName Value="UMetaCanvas"/> 103 </Unit5> 99 104 </Units> 100 105 </ProjectOptions> -
trunk/BigMetro.lpr
r25 r29 8 8 {$ENDIF}{$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, SysUtils, UFormMain, UEngine, UGeometric, UTrack 10 Forms, SysUtils, UFormMain, UEngine, UGeometric, UTrack, UMetaCanvas 11 11 { you can add units after this }; 12 12 -
trunk/UEngine.pas
r28 r29 43 43 TMapStations = class(TObjectList) 44 44 Engine: TEngine; 45 function GetRect: TRect; 45 46 function AddNew: TMapStation; 46 47 end; … … 186 187 end; 187 188 189 { TRiver } 190 191 TRiver = class 192 Points: array of TPoint; 193 procedure Paint(Canvas: TCanvas); 194 end; 195 196 TRivers = class(TObjectList) 197 end; 198 188 199 TMap = class 189 200 Size: TPoint; 201 Rivers: TRivers; 202 constructor Create; 203 destructor Destroy; override; 190 204 end; 191 205 … … 267 281 clOrange = TColor($0080ff); 268 282 clBrown = TColor($003090); 269 LineColors: array[0..7] of TColor = (clBlue, clRed, clDarkYellow, clGreen, 270 clPurple, clGray, clOrange, clBrown); 283 clCyan = TColor($FFFF00); 284 LineColors: array[0..8] of TColor = (clBlue, clRed, clDarkYellow, clGreen, 285 clPurple, clGray, clOrange, clBrown, clCyan); 271 286 StationSize = 30; 272 287 StationOverloadSize = 60; … … 303 318 SZeroZoomNotAlowed = 'Zero zoom not allowed'; 304 319 320 { TRiver } 321 322 procedure TRiver.Paint(Canvas: TCanvas); 323 begin 324 Canvas.Brush.Color := $ffffe0; 325 Canvas.Brush.Style := bsSolid; 326 Canvas.Polygon(Points); 327 end; 328 329 { TMap } 330 331 constructor TMap.Create; 332 begin 333 Rivers := TRivers.Create; 334 end; 335 336 destructor TMap.Destroy; 337 begin 338 Rivers.Free; 339 inherited Destroy; 340 end; 341 305 342 { TView } 306 343 … … 486 523 487 524 { TMapStations } 525 526 function TMapStations.GetRect: TRect; 527 var 528 I: Integer; 529 begin 530 if Count > 0 then begin 531 with TMapStation(Items[0]) do 532 Result := Rect(Position.X, Position.Y, Position.X, Position.Y); 533 for I := 1 to Count - 1 do 534 with TMapStation(Items[I]) do begin 535 if Position.X < Result.Left then Result.Left := Position.X; 536 if Position.X > Result.Right then Result.Right := Position.X; 537 if Position.Y < Result.Top then Result.Top := Position.Y; 538 if Position.Y > Result.Bottom then Result.Bottom := Position.Y; 539 end; 540 end else Result := Rect(0, 0, 0, 0); 541 end; 488 542 489 543 function TMapStations.AddNew: TMapStation; … … 1564 1618 LastNewStationTime := Time; 1565 1619 Stations.AddNew; 1620 // Need to see all stations on screen 1621 View.SourceRect := RectEnlarge(Stations.GetRect, 70); 1566 1622 end; 1567 1623 … … 1579 1635 while (Passenger.Shape = Passenger.Station.Shape) or not (Passenger.Shape in GetExistStationShapes) do 1580 1636 Passenger.Shape := TStationShape((Integer(Passenger.Shape) + 1) mod Integer(ShapeCount)); 1581 1582 1637 end; 1583 1638 end; … … 1684 1739 SelectedTrain.BaseTrackPoint := FocusedTrack.PointUp; 1685 1740 end; 1741 FocusedTrack.Free; 1686 1742 end; 1687 1743 … … 1761 1817 Exit; 1762 1818 end; 1819 if Assigned(Track) then Track.Free; 1763 1820 1764 1821 // New track creation from selected station as start … … 1792 1849 1793 1850 // Start with 3 stations with each different shape 1794 InitialStationCount := 3 0;1851 InitialStationCount := 3; 1795 1852 for I := 0 to InitialStationCount - 1 do begin 1796 1853 NewStation := Stations.AddNew; … … 1800 1857 end; 1801 1858 1802 for I := 0 to 7do begin1859 for I := 0 to 8 do begin 1803 1860 Lines.AddNew; 1804 1861 NewTrain := TMetroTrain.Create; -
trunk/UGeometric.pas
r28 r29 23 23 function ArcTanPoint(Point: TPoint): Float; 24 24 function RectEquals(A, B: TRect): Boolean; 25 function RectEnlarge(Rect: TRect; Value: Integer): TRect; 25 26 26 27 implementation … … 132 133 end; 133 134 135 function RectEnlarge(Rect: TRect; Value: Integer): TRect; 136 begin 137 Rect.Left := Rect.Left - Value; 138 Rect.Right := Rect.Right + Value; 139 Rect.Top := Rect.Top - Value; 140 Rect.Bottom := Rect.Bottom + Value; 141 end; 142 134 143 135 144 end.
Note:
See TracChangeset
for help on using the changeset viewer.