Bug in application with dynamic action creation

[Unregistered]

Hi,

If you compile the follow sample code found on the internet with Eurekalog ( with catch memory exceptions active ), you get an AV when trying to use the menu...

( Code found on the internet while researching dynamic menu creation ) :


unit FormMain;

interface

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

type
TfrmMain = class(TForm)
btnCreate: TButton;
procedure btnCreateClick(Sender: TObject);
private
procedure OnExecuteAction(Sender: TObject);
public
end;

var
frmMain: TfrmMain;

implementation

uses
ActnMan, ActnCtrls, ActnMenus, ActnList, XPStyleActnCtrls;

{$R *.dfm}

procedure TfrmMain.btnCreateClick(Sender: TObject);
var
AM: TActionManager;
AMMB: TActionMainMenuBar;
ABI: TActionBarItem;

CA1, CA2: TAction;
CAMenu: TContainedAction;

ACIMain, SomeMenu, SubMenu: TActionClientItem;
begin
// create a new action manager to handle our action components (not actually shown in this demo)
AM := TActionManager.Create(Self);
// create a new action main menu bar
AMMB := TActionMainMenuBar.Create(Self);
AMMB.Parent := Self;
// create a new action bar item and connect the action manager and the action main menu through that
ABI := AM.ActionBars.Add;
ABI.ActionBar := AMMB;

// now, we do have tro create our first menu item in the action main menu bar, which in turn
// will hold more items and a sub menu.

// first we will create two actions to use later on
CA1 := TAction.Create(Self);
CA1.Caption := 'Some Action No. 1';
CA1.OnExecute := OnExecuteAction;
AM.AddAction(CA1, nil);

CA2 := TAction.Create(Self);
CA2.Caption := 'Some Action No. 2';
CA2.OnExecute := OnExecuteAction;
AM.AddAction(CA2, nil);

// next we need to create a dummy action, we will assign to our sub menu parent items
// and use that later on
CAMenu := TContainedAction.Create(Self);

// now, for our action bar (which hold a reference to the action main menu) we need to
// create the menu item
ACIMain := ABI.Items.Add;
ACIMain.Action := CAMenu;
ACIMain.Caption := 'Main Menu Item 1';

// add two simple menu items to the main menu entry
SomeMenu := ACIMain.Items.Add;
SomeMenu.Action := CA1;
SomeMenu := ACIMain.Items.Add;
SomeMenu.Action := CA2;

// add another sub menu
SubMenu := ACIMain.Items.Add;
SubMenu.Action := CAMenu;
SubMenu.Caption := 'Sub Menu';

// add two simple menu items to the sub menu entry
SomeMenu := SubMenu.Items.Add;
SomeMenu.Action := CA1;
SomeMenu := SubMenu.Items.Add;
SomeMenu.Action := CA2;
end;

procedure TfrmMain.OnExecuteAction(Sender: TObject);
begin
ShowMessage(TAction(Sender).Caption);
end;

end.

[admin]

Hi,

what Delphi version are you using?

[Unregistered]

Hi i'm using D2007,

[Karl]

Hi,

I'm getting AV's without EurekaLog enabled as well, a quick way is to press the button twice :)

Here's some sample code for dynamic menu's, it's fairly simple and can easily be expanded on:


procedure TfrmMain.DoNothing(Sender: TObject);
begin
//Used to enable menu headers and sub menus
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
MainActMan : TActionManager;
MainMenu : TActionMainMenuBar;
mnuFile, mnuSub : TActionClientItem;
begin
//create action manager and main menu
MainActMan := TActionManager.Create(Self);
MainMenu := TActionMainMenuBar.Create(nil);
MainMenu.Parent := Self;
MainMenu.ActionManager := MainActMan;
MainActMan.ActionBars.Add.ActionBar := MainMenu;

//create a root menu item
mnuFile := NewAction(TActionClientItem(MainMenu.ActionClient) , 'File', DoNothing);

//create a sub menu
mnuSub := NewAction(mnuFile, 'SubMenu', DoNothing);

//add items to sub menu
NewAction(mnuSub, 'Sub1', OnExecuteAction);
NewAction(mnuSub, 'Sub2', OnExecuteAction);

//add item to root menu
NewAction(mnuFile, 'Exit', OnExecuteAction);

end;

function TfrmMain.NewAction(AParent: TActionClientItem; Caption: String; ExecuteAction: TNotifyEvent):TActionClientItem;
var
newActionClient : TActionClientItem;
newAction : TAction;
begin
newActionClient := TActionClientItem(AParent.Items.insert(AParent.Ite ms.Count));
newActionClient.Caption := Caption;
newAction := TAction.Create(Self);
newAction.Caption := Caption;
newAction.OnExecute := ExecuteAction;
newActionClient.Action := newAction;

Result := newActionClient;
end;



Note I've only used TActionClientItems and as such wired in a DoNothing procedure for root menu and sub menu headers just for this quick example. Does this help you move forward?

cheers
Karl