Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2010.08.27;
Скачать: CL | DM;

Вниз

ListView вывод иконок   Найти похожие ветки 

 
Rolls   (2010-05-07 16:06) [0]

Здравствуйте, форумчане!
Вопрос банальный : нужно вывести в ListView список файлов с иконками из определённой директории с возможностью запуска (аналог эксплорера).
В поисках ответа я облазил весь инет, на всех сайтах одна и та же статья, к сожалению не рабочая Пробовал компилить на разных версиях делфи, запускать на разных виндовсах -результат один - иконки не отображаются. Подскажите пожалуйста где ошибка или посоветуйте другой способ.
Заранее большое спасибо!

А вот собственно и эта статья :


Удобнее всего воспользоваться компонентом ListView. Его используют многие программы, так как он позволяет очень просто создать удобный список.

Вначале создадим ImageList и с помощью функции WinAPI SHGetFileInfo заполним его иконками, связанными со всеми зарегистрированными расширениями. Затем, при выборе пользователем в DirectoryListBox каталога, найдем все файлы в этом каталоге и для каждого определим иконку при помощи той же функции SHGetFileInfo. И еще к каждому элементу списка добавляется размер файла. Если вывести список в виде таблицы (для этого нужно выбрать пункт Table в ComboBox), то справа от имени каждого файла окажется его размер.
uses
 ShellAPI;

procedure UpdateFiles;
var
 sr: TSearchRec;
 li: TListItem;
 fi: TSHFileInfo;
 ext: string;
 IconIndex: word;
 ic: TIcon;
begin
 Form1.ListView1.Items.BeginUpdate;
 Form1.ListView1.Items.Clear;
 if FindFirst(Form1.DirectoryListBox1.Directory + "\*.*", faAnyFile, sr) = 0 then
   repeat
     if sr.Attr and faDirectory <> 0 then
       continue;
     li := Form1.ListView1.Items.Add;
     li.Caption := sr.name;
     ext := LowerCase(ExtractFileExt(li.Caption));
     ShGetFileInfo(PChar("*" + ext), 0, fi, SizeOf(fi),
     SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);
     li.ImageIndex := fi.iIcon;
     if sr.Size < 1024 then
       li.SubItems.Add(IntToStr(sr.Size) + " byte")
     else
     if sr.Size < 1024 * 1024 then
       li.SubItems.Add(IntToStr(round(sr.Size / 1024)) + " KByte")
     else
       li.SubItems.Add(IntToStr(round(sr.Size / (1024 * 1024))) + " MByte");
     li.SubItems.Add(fi.szTypeName);
   until
     FindNext(sr) <> 0;
 FindClose(sr);
 Form1.ListView1.Items.EndUpdate;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 fi: TSHFileInfo;
 lc: TListColumn;
begin
 DriveComboBox1.DirList := DirectoryListBox1;
 with ListView1 do
 begin
   SmallImages := TImageList.CreateSize(16,16);
   SmallImages.Handle := ShGetFileInfo("*.*", 0, fi,
     SizeOf(fi), SHGFI_SMALLICON or SHGFI_ICON
     or SHGFI_SYSICONINDEX);
   LargeImages := TImageList.Create(nil);
   LargeImages.Handle := ShGetFileInfo("*.*", 0, fi,
     SizeOf(fi), SHGFI_LARGEICON or SHGFI_ICON
     or SHGFI_SYSICONINDEX);
   lc := Columns.Add;
   lc.Caption := "Name";
   lc := Columns.Add;
   lc.Caption := "Size";
   ComboBox1.Items.Add("Icons");
   ComboBox1.Items.Add("List");
   ComboBox1.Items.Add("Table");
   ComboBox1.Items.Add("SmallIcons");
   ComboBox1.ItemIndex := 0;
 end;
 UpdateFiles;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
 UpdateFiles;
end;

procedure TForm1.ComboBox1Click(Sender: TObject);
begin
 case ComboBox1.ItemIndex of
   0: ListView1.ViewStyle := vsIcon;
   1: ListView1.ViewStyle := vsList;
   2: ListView1.ViewStyle := vsReport;
   else
     ListView1.ViewStyle := vsSmallIcon;
 end;
end;


 
И. Павел ©   (2010-05-07 17:03) [1]

> [0] Rolls   (07.05.10 16:06)

Скачайте библиотеку AlphaControls - там есть компонент, в котором это уже реализовано. Компонент называется sShellTreeView.


 
И. Павел ©   (2010-05-07 17:04) [2]

Ну или SShellListView, если нужно показывать просто папку без иерерхии.


 
DmitrichJ   (2010-05-08 02:22) [3]

VirtualStringTree


 
Maksim V. ©   (2010-05-09 01:52) [4]

Rolls

Может статья неполная, но где связывание хэндла списка изображений с ListView? Конечно, значки не отобразятся. :)

ListView_SetImageList
или
LVM_SETIMAGELIST


 
Eraser ©   (2010-05-09 04:16) [5]

   ilFileIcons.Handle := SHGetFileInfo(PChar(""),
     0,
     FileInfo,
     SizeOf(TSHFileInfo),
     SHGFI_ADDOVERLAYS or
     SHGFI_ICON or SHGFI_SMALLICON or
     SHGFI_SYSICONINDEX);


 
Eraser ©   (2010-05-09 04:19) [6]

>     ShGetFileInfo(PChar("*" + ext), 0, fi, SizeOf(fi),
>     SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME)
> ;

         SHGetFileInfo(PChar("*" + ext),
           FILE_ATTRIBUTE_NORMAL,
           FileInfo,
           SizeOf(TSHFileInfo),
           SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_SMALLICON or
           SHGFI_TYPENAME or
           SHGFI_SYSICONINDEX);


 
Германн ©   (2010-05-09 04:52) [7]


> Eraser ©   (09.05.10 04:19) [6]

Есть у меня  некие сомнения.


 
Rolls   (2010-05-12 15:12) [8]


> Скачайте библиотеку AlphaControls

пробовал ей воспользоваться - вылетает куча непонятных ошибок и глюков, решил  домучать стандартный TListView.

Всем огромное спасибо, проблема решена!
Вот листинг работоспособного кода :


function TForm1.GetImageIndex(const FileName: String): Integer;
var
 fi: TSHFileInfo;
begin
 SHGetFileInfo(
   PChar(FileName),
   0,
   fi,
   SizeOf(TSHFileInfo),
   SHGFI_SYSICONINDEX
 );
 Result := fi.iIcon;
end;

function TForm1.GetFileType(const FileName: String): String;
var
 fi: TSHFileInfo;
begin
 SHGetFileInfo(
   PChar(FileName),
   0,
   fi,
   SizeOf(TSHFileInfo),
   SHGFI_TYPENAME
 );
 Result := fi.szTypeName;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 case ComboBox1.ItemIndex of
   0: ListView1.ViewStyle := vsIcon;
   1: ListView1.ViewStyle := vsList;
   2: ListView1.ViewStyle := vsReport;
   3: ListView1.ViewStyle := vsSmallIcon;
   else
     raise EArgumentOutOfRangeException.CreateFmt("WTF "%d"?", [ComboBox1.ItemIndex]);
 end;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
 UpdateFiles;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 fi: TSHFileInfo;
 lc: TListColumn;
begin
 DriveComboBox1.DirList := DirectoryListBox1;
 with ListView1 do
 begin
   SmallImages := TImageList.CreateSize(16,16);
   SmallImages.Handle := ShGetFileInfo("C:\", 0, fi, SizeOf(fi), SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
   LargeImages := TImageList.Create(nil);
   LargeImages.Handle := ShGetFileInfo("C:\", 0, fi, SizeOf(fi), SHGFI_LARGEICON or SHGFI_SYSICONINDEX);
   lc := Columns.Add;
   lc.Caption := "Name";
   lc.Width := 300;
   lc := Columns.Add;
   lc.Caption := "Size";
   lc.Width := 100;
   ComboBox1.Items.Add("Icons");
   ComboBox1.Items.Add("List");
   ComboBox1.Items.Add("Table");
   ComboBox1.Items.Add("SmallIcons");
   ComboBox1.ItemIndex := 0;
 end;
 UpdateFiles;
end;

procedure TForm1.UpdateFiles;
var
 sr: TSearchRec;
 li: TListItem;
begin
 Form1.ListView1.Items.Clear;
 Form1.ListView1.Items.BeginUpdate;
 if FindFirst(Form1.DirectoryListBox1.Directory + "\*.*", faAnyFile, sr) = 0 then
   repeat
     if sr.Attr and faDirectory <> 0 then
       continue;
     li := Form1.ListView1.Items.Add;
     li.Caption := sr.name;
     li.ImageIndex := GetImageIndex(sr.name);
     if sr.Size < 1024 then
       li.SubItems.Add(IntToStr(sr.Size) + " byte")
     else
     if sr.Size < 1024 * 1024 then
       li.SubItems.Add(IntToStr(round(sr.Size / 1024)) + " KByte")
     else
       li.SubItems.Add(IntToStr(round(sr.Size / (1024 * 1024))) + " MByte");
     li.SubItems.Add(GetFileType(sr.name));
   until
     FindNext(sr) <> 0;
 FindClose(sr);
 Form1.ListView1.Items.EndUpdate;
end;


 
И. Павел ©   (2010-05-12 16:04) [9]

> пробовал ей воспользоваться - вылетает куча непонятных ошибок
> и глюков

В старых версиях были глюки с перерисовкой (кое что делал вручную) - но сейчас они, кажется, исчезли. Еще был глюк, из за которого я выключил скины для диалоговых окон (MessageDlg и т.д.) Других глюков не встречал. ИМХО вы просто ее неправильно поставили (там в readme все описано).



Страницы: 1 вся ветка

Текущий архив: 2010.08.27;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.078 c
3-1239559848
Александр Степанов
2009-04-12 22:10
2010.08.27
Проблема с подключением к базе FireBird


2-1273211356
slay64
2010-05-07 09:49
2010.08.27
Ошибка в запросе


15-1265697833
12
2010-02-09 09:43
2010.08.27
Не будет ли так любезен сенсей дать скачать для offline познания?


6-1216982606
Uzer32.dll
2008-07-25 14:43
2010.08.27
Доступ к запароленым шарам


15-1271958315
TUser
2010-04-22 21:45
2010.08.27
Оппозиции на заметку