Changeset 140 for trunk/Packages

Timestamp:

May 17, 2023, 12:18:41 AM (18 months ago)

Author:

chronos

Message:

• Modified: Draw curved metro lines.

Location:

trunk/Packages/Common

Files:

• UGeometric.pas (modified) (3 diffs)
• UMetaCanvas.pas (modified) (7 diffs)

trunk/Packages/Common/UGeometric.pas

@@ -14 +14 @@
     Position: TPoint;
     Direction: TPoint;
-    function GetLength: Integer;
+    function GetLength: Double;
     function GetAngle: Double;
+    procedure SetLength(Value: Double);
+    class function Create(P1, P2: TPoint): TVector; static;
   end;
 
@@ -176 +178 @@
 { TVector }
 
-function TVector.GetLength: Integer;
-begin
-  Result := Trunc(Sqrt(Sqr(Direction.X) + Sqr(Direction.Y)));
+function TVector.GetLength: Double;
+begin
+  Result := Sqrt(Sqr(Direction.X) + Sqr(Direction.Y));
 end;
 
@@ -186 +188 @@
 end;
 
+procedure TVector.SetLength(Value: Double);
+var
+  Angle: Double;
+begin
+  Angle := GetAngle;
+  Direction := Point(Round(Cos(Angle) * Value),
+    Round(Sin(Angle) * Value));
+end;
+
+class function TVector.Create(P1, P2: TPoint): TVector;
+begin
+  Result.Position := P1;
+  Result.Direction := Point(P2.X - P1.X, P2.Y - P1.Y);
+end;
+
 end.
 

trunk/Packages/Common/UMetaCanvas.pas

@@ -63 +63 @@
 
   TCanvasPolygon = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    Points: array of TPoint;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasPolyline }
+
+  TCanvasPolyline = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    Points: array of TPoint;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasPolyBezier }
+
+  TCanvasPolyBezier = class(TCanvasObject)
     Pen: TPen;
     Brush: TBrush;
@@ -133 +159 @@
     procedure DoMoveTo(X, Y: Integer); override;
     procedure DoLineTo(X, Y: Integer); override;
+    procedure DoPolyline(const Points: array of TPoint); override;
+    procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
+      Filled: Boolean = False; Continuous: Boolean = False); override;
   public
     Objects: TCanvasObjects;
@@ -141 +170 @@
     procedure TextOut(X,Y: Integer; const Text: String); override;
     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); override;
+    procedure Polyline(Points: PPoint; NumPts: Integer); override;
+    procedure PolyBezier(Points: PPoint; NumPts: Integer;
+      Filled: Boolean = False; Continuous: Boolean = True); override;
     procedure Ellipse(x1, y1, x2, y2: Integer); override;
     procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
@@ -161 +193 @@
   UGeometric, LCLIntf;
 
+{ TCanvasPolyBezier }
+
+procedure TCanvasPolyBezier.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Brush.Assign(Brush);
+  Canvas.PolyBezier(Points);
+end;
+
+procedure TCanvasPolyBezier.Zoom(Factor: Double);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := Point(Trunc(Points[I].X * Factor),
+      Trunc(Points[I].Y * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasPolyBezier.Move(Delta: TPoint);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := AddPoint(Points[I], Delta);
+end;
+
+constructor TCanvasPolyBezier.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasPolyBezier.Destroy;
+begin
+  FreeAndNil(Brush);
+  FreeAndNil(Pen);
+  inherited;
+end;
+
+{ TCanvasPolyline }
+
+procedure TCanvasPolyline.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Brush.Assign(Brush);
+  Canvas.Polyline(Points);
+end;
+
+procedure TCanvasPolyline.Zoom(Factor: Double);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := Point(Trunc(Points[I].X * Factor),
+      Trunc(Points[I].Y * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasPolyline.Move(Delta: TPoint);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := AddPoint(Points[I], Delta);
+end;
+
+constructor TCanvasPolyline.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasPolyline.Destroy;
+begin
+  FreeAndNil(Brush);
+  FreeAndNil(Pen);
+  inherited;
+end;
+
 { TCanvasPie }
 
@@ -304 +416 @@
 destructor TCanvasPolygon.Destroy;
 begin
-  Brush.Free;
-  Pen.Free;
+  FreeAndNil(Brush);
+  FreeAndNil(Pen);
   inherited;
 end;
@@ -511 +623 @@
     APoints[I] := Points[I];
   DoPolygon(APoints);
+end;
+
+procedure TMetaCanvas.Polyline(Points: PPoint; NumPts: Integer);
+var
+  APoints: array of TPoint;
+  I: Integer;
+begin
+  APoints := nil;
+  SetLength(APoints, NumPts);
+  for I := 0 to High(APoints) do
+    APoints[I] := Points[I];
+  DoPolyline(APoints);
+end;
+
+procedure TMetaCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
+  Filled: Boolean; Continuous: Boolean);
+begin
+  DoPolyBezier(Points, NumPts, Filled, Continuous);
 end;
 
@@ -580 +710 @@
 end;
 
+procedure TMetaCanvas.DoPolyline(const Points: array of TPoint);
+var
+  NewObj: TCanvasPolyline;
+  I: Integer;
+begin
+  NewObj := TCanvasPolyline.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  SetLength(NewObj.Points, Length(Points));
+  for I := 0 to High(Points) do
+    NewObj.Points[I] := Points[I];
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
+  Filled: Boolean; Continuous: Boolean);
+var
+  NewObj: TCanvasPolyBezier;
+  I: Integer;
+begin
+  NewObj := TCanvasPolyBezier.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  SetLength(NewObj.Points, NumPts);
+  for I := 0 to High(NewObj.Points) do
+    NewObj.Points[I] := Points[I];
+  Objects.Add(NewObj);
+end;
+
 procedure TMetaCanvas.FillRect(const ARect: TRect);
 begin