简单的问题--动态菜单(50分)

我想作一个动态的菜单，请各位能不能给个源码。我没发判断菜单中的一级 和二级怎么付值呀
MenuItem。Caption := 只能是一级菜单付值，二级三级怎么付值呢？？？？

每个menuitem都有自己的name吧，可以直接负值呀

看一下TMainMenu.Items.Add方法，可以动态的添加菜单项，菜单项还可以是菜单项的集合，
就实现了多级菜单，相应的可以用Delete方法删除，但是要记住序号

我是想动态的呀，没发预料name ，

送分的问题都没有人给源码吗？？？不是吧

利用 hint属性设置字符串

天呀，没人救我！！！！！！
结果自己研究出来了，呵呵

谁给我分，自己给自己好了

function SetBlackFont(Item: TFont): Boolean;
var
AF: TFont;
begin
Try
AF := TFont.Create;
AF.Name := '宋体';
AF.Color := clBlack;
AF.Size := 9;
AF.Style := ([fsBold]);
Item.Assign(AF);
AF.Free;
Result := True;
Except
on Exception Do
Result := False;
end;

end;
function CreateActionList(mainActions: TActionList;
Out CategoryList: TStrings): Boolean;
var
i: Integer;
CDS: TClientDataSet;
begin
Try
CDS := TClientDataSet.Create(Nil);
with CDS do
begin
with FieldDefs do
begin
with AddFieldDef do begin

Name := 'tag';
DataType := ftInteger;
Required := True;
end;
with AddFieldDef do begin
Name := 'name';
DataType := ftString;
Size := 50;
end;
end;
CreateDataSet;
end;

with MainActions do
if ActionCount > 0 then
for i := 0 to ActionCount -1 Do
if (Not CDS.Locate('name',Actions.Category,[loCaseInsensitive])) and
TAction(Actions).Enabled then
begin
CDS.Append;
CDS.FieldByName('tag').Value := Actions.Tag;
CDS.FieldByName('name').Value := Actions.Category;
CDS.Post;
end;
with CDS Do
begin
IndexDefs.Add('tag_index','tag',[ixPrimary]);
IndexFieldNames := 'tag';
First;
While not EOF Do
begin
CategoryList.Append(FieldByName('Name').Value);
Next;
end;
Free;
end;
Result := True;
except
On Exception Do
Result := False;
end;
end;
//************************
function CreateActionItem(Menu: TMainMenu; n: integer; Group: TfcOutLookPage;
mainActions: TActionList; Imgs: TImageList) : Boolean;
var
i: Integer;
actItem: TfcOutLookListItem;
//Menu-----------
Menuitem: TMenuItem;
//Menu-----------
begin
Menu.Images := Imgs ;
try
For i := 0 To MainActions.ActionCount - 1 Do
if (MainActions.Actions.Category = Group.Button.Caption) and
TAction(MainActions.Actions).Enabled then
begin
actItem := Group.OutlookList.Items.add;
with actItem Do
begin
OutlookList.Images := Imgs;
OutlookList.Transparent := True;
Action := MainActions.Actions;
ImageIndex := TAction(MainActions.Actions).ImageIndex;
end;
//Menu------
Menuitem:=TmenuItem.Create(Menu);
Menuitem.Caption :=actitem.DisplayName;
Menuitem.Action := MainActions.Actions;
Menuitem.ImageIndex := TAction(MainActions.Actions).ImageIndex;
Menu.items[n].Add (Menuitem) ;
//Menu-----
end;
Result := True;
Except
On Exception Do
Result := False;
end;
end;
procedure CreateOutBar(Menu: TMainMenu;BAR: TfcOutLookBar;MActions: TActionList;
MImgs: TImageList);
var
NameList: TStrings;
i,n: Integer;
btnItem: TfcOutLookPage;
//Menu------------
Menuitem: TMenuItem;
//Menu-------------
begin
try
NameList := TStringList.Create;
//收集ActionList中的分组名称
if not CreateActionList(MActions,Namelist) Then Exit;
//在OutBar中添加分组
for i := 0 to NameList.Count - 1 Do
begin
btnItem := BAR.OutlookItems.Add;
btnItem.Button.Caption := NameList.Strings;
if Not SetBlackFont(btnItem.OutLookList.Font) then exit;
//Menu-------
Menuitem := TMenuItem.Create(Menu);
try
Menuitem.Caption := NameList.Strings+' ';
Menu.Items.insert(i, Menuitem);
n:=i;
except
Menuitem.Free;
raise; { reraise the exception }
end;
//Menu--------
//添加功能组项
if Not CreateActionItem(Menu , n, btnItem, MActions,MImgs) then Exit;
end;
Finally
NameList.Free;
Menuitem.Free;
end;
end;
//***************************************

多人接受答案了。