Changeset 145 for trunk/Packages/Common/MetaCanvas.pas

Timestamp:

Jun 5, 2023, 6:44:57 PM (18 months ago)

Author:

chronos

Message:

• Modified: Remove U prefix from unit names.
• Modified: Updated Common package.

File:

• trunk/Packages/Common/MetaCanvas.pas (moved) (moved from trunk/Packages/Common/UMetaCanvas.pas ) (10 diffs)

trunk/Packages/Common/MetaCanvas.pas

@@ -1 @@
-unit UMetaCanvas;
+unit MetaCanvas;
 
 interface
 
 uses
-  Classes, SysUtils, Graphics, Types, fgl;
+  Classes, SysUtils, Graphics, Types, Generics.Collections;
 
 type
@@ -17 +17 @@
   end;
 
-  TCanvasObjects = class(TFPGObjectList<TCanvasObject>)
+  TCanvasObjects = class(TObjectList<TCanvasObject>)
   end;
 
@@ -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;
@@ -159 +191 @@
 
 uses
-  UGeometric, LCLIntf;
+  Geometric, 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
@@ -664 +823 @@
 
 end.
-