× Components and Libraries for Reports Development, discussions, problems and suggestions

Question Some changes in fpreport

  • Klaus Riesterer
  • Klaus Riesterer's Avatar Topic Author
  • Offline
  • User is blocked
  • User is blocked
More
9 months 4 days ago #14195 by Klaus Riesterer
Some changes in fpreport was created by Klaus Riesterer
Thanks A.Fries the font width and height will be calculated correct when you use html-tags in report fields.
The new fpreport.pp is in attachment.

Chnages are:
Index: packages/fcl-report/src/fpreport.pp
===================================================================
--- packages/fcl-report/src/fpreport.pp	(revision 43561)
+++ packages/fcl-report/src/fpreport.pp	(working copy)
@@ -1944,9 +1944,11 @@
     function    PixelsToMM(APixels: single): single; inline;
     function    mmToPixels(mm: single): integer; inline;
     { Result is in millimeters. }
-    function    TextHeight(const AText: string; out ADescender: TFPReportUnits): TFPReportUnits;
+    function TextHeight(const AText, FontName: string; FontSize: Integer; out
+      ADescender: TFPReportUnits): TFPReportUnits;
     { Result is in millimeters. }
-    function    TextWidth(const AText: string): TFPReportUnits;
+    function TextWidth(const AText, FontName: string; FontSize: Integer
+      ): TFPReportUnits;
     procedure   SetLinkColor(AValue: TFPReportColor);
     procedure   SetTextAlignment(AValue: TFPReportTextAlignment);
     procedure   SetOptions(const AValue: TFPReportMemoOptions);
@@ -4467,8 +4469,8 @@
 
     FCurTextBlock.FontName := lNewFontName;
 
-    FCurTextBlock.Width := TextWidth(FCurTextBlock.Text);
-    FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, lDescender);
+    FCurTextBlock.Width := TextWidth(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size);
+    FCurTextBlock.Height := TextHeight(FCurTextBlock.Text,FCurTextBlock.FontName, Font.Size, lDescender);
     FCurTextBlock.Descender := lDescender;
 
     // get X offset from previous textblocks
@@ -4495,7 +4497,7 @@
   Result := Round(mm * (gTTFontCache.DPI / cMMperInch));
 end;
 
-function TFPReportCustomMemo.TextHeight(const AText: string; out ADescender: TFPReportUnits): TFPReportUnits;
+function TFPReportCustomMemo.TextHeight(const AText, FontName: string; FontSize: Integer; out ADescender: TFPReportUnits): TFPReportUnits;
 var
   lHeight: single;
   lDescenderHeight: single;
@@ -4502,12 +4504,11 @@
   lFC: TFPFontCacheItem;
 
 begin
-  // TODO: FontName might need to change to TextBlock.FontName.
-  lFC := gTTFontCache.FindFont(Font.Name); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
+  lFC := gTTFontCache.FindFont(FontName); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
   if not Assigned(lFC) then
-    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]);
+    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [FontName]);
   { Both lHeight and lDescenderHeight are in pixels }
-  lHeight := lFC.TextHeight(AText, Font.Size, lDescenderHeight);
+  lHeight := lFC.TextHeight(AText, FontSize, lDescenderHeight);
 
   { convert pixels to mm. }
   ADescender := PixelsToMM(lDescenderHeight);
@@ -4514,17 +4515,17 @@
   Result := PixelsToMM(lHeight);
 end;
 
-function TFPReportCustomMemo.TextWidth(const AText: string): TFPReportUnits;
+function TFPReportCustomMemo.TextWidth(const AText, FontName: string; FontSize: Integer): TFPReportUnits;
 var
   lWidth: single;
   lFC: TFPFontCacheItem;
 begin
   // TODO: FontName might need to change to TextBlock.FontName.
-  lFC := gTTFontCache.FindFont(Font.Name); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
+  lFC := gTTFontCache.FindFont(FontName); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
   if not Assigned(lFC) then
-    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]);
+    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [FontName]);
   { result is in pixels }
-  lWidth := lFC.TextWidth(AText, Font.Size);
+  lWidth := lFC.TextWidth(AText, FontSize);
 
   { convert pixels to mm. }
   Result := PixelsToMM(lWidth);
@@ -4644,8 +4645,8 @@
   try
     FCurTextBlock.Text := AText;
     FCurTextBlock.FontName := Font.Name;
-    FCurTextBlock.Width := TextWidth(FCurTextBlock.Text);
-    FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, lDescender);
+    FCurTextBlock.Width := TextWidth(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size);
+    FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size, lDescender);
     FCurTextBlock.Descender := lDescender;
 
     // get X offset from previous textblocks

File Attachment:

File Name: fpreport.p...2-19.zip
File Size:65 KB

Mint Cinnamon 19.3 / CT 7.1 / FPC/Lazarus
Attachments:

Please Log in or Create an account to join the conversation.

  • Sternas Stefanos
  • Sternas Stefanos's Avatar
  • Away
  • Moderator
  • Moderator
  • Ex Pilot, M.Sc, Ph.D
More
9 months 3 days ago #14199 by Sternas Stefanos
Replied by Sternas Stefanos on topic Some changes in fpreport
Thanks Sir
we will test and add to CT source

PilotLogic Architect and Core Programmer

Please Log in or Create an account to join the conversation.