From 198b89662a969625e38d17fd0c69ef65968aeecd Mon Sep 17 00:00:00 2001
From: Ansgar Becker <anse@heidisql.com>
Date: Wed, 24 Oct 2018 21:22:54 +0200
Subject: [PATCH] Issue #213: scale main image list, by stretching icons and
 breaking their alpha transparency

---
 source/apphelpers.pas | 44 ++++++++++++++++++++++++++++++++++++++++++-
 source/main.pas       |  3 +++
 2 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/source/apphelpers.pas b/source/apphelpers.pas
index 868aa7cf..2c49edf7 100644
--- a/source/apphelpers.pas
+++ b/source/apphelpers.pas
@@ -13,7 +13,8 @@ uses
   Windows, ShlObj, ActiveX, VirtualTrees, SynRegExpr, Messages, Math,
   Registry, DateUtils, Generics.Collections, StrUtils, AnsiStrings, TlHelp32, Types,
   dbconnection, mysql_structures, SynMemo, Menus, WinInet, gnugettext, Themes,
-  Character, ImgList, System.UITypes, ActnList, WinSock, IOUtils, StdCtrls, ComCtrls;
+  Character, ImgList, System.UITypes, ActnList, WinSock, IOUtils, StdCtrls, ComCtrls,
+  CommCtrl;
 
 type
 
@@ -346,6 +347,7 @@ type
   function GetCurrentPackageFullName(out Len: Cardinal; Name: PWideChar): Integer; stdcall; external kernel32 delayed;
   function GetUwpFullName: String;
   function RunningAsUwp: Boolean;
+  procedure ScaleImageList(const ImgList: TImageList; ScaleFactor: Real);
 
 var
   AppSettings: TAppSettings;
@@ -2937,6 +2939,46 @@ begin
 end;
 
 
+procedure ScaleImageList(const ImgList: TImageList; ScaleFactor: Real);
+var
+  i: Integer;
+  Extracted, Scaled: Graphics.TBitmap;
+  ImgListCopy: TImageList;
+begin
+  if ScaleFactor = 1 then
+    Exit;
+
+  // Create copy of original image list
+  ImgListCopy := TImageList.Create(nil);
+  ImgListCopy.ColorDepth := cd32Bit;
+  ImgListCopy.DrawingStyle := dsTransparent;
+  ImgListCopy.Clear;
+
+  // Add from source image list
+  for i := 0 to ImgList.Count-1 do begin
+    ImgListCopy.AddImage(ImgList, i);
+  end;
+
+  // Set size to match scale factor
+  ImgList.SetSize(Round(ImgList.Width * ScaleFactor), Round(ImgList.Height * ScaleFactor));
+
+  for i:= 0 to ImgListCopy.Count-1 do begin
+    Extracted := Graphics.TBitmap.Create;
+    ImgListCopy.GetBitmap(i, Extracted);
+    Scaled := Graphics.TBitmap.Create;
+    Scaled.Width := ImgList.Width;
+    Scaled.Height := ImgList.Height;
+    Scaled.Canvas.FillRect(Scaled.Canvas.ClipRect);
+    GraphUtil.ScaleImage(Extracted, Scaled, ScaleFactor);
+    ImgList.Add(Scaled, Scaled);
+  end;
+
+  ImgListCopy.Free;
+
+end;
+
+
+
 { Threading stuff }
 
 constructor TQueryThread.Create(Connection: TDBConnection; Batch: TSQLBatch; TabNumber: Integer);
diff --git a/source/main.pas b/source/main.pas
index ca99dfd4..1c0e0880 100644
--- a/source/main.pas
+++ b/source/main.pas
@@ -1606,6 +1606,7 @@ var
   DonateCaptions: TStringList;
   OldSnippetsDir, CurrentSnippetsDir, TargetSnippet: String;
   Files: TStringDynArray;
+  DpiScaleFactor: Double;
 begin
   caption := APPNAME;
 
@@ -1616,6 +1617,8 @@ begin
   TP_GlobalIgnoreClass(TFont);
   TranslateComponent(Self);
   FixDropDownButtons(Self);
+  DpiScaleFactor := Monitor.PixelsPerInch / PixelsPerInch;
+  ScaleImageList(ImageListMain, DpiScaleFactor);
   MainMenu1.Images := ImageListMain;
   // Translate menu items
   menuQueryHelpersGenerateSelect.Caption := f_('Generate %s ...', ['SELECT']);