Delphi Dynamic Menu Items
I have a popup menu that has a few items in it.
Option 1 - Sub1 - Sub2 Option 2 - Sub1 - Sub2 Option 3 - Sub1 - Sub2
I want to be able to add a Sub sub menu to Option 3 sub2 so it would look like:
Option 1 - Sub1 - Sub2 Option 2 - Sub1 - Sub2 Option 3 - Sub1 - Sub2 - Dynamic Item1 - Dynamic Item2 - Dynamic Item3
I've been trying to work with the following code to figure it out, I can do it "IF" the menu option is not already there (Option 3) but I cannot do it if Option 3 is already there (It creates a duplicate menu option)
How would I do this?
Thank you
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TForm2 = class(TForm)
popMenu: TPopupMenu;
gbDynamic: TGroupBox;
gbMain: TGroupBox;
popDynamic: TPopupMenu;
Option11: TMenuItem;
Option21: TMenuItem;
Option31: TMenuItem;
Sub11: TMenuItem;
Sub21: TMenuItem;
Item11: TMenuItem;
Item21: TMenuItem;
Item31: TMenuItem;
Item41: TMenuItem;
Sub12: TMenuItem;
Sub22: TMenuItem;
Sub13: TMenuItem;
Sub23: TMenuItem;
Option12: TMenuItem;
Sub24: TMenuItem;
Sub14: TMenuItem;
Option22: TMenuItem;
Sub25: TMenuItem;
Sub15: TMenuItem;
Option32: TMenuItem;
Sub26: TMenuItem;
Sub16: TMenuItem;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure PopupItemClick ( Sender : TObject );
end;
var
Form2: TForm2;
stlist: TStrings;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
Var
menuItem,SubItem : TMenuItem;
I, N : Integer;
s : String;
begin
//This will be a downloaded list from a server.
stlist := TStringList.Create;
stlist.Add ( 'Item 1' );
stlist.Add ( 'Item 2' );
stlist.Add ( 'Item 3' );
SubItem := TMenuItem.Create(popDynamic);
SubItem.Caption := 'Option 3';
popDynamic.Items.Add(SubItem);
MenuItem := TMenuItem.Create(popDynamic);
MenuItem.Caption := 'Sub 1';
SubItem.Add(MenuItem);
//This would work if Option 3 menu item was not aleady a menu item.
For I := 0 To stlist.Count - 1 Do
Begin
SubItem := TMenuItem.Create ( popDynamic );
SubItem.Caption := stlist [i];
SubItem.OnClick := PopupItemClick;
//assign it a custom integer value..
SubItem.Tag := i;
MenuItem.Add(SubItem);
End;
end;
Procedure TForm2.PopupItemClick ( Sender : TObject );
Var
menuItem : TMenuItem;
Begin
menuItem := TMenuItem ( sender );
label1.caption := stlist.Strings [menuItem.Tag];
End;
end.
Form:
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 247
ClientWidth = 480
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object gbDynamic: TGroupBox
Left = 0
Top = 0
Width = 217
Height = 247
Align = alLeft
Caption = 'Dynamic'
PopupMenu = popDynamic
TabOrder = 0
object Label1: TLabel
Left = 48
Top = 32
Width = 31
Height = 13
Caption = 'Label1'
end
end
object gbMain: TGroupBox
Left = 217
Top = 0
Width = 263
Height = 247
Align = alClient
Caption = 'What I Want Dynamically Created'
PopupMenu = popMenu
TabOrder = 1
ExplicitLeft = 336
ExplicitTop = 72
ExplicitWidth = 185
ExplicitHeight = 105
end
object popDynamic: TPopupMenu
Left = 136
Top = 96
object Option12: TMenuItem
Caption = 'Option 1'
object Sub14: TMenuItem
Caption = 'Sub 1'
end
object Sub24: TMenuItem
Caption = 'Sub 2'
end
end
object Option22: TMenuItem
Caption = 'Option 2'
object Sub15: TMenuItem
Caption = 'Sub 1'
end
object Sub25: TMenuItem
Caption = 'Sub 2'
end
end
object Option32: TMenuItem
Caption = 'Option 3'
object Sub16: TMenuItem
Caption = 'Sub 1'
end
object Sub26: TMenuItem
Caption = 'Sub 2'
end
end
end
object popMenu: TPopupMenu
Left = 256
Top = 112
object Option11: TMenuItem
Caption = 'Option 1'
object Sub13: TMenuItem
Caption = 'Sub 1'
end
object Sub23: TMenuItem
Caption = 'Sub 2'
end
end
object Option21: TMenuItem
Caption = 'Option 2'
object Sub12: TMenuItem
Caption = 'Sub 1'
end
object Sub22: TMenuItem
Caption = 'Sub 2'
end
end
object Option31: TMenuItem
Caption = 'Option 3'
object Sub11: TMenuItem
Caption = 'Sub 1'
object Item11: TMenuItem
Caption = 'Item 1'
end
object Item21: TMenuItem
Caption = 'Item 2'
end
object Item31: TMenuItem
Caption = 'Item 3'
end
object Item41: TMenuItem
Caption = 'Item 4'
end
end
object Sub21: TMenuItem
Caption = 'Sub 2'
end
end
end
end
The easiest way to do this is to give Option3 a name and then check for it in a loop:
SubItem := nil;
for i := 0 to popdynamic.Items.Count-1 do
if SameText(popdynamic.Items[i].Name, 'mnuOption3') then
SubItem := popdynamic.Items[i];
if SubItem = nil then
begin
SubItem := TMenuItem.Create(popDynamic);
SubItem.Caption := 'Option 3';
Subitem.Name := 'mnuOption3';
popDynamic.Items.Add(SubItem);
end;
This way your not creating a new subitem if it already exists.
All you need to do to create a new submenu is take your reference to the existing menu item - if it's the same everytime, just refer to the object directly, otherwise, find it somehow - and then call Add on it with the TMenuItem you want to add. I use something similar in one of my apps to recursively build a menu from an XML file.
This should serve as a very condensed version of what I'm doing.
procedure TMainForm.AddMenuItems(XMLNode: IXMLDOMNode; Parent: TMenuItem);
var
node: IXMLNode;
item: TMenuItem;
begin
for i := 0 to XMLNode.childNodes.length - 1 do begin
node := XMLNode.childNodes.item[i];
item := NewItem(node.attributes.getNamedItem('name').nodeValue, 0, false, true, nil, 0, '');
if node.nodeName = 'group' then begin
Parent.Add(item);
AddMenuItems(node, item);
end else begin
//You probably want to add a Tag to your items so you can tell them apart.
item.OnClick := DynamicItemClick;
Parent.Add(item);
end;
end;
end;
procedure TMainForm.LoadData;
var
XMLNode: IXMLNode;
//...
begin
//Clear old dynamic items
while Set1.Count > 0 do
Set1.Items[0].Free;
//Open XML file, find right XMLNode...
AddMenuItems(XMLNode.firstChild, Set1, '');
end;
...where Set1 is the menu item I'm building menu items for. In your case, I'm guessing that would be Sub26 (and Sub23 for the one in the pop-up menu). Just use this basic approach, replacing the XML stuff with whatever you need to read your file.
链接地址: http://www.djcxy.com/p/91068.html下一篇: Delphi动态菜单项