⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 treemenu.pas

📁 DELPHI深度遍历当前主菜单中所有子菜单
💻 PAS
字号:
unit treeMenu;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    b1: TMenuItem;
    g2: TMenuItem;
    h1: TMenuItem;
    jk1: TMenuItem;
    j1: TMenuItem;
    Button1: TButton;
    fg1: TMenuItem;
    yu1: TMenuItem;
    dsa1: TMenuItem;
    ty1: TMenuItem;
    dsa2: TMenuItem;
    ui1: TMenuItem;
    uo1: TMenuItem;
    saf1: TMenuItem;
    fgdhf1: TMenuItem;
    fdfg1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    Button2: TButton;
    TreeView1: TTreeView;
    Label6: TLabel;
    iloveyou1: TMenuItem;
    procedure Button2Click(Sender: TObject);
    procedure g1Click(Sender: TObject);
    procedure yu1Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure dsa2Click(Sender: TObject);
    procedure ui1Click(Sender: TObject);
    procedure uo1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure h1Click(Sender: TObject);
    procedure fdfg1Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure ty2Click(Sender: TObject);
    procedure tyu1Click(Sender: TObject);
    procedure iloveyou1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyMenuItemList:TStrings;
implementation

{$R *.dfm}
Procedure TransMenuToTree(MyMainMenu:TMainMenu;MyTreeView:TTreeView);
 procedure TravelSubMenuItem(MyMenuItem:TMenuItem;PNode:TTreeNode);
 //遍历菜单项的递归过程
  Var i:Integer;CNode:TTreeNode;
  Begin
   CNode:=Nil;
   If PNode=Nil Then
       CNode:=MyTreeView.Items.AddChildObject(PNode,'菜单',Nil);
   If  PNode<>Nil Then
       If MyMenuItem.Visible=True Then
         CNode:=MyTreeView.Items.AddChildObject(PNode,MyMenuItem.Caption,MyMenuItem);
   For i:=0 To MyMenuItem.Count-1 Do //依次对当前菜单项的各个子菜单项进行递归
    If MyMenuItem.Items[i].Visible=True Then//只有那些可见的菜单才被处理
     TravelSubMenuItem(MyMenuItem.Items[i],CNode);//
  End;
Begin
  MyTreeView.Items.BeginUpdate;
   MyTreeView.Items.Clear;
   TraVelSubMenuItem(MyMainMenu.Items,Nil);
   MyTreeView.FullExpand;
  MyTreeView.Items.EndUpdate;
 
End;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Close;
end;


procedure TForm1.g1Click(Sender: TObject);
begin
ShowMessage('你单击了打开');
end;

procedure TForm1.yu1Click(Sender: TObject);
begin
ShowMessage('你选中了"导入"!');
end;

procedure TForm1.N15Click(Sender: TObject);
begin
ShowMessage('you click on Mail caption');
end;

procedure TForm1.dsa2Click(Sender: TObject);
begin
ShowMessage('you Click on SaveAll');
end;

procedure TForm1.ui1Click(Sender: TObject);
begin
ShowMessage('you Click on SaveAs...');
end;

procedure TForm1.uo1Click(Sender: TObject);
begin
ShowMessage('you Click On CurrentFile');
end;

procedure TForm1.N1Click(Sender: TObject);
begin
ShowMessage('You Click On Export');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
ShowMessage('You Click On Exit');
end;

procedure TForm1.h1Click(Sender: TObject);
begin
ShowMessage('You Click On Modify');
end;

procedure TForm1.fdfg1Click(Sender: TObject);
begin
ShowMessage('You Click On Debugging');
end;

procedure TForm1.N11Click(Sender: TObject);
begin
ShowMessage('You Click On Browse');
end;

procedure TForm1.N8Click(Sender: TObject);
begin
ShowMessage('You Click On PackageForDesign');
end;

procedure TForm1.ty2Click(Sender: TObject);
begin
ShowMessage('you click me');
end;

procedure TForm1.tyu1Click(Sender: TObject);
begin
ShowMessage('you click on Tyu1');
end;

procedure TForm1.iloveyou1Click(Sender: TObject);
begin
ShowMessage('you said you love me,really?');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TransMenuToTree(MainMenu1,TreeView1);
end;

procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 Var MyHitInf:THitTests;
begin
   MyHitInf:=TreeView1.GetHitTestInfoAt(X,Y);
   If HtOnItem In MyHitInf Then
   If (TreeView1.Selected.Data<>Nil) Then  TMenuItem(TreeView1.Selected.Data).Click;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -