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

Вниз

Список файлов и директорий с их иконками   Найти похожие ветки 

← →
Алекс   (2004-11-02 17:56) [0]

Помогите создать список файлов и директорий с их иконками

---

← →
clickmaker ©   (2004-11-02 18:33) [1]

FindFirstFile / FindNextFile / FindClose
SHGetFileInfo

---

← →
Lin7   (2004-11-02 18:33) [2]

Присмотрись к Demos/Virtual Listview должно помочь...
Удачи!

---

← →
Stexen   (2004-11-03 02:49) [3]

Надеюсь за спам не убьют!Ну я же стараюсь помочь!

{$IFDEF VER100}
 {$DEFINE SI_D3}
{$ELSE}
 {$IFDEF VER120}
   {$DEFINE SI_D4}
 {$ELSE}
   {$DEFINE SI_D5OrHigher}
 {$ENDIF}
{$ENDIF}

unit SysImg;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 {$IFDEF SI_D3} ComCtrls {$ELSE} ImgList {$ENDIF};

type

 TIconSize = (isSmallIcons, isLargeIcons);

 TSysImageList = class({$IFDEF SI_D3} TImageList {$ELSE} TCustomImageList {$ENDIF})
 private
   fIconSize: TIconSize;
   procedure SetIconSize(Value: TIconSize);
   procedure UpdateHandle;
 public
   constructor Create(AOwner: TComponent); override;
   function ImageIndexOf(const Path: String; OpenIcon: Boolean
     {$IFNDEF SI_D3} = False {$ENDIF}): Integer;
 published
   Property BkColor;
   Property BlendColor;
   property DrawingStyle default dsTransparent;
   property IconSize: TIconSize read fIconSize write SetIconSize default isSmallIcons;
   property OnChange;
 end;

procedure Register;

implementation

uses
 ShellAPI, ShlObj, ActiveX;

type
 TSpecialFolder = record
   Name: String;
   ID: Integer;
 end;

const
 IconSizeFlags: array[TIconSize] of Word =
   (SHGFI_SMALLICON, SHGFI_LARGEICON);
 OPenIconFlags: array[Boolean] of Word =
   (0, SHGFI_OPENICON);
 SpecialFolders: array[1..7] of TSpecialFolder = (
   (Name: "Desktop";              ID: CSIDL_DESKTOP),
   (Name: "Control Panel";        ID: CSIDL_CONTROLS),
   (Name: "Printers";             ID: CSIDL_PRINTERS),
   (Name: "My Documents";         ID: CSIDL_PERSONAL),
   (Name: "Recycle Bin";          ID: CSIDL_BITBUCKET),
   (Name: "My Computer";          ID: CSIDL_DRIVES),
   (Name: "Network Neighborhood"; ID: CSIDL_NETWORK));

constructor TSysImageList.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 fIconSize := isSmallIcons;
 DrawingStyle := dsTransparent;
 ShareImages := True;
 UpdateHandle;
end;

procedure TSysImageList.UpdateHandle;
var
 FileInfo: TShFileInfo;
begin
 Handle := ShGetFileInfo("C:\", 0, FileInfo, SizeOf(FileInfo),
   IconSizeFlags[fIconSize] or SHGFI_SYSICONINDEX);
end;

function TSysImageList.ImageIndexOf(const Path: String; OpenIcon: Boolean): Integer;
var
 FileInfo: TShFileInfo;
 DesktopFolder: IShellFolder;
 PIDL: PItemIDList;
 Malloc: IMalloc;
 NumChars, Flags: {$IFDEF SI_D3} LongInt {$ELSE} Cardinal {$ENDIF};
 WidePath: PWideChar;
 SpecialFolderID, Index: Integer;
begin
 Result := 0;
 SpecialFolderID := -1;
 for Index := Low(SpecialFolders) to High(SpecialFolders) do
   if CompareText(Path, SpecialFolders[Index].Name) = 0 then
   begin
     SpecialFolderID := SpecialFolders[Index].ID;
     Break;
   end;
 if SpecialFolderID >= 0 then
   SHGetSpecialFolderLocation(Application.Handle, SpecialFolderID, PIDL)
 else
 begin
   Flags := 0;
   if (Pos(":", Path) = 0) then
     WidePath := StringToOleStr("*" + ExtractFileExt(Path))
   else
     WidePath := StringToOleStr(Path);
   NumChars := Length(WidePath);
   SHGetDesktopFolder(DesktopFolder);
   DesktopFolder.ParseDisplayName(0, nil, WidePath, NumChars, PIDL, Flags);
 end;
 if PIDL <> nil then
 begin
   FillChar(FileInfo, SizeOf(FileInfo), 0);
   ShGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo), SHGFI_PIDL or
     SHGFI_SYSICONINDEX or IconSizeFlags[fIconSize] or OpenIconFlags[OpenIcon]);
   if FileInfo.iIcon > 0 then Result := FileInfo.iIcon;
   ShGetMalloc(Malloc);
   Malloc.Free(PIDL);
 end;
end;

procedure TSysImageList.SetIconSize(Value: TIconSize);
begin
 if fIconSize <> Value then
 begin
   fIconSize := Value;
   UpdateHandle;
 end;
end;

procedure Register;
begin
 RegisterComponents("Win32", [TSysImageList]);
end;

end.
Пример использования:

...
var
ItemGlyph: TSysImageList
begin
 ItemGlyph:=TSysImageList.Create(nil);
...
end;
ItemGlyph.Draw(Canvas, 0, 0, ItemGlyph.ImageIndexOf(FilePath) { FilePath - путь к файлу для которого надо нарисовать иконку }

Так и создание списка файлов:

function ReadFileNames(const ParentDirectory: string;
 FileList: TStringList; SerAtr:integer): Integer;
var
 Status: Integer;
 SearchRec: TSearchRec;
begin
 Result := 0;
 Status := FindFirst(SlashSep(ParentDirectory, "*.*"), SerAtr, SearchRec);
 try
   while Status = 0 do
   begin
     if (SearchRec.Attr and SerAtr = SerAtr) then
     begin
       if (SearchRec.Name <> "."){ and (SearchRec.Name <> "..")} then
       begin
         FileList.Add(SearchRec.Name);
         Inc(Result);
       end;
     end;
     Status := FindNext(SearchRec);
   end;
 finally
   FindClose(SearchRec);
 end;
end;

Вызываешь процедуру три раза для одного и того же FileList изменяя лишь SerAtr
SerAtr: 1)0,  2)faHidden 3)faDirectory
тогда получишь полный список файлов и папок для данной дириктории ParentDirectory.
пример

procedure ReadRootDir;
var
 Files: TStringList;
 Indx: integer;
 ItemGlyph: TSysImageList
begin
 ItemGlyph:=TSysImageList.Create(NortView);
 Files := TStringList.Create;
 ReadFileNames("c:\",  Files, 0);
 ReadFileNames("c:\",  Files, faHidden);
//  ReadFileNames("c:\",  Files, faDirectory);
 for Indx := 0 to Files.Count - 1 do
   begin
     ItemGlyph.Draw(Canvas, Ind+10, 0, ItemGlyph.ImageIndexOf("c:\"+Files.Strings[Indx]);
     Canvas.TextOut(Ind+10,0,Files.Strings[Indx]);
   end;
end;

Вот так вот ты выведешь на форму значки с именами файлов в c:\
ну дальше разберешься...если нет то уже все плохо...

Что то может не работать вытащил из своего менджера, по надписи сверху исходников понял что писалось это дело в 2001, когда я был еще маленьким.а примеры тоже не проверялись пришлось импровезировать!

---

← →
Stexen   (2004-11-03 02:53) [4]

Ind + 10 там будет наложение одного на другой файлов так что там надо так что нужен еще один счетчик координат вывода

---

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

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

Наверх

Память: 0.48 MB
Время: 0.023 c