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

* Patches from Joellin to improve LCL export of fpreport: borders, linewidth, fonts

Browse Source 
git-svn-id: trunk@64939 -
This commit is contained in:
michael 2021-04-07 09:40:20 +00:00
parent 1cdf85def9
commit e89aceb58c
2 changed files with 34 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/fpreport/fpreportlclexport.pas
View File

@ -143,6 +143,7 @@ type
function CoordToRect(const APos: TFPReportPoint; const AWidth: TFPReportUnits=0; const AHeight: TFPReportUnits=0): TRect;
function HmmToPixels(const AValue: TFPReportUnits): Integer;
function VmmToPixels(const AValue: TFPReportUnits): Integer;
function PtToPixels(const AValue: Integer): Integer;
Function GetPageRect(APage : TFPReportCustomPage; WithoutMargin : Boolean = False) : TRect;
Function GetBandRect(L : TFPReportLayout;IncludeHandle: Boolean) : TRect;
Function GetBandRect(ABand : TFPReportCustomBand; IncludeHandle : Boolean) : TRect;
@ -172,11 +173,13 @@ type
const
cInchToMM = 25.4;
cPtToDPI = 72;
RGBA_Width = 4;
implementation
uses
fpTTF,
fpwritepng,
math;
@ -280,6 +283,15 @@ begin
Result := Round(AValue * (VDPI * Zoom/ cInchToMM));
end;
function TFPReportExportCanvas.PtToPixels(const AValue: Integer): Integer;
begin
// This is used for line widths and ideally should be individually
// calculated for every line angle as HDPI and VDPI differ on some
// printers. They do not differ greatly though (usually factor 2)
// so we get away with an average to keep things simple.
Result := Round(AValue * (((HDPI + VDPI) / 2) * Zoom / cPtToDPI));
end;
procedure TFPReportExportCanvas.SetupPageRender(const APage: TFPReportPage);
begin
@ -384,7 +396,7 @@ begin
begin
Canvas.Pen.Style:=AFrame.Pen;
Canvas.Pen.Color:= RGBtoBGR(AFrame.Color);
Canvas.Pen.Width:=AFrame.Width;
Canvas.Pen.Width:=PtToPixels(AFrame.Width);
end;
{$IFDEF DEBUGRD}
Writeln('Rendering frame [',AFrame.Shape,'] (',ARect.Left,',',ARect.Top,',',ARect.right,',',ARect.Bottom,') : ',(bStroke or bFill));
@ -456,6 +468,8 @@ Type
function TFPReportExportCanvas.GetFont(const AFontName: String): TFont;
Var
fontCached : TFPFontCacheItem;
fontStyles : TFontStyles;
ftFont : TFont;
begin
@ -465,6 +479,19 @@ begin
begin
ftFont:=TFont.create;
ftFont.Name:=AFontName;
fontCached := gTTFontCache.Find(AFontName);
if Assigned(fontCached) then
begin
// This still requires that the Font is available to the lcl back-end,
// custom fpTTF fonts are not implicitly available. E.g. on Windows a
// custom font would require the use of AddFontMemResourceEx() to
// make it available to GDI (and thus lcl Canvas).
ftFont.Name := fontCached.FamilyName;
fontStyles := [];
if fontCached.IsBold then Include(fontStyles, TFontStyle.fsBold);
if fontCached.IsItalic then Include(fontStyles, TFontStyle.fsItalic);
ftFont.Style := fontStyles;
end;
Result:=ftFont;
FFonts.Add(AFontName,Result);
end;
@ -764,7 +791,7 @@ begin
exit;
Canvas.Pen.Color:=TFPReportShape(AShape).Color;
Canvas.Pen.Style:=psSolid;
Canvas.Pen.Width:=1;
Canvas.Pen.Width:=PtToPixels(1);
lPt1.Left := BL.Left + SL.Left;
lPt1.Top := BL.Top + SL.Top;
case TFPReportShape(AShape).ShapeType of

5
components/fpreport/fpreportprinterexport.pas
View File

@ -110,6 +110,7 @@ Var
E : TFPReportExportCanvas;
I : Integer;
First : Boolean;
WorkRect : TRect;
begin
if ShowPrinterDialog then
@ -124,6 +125,10 @@ begin
E.Report:=Self.Report;
E.HDPI:=P.XDPI;
E.VDPI:=P.YDPI;
// Ignore printer specific borders
WorkRect := P.PaperSize.PaperRect.WorkRect;
E.HorzOffset:=-WorkRect.Left;
E.VertOffset:=-WorkRect.Top;
First:=true;
For I:=0 to ARTObjects.Count-1 do
if MustPrintPage(I+1) and Not P.Aborted then