home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue152 / delphi / copydelp.exe / Shinfo / shinfoUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-02-15  |  2.0 KB  |  86 lines
  1. unit shinfoUnit;
  2. { Note: You must remember to set viewStyle to vsSmallIcon in the
  3.   Property Inspector!!!! }
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   StdCtrls, ShellAPI, Buttons, ComCtrls, CommCtrl;   { CommCtrl see XXX below }
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     Button1: TButton;
  13.     ListView1: TListView;
  14.     procedure Button1Click(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.   public
  19.     { Public declarations }
  20.     procedure upDateListView;
  21.   end;
  22.  
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. const
  28.    ROOTDIR = 'C:\';
  29.  
  30. implementation
  31.  
  32. {$R *.DFM}
  33.  
  34. function GetIcon( fn : string ) : integer;
  35. var
  36.   FileInfo : TSHFileInfo;
  37. begin
  38.   FillChar(FileInfo, SizeOf(FileInfo), #0);
  39.   SHGetFileInfo(PChar(fn),0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX );
  40.   result := FileInfo.iIcon;
  41. end;
  42.  
  43.  
  44. procedure TForm1.Button1Click(Sender: TObject);
  45. begin
  46.    updateListView;
  47. end;
  48.  
  49. procedure TForm1.upDateListView;
  50. var
  51.    NewItem : TListItem;
  52.    d : string;
  53.    Result : integer;
  54.    SearchRec: TSearchRec;
  55. begin
  56.     d := ROOTDIR;
  57.     ListView1.Items.Clear;
  58.     ListView1.Items.BeginUpdate;
  59.     Result := FindFirst(d+'*.*', faAnyFile, SearchRec);
  60.     while Result = 0 do
  61.     begin
  62.         NewItem := ListView1.Items.Add;
  63.         NewItem.Caption := SearchRec.Name;
  64.         NewItem.ImageIndex := GetIcon(d + Searchrec.Name);
  65.       Result := FindNext(SearchRec);
  66.     end;
  67.     FindClose(SearchRec);
  68.     ListView1.Items.EndUpdate;
  69. end;
  70.  
  71. procedure TForm1.FormCreate(Sender: TObject);
  72. var
  73.   ImageListHandle : THandle;
  74.   FileInfo : TSHFileInfo;
  75. begin
  76.   ImageListHandle := SHGetFileInfo('',
  77.                            0,
  78.                            FileInfo,
  79.                            SizeOf(FileInfo),
  80.                            SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  81.                                 { XXX CommCtrl needed for these constants }
  82.   SendMessage(ListView1.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
  83. end;
  84.  
  85. end.
  86.