我做一个搜索文件的程序,怎样才能使LISTVIEW组件中显示的IMAGE就是文件自己的ICON?(100分)

  • 主题发起人 主题发起人 kevenzhang
  • 开始时间 开始时间
K

kevenzhang

Unregistered / Unconfirmed
GUEST, unregistred user!
就像WINDOWS中的搜索文件的程序
 
获取系统图标
 
Get File Icon and Draw it by yourself
 
新建一个Application窗体上放置一个ImageList,Button,ListView,然后让ListView和ImageList相关联,然后写入下面的代码:

function TForm1.GetIconIndex(mPath: string): Integer;
var
vSHFileInfo: TSHFileInfo;
begin
FillChar(vSHFileInfo, SizeOf(vSHFileInfo), 0);
SHGetFileInfo(PChar(mPath), 0, vSHFileInfo, SizeOf(vSHFileInfo),
SHGFI_SYSICONINDEX);
Result := vSHFileInfo.iIcon;
end;

function TForm1.GetSystemImageList(mImageList: TImageList): Boolean;
var
mHandle: THandle;
vSHFileInfo: TSHFileInfo;
begin
FillChar(vSHFileInfo, SizeOf(vSHFileInfo), 0);
mHandle := SHGetFileInfo('', 0, vSHFileInfo, SizeOf(vSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Result := mHandle <> 0;
mImageList.Handle := mHandle;
mImageList.ShareImages := True;
end;


procedure TForm1.PathToListItem(mDirName: string);
var
vSearchRec: TSearchRec;
vPathName: string;
K: Integer;
vListItem: TListItem;
begin
vPathName := mDirName + '/*.*';
K := FindFirst(vPathName, faAnyFile, vSearchRec);
while K = 0 do
begin
if (vSearchRec.Attr and faDirectory <> 0) and (Pos(vSearchRec.Name, '..') = 0) then
begin
vListItem := ListView1.Items.Add;
vListItem.Caption := vSearchRec.Name;
vListItem.ImageIndex := GetIconIndex(mDirName + '/' + vSearchRec.Name);
PathToListItem(mDirName + '/' + vSearchRec.Name)
end
else if (Pos(vSearchRec.Name, '..') = 0) then
begin
vListItem := ListView1.Items.Add;
vListItem.Caption := vSearchRec.Name;
vListItem.ImageIndex := GetIconIndex(mDirName + '/' + vSearchRec.Name);
end;
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end;
///上面是自己定义的函数

procedure TForm1.Button1Click(Sender: TObject);
var
vDirectory: string;
begin
if not SelectDirectory('Path', '', vDirectory) then Exit;
PathToListItem(vDirectory);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetSystemImageList(ImageList1);
ImageList1.DrawingStyle := dsTransparent;
end;

编译运行,就可以了。
 
function TForm1.GetIconIndex(mPath: string): Integer;
这个函数有问题呀
是不是漏了什么类库
 
uses ShellApi;
 
uses shellapi,QDialogs;
 
加一个imagelist,button,listview
设listview的imagelist关联
uses shellapi;
function GetFileIcon(const Filename: String; SmallIcon: Boolean): HICON;
var
info: TSHFILEINFO;
Flag: Integer;
begin
if SmallIcon then
Flag := (SHGFI_SMALLICON or SHGFI_ICON)
else
Flag := (SHGFI_LARGEICON or SHGFI_ICON);
SHGetFileInfo(Pchar(Filename), 0, info, Sizeof(info), Flag);
Result := info.hIcon;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
aa: TIcon;
item:Tlistitem;
begin
listview1.Clear ;
aa:=Ticon.Create ;
begin
aa.Handle := GetFileIcon('C:/windows/desktop/腾讯QQ.lnk',true);
imagelist1.AddIcon(aa);
item:=Listview1.Items.Add ;
item.Caption := '1111111111';
item.SubItems.Add('11111');
item.ImageIndex:= 0;
end;
aa.Free ;
end;
 
function TbsSkinFileListView.AddFile(FileMask: String; Attr: DWord): Boolean;
var
ShInfo: TSHFileInfo;
attributes: String;
FDate, FName, FileName: String;
FSize: Integer;
FI: TSearchRec;

function AttrStr(Attr: integer): String;
begin
Result:='';
if (FILE_ATTRIBUTE_DIRECTORY and Attr)>0 then
Result:=Result+'';
if (FILE_ATTRIBUTE_ARCHIVE and Attr)>0 then
Result:=Result+'A';
if (FILE_ATTRIBUTE_READONLY and Attr)>0 then
Result:=Result+'R';
if (FILE_ATTRIBUTE_HIDDEN and Attr)>0 then
Result:=Result+'H';
if (FILE_ATTRIBUTE_SYSTEM and Attr)>0 then
Result:=Result+'S';
end;

begin
Result := False;
if not SetCurrentDir(FDirectory) then
exit;
if FindFirst(FileMask,faAnyFile,FI)=0 then
try
repeat
if ((Attr and FILE_ATTRIBUTE_DIRECTORY)=(FI.Attr and FILE_ATTRIBUTE_DIRECTORY)) then
begin
CurPath:=IncludeTrailingBackslash(FDirectory);
FName:=FI.Name;
FileName:=IncludeTrailingBackslash(FDirectory)+FName;
if (FName='.') or (FName='..') then
continue;
SHGetFileInfo(PChar(FileName),0,ShInfo,SizeOf(ShInfo),SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME);
FSize:=FI.Size;
FDate:=DateTimeToStr(FileDateToDateTime(FI.Time));
Attributes:=AttrStr(FI.Attr);
with Items.Add do begin
Caption:=FName;
if SmallImages<>nil then
ImageIndex:=ShInfo.iIcon;
if (FI.Attr and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
SubItems.Add(' ')
else
SubItems.Add(Trim(IntToStr(FSize)));
SubItems.Add((ShInfo.szTypeName));
SubItems.Add(FDate);
SubItems.Add(attributes);
SubItems.Add(FileName);
if (FI.Attr and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
SubItems.Add('dir')
else
SubItems.Add('file');
end;
FDirectorySize:=FDirectorySize+FSize;
Result:=True;
end;
until FindNext(FI)<>0;
finally
FindClose(FI);
end;
end;
这是一个三方控件关于获取目录下所有文件的代码,你看一下,希望对你有帮助
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部