Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #7  
Antiguo 20-04-2009
jconnor82 jconnor82 is offline
Miembro
 
Registrado: feb 2008
Posts: 22
Poder: 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
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
ToolBar Paulao Varios 5 14-10-2008 22:47:49
Ayuda con ToolBar ManuelPerez Varios 0 05-03-2008 12:53:57
toolbar ercrizeporta Varios 3 17-09-2007 18:10:52
Problema con un toolbar mavm03 C++ Builder 6 02-10-2006 17:57:02
mover una toolbar Javi2 Varios 2 25-02-2005 18:56:57


La franja horaria es GMT +2. Ahora son las 02:04:06.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi