Iconos con transperencia en ToolBar

[Chandra_]

Hola. Me estoy volviendo loco: pongo una ToolBar en el form, le enlazo un ImageList con unas imágenes con transparencias (sacadas de iconos similares a los de XP y Vista) y el ToolButton me "recorta" la transparencia, dejando unos feísimos dientes de sierra.

¿Hay alguna forma de que conserve las transparencias de los bordes para que se vea suave?

He probado a recuperar la misma imagen .ico en un TImage, ponerle Transparent a True y ponerle detrás otro TImage. Resultado: conserva todas las transparencias (sombras, degradado del borde, etc...).

Además, se nota mucho lo del ToolBar, porque tiene el fondo degradado en negro-gris y resaltan los disntes de sierra del borde de la imagen.

¿Alguna idea? Aunque... no tengo mucha esperanza, porque veo que también lo hace en las pestañas de los PageControl si le meter iconos con bordes difuminados.

Adjunto una imagen para ilustrarlo.

1551

Ah, lo olvidaba, uso Delphi 2007 for win32

[look]

Hola. Me estoy volviendo loco: pongo una ToolBar en el form, le enlazo un ImageList con unas imágenes con transparencias (sacadas de iconos similares a los de XP y Vista) y el ToolButton me "recorta" la transparencia, dejando unos feísimos dientes de sierra.

¿Hay alguna forma de que conserve las transparencias de los bordes para que se vea suave?

He probado a recuperar la misma imagen .ico en un TImage, ponerle Transparent a True y ponerle detrás otro TImage. Resultado: conserva todas las transparencias (sombras, degradado del borde, etc...).

Además, se nota mucho lo del ToolBar, porque tiene el fondo degradado en negro-gris y resaltan los disntes de sierra del borde de la imagen.

¿Alguna idea? Aunque... no tengo mucha esperanza, porque veo que también lo hace en las pestañas de los PageControl si le meter iconos con bordes difuminados.

Adjunto una imagen para ilustrarlo.

1551

Ah, lo olvidaba, uso Delphi 2007 for win32

lo que hago en estos casos es utilizar el componente PNGButton, y utilizo imagenes png , queda muy bien, de otra manera va a ser muy dificil obterner el efecto que quieres..:)

[Chandra_]

lo que hago en estos casos es utilizar el componente PNGButton, y utilizo imagenes png , queda muy bien, de otra manera va a ser muy dificil obterner el efecto que quieres..:)

Pues sí... estoy viendo que voy a tener que hacerme algún apaño de esos :( , porque Delphi (al menos, la versión 2007), no respeta transparencias cuando vienen de un ImageList. Lo malo es que hay componentes, como la ToolBar de la que hablo, o los PageControl, que no tienen "recambio". La única solución es usar iconos pequeñitos para que pase desapercibida la chapuza de los bordes.

Es una pena, porque otros IDEs parece que sí lo permiten (cualquier programa de VisualStudio).

[Chandra_]

Al final lo he solucionado :)

Pego a continuación el código, por si a alguien le sirve. Hace falta un ImageList vacío y hay que asignar ese ImageList al componente(es) que queremos que tenga las imágenes. No olvidéis meter en uses CommCtrl y Consts, que si no, se quejará amargamente.

procedure TForm1.ConvertTo32BitImageList(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;

...y así se usa (lo he metido en el evento OnClick de un Button, para probarlo, pero iría, por ejemplo, en el FormCreate):

procedure TForm1.Button1Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.LoadFromFile('icono.ico');
ImageList1.AddIcon(Ico);
Ico.LoadFromFile('otroicono.ico');
ImageList1.AddIcon(Ico);
finally
Ico.Free;
end;

Según he averiguado, es un viejo problema del ImageList y sólo se soluciona como he hecho más arriba: cargando en tiempo de ejecución las imágenes en el ImageList a trabés de un TIcon (porque los TIcon mantienen el canal alfa de las imágenes) y luego pasándoselas a nuestro ImageList, que está enlazado a los componentes.

Pues eso, que funciona perfectamente... pero hay un problemilla que estoy tratando de solucionar ahora mismo: no me funciona con imágenes mayores de 32x32, me da un error de tamaño incompatible. He trazado el programa y el error aparece cuando se trata de cargar la imagen de 48x48 en el TIcon. He tratado de cambiarle el Height y el Width tras crearlo, pero ni caso... También he estado investigando a ver si puedo especificar el tamaño del TIcon en el mismo constructor, pero no hay manera.

En fin, si alguien se anima a echarle un vistazo, se lo agradeceré :)

[Chandra_]

¿Es que un TIcon no puede ser más grande de 32x32? Es que lo estoy intentando con todos los tamaños y el error de tamaño no válido me lo da cuando salto de 32x32 a 48x48. 16x16 va también sin problemas :confused:

Por supuesto, cada vez que cambio el tamaño del archivo de icono, pongo también ese mismo tamaño en el Height y el Width del ImageList1. Pero nada... el TIcon se atranca en 48x48... :(

ACTUALIZACIÓN: Acabo de probar a 33x33 y no funciona. El límite del TIcon está en 32x32. A ver cómo me las ingenio yo ahora para pasarle la imagen al ImageList, que sólo acepta bitmaps (inútiles parta este propósito, pues no tienen canal alfa) e imágenes tipo TIcon...

ACTUALIZACIÓN2: Pues me he equivocado:rolleyes: . Dónde falla es una línea más abajo:

ImageList1.AddIcon(Ico);

Es decir, al asignar el TIcon al ImageList es cuando salta el error de "Invalid Image Size". Y no lo entiendo, porque tengo el ImageList1 en 48x48 en las propiedades Width y Height del Object Inspector. O sea, que debe ser la procedure ConvertTo32BitImageList la que joroba esos valores...

ACTUALIZACIÓN 3: ¡Quito el salto a la procedure y sigue fallando! Me estoy volviendo loco :eek: :confused: No entiendo nada

ACTUALIZACIÓN 4: Delphi se está cachondeando de mi:

A) meto un TrayIcon en el formulario (por aquello de que tiene un TIcon como imagen, que es compatible con el tipo de imagen del ImageList), lo cargo con un icono de 48x48, le asigno el contenido de la imagen del TrayIcon al ImageList (en lugar de hacer lo de "Ico.LoadFromFile('icono.ico');", y me dice lo de siempre: "Invalid Image Size" (¡¿por qué, si el TrayIcon lo ha aceptado?!).

B) Me doy cuenta de que los TrayIcon tienen la propiedad Visible en False... la pongo en True, por si acaso, y ahora... FUNCIONA (¡¡¡¿¿¿Por qué???!!!). La solución, obviamente, nome sirve de nada: no puedo llenar la pantalla del usuario de iconos de notificación para hacer mi chapuza con el ImageList...

C) Me voy a la cama

[Chandra_]

Esto funciona con iconos de 48x48 (es ABSURDO, pero funciona):

procedure TForm1.Button1Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.LoadFromFile('icono48x48.ico');
// ImageList1.AddIcon(Ico); <--- aquí falla
TrayIcon1.Icon := Ico;
ImageList1.AddIcon(TrayIcon1.Icon);
finally
Ico.Free;
end;

Si pongo lo siguiente, deja de funcionar y vuelve con la chorrada del tamaño:

procedure TForm1.Button1Click(Sender: TObject);
begin
ConvertTo32BitImageList(ImageList1);
TrayIcon1.Icon.LoadFromFile('icono48x48.ico');
ImageList1.AddIcon(TrayIcon1.Icon);
end;

[jconnor82]

No lo he probado pero antes de cargar el icono no se tendria q dar las dimensiones?.


Icon.Width := ImageList.Width;
Icon.Height := ImageList.Height;
Icon.LoadFromFile('icono48x48.ico');


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


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.

[Chandra_]

Gracias por tu tiempo, jconnor82.

No lo he probado pero antes de cargar el icono no se tendria q dar las dimensiones?.

Pues tampoco funciona. A continuación tienes el código con las líneas que propones y... sigue dando el mismo mensaje de error:

Proyect Proyect1.exe raised exception class EInvalidOperation with message 'Invalid Image Size'


procedure TForm1.Button2Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.Width := ImageList1.Width;
Ico.Height := ImageList1.Height;
Ico.LoadFromFile('icono48x48.ico');
ImageList1.AddIcon(Ico); // <--- aquí salta de nuevo el error
finally
Ico.Free;
end;
end;


Lo curioso es que lo siguiente no falla, pero, aunque el Height y el Width del ImageList los pongo en tiempo de diseño en 48 (lo juro), el icono final lo reconvierte a 32x32 y sin canal alfa


procedure TForm1.Button2Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.Width := 48;
Ico.Height := 48; //esto se lo pasa Delphi por las narices: el Ico sigue a 32x32
Ico.LoadFromFile('icono48x48.ico');

Label1.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));
ImageList1.Width := Ico.Width;
Label2.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));

Label3.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));
ImageList1.Height := Ico.Height;
Label4.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));

ImageList1.AddIcon(Ico);
finally
Ico.Free;
end;
end;


También da error si el ImageList no está vacío, y está ya precargado con un icono 48x48 (es decir, si por co**nes el ImageList está a 48x48).

¿Por qué sí se puede hacer si carcas el icono a través de un TrayIcon? No sé... misterios insondables de Delphi

CONCLUSIÓN: Los TIcon, según les pilla, no aceptam iconos de más de 32x32. Es decir, si le van a pasar el icono a un TrayIcon, se lo pasan de 48x48 sin despeinarse; si el que recibe es un ImageList... se vuelven tontos y dicen que el icono es de 32x32

Se pueden "cazar" fácilmente las gamberradas de Delphi en el siguiente código con 4 TLabel:


//Funciona, pero dibuja iconos 32x32 sin canal alfa
procedure TForm1.Button2Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.Width := 48;
Ico.Height := 48;
Ico.LoadFromFile('browser.ico');

//salida de label1: ImageList1.Width: 48; Ico.Width: 32
Label1.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));
ImageList1.Width := Ico.Width;
//salida de label2: ImageList1.Width: 32; Ico.Width: 32
Label2.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));

//salida de label3: ImageList1.Height: 48; Ico.Height: 32
Label3.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));
ImageList1.Height := Ico.Height;
//salida de label4: ImageList1.Height: 32; Ico.Height: 32
Label4.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));

ImageList1.AddIcon(Ico);
finally
Ico.Free;
end;
end;

//funciona
procedure TForm1.Button3Click(Sender: TObject);
var
Ico: TIcon;
begin
Ico := TIcon.Create;
try
ConvertTo32BitImageList(ImageList1);
Ico.LoadFromFile('browser.ico');
//salida de label1: ImageList1.Width: 48; Ico.Width: 32
Label1.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));
//salida de label2: ImageList1.Height: 48; Ico.Height: 32
Label2.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));
TrayIcon1.Icon := Ico;
ImageList1.AddIcon(TrayIcon1.Icon);
//salida de label3: ImageList1.Width: 48; Ico.Width: 48 ¡¡¡Sorpresa!!! ha cambiado el tamaño
Label3.Caption := ('ImageList1.Width: '+IntToStr (ImageList1.Width) + '; Ico.Width: '+IntToStr (Ico.Width));
//salida de label4: ImageList1.Height: 48; Ico.Height: 48 ¡¡¡Sorpresa!!! ha cambiado el tamaño
Label4.Caption := ('ImageList1.Height: '+IntToStr (ImageList1.Height) + '; Ico.Height: '+IntToStr (Ico.Height));
finally
Ico.Free;
end;
end;


Os animo a hacer las pruebas y vereis qué "divertido" puede llegar a ser Delphi...

Por cierto, jconnor82, voy a probar la unit ahora, a ver qué tal me va. Luego te cuento. Ah, y muchas gracias.

[Chandra_]

jconnor82: he usado la unit que me has pasado, concretamente la procedure AddIconFileToImageList, y sigue dando el mensaje de error de "invalid Image size" con iconos mayores de 32x32:

procedure TForm1.Button4Click(Sender: TObject);
begin
ConvertTo32BitImageList(ImageList1);
AddIconFileToImageList('icono48x48.ico', 0, ImageList1);
end;

Nada, que no hay manera, es imposible :confused:

[jconnor82]

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


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:


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 (http://www.angelfire.com/hi5/delphizeus/saveicons.html)
HILPERS (http://www.hilpers.pl/882138-ikony-48x48-lub-wieksze-w)

[Chandra_]

Hola de nuevo, jconnor82:

Antes de seguir, quiero agradecerte todo el interés que te estás tomando :)

Perdona que no te agradeciera antes tu último comentario, pero es que llevo todo el día tratando de solucionar un problemilla:

He estado probando las nuevas funciones que me comentas, haciendo uso de HICON, pero no consigo compilar, porque me debe de faltar alguna unit por declarar en uses, porque me da varios mensajes de error con los siguientes tipos:

Undeclared identifier: 'IShellFolder'
Undeclared identifier: 'IExtractIcon'
Undeclared identifier: 'PItemIDList'
Undeclared identifier: 'SHGetDesktopFolder'

(omito, lógicamente, todas las variables declaradas basadas en estos tipos, que también aparecen como "undeclared identifier")


Buscando en la ayuda de Delphi, he visto que son para tener acceso al shell de windows, a la Microsoft Windows Shell interfaces, pero no termino de encontrar las clases de Delphi que manejan eso para declararlas (en la ayuda de delphi, todo lo que es el SDK de Windows aparece desligado del código de Object Pascal). Creía que con declarar, como haces tú, ShellAPI, era suficiente, pero parece que no. Si me pudieras decir algo, te estaría muy agradecido :)

Gracias de nuevo


ACTUALIZACIÓN:

Nada, ni caso a lo anterior: ya he encontrado la cláusula uses en la web de DelphiZeus con la "unit mágica" :D (pero qué burro soy!): ShlObj.

Voy a disfrutarlo, por fin :D:D:D

Un millón de gracias, jconnor82, por tu inestimable ayuda.

[jconnor82]

Algo me decia q me estaba olvidando algo :D:D:D