pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

PowerPDF: Basic gradient support for TPRRect

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5746 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jesusr
2017-02-15 06:31:55 +00:00
parent 3a01999407
commit e15e8375ca
2 changed files with 128 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
components/powerpdf/PReport.pas
View File

@ -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
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,6 +2379,9 @@ begin
end;
end;
if self.GradientColor<>clNone then
ACanvas.PdfCanvas.ClosepathFillStroke
else
StdFillOrStroke(ACanvas.PDFCanvas);
end;
end;

83
components/powerpdf/PdfDoc.pas
View File

@ -458,6 +458,11 @@ type
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