paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 07:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, fix postscriptcanvas problem on consecutive LineTo operations, issue #16112

Browse Source 
git-svn-id: trunk@24213 -
This commit is contained in:
jesus 2010-03-25 20:18:45 +00:00
parent 5f46559cad
commit 4ddf5a3e30
1 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/postscriptcanvas.pas
View File

@ -54,6 +54,9 @@ Type
fx,fy:single; fx,fy:single;
end; end;
TPsCanvasState = ( pcsPosValid, pcsClipping, pcsClipSaved );
TPsCanvasStatus = set of TPsCanvasState;
TPostScriptPrinterCanvas = Class(TPrinterCanvas) TPostScriptPrinterCanvas = Class(TPrinterCanvas)
private private
fHeader : TStringList; //Header document fHeader : TStringList; //Header document
@ -72,8 +75,7 @@ Type
FFs : TFormatSettings; FFs : TFormatSettings;
fSaveCount : Integer; fSaveCount : Integer;
FClipRect : TRect; FClipRect : TRect;
FClipping : boolean; FStatus : TPsCanvasStatus;
FClipSaved : boolean;
procedure psDrawRect(ARect:TRect); procedure psDrawRect(ARect:TRect);
procedure WriteHeader(St : String); procedure WriteHeader(St : String);
@ -105,6 +107,7 @@ Type
function GetFontSize: Integer; function GetFontSize: Integer;
procedure RestoreClip; procedure RestoreClip;
procedure SaveClip; procedure SaveClip;
procedure CheckLastPos;
protected protected
procedure CreateHandle; override; procedure CreateHandle; override;
procedure CreateBrush; override; procedure CreateBrush; override;
@ -893,6 +896,7 @@ var
begin begin
pp:=Self.TranslateCoord(fpenPos.X,fPenPos.Y); pp:=Self.TranslateCoord(fpenPos.X,fPenPos.Y);
write(Format('%f %f moveto',[pp.fx,pp.fy],Ffs)+' %last pos'); write(Format('%f %f moveto',[pp.fx,pp.fy],Ffs)+' %last pos');
Include(FStatus, pcsPosValid);
end; end;
//Add at the PstScript sequence, the Fill Pattern/Color and Broder //Add at the PstScript sequence, the Fill Pattern/Color and Broder
@ -1063,11 +1067,11 @@ end;
procedure TPostScriptPrinterCanvas.RestoreClip; procedure TPostScriptPrinterCanvas.RestoreClip;
begin begin
if FClipSaved then if pcsClipSaved in FStatus then
begin begin
Self.WriteComment('Restoring Old clip rect'); Self.WriteComment('Restoring Old clip rect');
Self.Write('cliprestore'); Self.Write('cliprestore');
FClipSaved := false; Exclude(FStatus, pcsClipSaved);
end; end;
end; end;
@ -1078,7 +1082,13 @@ begin
psDrawRect(FClipRect); psDrawRect(FClipRect);
Write(FBuffer); Write(FBuffer);
Self.Write('clip'); Self.Write('clip');
FClipSaved := true; Include(FStatus, pcsClipSaved);
end;
procedure TPostScriptPrinterCanvas.CheckLastPos;
begin
if not (pcsPosValid in FStatus) then
MoveToLastPos;
end; end;
procedure TPostScriptPrinterCanvas.CreateHandle; procedure TPostScriptPrinterCanvas.CreateHandle;
@ -1163,7 +1173,7 @@ begin
Ffs.DecimalSeparator:='.'; Ffs.DecimalSeparator:='.';
Ffs.ThousandSeparator:=#0; Ffs.ThousandSeparator:=#0;
FClipping := true; Include(FStatus, pcsClipping);
end; end;
destructor TPostScriptPrinterCanvas.Destroy; destructor TPostScriptPrinterCanvas.Destroy;
@ -1507,6 +1517,8 @@ begin
pp:=TranslateCoord(X1,Y1); pp:=TranslateCoord(X1,Y1);
write(Format('%f %f moveto',[pp.fx,pp.fy],FFs)); write(Format('%f %f moveto',[pp.fx,pp.fy],FFs));
Include(FStatus, pcsPosValid);
end; end;
//Drawe line //Drawe line
@ -1514,6 +1526,9 @@ procedure TPostScriptPrinterCanvas.DoLineTo(X1, Y1: Integer);
var var
pp:TpsPoint; pp:TpsPoint;
begin begin
checkLastPos;
Changing; Changing;
RequiredState([csHandleValid, csPenValid]); RequiredState([csHandleValid, csPenValid]);
WriteComment(Format('DoLineTo(%d,%d)',[x1,y1])); WriteComment(Format('DoLineTo(%d,%d)',[x1,y1]));
@ -1524,6 +1539,8 @@ begin
UpdateLineStyle; UpdateLineStyle;
write(Format('%f %f lineto stroke',[pp.fx,pp.fy],FFs)); write(Format('%f %f lineto stroke',[pp.fx,pp.fy],FFs));
changed; changed;
Exclude(FStatus, pcsPosValid);
end; end;
procedure TPostScriptPrinterCanvas.Polyline(Points: PPoint; NumPts: Integer); procedure TPostScriptPrinterCanvas.Polyline(Points: PPoint; NumPts: Integer);
@ -2200,29 +2217,32 @@ end;
procedure TPostScriptPrinterCanvas.SetClipRect(const ARect:TRect); procedure TPostScriptPrinterCanvas.SetClipRect(const ARect:TRect);
begin begin
if FClipping then if pcsClipping in FStatus then
RestoreClip; RestoreClip;
FClipRect := ARect; FClipRect := ARect;
if FClipping then if pcsClipping in FStatus then
SaveClip; SaveClip;
end; end;
function TPostScriptPrinterCanvas.GetClipping: Boolean; function TPostScriptPrinterCanvas.GetClipping: Boolean;
begin begin
Result:=FClipping; result := (pcsClipping in FStatus);
end; end;
procedure TPostScriptPrinterCanvas.SetClipping(const AValue: boolean); procedure TPostScriptPrinterCanvas.SetClipping(const AValue: boolean);
begin begin
if FClipping<>AValue then if GetClipping<>AValue then
begin begin
if FClipping then if GetClipping then
RestoreClip RestoreClip
else else
SaveClip; SaveClip;
FClipping := AValue; if AValue then
Include(FStatus, pcsClipping)
else
Exclude(FStatus, pcsClipping);
end; end;
end; end;