Bug 2172: Directory tree does not adjust line height to custom panel font size

https://winscp.net/tracker/2172

Source commit: 3b44e1e4b5373fa49ac83f10b41b3e61c3404fd0

source/packages/filemng/CustomDriveView.pas

@@ -86,6 +86,7 @@ type
     procedure NeedImageLists(Recreate: Boolean);
     procedure DoCompare(Sender: TObject; Node1, Node2: TTreeNode; Data: Integer; var Compare: Integer);
     function DoCompareText(Text1, Text2: string): Integer;
+    procedure UpdateItemHeight;
 
     procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
     procedure CMColorChanged(var Msg: TMessage); message CM_COLORCHANGED;
@@ -97,6 +98,7 @@ type
     procedure WMContextMenu(var Msg: TWMContextMenu); message WM_CONTEXTMENU;
     procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
     procedure CMDPIChanged(var Message: TMessage); message CM_DPICHANGED;
+    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
 
     procedure Delete(Node: TTreeNode); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@@ -230,7 +232,7 @@ type
 implementation
 
 uses
-  SysUtils, ShellApi, ImgList, ActiveX,
+  SysUtils, ShellApi, ImgList, ActiveX, Math,
   IEListView, BaseUtils;
 
 constructor TCustomDriveView.Create(AOwner: TComponent);
@@ -306,9 +308,25 @@ begin
   inherited Destroy;
 end;
 
+procedure TCustomDriveView.UpdateItemHeight;
+var
+  ImageHeight: Integer;
+  TextHeight: Integer;
+begin
+  ImageHeight := (Images.Width * 9) div 8;
+  // 16 seems to be the system default tree view item height
+  TextHeight := ScaleByControlTextHeightRunTime(Canvas, 16);
+  TreeView_SetItemHeight(Handle, Max(ImageHeight, TextHeight));
+end;
+
+procedure TCustomDriveView.CMFontChanged(var Message: TMessage);
+begin
+  inherited;
+  UpdateItemHeight;
+end;
+
 procedure TCustomDriveView.NeedImageLists(Recreate: Boolean);
 var
-  MinHeight: Integer;
   AImages: TImageList;
 begin
   if not Assigned(Images) then
@@ -331,9 +349,7 @@ begin
     FImageList := OverlayImageList(Images.Width);
   end;
 
-  MinHeight := ScaleByTextHeight(Self, 18);
-  if TreeView_GetItemHeight(Handle) < MinHeight then
-    TreeView_SetItemHeight(Handle, MinHeight);
+  UpdateItemHeight;
 end;
 
 procedure TCustomDriveView.CMDPIChanged(var Message: TMessage);

source/packages/my/PasTools.pas

@@ -3,7 +3,7 @@ unit PasTools;
 interface
 
 uses
-  Windows, Types, Classes, ComCtrls, ExtCtrls, Controls, Dialogs, Forms, Messages;
+  Windows, Types, Classes, ComCtrls, ExtCtrls, Controls, Dialogs, Forms, Messages, Graphics;
 
 function Construct(ComponentClass: TComponentClass; Owner: TComponent): TComponent;
 
@@ -60,6 +60,7 @@ function SaveDefaultPixelsPerInch: string;
 
 function ScaleByTextHeight(Control: TControl; Dimension: Integer): Integer;
 function ScaleByTextHeightRunTime(Control: TControl; Dimension: Integer): Integer;
+function ScaleByControlTextHeightRunTime(Canvas: TCanvas; Dimension: Integer): Integer;
 
 function GetSystemMetricsForControl(Control: TControl; nIndex: Integer): Integer;
 
@@ -152,7 +153,7 @@ type
 implementation
 
 uses
-  SysUtils, StdCtrls, Graphics, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry;
+  SysUtils, StdCtrls, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry;
 
 const
   DDExpandDelay = 15000000;
@@ -393,7 +394,6 @@ type
   TFormHelper = class helper for TCustomForm
   public
     function RetrieveTextHeight: Integer;
-    function CalculateTextHeight: Integer;
   end;
 
 function TFormHelper.RetrieveTextHeight: Integer;
@@ -401,19 +401,18 @@ begin
   Result := Self.FTextHeight;
 end;
 
-function TFormHelper.CalculateTextHeight: Integer;
+function CalculateTextHeight(Canvas: TCanvas): Integer;
 begin
-  Result := Self.GetTextHeight;
+  // RTL_COPY (TCustomForm.GetTextHeight)
+  Result := Canvas.TextHeight('0');
 end;
 
-function ScaleByTextHeightImpl(Control: TControl; Dimension: Integer; TextHeight: Integer): Integer;
+function ScaleByTextHeightImpl(Canvas: TCanvas; Dimension: Integer; TextHeight: Integer): Integer; overload;
 var
-  Form: TCustomForm;
   NewTextHeight: Integer;
 begin
   // RTL_COPY (TCustomForm.ReadState)
-  Form := ValidParentForm(Control);
-  NewTextHeight := Form.CalculateTextHeight;
+  NewTextHeight := CalculateTextHeight(Canvas);
   if TextHeight <> NewTextHeight then
   begin
     Dimension := MulDiv(Dimension, NewTextHeight, TextHeight);
@@ -421,6 +420,15 @@ begin
   Result := Dimension;
 end;
 
+function ScaleByTextHeightImpl(Control: TControl; Dimension: Integer; TextHeight: Integer): Integer; overload;
+var
+  Form: TCustomForm;
+begin
+  // RTL_COPY (TCustomForm.ReadState)
+  Form := ValidParentForm(Control);
+  Result := ScaleByTextHeightImpl(Form.Canvas, Dimension, TextHeight);
+end;
+
 const
   OurDesignTimeTextHeight = 13;
 
@@ -457,7 +465,7 @@ end;
 
 procedure GetFormScaleRatio(Form: TForm; var M, D: Integer);
 begin
-  M := Form.CalculateTextHeight;
+  M := CalculateTextHeight(Form.Canvas);
   D := Form.RetrieveTextHeight;
 end;
 
@@ -468,6 +476,11 @@ begin
   Result := ScaleByTextHeightImpl(Control, Dimension, OurDesignTimeTextHeight);
 end;
 
+function ScaleByControlTextHeightRunTime(Canvas: TCanvas; Dimension: Integer): Integer;
+begin
+  Result := ScaleByTextHeightImpl(Canvas, Dimension, OurDesignTimeTextHeight);
+end;
+
 function GetSystemMetricsForControl(Control: TControl; nIndex: Integer): Integer;
 begin
   if Assigned(GetSystemMetricsForDpi) then