Ver Mensaje Individual
  #7  
Antiguo 20-04-2009
jconnor82 jconnor82 is offline
Miembro
 
Registrado: feb 2008
Posts: 22
Reputación: 0
jconnor82 Va por buen camino
No lo he probado pero antes de cargar el icono no se tendria q dar las dimensiones?.

Código Delphi [-]
  Icon.Width  := ImageList.Width;
  Icon.Height := ImageList.Height;
  Icon.LoadFromFile('icono48x48.ico');

La siguiente unidad tiene rutinas para trabajar con iconos e ImageList.

Código Delphi [-]
unit MclXPIcons;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Consts;

procedure AddIconFileToImageList(const FileName: string; IconIndex: Integer;
  const ImageList: TImageList);

function AddIconResourceToImageList(const ResourceName: string;
  const ImageList: TImageList): Integer; overload;

function AddIconResourceToImageList(Instance: Cardinal;
  const ResourceName: string; const ImageList: TImageList): Integer; overload;

function AddIconResourceToImageList(const FileName, ResourceName: string;
  const ImageList: TImageList): Integer; overload;

procedure ConvertTo32BitImageList(const ImageList: TImageList);

function GetFileIcon(const FileName: string; IconIndex: Integer): THandle;

implementation

uses
  ShellAPI, CommCtrl;

type
  PHICON = ^HICON;

function ExtractIconEx(lpszFile: PChar; nIconIndex: Integer;  phIconLarge,
  phIconSmall: PHICON; nIcons: UINT): UINT; stdcall; external shell32;

procedure ConvertTo32BitImageList(const ImageList: TImageList);
const
  Mask: array[Boolean] of Longint = (0, ILC_MASK);
var
  TempList: TImageList;
begin
  if Assigned(ImageList) then
  begin
    TempList := TImageList.Create(nil);
    try
      TempList.Assign(ImageList);
      with ImageList do
      begin
        Handle := ImageList_Create(Width, Height, ILC_COLOR32 or Mask[Masked],
          0, AllocBy);

        if not HandleAllocated then
          raise EInvalidOperation.Create(SInvalidImageList);
      end;

      ImageList.AddImages(TempList);
    finally
      FreeAndNil(TempList);
    end;
  end;
end;

function GetFileIcon(const FileName: string; IconIndex: Integer): THandle;
var
  IconHandle: HICON;
  IconCount: UINT;
begin
  IconHandle := 0;
  IconCount := ExtractIconEx(PChar(FileName), IconIndex, @IconHandle, nil, 1);
  if (IconCount > 0) and (IconHandle > 0) then
    Result := IconHandle
  else
    Result := 0;
end;

procedure AddIconFileToImageList(const FileName: string; IconIndex: Integer;
  const ImageList: TImageList);
var
  TempIcon: TIcon;
begin
  TempIcon := TIcon.Create;
  try
    TempIcon.Width  := ImageList.Width;
    TempIcon.Height := ImageList.Height;
    TempIcon.Handle := GetFileIcon(FileName, IconIndex);
    if (TempIcon.Handle > 0) then
    begin
      ImageList.AddIcon(TempIcon);
      DestroyIcon(TempIcon.Handle);
    end;
  finally
    FreeAndNil(TempIcon);
  end;
end;

function AddIconResourceToImageList(const ResourceName: string;
  const ImageList: TImageList): integer;
var
  TempIcon: TIcon;
begin
  Result := -1;

  TempIcon := TIcon.Create;
  try
    TempIcon.Width  := ImageList.Width;
    TempIcon.Height := ImageList.Height;
    TempIcon.Handle := LoadIcon(HInstance, PChar(ResourceName));
    if (TempIcon.Handle > 0) then
    begin
      Result := ImageList.AddIcon(TempIcon);
      DestroyIcon(TempIcon.Handle);
    end;
  finally
    FreeAndNil(TempIcon);
  end;
end;

function AddIconResourceToImageList(Instance: Cardinal;
  const ResourceName: string; const ImageList: TImageList): integer;
var
  TempIcon: TIcon;
begin
  Result := -1;

  TempIcon := TIcon.Create;
  try
    TempIcon.Width  := ImageList.Width;
    TempIcon.Height := ImageList.Height;
    TempIcon.Handle := LoadIcon(Instance, PChar(ResourceName));
    if (TempIcon.Handle > 0) then
    begin
      Result := ImageList.AddIcon(TempIcon);
      DestroyIcon(TempIcon.Handle);
    end;
  finally
    FreeAndNil(TempIcon);
  end;
end;

function AddIconResourceToImageList(const FileName, ResourceName: string;
  const ImageList: TImageList): Integer;
var
  Instance: Cardinal;
  TempIcon: TIcon;
begin
  Result := -1;

  if FileExists(FileName) then
  begin
    Instance := LoadLibrary(PChar(FileName));
    if (0 < Instance) then
      try
        TempIcon := TIcon.Create;
        try
          TempIcon.Width  := ImageList.Width;
          TempIcon.Height := ImageList.Height;
          TempIcon.Handle := LoadIcon(Instance, PChar(ResourceName));
          if (0 < TempIcon.Handle) then
          begin
            Result := ImageList.AddIcon(TempIcon);
            DestroyIcon(TempIcon.Handle);
          end;
        finally
          FreeAndNil(TempIcon);
        end;
      finally
        FreeLibrary(Instance);
      end;
  end;
end;

end.

PD: Despues de usar ConvertTo32BitImageList cargar los iconos.

Última edición por jconnor82 fecha: 20-04-2009 a las 16:47:05.
Responder Con Cita