Ver Mensaje Individual
  #2  
Antiguo 28-06-2014
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Reputación: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Mira este ejemplo:

Código Delphi [-]
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.

Última edición por escafandra fecha: 09-03-2020 a las 08:00:24.
Responder Con Cita