Как загрузить 48x48 .ico во время выполнения в список изображений и сохранить прозрачность

Я предпочитаю 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);

1 ответ

Я нашел некоторую информацию сейчас.

A) Чтобы использовать иконку большего размера, чем 32x32, мы должны использовать функцию LoadImage.

Б) Чтобы избежать уродливого черного края, используйте 32-битный ImageList, используя функцию ImageList_Create во время выполнения.

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);
Другие вопросы по тегам