这里有一个相关的问题:Delphi - Populate an imagelist with icons at runtime 'destroys' transparency。
我已经测试了@TOndrej的答案。但似乎我需要启用视觉样式(XP清单),才能使此方法起作用(将使用Windows公共控件版本6.0,但我现在不想要)。我通过ExtractIconEx
和ImageList_AddIcon
在运行时添加图标。
显然,设置ImageList.Handle
使用系统图像列表句柄,并不需要XP清单。因此,即使是我在D3中编写的旧程序,在使用系统图像列表显示文件列表(带有TListView
)时,也可以正确地显示具有Alpha混合的图标。
我在思考系统图像列表有什么特别之处,以及它是如何创建的,以便在所有情况下都支持Alpha混合?我无法弄清楚。这里是一些示例代码:
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.
关闭视觉样式:
启用视觉样式:
解决方法是使用拦截器类或子类TImageList
并覆盖DoDraw
,如此所示,但我真正想知道的是如何创建与系统图像列表相同的图像列表。
注意:我知道TPngImageList
,但在这种情况下不想使用它。
编辑: @David的答案(和评论)是准确的:
你必须显式链接到ImageList_Create(v6),否则它会在模块加载时隐式链接,并绑定到v5.8
示例代码(不使用激活上下文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: 通过激活上下文API,David提供的示例代码展示了正确的实现方法。
if IsLibrary then
这一行,但我不明白如何在我的EXE中实现它。特别是这两行代码:ActCtx.dwFlags := ACTCTX_FLAG_RESOURCE_NAME_VALID or ACTCTX_FLAG_HMODULE_VALID;
和ActCtx.lpResourceName := MakeIntResource(2);
- kobikImageList_Create
,否则它会在模块加载时隐式链接并绑定到 v5.8。我不能说我曾经尝试过这个。这不是一个完全琐碎的工作。你需要在调试器(例如msdepends或者process explorer)下仔细观察,并确保你正在加载v6 comctl。 - David Heffernan