Changeset 60 for trunk/Packages/Common/UMetaCanvas.pas

Timestamp:

Nov 25, 2020, 12:14:18 PM (3 years ago)

Author:

chronos

Message:

• Modified: Updated Common package.

File:

• trunk/Packages/Common/UMetaCanvas.pas (modified) (8 diffs)

trunk/Packages/Common/UMetaCanvas.pas

@@ -39 +39 @@
     Brush: TBrush;
     BoundingRect: TRect;
+    Rounded: TPoint;
     procedure Paint(Canvas: TCanvas); override;
     procedure Zoom(Factor: Double); override;
@@ -133 +134 @@
   public
     Objects: TObjectList;
+    procedure FillRect(const ARect: TRect); overload; override;
+    procedure FillRect(X1,Y1,X2,Y2: Integer); overload;
+    procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; override;
+    procedure RoundRect(const Rect: TRect; RX,RY: Integer); overload;
     procedure TextOut(X,Y: Integer; const Text: String); override;
     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
@@ -152 +157 @@
 
 uses
-  UGeometric;
+  UGeometric, LCLIntf;
 
 { TCanvasPie }
@@ -340 +345 @@
   Canvas.Pen.Assign(Pen);
   Canvas.Brush.Assign(Brush);
-  Canvas.Rectangle(BoundingRect);
+
+  if Rounded <> Point(0, 0) then Canvas.RoundRect(BoundingRect, Rounded.X, Rounded.Y)
+    else Canvas.Rectangle(BoundingRect);
 end;
 
@@ -354 +361 @@
 procedure TCanvasRectangle.Move(Delta: TPoint);
 begin
-  ShiftRect(BoundingRect, Delta);
+  BoundingRect := ShiftRect(BoundingRect, Delta);
 end;
 
@@ -361 +368 @@
   Pen := TPen.Create;
   Brush := TBrush.Create;
+  Rounded := Point(0, 0);
 end;
 
@@ -547 +555 @@
 
 function TMetaCanvas.TextExtent(const Text: string): TSize;
-begin
-  Result := Size(0, 0);
+var
+  Canvas: TCanvas;
+begin
+  Canvas := TCanvas.Create;
+  Canvas.Handle := CreateCompatibleDC(0);
+  Canvas.Font.Assign(Font);
+  Result := Canvas.TextExtent(Text);
+  DeleteDC(Canvas.Handle);
+  Canvas.Free;
 end;
 
@@ -560 +575 @@
   DoLine(FPenPos.X, FPenPos.Y, X, Y);
   DoMoveTo(X, Y);
+end;
+
+procedure TMetaCanvas.FillRect(const ARect: TRect);
+begin
+  DoRectangleFill(ARect);
+end;
+
+procedure TMetaCanvas.FillRect(X1, Y1, X2, Y2: Integer);
+begin
+  FillRect(Rect(X1, Y1, X2, Y2));
+end;
+
+procedure TMetaCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
+begin
+  RoundRect(Rect(X1, Y1, X2, Y2), RX, RY);
+end;
+
+procedure TMetaCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
+var
+  NewObj: TCanvasRectangle;
+begin
+  NewObj := TCanvasRectangle.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Rect;
+  NewObj.Rounded := Point(RX, RY);
+  Objects.Add(NewObj);
 end;