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

Question

我更喜欢48x48 .ico在popupmenu中显示。

如果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）为了避免丑陋的白边，请使用resoures中的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启用visualstyle平滑边缘。创建包含

以下内容的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);