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;
给你一个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;
' 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