delphi - 如何在运行时将 48x48 .ico 加载到图像列表中并保持透明度

Question

我更喜欢在弹出菜单中显示 48x48 .ico。

如果 BkColor 设置为 clNone，图标看起来很难看。 ImageList_GetIcon 也有一些丑陋的边缘。

如果BkColor设置为ClMenu，图标很漂亮，但是当突出显示时，图标有灰色背景。

ImageList_LoadImage 仅适用于 .bmp，因此无法使用。

ImageList1.BkColor := clMenu;
if FileExists(filename) then
begin
    //h := ImageList_LoadImage(0, PChar(filename), 48, 48, CLR_NONE, IMAGE_ICON, LR_LOADFROMFILE);
    h := LoadImage(0, PChar(filename), IMAGE_ICON, 48, 48, LR_LOADFROMFILE);
end
else
begin
    h := ImageList_GetIcon(ImageList1.Handle, 0, ILD_NORMAL);
end;
ImageList_AddIcon(ImageList1.Handle, h);
DeleteObject(h);

Answer 1

我现在找到了一些信息。

A) 要使用大于 32x32 的图标，我们必须使用 LoadImage 函数。

B) 为了避免难看的黑边，请在运行时使用 ImageList_Create 函数来使用 32 位 ImageList。

C) 为了避免难看的白边，请使用资源中的 LoadIcon 函数而不是设计时 ImageList。

procedure TForm1.LoadICO;
var
   i: Integer;
   h: HIcon;
   folder: string;
   filename: string;
begin
   folder := GetCurrentDir + '\icon\';

   {To support alpha transparency, you need to create the ImageList and populate it at runtime}
   ImageList1.Handle := ImageList_Create(48, 48, ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);

   /////////////////////////////////////////////////////////////

   filename := folder + ParamStr(i);

   if FileExists(filename) then
   begin
            //h := ImageList_LoadImage(0, PChar(filename), 48, 48, CLR_NONE, IMAGE_ICON, LR_LOADFROMFILE);   
            {ImageList_LoadImage function work only IMAGE_BITMAP}
            h := LoadImage(0, PChar(filename), IMAGE_ICON, 48, 48, LR_LOADFROMFILE);                       
            {LoadImage function work with icon bigger than 32x32}
   end
   else
   begin
            //h := ImageList_GetIcon(ImageList3.Handle, 1, ILD_NORMAL);                                    
            {Ugly when get icon from designtime ImageList}
            h := LoadIcon(hInstance, 'ICO1');                                                              
            {Pretty when load icon from resources}
   end;

   /////////////////////////////////////////////////////////////

   ImageList_AddIcon(ImageList1.Handle, h);
   DeleteObject(h);
end; 

D) 为了避免难看的黑边，还可以使用 comctl32.dll v6 启用视觉样式平滑边缘。创建 xxx.exe.manifest 文件，内容如下

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<dependency>
    <dependentAssembly>
        <assemblyIdentity
            type="win32"
            name="Microsoft.Windows.Common-Controls"
            version="6.0.0.0"
            processorArchitecture="*"
            publicKeyToken="6595b64144ccf1df"
            language="*"
        />
    </dependentAssembly>
</dependency>
</assembly>

E) 分配命令也会使白色边缘变得难看。使用For循环和ImageList_ReplaceIcon函数效果更好。

//ImageList3.Assign(ImageList1);  {Assign command make ugly white edge}
h := ImageList_GetIcon(ImageList1.Handle, i, ILD_NORMAL);
ImageList_ReplaceIcon(ImageList3.Handle, i, h);
DeleteObject(h);