谁能自己编写代码把Window系统所用的图标取出来?
自己认为是可以取出来的, 因为我在word 里面看见是在shell32.dll
取出来的. 最好给出关键代码. 感谢!
问题点数：100、回复次数：8Top
1 楼naner_china（naner）回复于 2005-06-03 16:35:28 得分 80
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellApi, ImgList, StdCtrls, Menus,FileCtrl;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
MainMenu1: TMainMenu;
Button1: TButton;
Edit1: TEdit;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure ItemClick(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetSystemImageList(mImageList: TImageList): Boolean;
var
vHandle: THandle;
vSHFileInfo: TSHFileInfo;
begin
FillChar(vSHFileInfo, SizeOf(vSHFileInfo), 0);
vHandle := SHGetFileInfo('', 0, vSHFileInfo, SizeOf(vSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Result := vHandle <> 0;
mImageList.Handle := vHandle;
mImageList.ShareImages := True;
end; { GetSystemImageList }
function 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; { GetIconIndex }
procedure PathToMenu(mDirName: string; mMenu: TMenu; mItemClick: TNotifyEvent); //显示目录文件名及其图片文件
procedure pScanPath(mDirName: string; mGoalMenuItem: TMenuItem); //指定的路径搜索
var
vSearchRec: TSearchRec;
vPathName: string;
K: Integer;
vMenuItem: TMenuItem;
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
vMenuItem := TMenuItem.Create(mMenu);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
vMenuItem.ImageIndex := GetIconIndex(mDirName + '\' + vSearchRec.Name);
vMenuItem.OnClick := mItemClick;
mGoalMenuItem.Add(vMenuItem);
pScanPath(mDirName + '\' + vSearchRec.Name, vMenuItem)
end else if (Pos(vSearchRec.Name, '..') = 0) then begin
vMenuItem := TMenuItem.Create(mMenu);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
vMenuItem.ImageIndex := GetIconIndex(mDirName + '\' + vSearchRec.Name);
vMenuItem.OnClick := mItemClick;
mGoalMenuItem.Add(vMenuItem);
end;
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { pScanPath }
begin
mMenu.Items.Clear;
pScanPath(mDirName, mMenu.Items)
end; { PathToMenu }
procedure TForm1.FormCreate(Sender: TObject);
begin
GetSystemImageList(ImageList1); //获取图片
ImageList1.DrawingStyle := dsTransparent;
MainMenu1.AutoHotkeys := maManual;
MainMenu1.Images := ImageList1;
PopupMenu1.AutoHotkeys := maManual;
PopupMenu1.Images := ImageList1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'E:\Naner\image'; //初始路径,请确保你的路径存在 ,该路径可改
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],1000) then
edit1.Text := Dir;
PathToMenu(Edit1.Text, MainMenu1, ItemClick); //添加到MainMenu
PathToMenu(Edit1.Text, PopupMenu1, ItemClick); //添加到PopupMenu1
end;
procedure TForm1.ItemClick(Sender: TObject);
begin
if FileExists(TMenuItem(Sender).Hint) then //避免目录
ShellExecute(Handle, 'OPEN', PChar(TMenuItem(Sender).Hint), nil, nil, SW_SHOW);
//查看对应的图片
end;
end.
Top
2 楼kl2000（）回复于 2005-06-03 17:00:38 得分 0
好象只能返回六个图标呢!Top
3 楼naner_china（naner）回复于 2005-06-03 17:07:58 得分 0
你查询的路径中只包含6个文件或图标
我查出一堆文件和图标
vPathName := mDirName + '\*.*'; //设置查询返回的程序类型
Top
4 楼kl2000（）回复于 2005-06-03 17:11:48 得分 0
我再试试看看!Top
5 楼kl2000（）回复于 2005-06-08 17:05:24 得分 0
我替换了windows里面的DLL文件还是取出那几个图标!
那位还有什么办法?Top
6 楼sandyboy（雨霆）回复于 2005-06-14 16:27:40 得分 10
关注。Top
7 楼force2004（牛牛）回复于 2005-06-14 18:27:56 得分 10
GZ
Top
8 楼kl2000（）回复于 2005-07-08 08:59:06 得分 0
再顶一次! 看今有什么收获!
今天下午结贴.Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
