Al parecer el problema es con la clase TIcon, sus dimensiones no superan la 32x32 o almenos no veo formar de cambiar ese limite, pero si se trabaja directamente con HICON no hay problema
Código Delphi
[-]
function GetFile48hIcon(const FileName: string; IconIndex: Integer = 0): HICON;
var
DeskTopISF: IShellFolder;
IExIcon: IExtractIcon;
PathPidl: PItemIDList;
hIconL, hIconS: HIcon;
begin
Result := 0;
if SHGetDesktopFolder(DeskTopISF) <> NOERROR then
Exit;
PathPidl := nil;
if DeskTopISF.GetUIObjectOf(0, 1, PathPidl, IID_IExtractIconA,
nil, IExIcon) <> NOERROR then
Exit;
if (IExIcon.Extract(PChar(FileName), IconIndex, hIconL, hIconS,
48 or (16 shl 16)) = NOERROR) and (hIconL <> 0) then
Result := hIconL;
DestroyIcon(hIconS);
end;
solo quedaria agregar la siguiente funcion:
Código Delphi
[-]
procedure AddIconFile48hToImageList(const FileName: string; IconIndex: Integer;
const ImageList: TImageList);
var
IconLarge: HICON;
begin
IconLarge := GetFile48hIcon(FileName, IconIndex);
if 0 < IconLarge then
begin
ImageList_AddIcon(ImageList.Handle, IconLarge);
DestroyIcon(IconLarge);
end;
end;
Webs de referencia:
DelphiZeus
HILPERS