Welcome, Guest
Username: Password: Remember me
Components and Libraries for Reports Development, discussions, problems and suggestions
  • Page:
  • 1

TOPIC:

Some changes in fpreport 4 years 11 months ago #14195

  • Klaus Riesterer
  • Klaus Riesterer's Avatar Topic Author
  • Visitor
  • Visitor
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

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

Some changes in fpreport 4 years 11 months ago #14199

  • Sternas Stefanos
  • Sternas Stefanos's Avatar
  • Offline
  • Moderator
  • Moderator
  • Ex Pilot, M.Sc, Ph.D
  • Posts: 4537
  • Thank you received: 1115
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.

  • Page:
  • 1