(*//
标题:目录转换成菜单项;获取系统图标
说明:示例打开文件
设计:Zswang
日期:2002-01-25
支持:wjhu111@21cn.com
//*)
///////Begin Source
uses
ShellApi;
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 PathToMenuItem(mDirName: string; mMenuItem: TMenuItem;
mItemClick: TNotifyEvent = nil);
{ 返回目录转换成菜单项是否成功 }
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(mMenuItem.Owner);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
vMenuItem.ImageIndex := GetIconIndex(mDirName + '\' + vSearchRec.Name);
vMenuItem.OnClick := mItemClick;
mMenuItem.Add(vMenuItem);
PathToMenuItem(mDirName + '\' + vSearchRec.Name, vMenuItem)
end else if (Pos(vSearchRec.Name, '..') = 0) then begin
vMenuItem := TMenuItem.Create(mMenuItem.Owner);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
vMenuItem.ImageIndex := GetIconIndex(mDirName + '\' + vSearchRec.Name);
vMenuItem.OnClick := mItemClick;
mMenuItem.Add(vMenuItem);
end;
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { PathToMenuItem }
///////End Source
///////Begin Demo
{ uses FileCtrl }
procedure TForm1.Button1Click(Sender: TObject);
var
vDirectory: string;
begin
{ 测试时不要选择内容太多的目录 }
if not SelectDirectory('Path', '', vDirectory) then Exit;
MainMenu1.Items.Clear;
PathToMenuItem(vDirectory, MainMenu1.Items, ItemClick);
PopupMenu1.Items.Clear;
PathToMenuItem(vDirectory, PopupMenu1.Items, ItemClick);
end;
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.ItemClick(Sender: TObject);
begin
if FileExists(TMenuItem(Sender).Hint) then //避免目录
ShellExecute(Handle, 'OPEN', PChar(TMenuItem(Sender).Hint), nil, nil, SW_SHOW);
end;
///////End Demo