View Issue Details

IDProjectCategoryView StatusLast Update
0036426PackagesLazReportpublic2019-12-11 20:14
ReporterMichal GawryckiAssigned To 
PrioritynormalSeverityminorReproducibilityhave not tried
Status newResolutionopen 
Product Version2.0.7 (SVN)Product Build 
Target VersionFixed in Version 
Summary0036426: Incorrect text height if default font is used.
DescriptionA multi-line Memo is not printed correctly when default system font is used (Font.Size = 0).
Patch attached.
TagsNo tags attached.
Fixed in Revision
LazTarget
WidgetsetWin32/Win64
Attached Files
  • lr_class_heightbug.patch (3,174 bytes)
    Index: components/lazreport/source/lr_class.pas
    ===================================================================
    --- components/lazreport/source/lr_class.pas	(revision 62333)
    +++ components/lazreport/source/lr_class.pas	(working copy)
    @@ -3704,6 +3704,8 @@
     end;
     
     procedure TfrCustomMemoView.AssignFont(aCanvas: TCanvas);
    +var
    +  fs: Integer;
     begin
       {$IFDEF DebugLR}
       DebugLnEnter('AssignFont (%s) INIT: Self.Font.Size=%d aCanvas.Font.Size=%d',
    @@ -3715,7 +3717,13 @@
         aCanvas.Font.Name := 'default';
       //Font := Self.Font;
       if not IsPrinting and (ScaleY<>0) then
    -    ACanvas.Font.Height := -Round(Self.Font.Size * 96 / 72 * ScaleY);
    +  begin
    +    if Self.Font.Size = 0 then
    +      fs := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
    +    else
    +      fs := Self.Font.Size;
    +    ACanvas.Font.Height := -Round(fs * 96 / 72 * ScaleY);
    +  end;
       {$IFDEF DebugLR}
       DebugLnExit('AssignFont (%s) DONE: Self.Font.Size=%d aCanvas.Font.Size=%d',
         [self.Font.Name,Self.Font.Size,ACanvas.Font.Size]);
    @@ -3988,7 +3996,11 @@
     begin
       WCanvas := TempBmp.Canvas;
       WCanvas.Font.Assign(Font);
    -  WCanvas.Font.Height := -Round(Font.Size * 96 / 72);
    +  if WCanvas.Font.Size = 0 then
    +    size := Round((-GetFontData(WCanvas.Font.Handle).Height * 72 / WCanvas.Font.PixelsPerInch))
    +  else
    +    size := WCanvas.Font.Size;
    +  WCanvas.Font.Height := -Round(size * 96 / 72);
       {$IFDEF DebugLR}
       DebugLnEnter('TfrMemoView.WrapMemo INI Font.PPI=%d Font.Size=%d Canvas.Font.PPI=%d WCanvas.Font.Size=%d',
         [Font.PixelsPerInch, Font.Size,Canvas.Font.PixelsPerInch,WCanvas.Font.Size]);
    @@ -4136,7 +4148,11 @@
         // calc our reference at 100% and then scale it
         // NOTE: this should not be r((Self.Font.Size*96/72 + LineSpacing)*ScaleY)
         //       as our base at 100% is rounded.
    -    thf := Round(Self.Font.Size*96/72 + LineSpacing)* ScaleY;
    +    if Self.Font.Size = 0 then
    +      i := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
    +    else
    +      i := Self.Font.Size;
    +    thf := Round(i*96/72 + LineSpacing)* ScaleY;
         // Corrects font height, that's the total line height minus the scaled linespacing
         Canvas.Font.Height := -Round(thf - LineSpc);
         {$IFDEF DebugLR}
    @@ -4211,7 +4227,11 @@
               x:=x+dx-VHeight;
           end;
           curx := x + InternalGapX;
    -      th := -Canvas.Font.Height + Round(LineSpacing * ScaleY);
    +      if Canvas.Font.Height = 0 then
    +        i := GetFontData(Canvas.Font.Reference.Handle).Height
    +      else
    +        i := Canvas.Font.Height;
    +      th := -i + Round(LineSpacing * ScaleY);
           CurStrNo := 0;
           for i := 0 to Memo1.Count - 1 do
             OutLine(Memo1[i]);
    @@ -4292,7 +4312,11 @@
       {$ENDIF}
       CalcRect := Rect(0, 0, dx, dy);
       Canvas.Font.Assign(Font);
    -  Canvas.Font.Height := -Round(Font.Size * 96 / 72);
    +  if Font.Size = 0 then
    +    n := Round((-GetFontData(Font.Handle).Height * 72 / Font.PixelsPerInch))
    +  else
    +    n := Font.Size;
    +  Canvas.Font.Height := -Round(n * 96 / 72);
       {$IFDEF DebugLR}
       DebugLn('Canvas.Font.PPI=%d Canvas.Font.Size=%d',[Canvas.Font.PixelsPerInch,Canvas.Font.Size]);
       {$ENDIF}
    
    lr_class_heightbug.patch (3,174 bytes)
  • lr_height_bug.png (14,007 bytes)
    lr_height_bug.png (14,007 bytes)

Activities

Michal Gawrycki

2019-12-11 20:14

reporter  

lr_class_heightbug.patch (3,174 bytes)
Index: components/lazreport/source/lr_class.pas
===================================================================
--- components/lazreport/source/lr_class.pas	(revision 62333)
+++ components/lazreport/source/lr_class.pas	(working copy)
@@ -3704,6 +3704,8 @@
 end;
 
 procedure TfrCustomMemoView.AssignFont(aCanvas: TCanvas);
+var
+  fs: Integer;
 begin
   {$IFDEF DebugLR}
   DebugLnEnter('AssignFont (%s) INIT: Self.Font.Size=%d aCanvas.Font.Size=%d',
@@ -3715,7 +3717,13 @@
     aCanvas.Font.Name := 'default';
   //Font := Self.Font;
   if not IsPrinting and (ScaleY<>0) then
-    ACanvas.Font.Height := -Round(Self.Font.Size * 96 / 72 * ScaleY);
+  begin
+    if Self.Font.Size = 0 then
+      fs := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
+    else
+      fs := Self.Font.Size;
+    ACanvas.Font.Height := -Round(fs * 96 / 72 * ScaleY);
+  end;
   {$IFDEF DebugLR}
   DebugLnExit('AssignFont (%s) DONE: Self.Font.Size=%d aCanvas.Font.Size=%d',
     [self.Font.Name,Self.Font.Size,ACanvas.Font.Size]);
@@ -3988,7 +3996,11 @@
 begin
   WCanvas := TempBmp.Canvas;
   WCanvas.Font.Assign(Font);
-  WCanvas.Font.Height := -Round(Font.Size * 96 / 72);
+  if WCanvas.Font.Size = 0 then
+    size := Round((-GetFontData(WCanvas.Font.Handle).Height * 72 / WCanvas.Font.PixelsPerInch))
+  else
+    size := WCanvas.Font.Size;
+  WCanvas.Font.Height := -Round(size * 96 / 72);
   {$IFDEF DebugLR}
   DebugLnEnter('TfrMemoView.WrapMemo INI Font.PPI=%d Font.Size=%d Canvas.Font.PPI=%d WCanvas.Font.Size=%d',
     [Font.PixelsPerInch, Font.Size,Canvas.Font.PixelsPerInch,WCanvas.Font.Size]);
@@ -4136,7 +4148,11 @@
     // calc our reference at 100% and then scale it
     // NOTE: this should not be r((Self.Font.Size*96/72 + LineSpacing)*ScaleY)
     //       as our base at 100% is rounded.
-    thf := Round(Self.Font.Size*96/72 + LineSpacing)* ScaleY;
+    if Self.Font.Size = 0 then
+      i := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
+    else
+      i := Self.Font.Size;
+    thf := Round(i*96/72 + LineSpacing)* ScaleY;
     // Corrects font height, that's the total line height minus the scaled linespacing
     Canvas.Font.Height := -Round(thf - LineSpc);
     {$IFDEF DebugLR}
@@ -4211,7 +4227,11 @@
           x:=x+dx-VHeight;
       end;
       curx := x + InternalGapX;
-      th := -Canvas.Font.Height + Round(LineSpacing * ScaleY);
+      if Canvas.Font.Height = 0 then
+        i := GetFontData(Canvas.Font.Reference.Handle).Height
+      else
+        i := Canvas.Font.Height;
+      th := -i + Round(LineSpacing * ScaleY);
       CurStrNo := 0;
       for i := 0 to Memo1.Count - 1 do
         OutLine(Memo1[i]);
@@ -4292,7 +4312,11 @@
   {$ENDIF}
   CalcRect := Rect(0, 0, dx, dy);
   Canvas.Font.Assign(Font);
-  Canvas.Font.Height := -Round(Font.Size * 96 / 72);
+  if Font.Size = 0 then
+    n := Round((-GetFontData(Font.Handle).Height * 72 / Font.PixelsPerInch))
+  else
+    n := Font.Size;
+  Canvas.Font.Height := -Round(n * 96 / 72);
   {$IFDEF DebugLR}
   DebugLn('Canvas.Font.PPI=%d Canvas.Font.Size=%d',[Canvas.Font.PixelsPerInch,Canvas.Font.Size]);
   {$ENDIF}
lr_class_heightbug.patch (3,174 bytes)
lr_height_bug.png (14,007 bytes)
lr_height_bug.png (14,007 bytes)

Issue History

Date Modified Username Field Change
2019-12-11 20:14 Michal Gawrycki New Issue
2019-12-11 20:14 Michal Gawrycki File Added: lr_class_heightbug.patch
2019-12-11 20:14 Michal Gawrycki File Added: lr_height_bug.png