Ver Mensaje Individual
  #10  
Antiguo 21-04-2009
jconnor82 jconnor82 is offline
Miembro
 
Registrado: feb 2008
Posts: 22
Reputación: 0
jconnor82 Va por buen camino
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

Última edición por jconnor82 fecha: 21-04-2009 a las 02:31:05.
Responder Con Cita