Changeset 140


Ignore:
Timestamp:
May 17, 2023, 12:18:41 AM (20 months ago)
Author:
chronos
Message:
  • Modified: Draw curved metro lines.
Location:
trunk
Files:
7 edited

Legend:

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

    r137 r140  
    334334msgstr "Špatný formát souboru"
    335335
     336#: uformmain.sfridayshort
     337#, fuzzy
     338msgctxt "uformmain.sfridayshort"
     339msgid "FRI"
     340msgstr "Pá"
     341
     342#: uformmain.smondayshort
     343#, fuzzy
     344msgctxt "uformmain.smondayshort"
     345msgid "MON"
     346msgstr "Po"
     347
     348#: uformmain.ssaturdayshort
     349#, fuzzy
     350msgctxt "uformmain.ssaturdayshort"
     351msgid "SAT"
     352msgstr "So"
     353
     354#: uformmain.ssundayshort
     355#, fuzzy
     356msgctxt "uformmain.ssundayshort"
     357msgid "SUN"
     358msgstr "Ne"
     359
     360#: uformmain.sthrusdayshort
     361#, fuzzy
     362msgctxt "uformmain.sthrusdayshort"
     363msgid "THU"
     364msgstr "Čt"
     365
     366#: uformmain.stuesdayshort
     367#, fuzzy
     368msgctxt "uformmain.stuesdayshort"
     369msgid "TUE"
     370msgstr "Út"
     371
     372#: uformmain.swednesdayshort
     373#, fuzzy
     374msgctxt "uformmain.swednesdayshort"
     375msgid "WED"
     376msgstr "St"
     377
    336378#: uitems.sreferencenotfound
    337379#, object-pascal-format
  • trunk/Languages/TransLines.de.po

    r137 r140  
    338338msgstr ""
    339339
     340#: uformmain.sfridayshort
     341msgctxt "uformmain.sfridayshort"
     342msgid "FRI"
     343msgstr ""
     344
     345#: uformmain.smondayshort
     346msgctxt "uformmain.smondayshort"
     347msgid "MON"
     348msgstr ""
     349
     350#: uformmain.ssaturdayshort
     351msgctxt "uformmain.ssaturdayshort"
     352msgid "SAT"
     353msgstr ""
     354
     355#: uformmain.ssundayshort
     356msgctxt "uformmain.ssundayshort"
     357msgid "SUN"
     358msgstr ""
     359
     360#: uformmain.sthrusdayshort
     361msgctxt "uformmain.sthrusdayshort"
     362msgid "THU"
     363msgstr ""
     364
     365#: uformmain.stuesdayshort
     366msgctxt "uformmain.stuesdayshort"
     367msgid "TUE"
     368msgstr ""
     369
     370#: uformmain.swednesdayshort
     371msgctxt "uformmain.swednesdayshort"
     372msgid "WED"
     373msgstr ""
     374
    340375#: uitems.sreferencenotfound
    341376#, object-pascal-format
  • trunk/Languages/TransLines.fr.po

    r137 r140  
    346346msgstr "Mauvais format de fichier"
    347347
     348#: uformmain.sfridayshort
     349msgctxt "uformmain.sfridayshort"
     350msgid "FRI"
     351msgstr ""
     352
     353#: uformmain.smondayshort
     354msgctxt "uformmain.smondayshort"
     355msgid "MON"
     356msgstr ""
     357
     358#: uformmain.ssaturdayshort
     359msgctxt "uformmain.ssaturdayshort"
     360msgid "SAT"
     361msgstr ""
     362
     363#: uformmain.ssundayshort
     364msgctxt "uformmain.ssundayshort"
     365msgid "SUN"
     366msgstr ""
     367
     368#: uformmain.sthrusdayshort
     369msgctxt "uformmain.sthrusdayshort"
     370msgid "THU"
     371msgstr ""
     372
     373#: uformmain.stuesdayshort
     374msgctxt "uformmain.stuesdayshort"
     375msgid "TUE"
     376msgstr ""
     377
     378#: uformmain.swednesdayshort
     379msgctxt "uformmain.swednesdayshort"
     380msgid "WED"
     381msgstr ""
     382
    348383#: uitems.sreferencenotfound
    349384#, object-pascal-format
  • trunk/Languages/TransLines.pot

    r137 r140  
    324324msgstr ""
    325325
     326#: uformmain.sfridayshort
     327msgctxt "uformmain.sfridayshort"
     328msgid "FRI"
     329msgstr ""
     330
     331#: uformmain.smondayshort
     332msgctxt "uformmain.smondayshort"
     333msgid "MON"
     334msgstr ""
     335
     336#: uformmain.ssaturdayshort
     337msgctxt "uformmain.ssaturdayshort"
     338msgid "SAT"
     339msgstr ""
     340
     341#: uformmain.ssundayshort
     342msgctxt "uformmain.ssundayshort"
     343msgid "SUN"
     344msgstr ""
     345
     346#: uformmain.sthrusdayshort
     347msgctxt "uformmain.sthrusdayshort"
     348msgid "THU"
     349msgstr ""
     350
     351#: uformmain.stuesdayshort
     352msgctxt "uformmain.stuesdayshort"
     353msgid "TUE"
     354msgstr ""
     355
     356#: uformmain.swednesdayshort
     357msgctxt "uformmain.swednesdayshort"
     358msgid "WED"
     359msgstr ""
     360
    326361#: uitems.sreferencenotfound
    327362#, object-pascal-format
  • trunk/Packages/Common/UGeometric.pas

    r105 r140  
    1414    Position: TPoint;
    1515    Direction: TPoint;
    16     function GetLength: Integer;
     16    function GetLength: Double;
    1717    function GetAngle: Double;
     18    procedure SetLength(Value: Double);
     19    class function Create(P1, P2: TPoint): TVector; static;
    1820  end;
    1921
     
    176178{ TVector }
    177179
    178 function TVector.GetLength: Integer;
    179 begin
    180   Result := Trunc(Sqrt(Sqr(Direction.X) + Sqr(Direction.Y)));
     180function TVector.GetLength: Double;
     181begin
     182  Result := Sqrt(Sqr(Direction.X) + Sqr(Direction.Y));
    181183end;
    182184
     
    186188end;
    187189
     190procedure TVector.SetLength(Value: Double);
     191var
     192  Angle: Double;
     193begin
     194  Angle := GetAngle;
     195  Direction := Point(Round(Cos(Angle) * Value),
     196    Round(Sin(Angle) * Value));
     197end;
     198
     199class function TVector.Create(P1, P2: TPoint): TVector;
     200begin
     201  Result.Position := P1;
     202  Result.Direction := Point(P2.X - P1.X, P2.Y - P1.Y);
     203end;
     204
    188205end.
    189206
  • trunk/Packages/Common/UMetaCanvas.pas

    r86 r140  
    6363
    6464  TCanvasPolygon = class(TCanvasObject)
     65    Pen: TPen;
     66    Brush: TBrush;
     67    Points: array of TPoint;
     68    procedure Paint(Canvas: TCanvas); override;
     69    procedure Zoom(Factor: Double); override;
     70    procedure Move(Delta: TPoint); override;
     71    constructor Create;
     72    destructor Destroy; override;
     73  end;
     74
     75  { TCanvasPolyline }
     76
     77  TCanvasPolyline = class(TCanvasObject)
     78    Pen: TPen;
     79    Brush: TBrush;
     80    Points: array of TPoint;
     81    procedure Paint(Canvas: TCanvas); override;
     82    procedure Zoom(Factor: Double); override;
     83    procedure Move(Delta: TPoint); override;
     84    constructor Create;
     85    destructor Destroy; override;
     86  end;
     87
     88  { TCanvasPolyBezier }
     89
     90  TCanvasPolyBezier = class(TCanvasObject)
    6591    Pen: TPen;
    6692    Brush: TBrush;
     
    133159    procedure DoMoveTo(X, Y: Integer); override;
    134160    procedure DoLineTo(X, Y: Integer); override;
     161    procedure DoPolyline(const Points: array of TPoint); override;
     162    procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
     163      Filled: Boolean = False; Continuous: Boolean = False); override;
    135164  public
    136165    Objects: TCanvasObjects;
     
    141170    procedure TextOut(X,Y: Integer; const Text: String); override;
    142171    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); override;
     172    procedure Polyline(Points: PPoint; NumPts: Integer); override;
     173    procedure PolyBezier(Points: PPoint; NumPts: Integer;
     174      Filled: Boolean = False; Continuous: Boolean = True); override;
    143175    procedure Ellipse(x1, y1, x2, y2: Integer); override;
    144176    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
     
    161193  UGeometric, LCLIntf;
    162194
     195{ TCanvasPolyBezier }
     196
     197procedure TCanvasPolyBezier.Paint(Canvas: TCanvas);
     198begin
     199  Canvas.Pen.Assign(Pen);
     200  Canvas.Brush.Assign(Brush);
     201  Canvas.PolyBezier(Points);
     202end;
     203
     204procedure TCanvasPolyBezier.Zoom(Factor: Double);
     205var
     206  I: Integer;
     207begin
     208  for I := 0 to High(Points) do
     209    Points[I] := Point(Trunc(Points[I].X * Factor),
     210      Trunc(Points[I].Y * Factor));
     211  Pen.Width := Trunc(Pen.Width * Factor);
     212end;
     213
     214procedure TCanvasPolyBezier.Move(Delta: TPoint);
     215var
     216  I: Integer;
     217begin
     218  for I := 0 to High(Points) do
     219    Points[I] := AddPoint(Points[I], Delta);
     220end;
     221
     222constructor TCanvasPolyBezier.Create;
     223begin
     224  Pen := TPen.Create;
     225  Brush := TBrush.Create;
     226end;
     227
     228destructor TCanvasPolyBezier.Destroy;
     229begin
     230  FreeAndNil(Brush);
     231  FreeAndNil(Pen);
     232  inherited;
     233end;
     234
     235{ TCanvasPolyline }
     236
     237procedure TCanvasPolyline.Paint(Canvas: TCanvas);
     238begin
     239  Canvas.Pen.Assign(Pen);
     240  Canvas.Brush.Assign(Brush);
     241  Canvas.Polyline(Points);
     242end;
     243
     244procedure TCanvasPolyline.Zoom(Factor: Double);
     245var
     246  I: Integer;
     247begin
     248  for I := 0 to High(Points) do
     249    Points[I] := Point(Trunc(Points[I].X * Factor),
     250      Trunc(Points[I].Y * Factor));
     251  Pen.Width := Trunc(Pen.Width * Factor);
     252end;
     253
     254procedure TCanvasPolyline.Move(Delta: TPoint);
     255var
     256  I: Integer;
     257begin
     258  for I := 0 to High(Points) do
     259    Points[I] := AddPoint(Points[I], Delta);
     260end;
     261
     262constructor TCanvasPolyline.Create;
     263begin
     264  Pen := TPen.Create;
     265  Brush := TBrush.Create;
     266end;
     267
     268destructor TCanvasPolyline.Destroy;
     269begin
     270  FreeAndNil(Brush);
     271  FreeAndNil(Pen);
     272  inherited;
     273end;
     274
    163275{ TCanvasPie }
    164276
     
    304416destructor TCanvasPolygon.Destroy;
    305417begin
    306   Brush.Free;
    307   Pen.Free;
     418  FreeAndNil(Brush);
     419  FreeAndNil(Pen);
    308420  inherited;
    309421end;
     
    511623    APoints[I] := Points[I];
    512624  DoPolygon(APoints);
     625end;
     626
     627procedure TMetaCanvas.Polyline(Points: PPoint; NumPts: Integer);
     628var
     629  APoints: array of TPoint;
     630  I: Integer;
     631begin
     632  APoints := nil;
     633  SetLength(APoints, NumPts);
     634  for I := 0 to High(APoints) do
     635    APoints[I] := Points[I];
     636  DoPolyline(APoints);
     637end;
     638
     639procedure TMetaCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
     640  Filled: Boolean; Continuous: Boolean);
     641begin
     642  DoPolyBezier(Points, NumPts, Filled, Continuous);
    513643end;
    514644
     
    580710end;
    581711
     712procedure TMetaCanvas.DoPolyline(const Points: array of TPoint);
     713var
     714  NewObj: TCanvasPolyline;
     715  I: Integer;
     716begin
     717  NewObj := TCanvasPolyline.Create;
     718  NewObj.Brush.Assign(Brush);
     719  NewObj.Pen.Assign(Pen);
     720  SetLength(NewObj.Points, Length(Points));
     721  for I := 0 to High(Points) do
     722    NewObj.Points[I] := Points[I];
     723  Objects.Add(NewObj);
     724end;
     725
     726procedure TMetaCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
     727  Filled: Boolean; Continuous: Boolean);
     728var
     729  NewObj: TCanvasPolyBezier;
     730  I: Integer;
     731begin
     732  NewObj := TCanvasPolyBezier.Create;
     733  NewObj.Brush.Assign(Brush);
     734  NewObj.Pen.Assign(Pen);
     735  SetLength(NewObj.Points, NumPts);
     736  for I := 0 to High(NewObj.Points) do
     737    NewObj.Points[I] := Points[I];
     738  Objects.Add(NewObj);
     739end;
     740
    582741procedure TMetaCanvas.FillRect(const ARect: TRect);
    583742begin
  • trunk/UEngine.pas

    r135 r140  
    361361    OldHighestServedDaysCount: Integer;
    362362    RegistryContext: TRegistryContext;
     363    CurvedLines: Boolean;
    363364    procedure InitMenus;
    364365    procedure InitCities;
     
    415416  TrackClickDistance = 15;
    416417  EndStationLength = 50;
     418  EndStationWidth = 20;
    417419  ShowDistances = False;
    418420  TimePerSecondNormal = 60 * OneMinute;
     
    30863088var
    30873089  MetroLine: TMetroLine;
    3088   S: Integer;
     3090  I: Integer;
     3091  Points: array of TPoint;
     3092  Vector: TVector;
     3093  HalfDownPoint: TPoint;
     3094  HalfUpPoint: TPoint;
     3095  Angle: Double;
     3096  EndPoint: TPoint;
     3097const
     3098  CurveRadius: Double = 0;
    30893099begin
    30903100  for MetroLine in Lines do
     
    30933103    Canvas.Pen.Style := psSolid;
    30943104    Canvas.Pen.Width := GetMetroLineThickness;
    3095     if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position);
    3096     for S := 1 to Track.Points.Count - 1 do begin
    3097       Canvas.LineTo(Track.Points[S].Position);
    3098 {      if (S = TrackPoints.Count - 1) then begin
     3105
     3106    if CurvedLines then begin
     3107      Points := nil;
     3108      if Track.Points.Count >= 2 then begin
     3109        SetLength(Points, (Track.Points.Count - 1) * 3 - 2);
     3110        for I := 1 to Track.Points.Count - 2 do begin
     3111          if I = 1 then begin
     3112            HalfDownPoint := Track.Points[I - 1].Position;
     3113          end else
     3114          if I > 0 then begin
     3115            HalfDownPoint := Point((Track.Points[I].Position.X + Track.Points[I - 1].Position.X) div 2,
     3116              (Track.Points[I].Position.Y + Track.Points[I - 1].Position.Y) div 2)
     3117          end else begin
     3118            HalfDownPoint := Track.Points[0].Position;
     3119          end;
     3120
     3121          if I = Track.Points.Count - 2 then begin
     3122            HalfUpPoint := Track.Points[I + 1].Position
     3123          end else
     3124          if I < Track.Points.Count - 1 then begin
     3125            HalfUpPoint := Point((Track.Points[I].Position.X + Track.Points[I + 1].Position.X) div 2,
     3126              (Track.Points[I].Position.Y + Track.Points[I + 1].Position.Y) div 2)
     3127          end else begin
     3128            HalfUpPoint := Track.Points[Track.Points.Count - 1].Position;
     3129          end;
     3130
     3131          Points[(I - 1) * 3] := HalfDownPoint;
     3132          Points[I * 3] := HalfUpPoint;
     3133
     3134          if (I > 0) and (I < Track.Points.Count - 1) then begin
     3135            Vector := TVector.Create(HalfDownPoint, Track.Points[I].Position);
     3136            Vector.SetLength(Vector.GetLength - CurveRadius);
     3137            Points[(I - 1) * 3 + 1] := AddPoint(Vector.Position, Vector.Direction);
     3138          end;
     3139          if I < Track.Points.Count - 1 then begin
     3140            Vector := TVector.Create(HalfUpPoint, Track.Points[I].Position);
     3141            Vector.SetLength(Vector.GetLength - CurveRadius);
     3142            Points[(I - 1) * 3 + 2] := AddPoint(Vector.Position, Vector.Direction);
     3143          end;
     3144        end;
     3145        if Length(Points) > 1 then
     3146          Canvas.PolyBezier(@Points[0], Length(Points));
     3147      end;
     3148    end else begin
     3149      if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position);
     3150      for I := 1 to Track.Points.Count - 1 do begin
     3151        Canvas.LineTo(Track.Points[I].Position);
     3152      end;
     3153    end;
     3154
     3155    if VisualStyle = vsLondon then begin
     3156      // Starting orthogonal line
     3157      if (Track.Points.Count > 1) then begin
    30993158        Canvas.Pen.EndCap := pecSquare;
    3100         Angle := arctan2D(((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
    3101           (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
    3102         EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
    3103           Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
     3159        Angle := Arctan2((Track.Points[1].Position.Y - Track.Points[0].Position.Y),
     3160          (Track.Points[1].Position.X - Track.Points[0].Position.X));
     3161        Canvas.MoveTo(Track.Points[1].Position);
     3162        EndPoint := Point(Round(Track.Points[1].Position.X - EndStationLength * Cos(Angle)),
     3163          Round(Track.Points[1].Position.Y - EndStationLength * Sin(Angle)));
    31043164        Canvas.LineTo(EndPoint);
    3105         Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
    3106           Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
    3107         Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
    3108           Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
     3165        Canvas.MoveTo(Point(Round(EndPoint.X - Cos(Angle + Pi / 2) * EndStationWidth / 2),
     3166          Round(EndPoint.Y - Sin(Angle + Pi / 2) * EndStationWidth / 2)));
     3167        Canvas.LineTo(Point(Round(EndPoint.X - Cos(Angle - Pi / 2) * EndStationWidth / 2),
     3168          Round(EndPoint.Y - Sin(Angle - Pi / 2) * EndStationWidth / 2)));
    31093169        Canvas.Pen.EndCap := pecRound;
    3110       end;}
    3111     end;
    3112 (*    Canvas.Pen.Color := Color;
    3113     Canvas.Pen.Style := psSolid;
    3114     Canvas.Pen.Width := GetMetroLineThickness div 2;
    3115     if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].PositionDesigned);
    3116     for S := 1 to Track.Points.Count - 1 do begin
    3117       Canvas.LineTo(Track.Points[S].PositionDesigned);
    3118 {      if (S = TrackPoints.Count - 1) then begin
     3170      end;
     3171
     3172      // Ending orthogonal line
     3173      if (Track.Points.Count > 1) then begin
    31193174        Canvas.Pen.EndCap := pecSquare;
    3120         Angle := arctan2((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
    3121           (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
    3122         EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
    3123           Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
     3175        Angle := Arctan2((Track.Points[Track.Points.Count - 1].Position.Y - Track.Points[Track.Points.Count - 2].Position.Y),
     3176          (Track.Points[Track.Points.Count - 1].Position.X - Track.Points[Track.Points.Count - 2].Position.X));
     3177        Canvas.MoveTo(Track.Points[Track.Points.Count - 2].Position);
     3178        EndPoint := Point(Round(Track.Points[Track.Points.Count - 2].Position.X + EndStationLength * Cos(Angle)),
     3179          Round(Track.Points[Track.Points.Count - 2].Position.Y + EndStationLength * Sin(Angle)));
    31243180        Canvas.LineTo(EndPoint);
    3125         Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
    3126           Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
    3127         Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
    3128           Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
     3181        Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationWidth / 2),
     3182        Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationWidth / 2)));
     3183        Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationWidth / 2),
     3184          Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationWidth / 2)));
    31293185        Canvas.Pen.EndCap := pecRound;
    3130       end;}
    3131     end;
    3132     {
    3133     if (TrackPoints.Count > 1) then begin
    3134       Canvas.Pen.EndCap := pecSquare;
    3135       Angle := arctan2((TrackPoints[1].Position.Y - TrackPoints[0].Position.Y),
    3136         (TrackPoints[1].Position.X - TrackPoints[0].Position.X));
    3137       Canvas.MoveTo(TrackPoints[0].Position);
    3138       EndPoint := Point(Round(TrackPoints[0].Position.X - EndStationLength * Cos(Angle)),
    3139         Round(TrackPoints[0].Position.Y - EndStationLength * Sin(Angle)));
    3140       Canvas.LineTo(EndPoint);
    3141       Canvas.MoveTo(Point(Round(EndPoint.X - Cos(Angle + Pi / 2) * EndStationLength / 3),
    3142         Round(EndPoint.Y - Sin(Angle + Pi / 2) * EndStationLength / 3)));
    3143       Canvas.LineTo(Point(Round(EndPoint.X - Cos(Angle - Pi / 2) * EndStationLength / 3),
    3144         Round(EndPoint.Y - Sin(Angle - Pi / 2) * EndStationLength / 3)));
    3145       Canvas.Pen.EndCap := pecRound;
    3146     end;  }
    3147     *)
     3186      end;
     3187    end;
    31483188  end;
    31493189
     
    42334273begin
    42344274  inherited;
     4275  CurvedLines := True;
    42354276  MovableTracks := True;
    42364277  Colors := TColors.Create;
Note: See TracChangeset for help on using the changeset viewer.