PowerPDF: Basic gradient support for TPRRect

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

components/powerpdf/PReport.pas

@@ -428,18 +428,24 @@ type
   { TPRShape }
   TPRShape = class(TPRItem)
   private
+    FGradientDirection: TGradientDirection;
     FLineWidth: Single;
     FLineColor: TColor;
     FLineStyle: TPenStyle;
     FFillColor: TColor;
+    FGradientColor: TColor;
+    procedure SetGradientDirection(AValue: TGradientDirection);
     procedure SetLineColor(Value: TColor);
     procedure SetFillColor(Value: TColor);
     procedure SetLineWidth(Value: Single);
     procedure SetLineStyle(Value: TPenStyle);
+    procedure SetGradientColor(AValue: TColor);
     procedure StdFillOrStroke(ACanvas: TPdfCanvas);
   protected
     procedure SetDash(ACanvas: TPdfCAnvas; APattern: TPenStyle);
     function  IsFillable: boolean; virtual;
+    property GradientColor: TColor read FGradientColor write SetGradientColor default clNone;
+    property GradientDirection: TGradientDirection read FGradientDirection write SetGradientDirection default gdVertical;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -462,6 +468,8 @@ type
     procedure Paint; override;
     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
   published
+    property GradientColor;
+    property GradientDirection;
     property Radius: single read GetRadius write SetRadius;
     property SquaredCorners: TPdfCorners read FCorners write SetCorners default [];
   end;
@@ -2123,6 +2131,7 @@ begin
   inherited Create(AOwner);
   FLineColor := clBlack;
   FFillColor := clNone;
+  FGradientColor := clNone;
 end;
 
 // SetLineColor
@@ -2135,6 +2144,13 @@ begin
   end;
 end;
 
+procedure TPRShape.SetGradientDirection(AValue: TGradientDirection);
+begin
+  if FGradientDirection = AValue then Exit;
+  FGradientDirection := AValue;
+  Invalidate;
+end;
+
 // SetLineStyle
 procedure TPRShape.SetLineStyle(Value: TPenStyle);
 begin
@@ -2145,6 +2161,13 @@ begin
   end;
 end;
 
+procedure TPRShape.SetGradientColor(AValue: TColor);
+begin
+  if FGradientColor = AValue then Exit;
+  FGradientColor := AValue;
+  Invalidate;
+end;
+
 procedure TPRShape.StdFillOrStroke(ACanvas: TPdfCanvas);
 begin
   with ACanvas do
@@ -2275,8 +2298,12 @@ begin
     begin
       Brush.Color := FFillColor;
       Brush.Style := bsSolid;
-      if ARadius=0 then
+      if ARadius=0 then begin
-        FillRect(ARect);
+        if GradientColor <> clNone then
+          GradientFill(ARect, ColorToRGB(FFillColor), ColorToRGB(GradientColor), GradientDirection)
+        else
+          FillRect(ARect);
+      end;
     end
     else
       Brush.Style := bsClear;
@@ -2287,7 +2314,7 @@ begin
       Pen.Width := Round(FLineWidth);
       Pen.Color := FLineColor;
       if ARadius=0 then
-        Polygon([Point(Left,Top), Point(Right,Top),
+        Polyline([Point(Left,Top), Point(Right,Top),
           Point(Right,Bottom), Point(Left,Bottom)]);
     end;
 
@@ -2325,6 +2352,15 @@ begin
 
     with ACanvas.PdfCanvas do
     begin
+
+      if self.GradientColor<>clNone then
+        case Self.GradientDirection of
+          gdVertical:
+            SetGradientFill(2, ColorToRGB(FillColor), ColorToRGB(GradientColor), [0,Top,0,Bottom]);
+          gdHorizontal:
+            SetGradientFill(2, ColorToRGB(FillColor), ColorToRGB(GradientColor), [Left,0,Right,0]);
+        end;
+
       if ARadius<>0.0 then
         RoundRect(Left, Bottom, Right-Left, Top-Bottom, ARadius, ARadius,
           SquaredCorners)
@@ -2343,7 +2379,10 @@ begin
       end;
     end;
 
-    StdFillOrStroke(ACanvas.PDFCanvas);
+    if self.GradientColor<>clNone then
+      ACanvas.PdfCanvas.ClosepathFillStroke
+    else
+      StdFillOrStroke(ACanvas.PDFCanvas);
   end;
 end;
 

components/powerpdf/PdfDoc.pas

@@ -448,16 +448,21 @@ type
     procedure MoveTextPoint(tx, ty: Single);                     {  Td  }
     procedure SetTextMatrix(a, b, c, d, x, y: Single);           {  Tm  }
     procedure MoveToNextLine;                                    {  T*  }
-    procedure ShowText(const s: string);                               {  Tj  }
+    procedure ShowText(const s: string);                         {  Tj  }
-    procedure ShowTextNextLine(const s: string);                       {  '   }
+    procedure ShowTextNextLine(const s: string);                 {  '   }
 
     {* external objects *}
-    procedure ExecuteXObject(const xObject: string);                   {  Do  }
+    procedure ExecuteXObject(const xObject: string);             {  Do  }
 
     {* Device-dependent color space operators *}
     procedure SetRGBFillColor(Value: TPdfColor);                 {  rg  }
     procedure SetRGBStrokeColor(Value: TPdfColor);               {  RG  }
 
+    (* Basic shading pattern*)
+    procedure SetGradientFill(shadingType:Byte;
+        startColor, endColor: TPdfColor; Coords: array of Double;
+        Extends: boolean = false);
+
     {* utility routines *}
     procedure SetPage(APage: TPdfDictionary);
     procedure SetFont(const AName: string; ASize: Single);
@@ -1441,7 +1446,7 @@ begin
 end;
 
 // GetColorStr
-function TPDFCanvas.GetColorStr(Color: TPdfColor): string;
+function TPdfCanvas.GetColorStr(Color: TPdfColor): string;
 var
   X: array[0..3] of Byte;
   rgb: integer;
@@ -2132,6 +2137,82 @@ begin
   WriteString(S);
 end;
 
+procedure TPdfCanvas.SetGradientFill(shadingType: Byte; startColor,
+  endColor: TPdfColor; Coords: array of Double; Extends: boolean);
+var
+  Resources, patternResource, Shading, Pattern: TPdfDictionary;
+  ObjectMgr: TPdfObjectMgr;
+  Gradient: String;
+
+  function CreateRealArray(arr: array of double): TPdfArray;
+  var
+    i: Integer;
+  begin
+    result := TPdfArray.CreateArray(Resources.ObjectMgr);
+    for i:=0 to high(arr) do
+      result.AddItem(TPdfReal.CreateReal(arr[i]));
+  end;
+  function ColorToArray(Color: TPdfColor): TPdfArray;
+  var
+    clr: record r,g,b,x: byte; end absolute Color;
+  begin
+    result := CreateRealArray([clr.r/255, clr.g/255, clr.b/255]);
+  end;
+  function CreateBoolArray(a,b: boolean): TPdfArray;
+  begin
+    result := TPdfArray.CreateArray(Resources.ObjectMgr);
+    result.AddItem(TPdfBoolean.CreateBoolean(a));
+    result.AddItem(TPdfBoolean.CreateBoolean(b));
+  end;
+  function CreateFunction2: TPdfDictionary;
+  begin
+    result := TPdfDictionary.CreateDictionary(Resources.ObjectMgr);
+    result.AddNumberItem('FunctionType', 2);
+    result.AddNumberItem('N', 1);
+    result.AddItem('Domain', CreateRealArray([0.0,1.0]));
+    result.AddItem('C0', ColorToArray(StartColor));
+    result.AddItem('C1', ColorToArray(EndColor));
+  end;
+begin
+  ObjectMgr := FPage.ObjectMgr;
+
+  // get or create a Pattern resource
+  Resources := FPage.PdfDictionaryByName('Resources');
+  if Resources=nil then begin
+    Resources := TPdfDictionary.CreateDictionary(ObjectMgr);
+    FPage.AddItem('Resources', Resources);
+  end;
+  patternResource := Resources.PdfDictionaryByName('Pattern');
+  if patternResource=nil then begin
+    patternResource := TPdfDictionary.CreateDictionary(ObjectMgr);
+    Resources.AddItem('Pattern', patternResource);
+  end;
+
+  // create a shading dictionary
+  Shading := TPdfDictionary.CreateDictionary(ObjectMgr);
+  Shading.AddNumberItem('ShadingType', shadingType);
+  Shading.AddNameItem('ColorSpace', 'DeviceRGB');
+  Shading.AddItem('Coords', CreateRealArray(Coords));
+  if Extends then
+    Shading.AddItem('Extends', CreateBoolArray(true, true));
+  Shading.AddItem('Function', CreateFunction2);
+  ObjectMgr.AddObject(Shading); // make it a reference
+
+  // create a shading pattern
+  Pattern := TPdfDictionary.CreateDictionary(ObjectMgr);
+  Pattern.AddNameItem('Type', 'Pattern');
+  Pattern.AddNumberItem('PatternType', 2);
+  Pattern.AddItem('Shading', Shading);
+
+  // add it to pattern resource
+  Gradient := 'Grad'+IntToStr(patternResource.ItemCount+1);
+  patternResource.AddItem(Gradient, Pattern);
+
+  // start using it
+  WriteString('/Pattern cs'#10);
+  WriteString('/'+Gradient+' scn'#10);
+end;
+
 { TPdfCanvas common routine }
 
 // TextWidth