瀏覽代碼

Issue 2374 – Directory tree indentation is scaled incorrectly when starting on scaled display on system with scaled primary monitor + Wrong icon size is used when starting on secondary monitor with different scaling than the primary one

https://winscp.net/tracker/2374
(cherry picked from commit f8dabcd9d025c8cede893dbc4319b0543071298e)

Source commit: 0436a71739dd8f976206cdcdcf2e617a7767523c
Martin Prikryl 5 月之前
父節點
當前提交
2d6d3c7fb1
共有 3 個文件被更改,包括 36 次插入9 次删除
  1. 2 0
      source/forms/CustomScpExplorer.cpp
  2. 24 8
      source/packages/filemng/CustomDriveView.pas
  3. 10 1
      source/packages/my/PasTools.pas

+ 2 - 0
source/forms/CustomScpExplorer.cpp

@@ -219,6 +219,8 @@ __fastcall TCustomScpExplorerForm::TCustomScpExplorerForm(TComponent* Owner):
   FHiContrastTheme = NULL;
   InitializeRemoteThumbnailMask();
 
+  GlyphsModule->PixelsPerInch = CurrentPPI;
+
   FEditorManager = new TEditorManager();
   FEditorManager->OnFileChange = ExecutedFileChanged;
   FEditorManager->OnFileReload = ExecutedFileReload;

+ 24 - 8
source/packages/filemng/CustomDriveView.pas

@@ -82,7 +82,7 @@ type
     function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
     function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
       Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override;
-    procedure NeedImageLists(Recreate: Boolean);
+    procedure NeedImageLists;
     procedure DoCompare(Sender: TObject; Node1, Node2: TTreeNode; Data: Integer; var Compare: Integer);
     function DoCompareText(Text1, Text2: string): Integer;
     procedure UpdateItemHeight;
@@ -98,6 +98,7 @@ type
     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 ChangeScale(M, D: Integer; isDpiChange: Boolean); override;
 
     procedure Delete(Node: TTreeNode); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@@ -326,24 +327,25 @@ begin
   UpdateItemHeight;
 end;
 
-procedure TCustomDriveView.NeedImageLists(Recreate: Boolean);
+procedure TCustomDriveView.NeedImageLists;
 var
   AImages: TImageList;
 begin
   if not Assigned(Images) then
   begin
     Images := TImageList.Create(Self);
-    Images.BkColor := Color;
   end;
 
   AImages := ShellImageListForControl(Self, ilsSmall);
   if Images.Handle <> AImages.Handle then
   begin
+    // When assigned directly (as in TCustomDirView), when moving from low to high DPI display,
+    // the images are resized vertically two times (thoguh originally, this approach was likely taken
+    // for different reasons)
     Images.Handle := AImages.Handle;
-  end;
+    Images.ShareImages := AImages.ShareImages;
+    Images.DrawingStyle := AImages.DrawingStyle;
 
-  if (not Assigned(FImageList)) or Recreate then
-  begin
     if Assigned(FImageList) then
       FImageList.Free;
 
@@ -356,7 +358,21 @@ end;
 procedure TCustomDriveView.CMDPIChanged(var Message: TMessage);
 begin
   inherited;
-  NeedImageLists(True);
+  NeedImageLists;
+end;
+
+procedure TCustomDriveView.ChangeScale(M, D: Integer; isDpiChange: Boolean);
+begin
+  inherited;
+  // WORKAROUND
+  // The Indent seems to be scaled by Windows.
+  // The TCustomTreeView.ChangeScale redundantly scales it again when Images.IsScaled
+  // (and we need Images.IsScaled, otherwise TCustomTreeView enables DPI [pixel] scaling)
+  // But we cannot just revert the scaling, because it is needed when DPI changes on runtime.
+  // (strangelly for plain tree view [e.g. navigation tree on preferences dialog, it works correctly,
+  // so it seems that Windows scales Ident on runtime only when the tree have images -
+  // what is confirmed by double scaling on Login dialog - so there we should do the same trick)
+  Indent := ScaleByCurrentPPI(19, Self);
 end;
 
 procedure TCustomDriveView.CreateWnd;
@@ -365,7 +381,7 @@ begin
 
   if DarkMode then AllowDarkModeForWindow(Self, DarkMode);
 
-  NeedImageLists(False);
+  NeedImageLists;
 
   if not (csDesigning in ComponentState) then
     FDragImageList := TDragImageList.Create(Self);

+ 10 - 1
source/packages/my/PasTools.pas

@@ -41,6 +41,7 @@ function DimensionToDefaultPixelsPerInch(Dimension: Integer): Integer;
 function ScaleByPixelsPerInch(Dimension: Integer; Monitor: TMonitor): Integer; overload;
 function ScaleByPixelsPerInch(Dimension: Integer; Control: TControl): Integer; overload;
 function ScaleByPixelsPerInchFromSystem(Dimension: Integer; Control: TControl): Integer;
+function ScaleByCurrentPPI(Dimension: Integer; Control: TControl): Integer;
 
 function LoadPixelsPerInch(S: string; Control: TControl): Integer;
 function SavePixelsPerInch(Control: TControl): string;
@@ -280,6 +281,7 @@ begin
   end;
 end;
 
+// Legacy, switch to TControl.CurrentPPI
 function GetControlPixelsPerInch(Control: TControl): Integer;
 var
   Form: TCustomForm;
@@ -359,6 +361,13 @@ begin
   Result := MulDiv(Dimension, GetControlPixelsPerInch(Control), Screen.PixelsPerInch);
 end;
 
+// Eventually, we should use this everywhere, instead of ScaleByPixelsPerInch.
+// The CurrentPPI is updated already at the beginning of ChangeScale, while PixelsPerInch only at the end.
+function ScaleByCurrentPPI(Dimension: Integer; Control: TControl): Integer;
+begin
+  Result := MulDiv(Dimension, Control.CurrentPPI, USER_DEFAULT_SCREEN_DPI);
+end;
+
 function LoadPixelsPerInch(S: string; Control: TControl): Integer;
 begin
   // for backward compatibility with version that did not save the DPI,
@@ -571,7 +580,7 @@ begin
     else Width := 0; Assert(False);
   end;
 
-  Width := ScaleByPixelsPerInch(Width, Control);
+  Width := ScaleByCurrentPPI(Width, Control);
 
   Result := ShellImageListForSize(Width);