瀏覽代碼

retina scaling for image browser

Johann ELSASS 5 年之前
父節點
當前提交
c1493a949a
共有 2 個文件被更改,包括 21 次插入0 次删除
  1. 13 0
      lazpaint/dialog/ubrowseimages.pas
  2. 8 0
      lazpaint/umyslv.pas

+ 13 - 0
lazpaint/dialog/ubrowseimages.pas

@@ -269,6 +269,7 @@ begin
   FChosenImage := TImageEntry.Empty;
 
   DarkThemeInstance.Apply(ComboBox_FileExtension, False, 0.40);
+  vsList.BitmapAutoScale:= false;
 
   bmp := TBitmap.Create;
   ImageList128.GetBitmap(0,bmp);
@@ -339,6 +340,7 @@ procedure TFBrowseImages.FormHide(Sender: TObject);
 begin
   FCacheComputeIconIndexes := nil;
   StopCaching(true);
+  BGRAThumbnail.CheckersScale:= 1;
 
   FLastBigIcon := (ShellListView1.ViewStyle = vsIcon);
   if not IsSaveDialog then FFilename:= FPreviewFilename;
@@ -385,6 +387,17 @@ var r:TRect; i: integer;
 begin
   if FInFormShow then exit;
   FInFormShow:= true;
+
+  BGRAThumbnail.CheckersScale:= GetCanvasScaleFactor;
+  ShellListView1.FontHeight:= ScaleY(round(13*GetCanvasScaleFactor),OriginalDPI);
+  ShellListView1.SmallIconSize := round(ScaleX(round(64*GetCanvasScaleFactor),OriginalDPI)/16)*16;
+  if ShellListView1.SmallIconSize > 128 then
+    ShellListView1.SmallIconSize := 128;
+  ShellListView1.LargeIconSize:= ShellListView1.SmallIconSize*2;
+  if ShellListView1.LargeIconSize > 192 then
+    ShellListView1.LargeIconSize := 192;
+  ShellListView1.DetailIconSize:= ShellListView1.SmallIconSize;
+
   ListBox_RecentDirs.Clear;
   for i := 0 to LazPaintInstance.Config.RecentDirectoriesCount-1 do
     ListBox_RecentDirs.Items.Add(LazPaintInstance.Config.RecentDirectory[i]);

+ 8 - 0
lazpaint/umyslv.pas

@@ -59,6 +59,7 @@ type
     FVerticalScrollPos: integer;
     FWantedItemVisible: integer;
     FItemsPerPage: integer;
+    FScaling: single;
     { Setters and getters }
     function GetColumnCount: integer;
     function GetHeight: integer;
@@ -701,6 +702,7 @@ begin
   ABitmap.FontHeight := FontHeight;
   ABitmap.FontQuality := fqSystemClearType;
   FActualRowHeight:= MinimumRowHeight;
+  FScaling := (Sender as TControl).GetCanvasScaleFactor;
   textHeight := ABitmap.FontFullHeight+2;
   if textHeight > FActualRowHeight then FActualRowHeight:= textHeight;
 
@@ -852,6 +854,8 @@ procedure TLCShellListView.MouseDown(Sender: TObject; Button: TMouseButton;
 var i,idx, prevIdx:integer;
   keepSelection, selChanged:boolean;
 begin
+  X := round(X*FScaling);
+  Y := round(Y*FScaling);
   SetFocus;
   for i := 0 to ColumnCount-1 do
     if PtInRect(Point(x,y),FColumns[i].displayRect) then
@@ -928,6 +932,8 @@ end;
 procedure TLCShellListView.MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
 begin
+  X := round(X*FScaling);
+  Y := round(Y*FScaling);
   if Assigned(FVScrollBar) then
     if FVScrollBar.MouseMove(X,Y) then
     begin
@@ -939,6 +945,8 @@ end;
 procedure TLCShellListView.MouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
+  X := round(X*FScaling);
+  Y := round(Y*FScaling);
   if Assigned(FVScrollBar) and (Button = mbLeft) then
     if FVScrollBar.MouseUp(X,Y) then
     begin