uses Windows, Menus, ShellAPI, ImgList;
// Im OnCreate des Forms
// "GlobalImageList" ist hier eine Membervariable des Forms vom Typ "TImageList"
var
SHFileInfo: TSHFileInfo;
SysIcons : THandle;
begin
// Anderer Konstruktorcode
// Korrektes anzeigen der Iconliste gewährleisten
GlobalImageList := TImageList.Create(Self);
GlobalImageList.Masked := False;
try
SysIcons := SHGetFileInfo(PChar(Copy(ParamStr(0), 1, 3)), 0, SHFileInfo,
SizeOf(SHFileInfo), SHGFI_SYSICONINDEX
or SHGFI_SMALLICON
or
SHGFI_ICON);
finally
DestroyIcon(SHFileInfo.hIcon);
end;
GlobalImageList.Handle := SysIcons;
GlobalImageList.ShareImages := True;
end;
// Funktion, um den Index einer Dateierweiterung zu bekommen
function GetAssociatedIconIndex(
const AExtension:
string;
ASmall: Boolean): Integer;
var
Info: TSHFileInfo;
Flags: Cardinal;
begin
if ASmall
then
Flags := SHGFI_ICON
or SHGFI_SMALLICON
or SHGFI_USEFILEATTRIBUTES
else
Flags := SHGFI_ICON
or SHGFI_LARGEICON
or SHGFI_USEFILEATTRIBUTES;
if SHGetFileInfo(PChar(AExtension), FILE_ATTRIBUTE_NORMAL, Info,
SizeOf(TSHFileInfo), Flags) <> 0
then
begin
// Das Handle auf das Icon wird nicht benötigt!!
DestroyIcon(Info.hIcon);
// --------------------------------------------
Result := Info.iIcon;
end else Result := -1;
end;
// Ein Menuitem mit Index hinzufügen
var
NewMenu: TMenuItem;
begin
// ParentMenu.SubMenuImages := GlobalImageList;
// Menü hinzufügen, Caption setzen, ...
NewMenu.ImageIndex := GetAssociatedIconIndex('
.txt', True);
// z.B.
end;