Gracias a Rob Kennedy para señalarme en la dirección de SHGetFileInfo . Luego busqué en Google y encontré estos dos ejemplos: Delphi 3000, Torry's. De eso escribí la siguiente clase para hacer lo que necesitaba.
Además, justo cuando estaba terminando la respuesta de Bill Miller me brindó la última ayuda que necesitaba. Originalmente estaba pasando nombres completos de archivo a ShGetFileInfo, que no era idealmente lo que quería. El cambio sugerido de pasar "* .EXT" fue genial.
La clase podría funcionar con más trabajo pero hace lo que necesito.Parece manejar extensiones de archivos que tampoco tienen detalles asociados.
Finalmente, en lo que estoy usando, lo cambié a usar TcxImageList en lugar de TImageList, ya que tenía problemas con bordes negros que aparecían en los iconos, porque era una solución rápida.
unit FileAssociationDetails;
{
Created : 2009-05-07
Description : Class to get file type description and icons.
* Extensions and Descriptions are held in a TStringLists.
* Icons are stored in a TImageList.
Assumption is all lists are in same order.
}
interface
uses Classes, Controls;
type
TFileAssociationDetails = class(TObject)
private
FImages : TImageList;
FExtensions : TStringList;
FDescriptions : TStringList;
public
constructor Create;
destructor Destroy; override;
procedure AddFile(FileName : string);
procedure AddExtension(Extension : string);
procedure Clear;
procedure GetFileIconsAndDescriptions;
property Images : TImageList read FImages;
property Extensions : TStringList read FExtensions;
property Descriptions : TStringList read FDescriptions;
end;
implementation
uses SysUtils, ShellAPI, Graphics, Windows;
{ TFileAssociationDetails }
constructor TFileAssociationDetails.Create;
begin
try
inherited;
FExtensions := TStringList.Create;
FExtensions.Sorted := true;
FDescriptions := TStringList.Create;
FImages := TImageList.Create(nil);
except
end;
end;
destructor TFileAssociationDetails.Destroy;
begin
try
FExtensions.Free;
FDescriptions.Free;
FImages.Free;
finally
inherited;
end;
end;
procedure TFileAssociationDetails.AddFile(FileName: string);
begin
AddExtension(ExtractFileExt(FileName));
end;
procedure TFileAssociationDetails.AddExtension(Extension : string);
begin
Extension := UpperCase(Extension);
if (Trim(Extension) <> '') and
(FExtensions.IndexOf(Extension) = -1) then
FExtensions.Add(Extension);
end;
procedure TFileAssociationDetails.Clear;
begin
FExtensions.Clear;
end;
procedure TFileAssociationDetails.GetFileIconsAndDescriptions;
var
Icon: TIcon;
iCount : integer;
Extension : string;
FileInfo : SHFILEINFO;
begin
FImages.Clear;
FDescriptions.Clear;
Icon := TIcon.Create;
try
// Loop through all stored extensions and retrieve relevant info
for iCount := 0 to FExtensions.Count - 1 do
begin
Extension := '*' + FExtensions.Strings[iCount];
// Get description type
SHGetFileInfo(PChar(Extension),
FILE_ATTRIBUTE_NORMAL,
FileInfo,
SizeOf(FileInfo),
SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES
);
FDescriptions.Add(FileInfo.szTypeName);
// Get icon and copy into ImageList
SHGetFileInfo(PChar(Extension),
FILE_ATTRIBUTE_NORMAL,
FileInfo,
SizeOf(FileInfo),
SHGFI_ICON or SHGFI_SMALLICON or
SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES
);
Icon.Handle := FileInfo.hIcon;
FImages.AddIcon(Icon);
end;
finally
Icon.Free;
end;
end;
end.
También aquí es una aplicación ejemplo de prueba de usarlo, es muy sencillo, basta con un formulario con un TPageControl en él. Mi uso real no fue para esto, sino para un Developer Express TcxImageComboxBox en un TcxGrid.
unit Main;
{
Created : 2009-05-07
Description : Test app for TFileAssociationDetails.
}
interface
uses
Windows, Forms, FileAssociationDetails, Classes, Controls, ComCtrls;
type
TfmTest = class(TForm)
PageControl1: TPageControl;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FFileDetails : TFileAssociationDetails;
public
{ Public declarations }
end;
var
fmTest: TfmTest;
implementation
{$R *.dfm}
procedure TfmTest.FormShow(Sender: TObject);
var
iCount : integer;
NewTab : TTabSheet;
begin
FFileDetails := TFileAssociationDetails.Create;
FFileDetails.AddFile('C:\Documents and Settings\...\Test.XLS');
FFileDetails.AddExtension('.zip');
FFileDetails.AddExtension('.pdf');
FFileDetails.AddExtension('.pas');
FFileDetails.AddExtension('.XML');
FFileDetails.AddExtension('.poo');
FFileDetails.GetFileIconsAndDescriptions;
PageControl1.Images := FFileDetails.Images;
for iCount := 0 to FFileDetails.Descriptions.Count - 1 do
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl := PageControl1;
NewTab.Caption := FFileDetails.Descriptions.Strings[iCount];
NewTab.ImageIndex := iCount;
end;
end;
procedure TfmTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
PageControl1.Images := nil;
FFileDetails.Free;
end;
end.
¡Gracias a todos por sus respuestas!
Una nota: cuando se pasan nombres completos de archivos, los accesos directos como '% 1' como acceso directo a los archivos de iconos o mapas de bits producirán el resultado correcto para cada archivo específico. * .ext solo mostrará un icono genérico en tales casos. – Martijn
@Martijn, ¿Qué quiere decir con el uso de '% 1'? ¿Puedes mostrar un ejemplo? – pcunite
@pcunite: Ahora veo que mi comentario no fue muy claro. En algunos casos, "% 1" se define como DefaultIcon para un tipo de archivo; este suele ser el caso de los archivos '.ico': cada archivo de icono en sí contiene el ícono para mostrar. En tal caso, usar el nombre de archivo completo arrojará el ícono correcto. Usar solo la extensión aquí resultaría en un ícono 'genérico'. – Martijn