paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 21:04:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, fix postscript arc and ellipse drawing (avoid double frame)

Browse Source 
git-svn-id: trunk@19027 -
This commit is contained in:
jesus 2009-03-18 22:46:07 +00:00
parent cd1ecbf189
commit 4835e9c805
1 changed files with 12 additions and 8 deletions

20
lcl/postscriptcanvas.pas
View File

@ -102,6 +102,7 @@ Type
procedure BrushChanging(APen: TObject); override;
procedure RegionChanging(APen: TObject); override;
procedure RequiredState(ReqState: TCanvasState); override;
procedure DoEllipseAndFill(const Bounds: TRect); override;
procedure BeginDoc; override;
procedure EndDoc; override;
@ -871,6 +872,10 @@ begin
// other states are anyway impossible, because handle is dummy
end;
procedure TPostScriptPrinterCanvas.DoEllipseAndFill(const Bounds: TRect);
begin
Ellipse(Bounds.Left, Bounds.Top, Bounds.Right, Bounds.Bottom);
end;
constructor TPostScriptPrinterCanvas.Create(APrinter: TPrinter);
begin
@ -1543,14 +1548,14 @@ var xScale : Real;
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
TranslateCoord(Left,Top);
TranslateCoord(Right,Bottom);
//calculate centre of ellipse
cx:=Left;
cy:=Top;
rx:=Right-Left;
ry:=Bottom-Top;
cx:=(Left+Right)/2;
cy:=(Top+Bottom)/2;
rx:=(Right-Left)/2;
ry:=(Bottom-Top)/2;
if Angle2>=0 then
Ang:='arc'
@ -1558,13 +1563,12 @@ begin
Ang:='arcn';
//calculate semi-minor and semi-major axes of ellipse
xScale:=Abs(rx);
yScale:=Abs(ry);
xScale:=Abs((Right-Left)/2.0);
yScale:=Abs((Bottom-Top)/2.0);
Code:=PPCFormat('matrix currentmatrix %.3f %.3f translate %.3f %.3f scale 0 0 1 %.3f %.3f %s setmatrix',
[cX,cY,xScale,yScale,Angle1/16,Angle2/16,ang]);
if (Pen.Color<>clNone) and ((Pen.Color<>Brush.Color) or (Brush.Style<>bsSolid)) then
begin
UpdateLineColor(clNone);