Показать файлы с ассоциированными с ними иконками в TListView

=== Показать файлы с ассоциированными с ними иконками в TListView ===
{ 
 The following example shows how to show all files and their 
 associated icons of a folder in a TListView. 
 To test the code, you need a ListView1 and a ImageList1 where the icons are stored. 
}
uses
 ShellApi;
procedure LV_InsertFiles(strPath: string; ListView: TListView; ImageList: TImageList);
var
 i: Integer;
 Icon: TIcon;
 SearchRec: TSearchRec;
 ListItem: TListItem;
 FileInfo: SHFILEINFO;
begin
 // Create a temporary TIcon 
 Icon := TIcon.Create;
 ListView.Items.BeginUpdate;
 try
 // search for the first file 
 i := FindFirst(strPath + '*.*', faAnyFile, SearchRec);
 while i = 0 do
 begin
 with ListView do
 begin
 // On directories and volumes 
 if ((SearchRec.Attr and FaDirectory <> FaDirectory) and
 (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then
 begin
 ListItem := ListView.Items.Add;
 // Get The DisplayName 
 SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
 SizeOf(FileInfo), SHGFI_DISPLAYNAME);
 Listitem.Caption := FileInfo.szDisplayName;
 // Get The TypeName 
 SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
 SizeOf(FileInfo), SHGFI_TYPENAME);
 ListItem.SubItems.Add(FileInfo.szTypeName);
 // Get The Icon That Represents The File 
 SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
 SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
 icon.Handle := FileInfo.hIcon;
 ListItem.ImageIndex := ImageList.AddIcon(Icon);
 // Destroy the Icon 
 DestroyIcon(FileInfo.hIcon);
 end;
 end;
 i := FindNext(SearchRec);
 end;
 finally
 Icon.Free;
 ListView.Items.EndUpdate;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Assign a Imagelist to the ListView 
 ListView1.SmallImages := ImageList1;
 // Show Listview in Report Style and add 2 Columns 
 ListView1.ViewStyle := vsReport;
 ListView1.Columns.Add;
 ListView1.Columns.Add;
 LV_InsertFiles('C:\Windows\', ListView1, ImageList1);
end;
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, comctrls, StdCtrls;
type
 TForm1 = class(TForm)
 ListView1: TListView;
 Button1: TButton;
 Button2: TButton;
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 procedure SaveListViewToFile(AListView: TListView; sFileName: string);
 procedure LoadListViewToFile(AListView: TListView; sFileName: string);
 public
 end;
const
 Msg1 = 'File "%s" does not exist!';
 Msg2 = '"%s" is not a ListView file!';
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.SaveListViewToFile(AListView: TListView; sFileName: string);
var
 idxItem, idxSub, IdxImage: Integer;
 F: TFileStream;
 pText: PChar;
 sText: string;
 W, ItemCount, SubCount: Word;
 MySignature: array[0..2] of Char;
begin
 //Initialization
 with AListView do
 begin
 ItemCount := 0;
 SubCount := 0;
 //****
 MySignature := 'LVF';
 // ListViewFile
 F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite);
 F.Write(MySignature, SizeOf(MySignature));
 if Items.Count = 0 then
 // List is empty
 ItemCount := 0
 else
 ItemCount := Items.Count;
 F.Write(ItemCount, SizeOf(ItemCount));
 if Items.Count > 0 then
 begin
 for idxItem := 1 to ItemCount do
 begin
 with Items[idxItem - 1] do
 begin
 // Save subitems count
 if SubItems.Count = 0 then
 SubCount := 0
 else
 SubCount := Subitems.Count;
 F.Write(SubCount, SizeOf(SubCount));
 // Save ImageIndex
 IdxImage := ImageIndex;
 F.Write(IdxImage, SizeOf(IdxImage));
 // Save Caption
 sText := Caption;
 w := Length(sText);
 pText := StrAlloc(Length(sText) + 1);
 StrPLCopy(pText, sText, Length(sText));
 F.Write(w, SizeOf(w));
 F.Write(pText^, w);
 StrDispose(pText);
 if SubCount > 0 then
 begin
 for idxSub := 0 to SubItems.Count - 1 do
 begin
 // Save Item's subitems
 sText := SubItems[idxSub];
 w := Length(sText);
 pText := StrAlloc(Length(sText) + 1);
 StrPLCopy(pText, sText, Length(sText));
 F.Write(w, SizeOf(w));
 F.Write(pText^, w);
 StrDispose(pText);
 end;
 end;
 end;
 end;
 end;
 F.Free;
 end;
end;
procedure TForm1.LoadListViewToFile(AListView: TListView; sFileName: string);
var
 F: TFileStream;
 IdxItem, IdxSubItem, IdxImage: Integer;
 W, ItemCount, SubCount: Word;
 pText: PChar;
 PTemp: PChar;
 MySignature: array[0..2] of Char;
 sExeName: string;
begin
 with AListView do
 begin
 ItemCount := 0;
 SubCount := 0;
 sExeName := ExtractFileName(sFileName);
 if not FileExists(sFileName) then
 begin
 MessageBox(Handle, PChar(Format(Msg1, [sExeName])), 'I/O Error', MB_ICONERROR);
 Exit;
 end;
 F := TFileStream.Create(sFileName, fmOpenRead);
 F.Read(MySignature, SizeOf(MySignature));
 if MySignature <> 'LVF' then
 begin
 MessageBox(Handle, PChar(Format(Msg2, [sExeName])), 'I/O Error', MB_ICONERROR);
 Exit;
 end;
 F.Read(ItemCount, SizeOf(ItemCount));
 Items.Clear;
 for idxItem := 1 to ItemCount do
 begin
 with Items.Add do
 begin
 // Read imageindex
 F.Read(SubCount, SizeOf(SubCount));
 // Read imageindex
 F.Read(IdxImage, SizeOf(IdxImage));
 ImageIndex := IdxImage;
 // Read the Caption
 F.Read(w, SizeOf(w));
 pText := StrAlloc(w + 1);
 pTemp := StrAlloc(w + 1);
 F.Read(pTemp^, W);
 StrLCopy(pText, pTemp, W);
 Caption := StrPas(pText);
 StrDispose(pTemp);
 StrDispose(pText);
 if SubCount > 0 then
 begin
 for idxSubItem := 1 to SubCount do
 begin
 F.Read(w, SizeOf(w));
 pText := StrAlloc(w + 1);
 pTemp := StrAlloc(w + 1);
 F.Read(pTemp^, W);
 StrLCopy(pText, pTemp, W);
 Items[idxItem - 1].SubItems.Add(StrPas(pText));
 StrDispose(pTemp);
 StrDispose(pText);
 end;
 end;
 end;
 end;
 F.Free;
 end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Save Items and Clear the ListView
 SaveListViewToFile(ListView1, 'MyListView.sav');
 ListView1.Items.Clear;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 // Load Items
 LoadListViewToFile(ListView1, 'MyListView.sav');
end;
Author: Song
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01147