Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.081 c
2-1267595287
allrussia
2010-03-03 08:48
2010.08.27
Перекодировка русского текста DOS+ANSI в ANSI


15-1266163521
БарЛог
2010-02-14 19:05
2010.08.27
Окружность-круг, а квадрат, треугольник и etc не имеют "пары"


2-1275547550
My__Nick__Name
2010-06-03 10:45
2010.08.27
Unicode в Open Office 3


15-1266830326
Денис_
2010-02-22 12:18
2010.08.27
Подскажите книгу


2-1274871683
AbdreyZAA
2010-05-26 15:01
2010.08.27
Как узнать заряд каждой батареии?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский