Ico и ListView - Общие вопросы Delphi

HTTqp · 19.02.2014, 18:01

Помогите пожалуйста загрузить иконки каждого файла в listview.
Вот код загрузки самих файлов написал, а с иконками беда, поискавики толку не дали, пробовал как написано но по их методы не выходит.

Код:

{Получение списка файлов и информации о них}
procedure TForm1.UpdateFile(LV:TListView;aPath:String);
var
Handle:THandle;
FindData:TWin32FindData;
temp_ext,Temp_Cap,result:String;
Folders:TStringList;
i,te:Byte;
begin
UpdateDrive;
LV.Clear;
Handle:=FindFirstFile(PChar(aPath+'*'),FindData);
if Handle<>INVALID_HANDLE_VALUE then
 try
  Folders:=TStringList.Create;
  while FindNextFile(Handle,FindData) do
  begin
    Temp_Cap:=ExtractFileName(FindData.cFileName);
    temp_ext:=ExtractFileExt(FindData.cFileName);
    if (FindData.dwFileAttributes and faDirectory)=faDirectory then
     begin
     Folders.append('['+Temp_Cap+']');
     end
     else
   with LV.Items.Add do   begin
    if (FindData.dwFileAttributes and faDirectory)<>faDirectory then
    begin
      for te:=1 to length(Temp_Cap) do
      if Temp_Cap[te]='.' then
      Caption:=copy(Temp_Cap,1,te-1);
      SubItems.Add(Copy(temp_ext,2,Length(temp_ext)-1));
      SubItems.Add(FloatToStrF(FindData.nFileSizeHigh+FindData.nFileSizeLow,ffNumber,18,0))
    end
      else SubItems.Add('');
      SubItems.Add(FileTimeToDateTimeStr(FindData.ftLastWriteTime));
      Result:='';
      if (FILE_ATTRIBUTE_ARCHIVE and FindData.dwFileAttributes)>0 then Result:=Result+'a' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_READONLY and FindData.dwFileAttributes)>0 then Result:=Result+'r' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_HIDDEN and FindData.dwFileAttributes)>0 then Result:=Result+'h' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_SYSTEM and FindData.dwFileAttributes)>0 then Result:=Result+'s' else Result:=Result+'-';
      SubItems.Add(Result);
    end;
   end;
  for i:=0 to Folders.count-1 do with  LV.Items.insert(i) do
  begin
   SubItems.Add('[Папка]');
   Caption:=Folders[i];
  end;
  Folders.free;
  finally
  LV.Items.EndUpdate;
  end;
end;

doktor255 · 19.02.2014, 21:14

Получение TIcon по имени файла

Код:

function TForm1.GetIcon(FileName: string): TIcon;
 var
   Info: TSHFileInfo;
   icon:TIcon;
 begin
   SHGetFileInfo(PChar(FileName),FILE_ATTRIBUTE_NORMAL,Info, SizeOf(TSHFileInfo),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);
   Icon:=TIcon.Create;
   icon.Handle:=Info.hIcon;
   Result:=icon;
 end;

HTTqp · 21.02.2014, 01:14

doktor255 , что то не получается пишу так

Код:

GetIcon(Temp_Cap);

но увы иконки так и не появляются(

doktor255 · 21.02.2014, 02:43

Я не вижу что содержит переменная Temp_Cap.

Код:

procedure TForm1.BitBtn1Click(Sender: TObject);
var Ico: TIcon;
begin
Ico:= TIcon.Create;
Ico:= GetIcon('c:/1.txt');
Image1.Picture.Graphic := TIcon.Create;
Image1.Picture.Graphic.Assign(ICo);
end;

Данный метод получает иконки приложений для открытия файла. Для получения внутренних иконок самих файлов необходима уже другая методика. TotalCommander так и делает. Получает вначале ассоциации, а уже после проверяет файлы на наличие внутренних иконок.

P.S. функцию писал 5 лет назад поэтому с ошибками. Сейчас я бы описал её как процедуру

Код:

procedure GetIcon(FileName: string; AIcon: TIcon);
 var
   Info: TSHFileInfo;
 begin
   SHGetFileInfo(PChar(FileName),FILE_ATTRIBUTE_NORMAL,Info, SizeOf(TSHFileInfo),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);
   AIcon.Handle:=Info.hIcon;
 end;

HTTqp · 22.02.2014, 12:31

Нашел код, вроде разобрался, но не могу сделать чтобы иконки грузились в LISTVIEW

Код:

procedure GetIcon(Path: String; var Icon: TIcon);
var
  FileInfo: TShFileInfo;
  ImageList: TImageList;
begin
  ImageList := TImageList.Create(nil);
  FillChar(FileInfo, Sizeof(FileInfo), #0);
  ImageList.ShareImages := True;
  ImageList.Handle := SHGetFileInfo(PChar(Path), SFGAO_SHARE, FileInfo, SizeOf(FileInfo), SHGFI_SMALLICON{ - 16x16, SHGFI_LARGEICON - 32x32} or SHGFI_SYSICONINDEX);
  ImageList.GetIcon(FileInfo.iIcon, Icon);
  ImageList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TmpIcon: TIcon;
begin
  TmpIcon:= TIcon.Create;
  GetIcon('C:\Windows\system32\calc.exe', TmpIcon);
  Image1.Picture.Icon:= TmpIcon;
  TmpIcon.Free;
end

Помогите пожалуйста допилить код вот тут, ниже код который заполняем listview файлами и инфой о них, а нужно чтобы и иконками тоже заполнялся.

Код:

procedure TForm1.UpdateFile(LV:TListView;aPath:String);
var
Handle:THandle;
FindData:TWin32FindData;
temp_ext,Temp_Cap,result:String;
Folders:TStringList;
i,te:Byte;
begin
LV.Items.BeginUpdate; //Начинаем прорисовку списка файлов
LV.Items.Clear; //Очищаем LV
Handle:=FindFirstFile(PChar(aPath+'*.*'),FindData);
if Handle<>INVALID_HANDLE_VALUE then
 try
  Folders:=TStringList.Create;
  while FindNextFile(Handle,FindData) do
  begin
    Temp_Cap:=ExtractFileName(FindData.cFileName);
    //GetIcon(Temp_Cap);
    temp_ext:=ExtractFileExt(FindData.cFileName);
    if (FindData.dwFileAttributes and faDirectory)=faDirectory then
     begin
     Folders.append('['+Temp_Cap+']');
     end
     else
   with LV.Items.Add do   begin
    if (FindData.dwFileAttributes and faDirectory)<>faDirectory then
    begin
      for te:=1 to length(Temp_Cap) do
      if Temp_Cap[te]='.' then
      Caption:=copy(Temp_Cap,1,te-1);
      SubItems.Add(Copy(temp_ext,2,Length(temp_ext)-1));
      SubItems.Add(FloatToStrF(FindData.nFileSizeHigh+FindData.nFileSizeLow,ffNumber,18,0))
    end
      else
      GetIcon(Temp_Cap);
      SubItems.Add('');
      SubItems.Add(FileTimeToDateTimeStr(FindData.ftLastWriteTime));
      Result:='';
      if (FILE_ATTRIBUTE_ARCHIVE and FindData.dwFileAttributes)>0 then Result:=Result+'a' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_READONLY and FindData.dwFileAttributes)>0 then Result:=Result+'r' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_HIDDEN and FindData.dwFileAttributes)>0 then Result:=Result+'h' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_SYSTEM and FindData.dwFileAttributes)>0 then Result:=Result+'s' else Result:=Result+'-';
      SubItems.Add(Result);
    end;
   end;
  for i:=0 to Folders.count-1 do with  LV.Items.insert(i) do
  begin
   SubItems.Add('[Папка]');
   Caption:=Folders[i];
  end;
  Folders.free;
  finally
  LV.Items.EndUpdate;
  end;
end;

doktor255 · 22.02.2014, 13:46

Код:

procedure GetIcon(Path: String; var Icon: TIcon);
var
  FileInfo: TShFileInfo;
  ImageList: TImageList;
begin
  ImageList := TImageList.Create(nil);
  FillChar(FileInfo, Sizeof(FileInfo), #0);
  ImageList.ShareImages := True;
  ImageList.Handle := SHGetFileInfo(PChar(Path), SFGAO_SHARE, FileInfo, SizeOf(FileInfo), SHGFI_SMALLICON{ - 16x16, SHGFI_LARGEICON - 32x32} or SHGFI_SYSICONINDEX);
  ImageList.GetIcon(FileInfo.iIcon, Icon);
  ImageList.Free;
end;

Извиняюсь но это полная чушь. Ты создаёшь ImageList, Пытаешься чтото с него выдрать функцией GetIcon, а потом на фиг всё уничтожаешь. Ну бред полнейший. Накидал немного кода по твоей процедуре. Добавь на форму ImageList. Он будет хранить иконки.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Shellapi, ShlObj, DateUtils, ImgList;

type
  TForm1 = class(TForm)
    LV: TListView;
    Button1: TButton;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure UpdateFile(LV:TListView;aPath:String);
    procedure GetIcon(FileName: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.GetIcon(FileName: string);
 var
   Info: TSHFileInfo;
   AIcon: TIcon;
 begin
   AIcon:= TIcon.Create;
   SHGetFileInfo(PChar(FileName),FILE_ATTRIBUTE_NORMAL,Info, SizeOf(TSHFileInfo),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);
   AIcon.Handle:=Info.hIcon;
   ImageList1.AddIcon(AIcon);
   LV.Items[LV.Items.Count -1].ImageIndex := ImageList1.Count -1;
   AIcon.Free;
 end;

function FileTimeToDateTimeStr(F: TFileTime): string;
var
  LocalFileTime: TFileTime;
  SystemTime: TSystemTime;
  DateTime: TDateTime;
begin
  if Comp(F) = 0 then Result := '-'
  else
  begin
    FileTimeToLocalFileTime(F, LocalFileTime);
    FileTimeToSystemTime(LocalFileTime, SystemTime);
    with SystemTime do
      DateTime := EncodeDate(wYear, wMonth, wDay) +
        EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    Result := DateTimeToStr(DateTime);
  end;
end;

procedure TForm1.UpdateFile(LV:TListView;aPath:String);
var
Handle:THandle;
FindData:TWin32FindData;
temp_ext,Temp_Cap,result:String;
Folders:TStringList;
i,te:Byte;
begin
ImageList1.Clear;
LV.SmallImages := ImageList1;
LV.Items.BeginUpdate; //Íà÷èíàåì ïðîðèñîâêó ñïèñêà ôàéëîâ
LV.Items.Clear; //Î÷èùàåì LV
Handle:=FindFirstFile(PChar(aPath+'*.*'),FindData);
if Handle<>INVALID_HANDLE_VALUE then
 try
  Folders:=TStringList.Create;
  while FindNextFile(Handle,FindData) do
  begin
    Temp_Cap:=ExtractFileName(FindData.cFileName);
    //GetIcon(Temp_Cap);
    temp_ext:=ExtractFileExt(FindData.cFileName);
    if (FindData.dwFileAttributes and faDirectory)=faDirectory then
     begin
     Folders.append('['+Temp_Cap+']');
     end
     else
   with LV.Items.Add do   begin
   GetIcon(Temp_Cap);
    if (FindData.dwFileAttributes and faDirectory)<>faDirectory then
    begin
      for te:=1 to length(Temp_Cap) do
      if Temp_Cap[te]='.' then
      Caption:=copy(Temp_Cap,1,te-1);
      SubItems.Add(Copy(temp_ext,2,Length(temp_ext)-1));
      SubItems.Add(FloatToStrF(FindData.nFileSizeHigh+FindData.nFileSizeLow,ffNumber,18,0))
    end
      else
      SubItems.Add('');
      SubItems.Add(FileTimeToDateTimeStr(FindData.ftLastWriteTime));
      Result:='';
      if (FILE_ATTRIBUTE_ARCHIVE and FindData.dwFileAttributes)>0 then Result:=Result+'a' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_READONLY and FindData.dwFileAttributes)>0 then Result:=Result+'r' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_HIDDEN and FindData.dwFileAttributes)>0 then Result:=Result+'h' else Result:=Result+'-';
      if (FILE_ATTRIBUTE_SYSTEM and FindData.dwFileAttributes)>0 then Result:=Result+'s' else Result:=Result+'-';
      SubItems.Add(Result);
    end;
   end;
  for i:=0 to Folders.count-1 do with  LV.Items.insert(i) do
  begin
   LV.Items[i].ImageIndex := -1; // èêîíêà êàòàëîãà
   SubItems.Add('[Ïàïêà]');
   Caption:=Folders[i];
  end;
  Folders.free;
  finally
  LV.Items.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  UpdateFile(LV, 'D:/');
end;

end.

Код не самый лучший, но идею работы с иконками отображает. Дальше сам.

HTTqp · 27.02.2014, 21:41

del//////////

HTTqp · 07.04.2014, 02:03

doktor255, сделал как ты и сказал вот что получилось.

doktor255 · 07.04.2014, 02:58

А должно было получиться что-то иное? Это список каталогов. У каталогов нет иконок. Если только свои программно не лепить.

HTTqp · 12.04.2014, 00:35

А как сделать если, у меня обновления делаю на 2 listview, поэтому переделал код вот так

Код:

procedure TForm1.GetIcon(LV:TListView;FileName:string);
var
Info:TSHFileInfo;
AIcon:TIcon;
begin
AIcon:=TIcon.Create;
SHGetFileInfo(PChar(FileName),FILE_ATTRIBUTE_NORMAL,Info, SizeOf(TSHFileInfo),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);
AIcon.Handle:=Info.hIcon;
ImageList1.AddIcon(AIcon);
LV.Items[LV.Items.Count-1].ImageIndex := ImageList1.Count -1;
AIcon.Free;
end;

и вызываю так

Код:

procedure TForm1.UpdateFile(LV:TListView;aPath:String);
var
Handle:THandle;
FindData:TWin32FindData;
Temp_ext,Temp_Cap,result:String;
Folders:TStringList;
i,Temp:Byte;
begin
ImageList1.Clear;
LV.SmallImages:=ImageList1;
LV.Items.BeginUpdate;//Начинаем прорисовку списка файлов
LV.Items.Clear; //Очищаем LV
Handle:=FindFirstFile(PChar(aPath+'*.*'),FindData);
if Handle<>INVALID_HANDLE_VALUE then
 try
  Folders:=TStringList.Create;
  while FindNextFile(Handle,FindData) do
  begin
    Temp_Cap:=ExtractFileName(FindData.cFileName); //Имя файлов
    Temp_ext:=ExtractFileExt(FindData.cFileName); //Формат(расширение)
    if (FindData.dwFileAttributes and faDirectory)=faDirectory then Folders.Append(Temp_Cap)
     else
   with LV.Items.Add do
   begin
    if (FindData.dwFileAttributes and faDirectory)<>faDirectory then
    begin
      GetIcon(LV,Temp_Cap);
 SubItems.Add(temp_ext);
      SubItems.Add(FloatToStrF(FindData.nFileSizeHigh+FindData.nFileSizeLow,ffNumber,18,0));
    end
      else
      SubItems.Add('');
      SubItems.Add(TimeToDateFile(FindData.ftLastWriteTime));
      Result:='';
      if (FILE_ATTRIBUTE_ARCHIVE and FindData.dwFileAttributes)>0 then Result:=Result+'a' else Result:=Result+'-';  //
      if (FILE_ATTRIBUTE_READONLY and FindData.dwFileAttributes)>0 then Result:=Result+'r' else Result:=Result+'-'; //Только чтение
      if (FILE_ATTRIBUTE_HIDDEN and FindData.dwFileAttributes)>0 then Result:=Result+'h' else Result:=Result+'-';   //Скрытые
      if (FILE_ATTRIBUTE_SYSTEM and FindData.dwFileAttributes)>0 then Result:=Result+'s' else Result:=Result+'-';   //Системные
      SubItems.Add(Result);
    end;
   end;
  for i:=0 to Folders.count-1 do with LV.Items.insert(i) do
  begin
   LV.Items[i].ImageIndex:=-1;
   SubItems.Add('[Папка]');
   SubItems.Add('');
   SubItems.Add(TimeToDateFile(FindData.ftLastWriteTime));
   Caption:=Folders[i];
  end;
  Folders.Free;
  finally
  LV.Items.EndUpdate; //Закончить прорисовку файлов
  end;
end;

21.02.2014, 01:14	#3
HTTqp Форумчанин Регистрация: 20.12.2013 Сообщений: 164	doktor255 , что то не получается пишу так Код: `GetIcon(Temp_Cap);` но увы иконки так и не появляются(

21.02.2014, 02:43	#4
doktor255 Заблокирован Регистрация: 31.03.2011 Сообщений: 976	Я не вижу что содержит переменная Temp_Cap. Код: `procedure TForm1.BitBtn1Click(Sender: TObject); var Ico: TIcon; begin Ico:= TIcon.Create; Ico:= GetIcon('c:/1.txt'); Image1.Picture.Graphic := TIcon.Create; Image1.Picture.Graphic.Assign(ICo); end;` Данный метод получает иконки приложений для открытия файла. Для получения внутренних иконок самих файлов необходима уже другая методика. TotalCommander так и делает. Получает вначале ассоциации, а уже после проверяет файлы на наличие внутренних иконок. P.S. функцию писал 5 лет назад поэтому с ошибками. Сейчас я бы описал её как процедуру Код: `procedure GetIcon(FileName: string; AIcon: TIcon); var Info: TSHFileInfo; begin SHGetFileInfo(PChar(FileName),FILE_ATTRIBUTE_NORMAL,Info, SizeOf(TSHFileInfo),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES); AIcon.Handle:=Info.hIcon; end;` Последний раз редактировалось doktor255; 21.02.2014 в 03:12.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как перетащить элемент ListView в другой ListView?	Paul Hindenburg	Компоненты Delphi	5	26.01.2013 11:35
Ehlib + *ico	new player	Компоненты Delphi	2	28.09.2010 14:56
[C# + WPF] ListView. Узнать выделена ли строка в нём. ListView.View == GridView.	Casper-SC	WPF, UWP, WinRT, XAML	2	12.08.2010 19:04
Bmp в ico	AngelOfDeath	Мультимедиа в Delphi	9	30.12.2008 06:21
Ico	Zeraim	Мультимедиа в Delphi	8	22.05.2008 09:11

27.02.2014, 21:41	#7
HTTqp Форумчанин Регистрация: 20.12.2013 Сообщений: 164	del//////////

07.04.2014, 02:03	#8
HTTqp Форумчанин Регистрация: 20.12.2013 Сообщений: 164	doktor255, сделал как ты и сказал вот что получилось.

07.04.2014, 02:58	#9
doktor255 Заблокирован Регистрация: 31.03.2011 Сообщений: 976	А должно было получиться что-то иное? Это список каталогов. У каталогов нет иконок. Если только свои программно не лепить.