PowerPDF: added mixed roundrect (rounded and squared corners) support

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2183 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jesusr
2011-12-05 17:57:15 +00:00
parent 7e58ddcf57
commit 6d2a15426e
4 changed files with 114 additions and 12 deletions

View File

@ -47,7 +47,7 @@ uses
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SysUtils, Classes, GraphMath, Graphics, Controls, Forms, Dialogs,
ExtCtrls, PdfDoc, PdfFonts, PdfTypes, PdfImages
{$IFDEF USE_JPFONTS}
, PdfJPFonts
@ -445,13 +445,16 @@ type
TPRRect = class(TPRShape)
private
FRadius: Single;
FCorners: TPdfCorners;
function GetRadius: single;
procedure SetCorners(AValue: TPdfCorners);
procedure SetRadius(const AValue: single);
protected
procedure Paint; override;
procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
published
property Radius: single read GetRadius write SetRadius;
property SquaredCorners: TPdfCorners read FCorners write SetCorners default [];
end;
{ TPREllipse }
@ -736,6 +739,71 @@ begin
result.y := y;
end;
procedure MixedRoundRect(Canvas:TCanvas; X1, Y1, X2, Y2: integer; RX, RY: integer;
SqrCorners: TPdfCorners);
var
Pts: PPoint;
c: Integer;
Mx,My: Integer;
procedure Corner(Ax,Ay,Bx,By,Cx,Cy:Integer);
begin
ReallocMem(Pts, SizeOf(TPoint)*(c+3));
Pts[c].x:=ax; Pts[c].y:=ay; inc(c);
Pts[c].x:=bx; Pts[c].y:=by; inc(c);
Pts[c].x:=cx; Pts[c].y:=cy; inc(c);
end;
begin
X2 := X2-1;
Y2 := Y2-1;
// basic checks
if X1>X2 then
begin
c :=X2;
X2 := X1;
X1 := c;
end;
if Y1>Y2 then
begin
c := Y2;
Y2 := Y1;
Y1 := c;
end;
if RY>(Y2-Y1) then
RY:=(Y2-Y1);
if RX>(X2-X1) then
RX :=(X2-X1);
MX := RX div 2;
MY := RY div 2;
c := 0;
Pts := nil;
if pcTopLeft in SqrCorners then
Corner(X1+MX,Y1, X1,Y1, X1,Y1+MY)
else
BezierArcPoints(X1,Y1,RX,RY, 90*16, 90*16, 0, Pts, c);
if pcBottomLeft in SqrCorners then
Corner(X1,Y2-MY,X1,Y2,X1+MX,Y2)
else
BezierArcPoints(X1,Y2-RY,RX,RY, 180*16, 90*16, 0, Pts, c);
if pcBottomRight in SqrCorners then
Corner(X2-MX,Y2, X2,Y2, X2, Y2-MY)
else
BezierArcPoints(X2-RX,Y2-RY,RX,RY, 270*16, 90*16, 0, Pts, c);
if pcTopRight in SqrCorners then
Corner(X2,Y1+MY, X2,Y1, X2-MX,Y1)
else
BezierArcPoints(X2-RX,Y1,RX,RY, 0, 90*16, 0, Pts, c);
Canvas.Polygon(Pts, c);
ReallocMem(Pts, 0);
end;
{ TPReport }
// Create
@ -2135,6 +2203,13 @@ begin
Result := FRadius;
end;
procedure TPRRect.SetCorners(AValue: TPdfCorners);
begin
if FCorners=AValue then Exit;
FCorners:=AValue;
Invalidate;
end;
procedure TPRRect.SetRadius(const AValue: single);
begin
if AValue<>FRadius then begin
@ -2182,7 +2257,8 @@ begin
end;
if ARadius<>0 then
RoundRect(Left,Top,Right,Bottom,ARadius*2,ARadius*2);
MixedRoundRect(Canvas, Left,Top,Right,Bottom,ARadius*2,ARadius*2,
SquaredCorners);
end;
end;
@ -2215,7 +2291,8 @@ begin
with ACanvas.PdfCanvas do
begin
if ARadius<>0.0 then
RoundRect(Left, Bottom, Right-Left, Top-Bottom, ARadius, ARadius)
RoundRect(Left, Bottom, Right-Left, Top-Bottom, ARadius, ARadius,
SquaredCorners)
else
begin
MoveTo(Left, Top);

View File

@ -472,7 +472,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);
procedure RoundRect(x, y, width, height, rx, ry: Single; SqrCorners:TPdfCorners=[]);
function TextWidth(Text: string): Single;
function MeasureText(Text: string; AWidth: Single): integer;
function GetNextWord(const S: string; var Index: integer): string;
@ -2174,20 +2174,39 @@ begin
y+height/2);
end;
procedure TPdfCanvas.RoundRect(x, y, width, height, rx, ry: Single);
procedure TPdfCanvas.RoundRect(x, y, width, height, rx, ry: Single;
SqrCorners:TPdfCorners=[]);
var
h1,w1:single;
begin
if 2*rx>width then
rx := width/2;
if 2*ry>height then
ry := height/2;
h1 := ry*11/20;
w1 := rx*11/20;
MoveTo(x, y+ry);
CurveToC(x, y+ry-h1, x+rx-w1, y, x+rx, y);
if pcBottomLeft in SqrCorners then
LineTo(x, y)
else
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);
if pcBottomRight in SqrCorners then
LineTo(x+width, y)
else
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);
if pcTopRight in SqrCorners then
LineTo(x+width, y+height)
else
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);
if pcTopLeft in SqrCorners then
LineTo(x, y+height)
else
CurveToC(x+rx-w1, y+height, x, y+height-ry+h1, x, y+height-ry);
LineTo(x, y+ry);
end;

View File

@ -78,6 +78,8 @@ type
Left, Top, Right, Bottom: Single;
end;
TPdfCorners = set of (pcTopLeft, pcBottomLeft, pcBottomRight, pcTopRight);
TPdfObjectType = (otDirectObject, otIndirectObject, otVirtualObject);
TPdfAlignment = (paLeftJustify, paRightJustify, paCenter);

View File

@ -1,10 +1,11 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="pack_powerpdf"/>
<AddToProjectUsesSection Value="True"/>
<CompilerOptions>
<Version Value="9"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
@ -16,11 +17,14 @@
</SyntaxOptions>
</Parsing>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-dLAZ_POWERPDF"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Version Minor="9" Release="6"/>
<Version Minor="9" Release="7"/>
<Files Count="12">
<Item1>
<Filename Value="PdfTypes.pas"/>