动态菜单问题（UP有分）

Linux2001 2002-01-23 10:15:51

现在有一个目录，下面有未知个子目录，每个子目录下可能有文件也可能没有，现在要做的就是有一个MainMenu，它动态生成菜单，如果是目录它的菜单就会有一个右箭头，如果里面有文件它就读取文件名作为菜单名，比如一个A目录下有B,C,D三个目录，B,C两个目录下有文件1，2，D目录下没有文件，这个菜单读取就是这样的一个形式，
File-----------一级菜单
A------------最顶层目录名字
B----------二级目录
1--------三级菜单，也是文件名
2--------三级菜单，也是文件名
C----------二级目录，目录名
1--------三级菜单，也是文件名
2--------三级菜单，也是文件名
D----------二级目录，底下没有文件了，所以没有下一级菜单了

...全文

119 13 打赏收藏转发到动态举报

写回复

用AI写文章

13 条回复

切换为时间正序

请发表友善的回复…

发表回复

dancemaple 2002-01-23

打赏
举报

g z

王集鹄 2002-01-23

打赏
举报

to Linux2001(准备升级中...): 请试一试

王集鹄 2002-01-23

打赏
举报

//改进结果
//Unit1.pas
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ImgList;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
MainMenu1: TMainMenu;
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure ItemClick(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

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 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.Button1Click(Sender: TObject);
begin
PathToMenu(Edit1.Text, MainMenu1, ItemClick);
PathToMenu(Edit1.Text, PopupMenu1, 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;
Edit1.Text := 'C:\My Documents';
Button1.Click;
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.

//Unit1.dfm
object Form1: TForm1
Left = 192
Top = 107
Width = 544
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
PopupMenu = PopupMenu1
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Edit1: TEdit
Left = 232
Top = 16
Width = 121
Height = 21
TabOrder = 0
Text = 'Edit1'
end
object Button1: TButton
Left = 240
Top = 40
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object MainMenu1: TMainMenu
AutoHotkeys = maManual
Left = 144
Top = 56
end
object ImageList1: TImageList
DrawingStyle = dsTransparent
Left = 176
Top = 56
end
object PopupMenu1: TPopupMenu
Left = 112
Top = 56
end
end

Linux2001 2002-01-23

打赏
举报

UP,,,,,,,,,,,,,,,,,UP,,,,,,,,,,,,,,,,,,,,,UP

王集鹄 2002-01-23

打赏
举报

//初步结果
procedure TForm1.FindFile(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(Self);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
mGoalMenuItem.Add(vMenuItem);
FindFile(mDirName + '\' + vSearchRec.Name, vMenuItem)
end else if (Pos(vSearchRec.Name, '..') = 0) then begin
vMenuItem := TMenuItem.Create(Self);
vMenuItem.Caption := vSearchRec.Name;
vMenuItem.Hint := mDirName + '\' + vSearchRec.Name;
mGoalMenuItem.Add(vMenuItem);
end;
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { FindFile }

procedure TForm1.Button1Click(Sender: TObject);
begin
MainMenu1.Items.Clear;
FindFile(Edit1.Text, MainMenu1.Items);
PopupMenu1.Items.Clear;
FindFile(Edit1.Text, PopupMenu1.Items);
end;

Linux2001 2002-01-23