Changeset 542 for Common

Timestamp:

Feb 3, 2020, 12:26:46 AM (5 years ago)

Author:

chronos

Message:

• Added: Support to draw to RoundRect in TMetaCanvas.

Location:

Common

Files:

• Common.lpk (modified) (2 diffs)
• UMetaCanvas.pas (modified) (8 diffs)

Common/Common.lpk

@@ -40 +40 @@
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="24">
+    <Files Count="26">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -147 +147 @@
         <UnitName Value="UGeometric"/>
       </Item24>
+      <Item25>
+        <Filename Value="UTranslator.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UTranslator"/>
+      </Item25>
+      <Item26>
+        <Filename Value="ULanguages.pas"/>
+        <UnitName Value="ULanguages"/>
+      </Item26>
     </Files>
     <i18n>

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;