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

Code:

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;