根据一个字符串(如“aaa.doc”)获得windows内与之相对应的图标的问题！超级疑难，非高手莫入！ (200分)

ligia · 2002-12-29

FUNCTION FtImageListAdd(vFile:STRING;vImageList:TImageList;vForm:TForm):INTEGER; VAR icoTemp:TIcon; imgList:TImageList; tshIcon: TSHFileInfo; BEGIN     icoTemp:=TIcon.Create;     imgList:=TImageList.Create(vForm);//     imgList.Handle:=SHGetFileInfo(PCHAR(vFile),0,tshIcon,SizeOf(tshIcon),SHGFI_SYSICONINDEX+SHGFI_SMALLICON);     imgList.ShareImages:=TRUE;     imgList.GetIcon(tshIcon.iIcon,icoTemp);     Result:=vImageList.AddIcon(icoTemp);     icoTemp.Free;     imgList.Free; END; 第二个问题. 如果你想做类似文件夹流览器建议使用控件. 关于PIDL因所设计的问题太多,推荐看一下, {这不是我写的} implementation uses   FileCtrl, ShellAPI, ActiveX, ShlObj, ComObj; {$R *.DFM} var   ShellMalloc: IMalloc;   DesktopFolder: IShellFolder;   CS : TRTLCriticalSection;   FileInfo: TSHFileInfo; function NextPIDL(PIDL: PItemIDList): PItemIDList; begin   Result := PIDL;   Inc(PChar(Result), PIDL^.mkid.cb); end; function GetPIDLSize(PIDL: PItemIDList): Integer; begin   Result := 0;   if Assigned(PIDL) then begin     Result := SizeOf(PIDL^.mkid.cb);     while PIDL^.mkid.cb <> 0 do begin       Result := Result + PIDL^.mkid.cb;       PIDL := NextPIDL(PIDL);     end;   end; end; function CreatePIDL(Size: Integer): PItemIDList; begin   try     Result := nil;     Result := ShellMalloc.Alloc(Size);     if Assigned(Result) then FillChar(Result^, Size, 0);   finally   end; end; procedure FreePIDL(PIDL: PItemIDList); begin   if PIDL <> nil then ShellMalloc.Free(PIDL); end; function ConcatPIDLs(PIDL1, PIDL2: PItemIDList): PItemIDList; var cb1, cb2: Integer; begin   if Assigned(PIDL1) then cb1 := GetPIDLSize(PIDL1) - SizeOf(PIDL1^.mkid.cb) else cb1 := 0;   cb2 := GetPIDLSize(PIDL2);   Result := CreatePIDL(cb1 + cb2);   if Assigned(Result) then begin     if Assigned(PIDL1) then CopyMemory(PChar(Result), PIDL1, cb1);     CopyMemory(PChar(Result) + cb1, PIDL2, cb2);   end; end; procedure TForm1.Button1Click(Sender: TObject); var   PIDL, RelativePIDL, NewPIDL: PItemIDList;   Eaten, Attributes: Cardinal;   path: string;   P: PWideChar;   ShellFolder: IShellFolder;   EnumIDList: IEnumIDList;   NumIDs: Cardinal; begin   // 设置要显示的路径,取其 PItemIDList   path := 'C:/Documents and Settings/Administrator/My Documents/Delphi_Tmp';   Eaten := Length(path);   P := StringToOleStr(path);   Attributes := 0;   OLECheck(DesktopFolder.ParseDisplayName(Application.Handle, nil, P, Eaten, PIDL, Attributes));   // 根据 PItemIDList 得到 IShellFolder   // 可以直接取文件的PIDL，但是存在与以前一样的现象，现在取其目录   DesktopFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(ShellFolder));   // 枚举目录下的文件到 EnumIDList   ShellFolder.EnumObjects(Application.Handle, SHCONTF_NONFOLDERS, EnumIDList);   NewPIDL := nil;   while EnumIDList.Next(1, RelativePIDL, NumIDs) = S_OK do     try       // 将列出的文件PIDL与目录合并得到文件的 PItemIDList       NewPIDL := ConcatPIDLs(PIDL, RelativePIDL);       // 根据合并出的完整文件PItemIDList取文件名和属性！       FillChar(FileInfo, SizeOf(FileInfo), 0);       SHGetFileInfo(PChar(NewPIDL), 0, FileInfo, SizeOf(FileInfo), SHGFI_PIDL or SHGFI_DISPLAYNAME or SHGFI_TYPENAME);       ListBox1.Items.Add( FileInfo.szDisplayName + ' - ' + FileInfo.szTypeName );     finally       FreePIDL(NewPIDL);       FreePIDL(RelativePIDL);     end; end; initialization   OLECheck(SHGetDesktopFolder(DesktopFolder));   InitializeCriticalSection(CS);   OleInitialize(nil);   OLECheck(ShGetMalloc(ShellMalloc)); finalization   DesktopFolder := nil;   ShellMalloc := nil;   OleUninitialize;   DeleteCriticalSection(CS); end. 新的一个问题,说起来容易做起来难. 用SaveToStream(); 和LoadfromStream();存取TStream变量. to zjfeng, 快捷方式那个图标确实是叠加的.

yanghai0437 · 2002-12-29

to 我爱PASCAL 我这个函数完全满足你的要求： function GetFileIcon(const DocFileNameExt: string): string; var FileClass: string; Reg: TRegistry; begin Result := ''; Reg := TRegistry.Create(KEY_EXECUTE); Reg.RootKey := HKEY_CLASSES_ROOT; FileClass := ''; if Reg.OpenKeyReadOnly(DocFileNameExt) then //在我的计算机上这句话打开不成功，不知道为什么 begin                                       //我只好用openkey打开   FileClass := Reg.ReadString(''); Reg.CloseKey; end; if FileClass <> '' then begin if Reg.OpenKeyReadOnly(FileClass + '/Shell/DefaultIcon') then //这个地方好像不对，应该不要shell,是不是 begin Result := Reg.ReadString(''); Reg.CloseKey; end; end; Reg.Free; end;

yanghai0437 · 2002-12-29

to chemstar   我没有说哪个函数错了，我只是说SHGetFileInfo这个函数只能得到   实际存在的文件的信息

天宇天蓝 · 2002-12-29

var fileinfo:shfileinfo; shgetfileinfo(pchar('wypeng.doc'),0,fileinfo,sizeof(fileinfo),shgfi_icon); listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;//返回文件的图标

天宇天蓝 · 2002-12-29

别忘了加分噢！！！ Delphi 编写Windows 资源管理器 编写资源管理器，Delphi 有最简单的方法，就是在form上加上一个 TShellComboBox1控件，一个TShellTreeView1控件和一个TShellListView1控件。然后分别指定他们的属性值为对应的属性就可以了。 但是这不是一个程序员所要的。因为你不能对上述的这些内容进行操作，所以，我 在这里要说的是第二种，也就是最为激动人心的有自己写的代码来实现以上的功能。 用程序实现的好处是控制随心所欲。这把这种方法用到了我写的木马当中。 在服务器端有我的一个服务程序，在我的机子上有我的另一个客户端程序。 当我要用我的客户端连接服务器端的时候，比如202.206.242.119，服务器端就把 本机(202.206.242.119)上的所有磁盘信息发送给我。（比如有c:,d:,e:,f:....) 当我在本地（我的机子）上点击"c:"时候，服务器端就把202.206.242.119上的 c:盘上的所有文件和目录发送给我，我一目了然。我还可以在他的机子上新建、删除 运行等各种文件。好不好玩啊？~_~当然，他首先得运行我的木马程序。 国内赫赫有名的"冰河"我想大家都用过吧，不错吧。就像是管理自己机子的资料管理器,好了，不再废话了，让我们开始这激动人心的一刻吧！ 首先要明白程序的流程，不然我不是在这瞎说一桶吗？ 第一步就是找到机子上的所有的硬盘，第二就是找到机子上对应硬盘下的所有文件和图标。 找硬盘的方法很多，我用的是Winapi函数：getdrivetype,因为它比较简单。 打文件就是findfirst和findnext就可以了。 剩下的就是怎样向ttreeview中填充了。 好了，开始吧！ 新建一个工程，然后窗体的caption为"资源管理器" 在窗体上添加一个TTreeview控件命名为dir,一个tlistview控件命名为wfile，两个tpopupmenu控件 两个timagelist控件.dir 对应第一个tpopupmemu,wfile对应第二个tpopupmemu。 第一个tpopupmemu的Items分别为：删除，新建文件夹，重命名。 第二个tpopupmemu的Items分别为：查看，删除，新建文件，新建文件夹，重命名。其中，查看的子项为： 大图标，小图标，列表和详细资料。 unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ExtCtrls, ComCtrls, ImgList,shellapi, StdCtrls, Buttons, Menus,   Grids, DBGrids; type   Tlistfile = class(TForm)     dir: TTreeView;     Wfile: TListView;     Splitter1: TSplitter;     ImageList1: TImageList;     PopupMenu1: TPopupMenu;     N1: TMenuItem;     Image1: TImage;     ImageList2: TImageList;     N2: TMenuItem;     R1: TMenuItem;     PopupMenu2: TPopupMenu;     D1: TMenuItem;     N3: TMenuItem;     R2: TMenuItem;     M1: TMenuItem;     zt: TStatusBar;     V1: TMenuItem;     N4: TMenuItem;     N5: TMenuItem;     N6: TMenuItem;     M2: TMenuItem;     L1: TMenuItem;     N7: TMenuItem;     procedure FormCreate(Sender: TObject);     procedure dirCollapsed(Sender: TObject; Node: TTreeNode);     procedure dirExpanded(Sender: TObject; Node: TTreeNode);     procedure WfileDblClick(Sender: TObject);     procedure dirClick(Sender: TObject);     procedure N1Click(Sender: TObject);     procedure dirEdited(Sender: TObject; Node: TTreeNode; var S: String);     procedure WfileEdited(Sender: TObject; Item: TListItem; var S: String);     procedure dirKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);     procedure D1Click(Sender: TObject);     procedure R2Click(Sender: TObject);     procedure N3Click(Sender: TObject);     procedure M1Click(Sender: TObject);     procedure N2Click(Sender: TObject);     procedure N4Click(Sender: TObject);     procedure L1Click(Sender: TObject);     procedure M2Click(Sender: TObject);     procedure N7Click(Sender: TObject);   private     procedure filedir(dirname:string;node:ttreenode);//查找文件     procedure wmdropfiles(var msg:twmdropfiles);message wm_dropfiles;     { Private declarations }   public     { Public declarations }   end; var   listfile: Tlistfile;   fileinfo:shfileinfo;   f:array [0..0,0..2] of string;   ListItem: TListItem;   filename,names:string;   pathname:string;   node1,node3:ttreenode; implementation {$R *.dfm} //以上是窗体上的控件和属性. function IsValidDir(SearchRec:TSearchRec):Boolean; begin   if ((SearchRec.Attr=16)or (searchrec.Attr =17)or      (searchrec.Attr =18)or (searchrec.Attr =22)      or (searchrec.Attr =49)or (searchrec.Attr =48))       and (SearchRec.Name<>'.')      and (SearchRec.Name<>'..') then       Result:=True   else      Result:=False;   //showmessage(inttostr(searchrec.Attr )); end; ////////以上是一个函数，功能是判断一个文件是不是文件夹。 function panel(node:ttreenode):string; var str:string; node2:ttreenode; begin   try   node2:=node.Parent;//返回父节点   str:=node2.Text+str;   node1:=node2;   filename:=str+'/'+filename;   panel(node2);   except     panel:=filename;   end; end; ///////一个递归函数，找到node的父节点。 procedure tlistfile.wmdropfiles(var msg:twmdropfiles); var numfiles:longint;    i:longint;    buffer:array[0..255] of char; begin   showmessage('asdfasdf'); end; ////////用兴趣的朋友可以在这处理鼠标拖放，本人没有处理，只是打到了。 procedure tlistfile.filedir(dirname:string;node:ttreenode); var searchrec:tsearchrec;     filename:string;     node1:ttreenode;     i:integer; begin   try   for i:=node.Count -1 downto 0 do     begin       node.Item .Delete ;     end;   except   end;   filename:=dirname+'/*.*';   wfile.Clear;   listfile.ImageList2.Clear;   listitem:=wfile.Items.Add;   listitem.Caption:='..';   if findfirst(filename,faAnyFile,searchrec)=0 then     begin       while findnext(searchrec)=0 do         begin          if IsValidDir(searchrec) then            begin              node1:=listfile.dir.Items.AddChild(node,searchrec.Name );              node1.ImageIndex:=1;              node1.SelectedIndex:=2;              listfile.dir.Items.AddChild(node1,'' );              shgetfileinfo(pchar(dirname+'/'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);              listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;//返回文件的图标              listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);//添加图标              f[0,0]:=searchrec.Name;//+'   '+inttostr(searchrec.Attr );              f[0,1]:=inttostr(searchrec.Size);              f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));              listitem:=wfile.Items.Insert(1);              listitem.Caption:=f[0,0];              listitem.SubItems.Add('');              listitem.SubItems.add(f[0,2]);              wfile.Items[1].ImageIndex:=imagelist2.Count-1 ;              wfile.Items[0].ImageIndex:=imagelist2.Count-1;            end          else            begin              if searchrec.Name <>'..' then                begin                  f[0,0]:=searchrec.Name;                  f[0,1]:=inttostr(searchrec.Size);                  f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));                  listitem:=listfile.wfile.Items.Add;                  listitem.Caption:=f[0,0];                  listitem.SubItems.Add(f[0,1]);                  listitem.SubItems.Add(f[0,2]);                  shgetfileinfo(pchar(dirname+'/'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);                  listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;////返回文件图标                  listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);                  wfile.Items[wfile.Items.Count-1].ImageIndex:=imagelist2.Count -1;                end;            end;         end;     end;   findclose(searchrec); end; //////////////以上是查找文件的过程 procedure SelectNode(const Tx: string; Tree: TTreeView); var www:Boolean; begin   if Tx = '' then exit;   node3:=tree.Items.GetFirstNode;   while node3<>nil do   begin     if pathname+'/'+node3.Text = tx then       begin         //node.Expanded:=true;         //listfile.filedir(pathname+'/'+node1.Text,node1);         node3.Expanded:=true;         www:=true;         break;       end     else       begin         try         node3:=node3.GetNext;         except         showmessage(tx);         shellexecute(listfile.handle,nil,pchar(tx ),           nil,nil,sw_shownormal)         end;       end;   end;   if www=false then   shellexecute(listfile.handle,nil,pchar(tx ),           nil,nil,sw_shownormal) end; ////////////以上是一个过程，处理鼠标在listviewh 双击事件过程 /////在树中查找 procedure Tlistfile.FormCreate(Sender: TObject); var i:integer;drivepath:string;     fname:string;     node:ttreenode;     rnode:ttreenode; begin   shgetfileinfo(pchar('c:/'),0,fileinfo,sizeof(fileinfo),shgfi_icon);   listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;   listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon);   listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);   shgetfileinfo(pchar('c:/Program Files'),0,fileinfo,sizeof(fileinfo),shgfi_icon);   listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;   listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon);   shgetfileinfo(pchar('c:/Program Files'),0,fileinfo,sizeof(fileinfo),shgfi_icon);   listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;   listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon); /////////////////////////////////////////////// ////因为有两个imagelist控件一个是树的，一个是listfile的，imagelist的图标库是空的。 ////以上是为两个imagelist控件添加图标。以上的代码可以不要，但为了界面的美观，可以手工的为 ////两个imagelist控件添加图标. ////////////////////以上添加的图标一个是硬盘的图标，一个是文件夹的图标.   dragacceptfiles(handle,true);   application.Title:='资源管理器';   for i:=0 to 25 do     begin      drivepath:=char(ord('A')+i)+':/';      case getdrivetype(pchar(drivepath))of        drive_removable:            //dir.Items.AddChild(nil,char(ord('A')+i)+':');            ;        drive_fixed:          begin            node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');            rnode:=dir.Items.AddChild(node,'');            rnode.ImageIndex:=-1;            fname:=char(ord('A')+i)+':';            f[0,0]:=fname;            listitem:=wfile.Items.Add;            listitem.Caption:=f[0,0];            listitem.SubItems.Add(f[0,1]);          end;        drive_remote:          begin            node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');            rnode:=dir.Items.AddChild(node,'');            rnode.ImageIndex:=-1;            fname:=char(ord('A')+i)+':';            f[0,0]:=fname;            listitem:=wfile.Items.Add;            listitem.Caption:=f[0,0];            listitem.SubItems.Add(f[0,1]);          end;        drive_cdrom:          begin            node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');            rnode:=dir.Items.AddChild(node,'');            rnode.ImageIndex:=-1;            fname:=char(ord('A')+i)+':';            f[0,0]:=fname;            listitem:=wfile.Items.Add;            listitem.Caption:=f[0,0];            listitem.SubItems.Add(f[0,1]);          end;        drive_ramdisk:          begin            node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');            rnode:=dir.Items.AddChild(node,'');            rnode.ImageIndex:=-1;            fname:=char(ord('A')+i)+':';            f[0,0]:=fname;            listitem:=wfile.Items.Add;            listitem.Caption:=f[0,0];            listitem.SubItems.Add(f[0,1]);          end;      end; ////////////以上的循环返回机器上的所有硬盘     end; end; /////////////以上是窗体加载时的事件 procedure Tlistfile.dirCollapsed(Sender: TObject; Node: TTreeNode); var I:integer; begin   for i:=node.Count -1 downto 1 do     begin       node.Item .Delete ;     end; end; ////////当treeview收缩时的事件 procedure Tlistfile.dirExpanded(Sender: TObject; Node: TTreeNode); begin    panel(node);   names:=filename;   if filename<>'' then     begin       filedir(filename+node.Text  ,node);       pathname:=filename+node.Text;     end   else     begin       filedir(node.Text ,node);       pathname:=node.Text;     end;    filename:=''; end; ///////treeview展开时的事件 /////以上的填充有两种，第一种就是我这种，第二种是在窗体加载时填充。 ////第一种节省速度。 ///////因为是网络传输，第一要考虑的就是速度，所以，我考虑第一种。 /////在节点展开是填充，收缩时删除节点，但只保留了一个。 procedure Tlistfile.WfileDblClick(Sender: TObject); var i:integer; begin   try   if wfile.ItemIndex=0 then     begin     node3.Collapse(true);     //node3.Expanded:=true;     node3.Parent.Selected:=true;     dir.OnClick(node3.Parent );     end   else   SelectNode(pathname+'/'+wfile.Selected.Caption,dir);   except   end;  //   shellexecute(handle,nil,pchar(pathname+'/'+wfile.Selected.Caption ),    //   nil,nil,sw_shownormal) end; /////////鼠标在listview上双击时 procedure Tlistfile.dirClick(Sender: TObject); begin   zt.Panels[0].Text:='';   panel(dir.Selected);   names:=filename;   if filename<>'' then     begin       filedir(filename+dir.Selected.Text,dir.Selected);       pathname:=filename+dir.Selected.Text;     end   else     begin       filedir(dir.Selected.Text ,dir.Selected);       pathname:=dir.Selected.Text;     end;    filename:=''; end; /////在treeview上单击时 procedure Tlistfile.N1Click(Sender: TObject); begin   if deletefile(pathname+'/'+wfile.Selected.Caption) then     begin       filedir(pathname,dir.Selected);       zt.Panels[0].Text:='删除成功';     end   else     begin       zt.Panels[0].Text:='删除不成功';     end; end;////处理在listview上删除一个对象是删除个文件 procedure Tlistfile.dirEdited(Sender: TObject; Node: TTreeNode;   var S: String); begin   if RenameFile(pathname, names+s) then     zt.Panels[0].Text:='更名成功'   else     zt.Panels[0].Text:='更名不成功'; end; //////在treeview上改名是更改对应的目录名 procedure Tlistfile.WfileEdited(Sender: TObject; Item: TListItem;   var S: String); begin  if  movefile(pchar(pathname+'/'+wfile.Selected.Caption),pchar(pathname+'/'+s)) then    zt.Panels[0].Text:='更名成功'  else    zt.Panels[0].Text:='更名不成功'; end;///////更改文件的文件名的事件 procedure Tlistfile.dirKeyUp(Sender: TObject; var Key: Word;   Shift: TShiftState); Var   T:TSHFileOpStruct;   P:String; begin   if key=46 then     begin       With T do         Begin         Wnd:=0;         wFunc:=FO_DELETE;         pFrom:=Pchar(pathname);         pTo:=nil;         fFlags:=FOF_ALLOWUNDO+FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复，无须确认并不显示出错信息         hNameMappings:=nil;         lpszProgressTitle:='正在删除文件夹...';         fAnyOperationsAborted:=False;         End;         if SHFileOperation(T)=0 then         begin           zt.Panels[0].Text:='删除完毕';           dir.Selected.Delete;         end         else           zt.Panels[0].Text:='删除不成功';     end; end;//////删除节点时同时删除对应的目录,用户按了键盘上的[Delete]键. procedure Tlistfile.D1Click(Sender: TObject); var key: word;Shift: TShiftState; begin   key:=46;   dir.OnKeyUp(sender,key,shift); end;////点击tpopupmemu1的删除时。 procedure Tlistfile.R2Click(Sender: TObject); begin   dir.Selected.EditText; end;////////点击重命名时。 procedure Tlistfile.N3Click(Sender: TObject); var node:ttreenode;  s:string;i:integer; begin   i:=pos(dir.Selected.Text,pathname);   s:=pathname;   delete(s,i,length(dir.Selected.Text ));   //showmessage(s+'新建文件夹');   mkdir(s+'新建文件夹');   node:=dir.Items.AddChild(dir.Selected.Parent,'新建文件夹');   node.ImageIndex:=1;   node.SelectedIndex:=1;   node.EditText; end;/////////点击新建文件夹时。 procedure Tlistfile.M1Click(Sender: TObject); begin   mkdir(pathname+'/'+'新建文件夹');   listitem:=wfile.Items.Add;   listitem.Caption:='新建文件夹';   listitem.ImageIndex:=0; end;///////在wfile上新建文件夹时. procedure Tlistfile.N2Click(Sender: TObject); var   f:textfile; begin   assignfile(f,pathname+'/'+'新建文件.Wxx');   rewrite(f);   closefile(f);   listitem:=wfile.Items.Add;   listitem.Caption:='新建文件.Wxx';   listitem.EditCaption; end;////新建文件时。 procedure Tlistfile.N4Click(Sender: TObject); begin   wfile.ViewStyle:=vsIcon; end;/////////大图标 procedure Tlistfile.L1Click(Sender: TObject); begin   wfile.ViewStyle:=vslist; end;////////////列表 procedure Tlistfile.M2Click(Sender: TObject); begin   wfile.ViewStyle:=vsSmallIcon; end;///////////小图标 procedure Tlistfile.N7Click(Sender: TObject); begin   wfile.ViewStyle:=vsReport; end;///////////详细资料。 end.

chemstar · 2002-12-29

to yanghai0437, 　看看我的开头的帖子的代码，那是我已经整理好了的！你老兄是不是不试代码呀？ 上面不是已经说的很明白了吗？在98下运行正常，但在NT下不保证！ 要在win2000下运行，需要做如下改动：  ShGetFileInfo('*.*',0,SHFileInfo...) 改成 ShGetFileInfo('',0,SHFileInfo...)

chemstar · 2002-12-29

to 天宇天蓝,   你要是早来一步，我可就省了老大的事了！现在我除了存取图标的问题外别的早就搞定了！ 但还是谢谢你！看了你的代码后仍有很大的收获！ 　这个问题你会吗？能否告诉我： 　问：怎样将取得的图标（我是用ExtractAssociatedIcon从盘上的一个文件提取的）存入一个数据库,如aaa.mdb？ 　　而后又怎样从库中取出来然后将它加到一个imagelist里面？ 　　其实不用数据库也行，只要能把很多的图标存入一个文件就行。

lu.weifeng · 2002-12-30

chemstar · 2002-12-30

to　ligia:   不好意思，还是没解决问题。看了你给的函数后，发现不太适合自己的要求。 我的意思是这样的：在一个listview内有些items，但是它们的图标要根据情况随时变化， 有的时候需要从系统imagelist内取相应的图标，但有的时候需要从自已预定的一个imagelist 内取（里面早已预置了很多的图标）。我的问题是怎么样可以使listview的Largeimagelist 和smallimagelist在系统的imsgelist和自已的imamelist两边方便的转换？ 　盼指点一二，谢谢！

ligia · 2002-12-30

http://www.iligia.com/chinese/index.asp  你可以下载 xpanels xp 我是这样作的. 1.首先用FkListViewImageInit对ListView初使话. 2.需要使用系统图标的时候使用下边的函数添加到 ListView.SmallImages. FUNCTION FtImageListAdd(vFile:STRING;vImageList:TImageList;vForm:TForm):INTEGER; VAR icoTemp:TIcon; imgList:TImageList; tshIcon: TSHFileInfo; BEGIN     icoTemp:=TIcon.Create;     imgList:=TImageList.Create(vForm);//     imgList.Handle:=SHGetFileInfo(PCHAR(vFile),0,tshIcon,SizeOf(tshIcon),SHGFI_SYSICONINDEX+SHGFI_SMALLICON);     imgList.ShareImages:=TRUE;     imgList.GetIcon(tshIcon.iIcon,icoTemp);     Result:=vImageList.AddIcon(icoTemp);     icoTemp.Free;     imgList.Free; END; 3.使用自己的图标的时候,如 ImageListDefault . VAR icoTemp:TIcon; iIndex:INTEGER; BEGIN     icoTemp:=TIcon.Create;     ImageListDefault.GetIcon(使用的那个图标的Index,icoTemp);     iIndex:=ListViewMain.SmallImages.AddIcon(icoTemp);     icoTemp.Free; END; iIndex就是新的Index.

chemstar · 2003-01-02

to ligia,   你的第一个函数里面的这个　vImageList　是做什么用的？哪儿来的？我用了后还是不行。 看来似乎是listview的问题。 　比如：在一个listview内有两个items，分别为aaa.doc和direction。 　aaa.doc的图标从系统内取得，应为一个word图标，但direction的图标是一个自定义的图标， 从自已的imagelist里面取第一个。 　这根本是不可能的！ 　程序运行后，要么都是系统内的图标，要么都是自己的imagelist里面的！也就是说，同一时刻， listview.smallimages只能付给一个imagelist！ 　这个问题可是困死我了！

ligia · 2003-01-02

你等一下,我给你造个小程序.

ligia · 2003-01-02

到下边下载,包含测试程序+源码.Delphi7  www.iligia.com/public/download/testicon/ligia_icon_test.rar

chemstar · 2003-01-03

to ligia:   非常感谢您不怕麻烦的解答我的问题。我试了你的代码，基本上可以，看来我前面的看法是错误的。 但仍有一点小问题：我作了如下改动后： procedure TFormMain.OpenFileClick(Sender: TObject); var sFile:STRING;   lItem:TListItem;icoTemp:TIcon; imgList:TImageList; tshIcon: TSHFileInfo;    // IF NOT FormMain.OpenDialogMain.Execute THEN Exit;   // sFile:=FormMain.OpenDialogMain.FileName;   //将上面原来的两句改成以面这一句      sFile:='aaa.doc';//aaa.doc并不是一个实际存在的文件   lItem:=FormMain.ListViewMain.Items.Add;   lItem.Caption:=sFile;     icoTemp:=TIcon.Create;   imgList:=TImageList.Create(FormMain);// //imgList.Handle:=SHGetFileInfo(PCHAR(sFile),0,tshIcon,SizeOf(tshIcon),SHGFI_SYSICONINDEX+SHGFI_SMALLICON);   //将上面一句改为下面这句：（这样才能获得并不实际存在的文件的图标） imgList.Handle:=SHGetFileInfo(PCHAR(sFile),0,tshIcon,SizeOf(tshIcon),SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SMALLICON);   　imgList.ShareImages:=TRUE;   imgList.GetIcon(tshIcon.iIcon,icoTemp);   FormMain.ListViewMain.SmallImages.AddIcon(icoTemp);   lItem.ImageIndex:=FormMain.ListViewMain.SmallImages.Count-1;   icoTemp.Free;   imgList.Free; end; 作了如上改动后，运行。出现了下面的情况： 　1、若先单击OpenFile按钮，再击myicon按钮，没有任何问题。listview内会出现一个work图标后， 　又出现了一个自己的ImageListDefault内的图标。 　2、但如果先击myicon按钮，再击OpenFile按钮，则出现了两个跟myicon一样的图标，（第二个应该是word图标）。 　3、如果再加入一个button2，将openfile按钮内的代码加到里面（只把aaa.doc改为aaa.txt），运行 　先击OpenFile按钮，再击button2，这时只出现两个word的图标，而不会出现txt图标。 　 　这说明您给出的代码似乎还有不妥之处，昐望您好人做到底，给予解答！

ligia · 2003-01-03

我按照你说修改了,没有出现你说的问题.可能与操作系统有关系.我的是XPpro+SP1. 修改以下内容.这一段去掉的内容不是必须的,只是为了保证图标色彩正常. FUNCTION FkListViewImageInit(vListView:TListView):BOOL; VAR  SysImageList: UINT;  SFI: TSHFileInfo; BEGIN   vListView.LargeImages:=TImageList.Create(vListView);   vListView.SmallImages:=TImageList.Create(vListView);   //vListView.PopupMenu:=TPopupMenu.Create(vListView);    //去掉开始>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  { WITH vListView DO     BEGIN     //[BIG]     SysImageList := SHGetFileInfo('',0,SFI,SizeOf(SFI),SHGFI_SYSICONINDEX OR SHGFI_LARGEICON);     IF SysImageList <> 0 THEN       BEGIN       LargeImages.Handle := SysImageList;       Largeimages.ShareImages := TRUE;       END;     //[SMALL]     SysImageList := SHGetFileInfo('',0,SFI,SizeOf(SFI),SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);     IF SysImageList <> 0 THEN       BEGIN       SmallImages.Handle := SysImageList;       SmallImages.ShareImages := TRUE;       END;     //[END OF WITH]     END;}    //去掉结束<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< END; //----------------------------------------------------------------------------------- 2.因为我的测试没有出现你说的错误,我也只能给你推断一下可能出现的原因. 在 　imgList.ShareImages:=TRUE;   ShowMessage(IntToStr(tshIcon.iIcon));//加入测试,如果数值<=0则,在系统中没有找到索引值.   imgList.GetIcon(tshIcon.iIcon,icoTemp);   ShowMessage(IntToStr(icoTemp.handle));//同样,加入测试,如果数值<=0则获得图标失败.   SHGetFileInfo情况这个函数不是每次都执行成功的.

jsxjd · 2003-01-03

文档读注册表，程序从文件中提取

hfghfghfg · 2003-01-03

[HKEY_CLASSES_ROOT/.doc] @="Word.Document.8" "Content Type"="application/msword" [HKEY_CLASSES_ROOT/.doc/PersistentHandler] @="{98de59a0-d175-11cd-a7bd-00006b827d94}" [HKEY_CLASSES_ROOT/.doc/ShellEx] [HKEY_CLASSES_ROOT/.doc/ShellEx/{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}] @="{9DBD2C50-62AD-11d0-B806-00C04FD706EC}" [HKEY_CLASSES_ROOT/.doc/ShellNew] [HKEY_CLASSES_ROOT/.doc/Word.Document.6] [HKEY_CLASSES_ROOT/.doc/Word.Document.6/ShellNew] "FileName"="winword.doc" [HKEY_CLASSES_ROOT/.doc/Word.Document.8] [HKEY_CLASSES_ROOT/.doc/Word.Document.8/ShellNew] "FileName"="winword8.doc" [HKEY_CLASSES_ROOT/.doc/WordDocument] [HKEY_CLASSES_ROOT/.doc/WordDocument/ShellNew] "FileName"="winword2.doc" [HKEY_CLASSES_ROOT/.doc/WordPad.Document.1] [HKEY_CLASSES_ROOT/.doc/WordPad.Document.1/ShellNew] "NullFile"=""

chemstar · 2003-01-03

to ligia,   非常感谢你！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！ 　我已经彻底解决这个问题了！受到你的启发，我改了一种思路。我是这样做的： 　1、在设计期间就给listview.smallimages加一个空的imagelist1，从面省去了FkListViewImageInit初始化。 　2、在程序中根据情况不同而随时往imagelist1里面加图标。比如要从系统中取图标时，先用SHGetFileInfo取出， 　　后将它加到imagelist1里面，并得到它的索引，后付给item。 　3、用自己的图标时，也是先把它加入到imagelist1里面，而后再从里面取出。 　这是我在开会时想出的办法（哈哈，看来有些会还是有一定作用的！）。这么做来，使程序显得更简练一些， 　而且绝不出问题。 　 　好了，应该散分了。给你150分（别嫌少），剩下的给别的热心的朋友。 　再一次谢谢大家！

根据一个字符串(如“aaa.doc”)获得windows内与之相对应的图标的问题！超级疑难，非高手莫入！ (200分)

ligia

Unregistered / Unconfirmed

yanghai0437

Unregistered / Unconfirmed

yanghai0437

Unregistered / Unconfirmed

天宇天蓝

Unregistered / Unconfirmed

天宇天蓝

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

lu.weifeng

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

ligia

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

ligia

Unregistered / Unconfirmed

ligia

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

ligia

Unregistered / Unconfirmed

jsxjd

Unregistered / Unconfirmed

hfghfghfg

Unregistered / Unconfirmed

chemstar

Unregistered / Unconfirmed

Similar threads