Imagelist with alpha blend icons loses Transparency

问题

Here is (more or less) a related question: Delphi - Populate an imagelist with icons at runtime 'destroys' transparency.

I have tested @TOndrej answer. But it seems I need to have visual styles (XP Manifest) enabled for this to work (version 6.0 of Windows common controls will be used - which I don't want right now). I add the Icons at run-time via ExtractIconEx and ImageList_AddIcon.

Apparently setting ImageList.Handle to use System Image-List handle, does not require XP Manifest. so even an old program I wrote back in D3 is showing up with alpha blended icons correctly when I use the System image list to display file listing (with a TListView).

I was wandering What is special about the System Image List and how is it created, so that it supports alpha blending in all cases? I can't figure that out. Here is some sample code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls, ShellAPI, ExtCtrls, Commctrl;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FileName: string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// {$R WindowsXP.res}

procedure TForm1.FormCreate(Sender: TObject);
begin
  PopupMenu1.Images := ImageList1;
  FileName := 'C:\Program Files\Mozilla Firefox\firefox.exe';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IconPath: string;
  IconIndex: Integer;
  hIconLarge, hIconSmall: HICON;
begin
  IconPath := FileName;
  IconIndex := 0; // index can be other than 0

  ExtractIconEx(PChar(IconPath), IconIndex, hIconLarge, hIconSmall, 1);

  Self.Refresh; // erase form
  DrawIconEx(Canvas.Handle, 10, 10, hIconSmall, 0, 16, 16, 0,
    DI_IMAGE or DI_MASK); // this will draw ok on the form

  // ImageList1.DrawingStyle := dsTransparent;
  ImageList1.Handle := ImageList_Create(ImageList1.Width, ImageList1.Height,
    {ILC_COLORDDB} ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
  ImageList_AddIcon(ImageList1.Handle, hIconSmall);

  MenuItem1.ImageIndex := 0;

  DestroyIcon(hIconSmall);
  DestroyIcon(hIconLarge);

  PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;

procedure TForm1.Button2Click(Sender: TObject);
// using sys image-list will work with or without Manifest
type
  DWORD_PTR = DWORD;
var
  ShFileINfo :TShFileInfo;
  SysImageList: DWORD_PTR;
  FileName: string;
begin
  SysImageList := ShGetFileInfo(nil, 0, ShFileInfo, SizeOf(ShFileInfo),
    SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);

  if SysImageList = 0 then Exit;
  ImageList1.Handle := SysImageList;
  ImageList1.ShareImages := True;

  if ShGetFileInfo(PChar(FileName), 0, ShFileInfo, SizeOf(ShFileInfo),
    SHGFI_SYSICONINDEX OR SHGFI_ICON OR SHGFI_SMALLICON) <> 0 then
  begin
    MenuItem1.ImageIndex := ShFileInfo.IIcon;
    Self.Refresh; // erase form
    DrawIconEx(Canvas.Handle, 10, 10, ShFileInfo.hIcon, 0, 16, 16, 0,
      DI_IMAGE or DI_MASK);
    DestroyIcon(ShFileInfo.hIcon); // todo: do I need to destroy here? 

    PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
  end;      
end;

end.

Visual Styles Disabled:

Visual Styles Enabled:

A Workaround is to use interposer class or subclass TImageList and override DoDraw as shown here, but what I really want to know is how to create my image list same as system Image list.

Note: I know about TPngImageList and don't want to use it in this case.

Edit: @David's answer (and comments) were accurate:

You'll have to explicitly link to ImageList_Create (v6) because otherwise it is implicitly linked at module load time and will be bound to v5.8

Sample code (no use of activation context API):

function ImageList_Create_V6(CX, CY: Integer; Flags: UINT; Initial, Grow: Integer): HIMAGELIST;
var
  h: HMODULE;
  _ImageList_Create: function(CX, CY: Integer; Flags: UINT;
    Initial, Grow: Integer): HIMAGELIST; stdcall;
begin
  // TODO: find comctl32.dll v6 path programmatically
  h := LoadLibrary('C:\WINDOWS\WinSxS\x86_Microsoft.Windows.Common-Controls_6595b64144ccf1df_6.0.2600.5512_x-ww_35d4ce83\comctl32.dll');
  if h <> 0 then
  try
    _ImageList_Create := GetProcAddress(h, 'ImageList_Create');
    if Assigned(_ImageList_Create) then
      Result := _ImageList_Create(CX, CY, Flags, Initial, Grow);
  finally
    FreeLibrary(h);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ...
  ImageList1.Handle := ImageList_Create_V6(ImageList1.Width, ImageList1.Height,
    ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
  ...
end;

Edi2: A sample code by @David that shows how it's done correctly via Activation Context API.

回答1:

There are two versions of the image list controls. The v5.8 version and the v6 version. The system image list is a shared coonent owned by the system and uses the v6 version. It's not special in any other way, it's just a plain v6 images list. In your app, your image list is either v5.8 or v6 depending on whether or not you include the manifest. But the system owned image list is always v6.

I don't know why you don't want to use v6 common controls in your app. But with that constraint you could use the activation context API to locally use v6 common controls just while you create your image list. That would solve your problem and leave the rest of your app with v5.8 common controls.

来源：https://stackoverflow.com/questions/9936518/imagelist-with-alpha-blend-icons-loses-transparency

标签

Delphi

delphi-7

delphi-5

imagelist

common-controls