PDA

Ver la Versión Completa : ¿como obtener icono del sistema?


JXJ
26-06-2014, 22:12:03
buenas.

tengo una duda.
¿como obtener icono del sistema?

es decir.
estoy haciendo un navegar de archivos.y estoy listando unidades y carpetas
y quiero usar el icono que windows les asigna
esto es por que no quiero poner iconos en timage, aqi que si se aplican themes
la aplicacion siga usando los iconos del sistema.

gracias.

escafandra
28-06-2014, 01:34:44
Mira este ejemplo:


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Shellapi, FileCtrl, ImgList;

type
TForm1 = class(TForm)
ListView1: TListView;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button8: TButton;
ImageList1: TImageList;
ImageList2: TImageList;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure GetSystemImages;
function AddIcon(sr: TSearchRec): integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.GetSystemImages;
var
Flags: DWORD;
fi: TSHFILEINFO;
SystemSmallIcons, SystemLargeIcons: THANDLE;
begin
Flags:= SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
SystemSmallIcons:= SHGetFileInfo('', 0, fi, sizeof(TSHFILEINFO), Flags);
ImageList1.Handle:= SystemSmallIcons;
Flags:= SHGFI_SYSICONINDEX or SHGFI_LARGEICON;
SystemLargeIcons:= SHGetFileInfo('', 0, fi, sizeof(TSHFILEINFO), Flags);
ImageList2.Handle:= SystemLargeIcons;
end;

// Añade un icono a la lista del sistema y devuelve su índice
function TForm1.AddIcon(sr: TSearchRec): integer;
var
fi: TSHFILEINFO;
Flags: DWORD;
begin
Flags:= SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES;
if (sr.Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0 then
//SHGetFileInfo('', FILE_ATTRIBUTE_DIRECTORY, fi, sizeof(SHFILEINFO), Flags)
fi.iIcon:= 3
else if SHGetFileInfo(PCHAR(sr.Name), FILE_ATTRIBUTE_DIRECTORY, fi, sizeof(SHFILEINFO), SHGFI_EXETYPE)<>0 then
SHGetFileInfo(PCHAR(sr.Name), sr.Attr, fi, sizeof(SHFILEINFO), Flags)
else
SHGetFileInfo(PCHAR(sr.Name), sr.Attr, fi, sizeof(SHFILEINFO), Flags);

Result:= fi.iIcon;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
pItem: TListItem;
sr: TSearchRec;
hFindFile: THANDLE;
Path: PCHAR;
Dir: String;
FileName: String;
begin
if not SelectDirectory('Selececione carpeta', 'C:\', Dir) then exit;

if FindFirst(Dir + '\*.*', faAnyFile, sr) = 0 then
begin
ListView1.Items.Clear;
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
Application.ProcessMessages;
pItem:= ListView1.Items.Add;
pItem.Caption:= sr.Name;
FileName:= ExtractFilePath(Dir) + sr.Name;
sr.Name:= FileName;
pItem.ImageIndex:= AddIcon(sr);
end;
until FindNext(sr)<>0;
FindClose(sr);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ListView1.ViewStyle:= vsSmallIcon;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ListView1.ViewStyle:= vsReport;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
ListView1.ViewStyle:= vsIcon;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ListView1.ViewStyle:= vsList;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetSystemImages;
end;

end.