PowerPDF: added rounded rect support

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1128 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/powerpdf/PReport.pas

@@ -424,8 +424,10 @@ type
     procedure SetFillColor(Value: TColor);
     procedure SetLineWidth(Value: Single);
     procedure SetLineStyle(Value: TPenStyle);
+    procedure StdFillOrStroke(Canvas: TPdfCanvas);
   protected
     procedure SetDash(ACanvas: TPdfCAnvas; APattern: TPenStyle);
+    function  IsFillable: boolean; virtual;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -438,9 +440,15 @@ type
 
   { TPRRect }
   TPRRect = class(TPRShape)
+  private
+    FRadius: Single;
+    function GetRadius: single;
+    procedure SetRadius(const AValue: single);
   protected
     procedure Paint; override;
     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
+  published
+    property Radius: single read GetRadius write SetRadius;
   end;
 
   { TPREllipse }
@@ -454,6 +462,7 @@ type
   TPRPolygon = class(TPRShape)
   protected
     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
+    function  IsFillable: boolean; override;
   public
     Points: TPRPointArray;
   end;
@@ -1962,6 +1971,44 @@ begin
   end;
 end;
 
+procedure TPRShape.StdFillOrStroke(Canvas: TPdfCanvas);
+begin
+  with Canvas do
+  begin
+    if (FillColor <> clNone) and IsFillable then
+      SetRGBFillColor(FFillColor);
+
+    if LineColor <> clNone then
+    begin
+      SetRGBStrokeColor(FLineColor);
+      SetLineWidth(FLineWidth);
+    end;
+
+    if FillColor <> clNone then
+      if IsFillable then
+        if (LineColor <> clNone) and (LineStyle <> psClear) then
+          ClosepathFillStroke
+        else
+        begin
+          Closepath;
+          Fill;
+        end
+      else
+      begin
+        Stroke;
+        Newpath;
+      end
+    else
+      if IsFillable then
+        ClosePathStroke
+      else
+      begin
+        Stroke;
+        Newpath;
+      end;
+  end;
+end;
+
 // SetFillColor
 procedure TPRShape.SetFillColor(Value: TColor);
 begin
@@ -1996,27 +2043,62 @@ begin
     end;
 end;
 
+function TPRShape.IsFillable: boolean;
+begin
+  result := (self.Width > 1) and (self.Height > 1);
+end;
+
 
 { TPRRect }
 
+function TPRRect.GetRadius: single;
+begin
+  if ClientHeight<ClientWidth then
+    Result := ClientHeight
+  else
+    Result := ClientWidth;
+
+  if FRadius<0.0 then
+    Result := Result/4
+  else
+  if FRadius>Result/2 then
+    Result := Result/2
+  else
+    Result := FRadius;
+end;
+
+procedure TPRRect.SetRadius(const AValue: single);
+begin
+  if AValue<>FRadius then begin
+    FRadius := AValue;
+    if FRadius<0.0 then
+      FRadius := -1.0;
+    Invalidate;
+  end;
+end;
+
 // Paint
 procedure TPRRect.Paint;
 var
   ARect: TRect;
+  ARadius: Integer;
 begin
   ARect := ClientRect;
-  with ARect, Canvas do
+  with Canvas, ARect do
   begin
     if self.Height > 1 then
       Bottom := Bottom - 1;
     if self.Width > 1 then
       Right := Right - 1;
 
+    ARadius := round(Radius);
+
     if FillColor <> clNone then
     begin
       Brush.Color := FFillColor;
       Brush.Style := bsSolid;
-      FillRect(ARect);
+      if ARadius=0 then
+        FillRect(ARect);
     end
     else
       Brush.Style := bsClear;
@@ -2026,9 +2108,13 @@ begin
       Pen.Style := FLineStyle;
       Pen.Width := Round(FLineWidth);
       Pen.Color := FLineColor;
-      Polygon([Point(Left,Top), Point(Right,Top),
+      if ARadius=0 then
-        Point(Right,Bottom), Point(Left,Bottom)]);
+        Polygon([Point(Left,Top), Point(Right,Top),
+          Point(Right,Bottom), Point(Left,Bottom)]);
     end;
+
+    if ARadius<>0 then
+      RoundRect(Left,Top,Right,Bottom,ARadius,ARadius);
   end;
 end;
 
@@ -2036,6 +2122,7 @@ end;
 procedure TPRRect.Print(ACanvas: TPRCanvas; ARect: TRect);
 var
   PageHeight: integer;
+  ARadius: single;
 begin
   PageHeight := GetPage.Height;
   with ARect do
@@ -2055,51 +2142,28 @@ begin
 
     SetDash(ACanvas.PdfCanvas, FLineStyle);
 
+    ARadius := Radius;
+
     with ACanvas.PdfCanvas do
     begin
-      MoveTo(Left, Top);
+      if ARadius<>0.0 then
-
+        RoundRect(Left, Bottom, Right-Left, Top-Bottom, ARadius, ARadius)
-      if self.Width > 1 then
-      begin
-        LineTo(Right, Top);
-        if self.Height > 1 then
-          LineTo(Right, Bottom);
-      end;
-      if self.Height > 1 then
-        LineTo(Left, Bottom);
-
-      if (FillColor <> clNone) and (self.Width > 1) and (self.Height > 1) then
-        SetRGBFillColor(FFillColor);
-
-      if LineColor <> clNone then
-      begin
-        SetRGBStrokeColor(FLineColor);
-        SetLineWidth(FLineWidth);
-      end;
-
-      if FillColor <> clNone then
-        if (self.Width > 1) and (self.Height > 1) then
-          if (LineColor <> clNone) and (LineStyle <> psClear) then
-            ClosepathFillStroke
-          else
-          begin
-            Closepath;
-            Fill;
-          end
-        else
-        begin
-          Stroke;
-          Newpath;
-        end
       else
-        if (self.Width > 1) and (self.Height > 1) then
+      begin
-          ClosePathStroke
+        MoveTo(Left, Top);
-        else
+
+        if self.Width > 1 then
         begin
-          Stroke;
+          LineTo(Right, Top);
-          Newpath;
+          if self.Height > 1 then
+            LineTo(Right, Bottom);
         end;
+        if self.Height > 1 then
+          LineTo(Left, Bottom);
+      end;
     end;
+
+    StdFillOrStroke(ACanvas.PDFCanvas);
   end;
 end;
 
@@ -2167,37 +2231,7 @@ begin
       with ARect do
         Ellipse(Left, Top, Right - Left, Bottom - Top);
 
-      if (FillColor <> clNone) and (Width > 1) and (Height > 1) then
+      StdFillOrStroke(ACanvas.PdfCanvas);
-        SetRGBFillColor(FFillColor);
-
-      if LineColor <> clNone then
-      begin
-        SetRGBStrokeColor(FLineColor);
-        SetLineWidth(FLineWidth);
-      end;
-
-      if FillColor <> clNone then
-        if (Width > 1) and (Height > 1) then
-          if (LineColor <> clNone) and (LineStyle <> psClear) then
-            ClosepathFillStroke
-          else
-          begin
-            Closepath;
-            Fill;
-          end
-        else
-        begin
-          Stroke;
-          Newpath;
-        end
-      else
-        if (Width > 1) and (Height > 1) then
-          ClosePathStroke
-        else
-        begin
-          Stroke;
-          Newpath;
-        end;
     end;
   end;
 end;
@@ -2472,37 +2506,12 @@ begin
   for i:=1 to Length(Pts)-1 do
     Canvas.LineTo(Pts[i].x, Pts[i].y);
 
-  if (FillColor <> clNone) and (Length(Points)>2) then
+  StdFillOrStroke(Canvas);
-    canvas.SetRGBFillColor(FFillColor);
+end;
 
-  if LineColor <> clNone then
+function TPRPolygon.IsFillable: boolean;
-  begin
+begin
-    Canvas.SetRGBStrokeColor(FLineColor);
+  result := (Length(Points)>2);
-    Canvas.SetLineWidth(FLineWidth);
-  end;
-
-  if FillColor <> clNone then
-    if Length(Points)>2 then
-      if (LineColor <> clNone) and (LineStyle <> psClear) then
-        Canvas.ClosepathFillStroke
-      else
-      begin
-        Canvas.Closepath;
-        Canvas.Fill;
-      end
-    else
-    begin
-      Canvas.Stroke;
-      Canvas.Newpath;
-    end
-  else
-    if Length(Points)>2 then
-      Canvas.ClosePathStroke
-    else
-    begin
-      Canvas.Stroke;
-      Canvas.Newpath;
-    end;
 end;
 
 end.

components/powerpdf/PdfDoc.pas

@@ -374,6 +374,8 @@ type
     property Font: TPdfFont read FFont write FFont;
   end;
 
+  { TPdfCanvas }
+
   TPdfCanvas = class(TObject)
   private
     FContents: TPdfStream;
@@ -463,6 +465,7 @@ type
     procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
         ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
     procedure Ellipse(x, y, width, height: Single);
+    procedure RoundRect(x, y, width, height, rx, ry: Single);
     function TextWidth(Text: string): Single;
     function MeasureText(Text: string; AWidth: Single): integer;
     function GetNextWord(const S: string; var Index: integer): string;
@@ -2097,6 +2100,23 @@ begin
              y+height/2);
 end;
 
+procedure TPdfCanvas.RoundRect(x, y, width, height, rx, ry: Single);
+var
+  hm,wm,h1,w1:single;
+begin
+  h1 := ry*11/20;
+  w1 := rx*11/20;
+  MoveTo(x, y+ry);
+  CurveToC(x, y+ry-h1, x+rx-w1, y, x+rx, y);
+  LineTo(x+width-rx, y);
+  CurveToC(x+width-rx+w1, y, x+width, y+ry-h1, x+width, y+ry);
+  LineTo(x+width, y+height-ry);
+  CurveToC(x+width, y+height-ry+h1, x+width-rx+w1, y+height, x+width-rx, y+height);
+  LineTo(x+rx, y+height);
+  CurveToC(x+rx-w1, y+height, x, y+height-ry+h1, x, y+height-ry);
+  LineTo(x, y+ry);
+end;
+
 // GetNextWord
 function TPdfCanvas.GetNextWord(const S: string;
   var Index: integer): string;

components/powerpdf/pack_powerpdf.lpk

@@ -21,7 +21,7 @@
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
-    <Version Minor="9" Release="3"/>
+    <Version Minor="9" Release="3" Build="1"/>
     <Files Count="12">
       <Item1>
         <Filename Value="PdfTypes.pas"/>