急急急!如何遍历程序中的菜单项?

sadpacific 2000-02-29 11:03:00
各位专家:
我想将程序中的所有菜单以TreeView的形式显示出来,如果某个菜单下有子菜单,
则将其子菜单显示在表示该菜单的结点下。成为其子结点,可是我该怎么办呢?

...全文
338 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
bigma 2000-03-06
  • 打赏
  • 举报
回复
给你一个Delphi源码

function getnode(mylist:tlist;prm:string):ttreenode;
var
i: Integer;
begin
result:=nil;
for i := 0 to myList.Count - 1 do
begin
if prm = Pobj(myList[i])^.namenode then
begin
result:=Pobj(myList[i])^.snode;
break;
end;
end;
end;
procedure setnode(mylist:tlist;prm:string;snode:ttreenode);
var
i: Integer;
pp:pobj;

begin

for i := 0 to myList.Count - 1 do
begin
if prm = Pobj(myList[i])^.namenode then
break
end;
new(pp);
pp^.namenode:=prm;
pp^.snode:=snode;
mylist.add(pp);

end;
function getcod(prm:string):string;
var fnd:integer;
begin
fnd:=pos(';',prm);
if fnd>0 then
result:=copy(prm,1,fnd-1)
else
result:=prm

end;
function getname(prm:string):string;
var fnd:integer;
begin
fnd:=pos(';',prm);
if fnd>0 then
result:=copy(prm,fnd+1,length(prm)-fnd)
else
result:=prm

end;

procedure TForm1.FormCreate(Sender: TObject);
var node:ttreenode;
i:integer;
menulist:tstringlist;
old,new:string;
begin
form1.Show;
list:=tlist.create;
menulist:=tstringlist.create;
menulist.LoadFromFile('menu.txt');
old:='';
setnode(list,old,nil);
for i:=0 to menulist.count -1 do
begin
if menulist.strings[i]='' then
Continue;
new:=getcod(trim(menulist.strings[i]));
if copy(new,1,length(new)-1)=copy(new,1,length(old)-1) then
node:=treeview1.Items.add(getnode(list,old),getname(trim(menulist.strings[i])))
else
node:=treeview1.Items.addchild(getnode(list,copy(new,1,length(new)-1)),getname(trim(menulist.strings[i])));

old:=getcod(trim(menulist.strings[i]));
setnode(list,old,node);
end;
treeview1.refresh;
if List <> nil then
begin
for i := 0 to List.Count - 1 do
begin
Pobj(List[i])^.snode := nil;
Dispose(Pobj(List[i]));
end;
end;

list.free;
end;
procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
if not TreeView1.Selected.HasChildren then
begin
form2.show;
form2.richedit1.lines.loadfromfile('help.txt');
end;
end;

end.
bigma 2000-03-03
  • 打赏
  • 举报
回复
快去看看DELPHI源码集合中的DMENU.ZIP文件
sadpacific 2000-03-03
  • 打赏
  • 举报
回复
I want it.
myall@tonghua.com.cn
radish 2000-03-02
  • 打赏
  • 举报
回复
给分少的同志吧
sadpacific 2000-03-02
  • 打赏
  • 举报
回复
谢谢诸位的支持。
我看这几种方法都行得通。
但是分少僧多,怎么办呢?
光明山人 2000-03-02
  • 打赏
  • 举报
回复
我以前做了一个小程序(Delphi),刚好是将某个窗口的菜单放到TreeView中,然后修改菜单的Enabled, Checked, Caption属性,你要不要?
AcherMagic 2000-03-02
  • 打赏
  • 举报
回复
有100个菜单赋100个Tag?
jll 2000-03-01
  • 打赏
  • 举报
回复
好象还应该加上SubItem吧?
zpwh 2000-03-01
  • 打赏
  • 举报
回复
有关于TreeView的内容我不再罗嗦,其实你只要将每个菜单项的Tag属性分别赋不同的
值,然后用菜单的Items[i]属性检验其对应的Tag值即可。例如:
A B C
a1 b1 c1
a2 b2 c2
可分别赋值 A.Tag:=10 B.Tag:=20 C.Tag:=30
a1.Tag:=11 b1.Tag:=21 c1.Tag:=31
a2.Tag:=12 b2.Tag:=22 c2.Tag:=32
这样的话,您能明白后面该怎么做了吧!
sess 2000-03-01
  • 打赏
  • 举报
回复
同意Redish的看法,可以在FORM中用 IS 语句判断所有的菜单.
kxy 2000-02-29
  • 打赏
  • 举报
回复
TMenu.Items
Use Items to access information about the elements in the menu

TMenuItem.Items
Use Items to access to a subitem by its position in the list of subitems
Lin 2000-02-29
  • 打赏
  • 举报
回复
晚了。同意 radish 意见。
radish 2000-02-29
  • 打赏
  • 举报
回复
看HELPT中MenuItem的Items及COUNT属性
AcherMagic 2000-02-29
  • 打赏
  • 举报
回复
给你一个Delphi源码
procedure TForm1.AddTree(ANode : TTreeNode;AItem : TMenuItem);
var
i : Integer;
Node : TTreeNode;
begin
for i:= 0 to AItem.Count-1 do
begin
Node := Tree.Items.AddChild(ANode,AItem.Items[i].Caption);
AddTree(Node,AItem.Items[i]);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : Integer;
Item : TMenuItem;
Node : TTreeNode;
begin
for i := 0 to Main.Items.Count-1 do
begin
Node := Tree.Items.AddChild(nil,Main.Items[i].Caption);
Item := Main.Items[i];
AddTree(Node,Item);
end;
end;
Un1 2000-02-29
  • 打赏
  • 举报
回复
给你一个VB源码:

Private Sub CreateWindowMenus(ByVal hWnd As Long)

' This subroutine accepts the handle to a window and then obtains and creates its main-level menu

Dim hMen As Long
Dim lMainCount As Long
Dim sToolName As String
Dim sToolID As String
Dim i As Integer

' This API function returns the handle of the window's menu
hMen = GetMenu(hWnd)

' This API function returns the number of menu items in the main-level menu
lMainCount = GetMenuItemCount(hMen)

' Exit if there are no menus
' Do this for each menu item in the main-level menu
For i = 0 To lMainCount - 1

' Sets the Tool's Name, which is determined by using the text string in the original menu
' (returned by the GetMenuName function), as well as removing the item's shortcut key text
sToolName = RemoveShortcut(GetMenuName(hMen, i))

' Sets the Tool's ID, which is determined by using its Name, as well as cleaning out some characters
sToolID = "id_" & CleanMenuID(sToolName)

' Adds the new main-level Menu Tool, which is used to store sub Tools
'修改此处增加到TreeView
'TreeView1.Nodes.Add

' Pass execution to the routine responsible for creating sub-menu items
Call CreateMenuSubs(sToolID, hMen, i)

Next i

' Pass execution to the routine that adds menu separators, but only if there are separators to add
If iSepCount > 0 Then Call AddSeps

End Sub
Private Sub CreateMenuSubs(ByVal sParent As String, ByVal hParentMenu As Long, ByVal lParentPos As Long)

' This subroutine accepts the name, handle, and menu position of a main-level menu item and
' creates its sub-menu items. It is called recursively, in order to obtain any sub-menu items
' of the menu. If so, this recursive process creates cascading menus.

Dim hSubMenu As Long
Dim lSubCount As Long
Dim sSubName As String
Dim sSubID As String
Dim siSepInfo As SepInfo
Dim i As Integer

' This API function returns the handle of a menu item, given its parent's position
hSubMenu = GetSubMenu(hParentMenu, lParentPos)
' This API function returns the number of menu items in a menu
lSubCount = GetMenuItemCount(hSubMenu)

' Exit if there are no menu items or if sParent is a separator
If lSubCount = 0 Or sParent = "separator" Then Exit Sub

' Do this for each menu item
For i = 0 To lSubCount - 1

' Sets the Tool's Name, which is determined by using the text string in the original sub-menu
' (returned by the GetMenuName function), as well as removing the item's shortcut key text
sSubName = RemoveShortcut(GetMenuName(hSubMenu, i))

' Sets the Tool's ID, which is determined by using its parent's ID, the Tool's Name,
' as well as cleaning out some characters
sSubID = sParent & CleanMenuID(sSubName)

' If the Tool doesn't have a name, it is probably a separator, so handle it accordingly
If sSubName = "" Then

sSubName = "separator"
sSubID = "separator"

'修改此处增加到TreeView

End If

Call CreateMenuSubs(sSubID, hSubMenu, i)

Next i

End Sub

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧