You've already forked lazarus-ccr
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:
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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);
|
||||
|
||||
|
@ -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"/>
|
||||
|
Reference in New Issue
Block a user