Permalink
Browse files

Issue #213: scale main image list, by stretching icons and breaking t…

…heir alpha transparency
  • Loading branch information...
ansgarbecker committed Oct 24, 2018
1 parent 47de6d7 commit 198b89662a969625e38d17fd0c69ef65968aeecd
Showing with 46 additions and 1 deletion.
  1. +43 −1 source/apphelpers.pas
  2. +3 −0 source/main.pas
@@ -13,7 +13,8 @@ interface
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 @@ TAppSettings = class(TObject)
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 @@ function RunningAsUwp: Boolean;
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);
@@ -1606,6 +1606,7 @@ procedure TMainForm.FormCreate(Sender: TObject);
DonateCaptions: TStringList;
OldSnippetsDir, CurrentSnippetsDir, TargetSnippet: String;
Files: TStringDynArray;
DpiScaleFactor: Double;
begin
caption := APPNAME;
@@ -1616,6 +1617,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
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']);

1 comment on commit 198b896

@ansgarbecker

This comment has been minimized.

Collaborator

ansgarbecker commented on 198b896 Nov 1, 2018

That code does only ugly upscaling, so I just asked a question on Stackoverflow: https://stackoverflow.com/questions/53107726/scaling-timagelist-with-png-icons-for-high-dpi-mode

Please sign in to comment.