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

LazReport, cut the objects that fall outside of page boundaries on preview window

Browse Source 
git-svn-id: trunk@49625 -
This commit is contained in:
jesus 2015-08-10 05:09:28 +00:00
parent c96d141c52
commit 4eaea7c197
1 changed files with 52 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/lazreport/source/lr_class.pas
View File

@ -8855,6 +8855,7 @@ var
sx, sy: Double;
v, IsPrinting: Boolean;
h: THandle;
oldRgn, pageRgn: HRGN;
begin
IsPrinting := Printer.Printing and (Canvas is TPrinterCanvas);
{$IFDEF DebugLR}
@ -8862,6 +8863,10 @@ begin
'CanvasPPI=%d',[ord(IsPrinting), Index, Canvas.ClassName,
Canvas.Font.pixelsPerInch]);
{$ENDIF}
pageRgn := 0;
oldRgn := CreateRectRgn(0, 0, 0, 0);
LCLIntf.GetClipRgn(Canvas.Handle, oldRgn);
try
DocMode := dmPrinting;
p := FPages[Index];
@ -8875,6 +8880,8 @@ begin
sx:=(DrawRect.Right-DrawRect.Left)/PrnInfo.PgW;
sy:=(DrawRect.Bottom-DrawRect.Top)/PrnInfo.PgH;
h:= Canvas.Handle;
pageRgn := CreateRectRgn(DrawRect.Left+1, DrawRect.Top+1, DrawRect.Right-1, DrawRect.Bottom-1);
LCLIntf.SelectClipRGN(Canvas.Handle, pageRgn);
for i := 0 to Page.Objects.Count - 1 do
begin
@ -8901,14 +8908,23 @@ begin
t.IsPrinting := IsPrinting;
t.Draw(Canvas);
end;
end;
LCLIntf.DeleteObject(pageRgn);
pageRgn := 0;
end
end
{ else
{ else
begin
Page.Free;
Page := nil;
end;}
end;
finally
if pageRgn<>0 then
LCLIntf.DeleteObject(pageRgn);
LCLIntf.SelectClipRGN(Canvas.Handle, oldRgn);
end;
end;
procedure TfrEMFPages.ExportData(Index: Integer);