Показать файлы с ассоциированными с ними иконками в 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 := Find(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;

Взято с сайта: http://www.swissdelphicenter.ch

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;

Автор: Song
Взято с Vingrad.ru http://forum.vingrad.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...