Re: dynamic menu problem

Looks like I have sorted out what went wrong
The test program code is as follows

{unit1.pas}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, Menus, StdCtrls, ZConnection, DB, ZAbstractRODataset,
ZDataset;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Button2: TButton;
DBConnection: TZConnection;
ReadMenu: TZReadOnlyQuery;
procedure Button2Click(Sender: TObject);
private
procedure DynamicMenuClick(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure DBBuildPopupMenu (mnu : TMenuItem; Notify :TNotifyEvent);
procedure BuildASubMenu (mnu : TMenuItem; level : integer);

function MakeNewItem(const caption,data: string;Image : integer):
TMenuItem;
begin
Result := TMenuItem.Create(nil);
Result.Caption := Caption;
Result.ImageIndex := Image;
if Data <> '' then
begin
Result.Hint := Data;
Result.OnClick := Notify;
end;
end;

var
last : TMenuItem;
lvl : integer;

begin
last := mnu;
lvl := Form1.ReadMenu.FieldByName('COLUMN_NUM').AsInteger;
while (lvl >= level) and (not Form1.ReadMenu.Eof) do
begin
if lvl = level
then
begin
last := MakeNewItem
(Form1.ReadMenu.FieldByName('CAPTION').AsString,Form1.ReadMenu.FieldByName('EXEC_DATA').AsString,-1);
mnu.Add (last);
Form1.ReadMenu.Next;
end else
begin
if lvl > level
then BuildASubMenu (last, level + 1);
end;
if not Form1.ReadMenu.Eof
then lvl := Form1.ReadMenu.FieldByName('COLUMN_NUM').AsInteger;
end;
end;

begin
if Form1.ReadMenu.RecordCount > 0 then
BuildASubMenu (mnu, 0);
end;



procedure TForm1.Button2Click(Sender: TObject);
var
MenuSQL : string;
begin
MainMenu1.Items.Clear;
MenuSQL := 'SELECT * FROM TRAK_MENU WHERE MENU_NUM ='+InttoStr(0)+'
ORDER BY SORT_NUM';
ReadMenu.Close;
ReadMenu.SQL.Text := MenuSQL;
ReadMenu.open;
ReadMenu.First;
DBBuildPopupMenu(MainMenu1.Items,DynamicMenuClick)
end;

procedure TForm1.DynamicMenuClick(Sender: TObject);
begin
showmessage(TMenuItem(Sender).Hint);
end;

end.

{End unit1.pas}

{unit1.dfm}
object Form1: TForm1
Left = 192
Top = 114
Width = 330
Height = 145
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button2: TButton
Left = 104
Top = 48
Width = 105
Height = 25
Caption = 'Database Menu'
TabOrder = 0
OnClick = Button2Click
end
object MainMenu1: TMainMenu
Left = 8
Top = 24
end
object DBConnection: TZConnection
Protocol = 'mssql'
HostName = '127.0.0.1'
Port = 0
Database = 'DBName'
User = 'sa'
Password = 'your password here'
Catalog = 'DBName'
AutoCommit = True
ReadOnly = True
TransactIsolationLevel = tiNone
Connected = False
SQLHourGlass = False
Left = 40
Top = 24
end
object ReadMenu: TZReadOnlyQuery
Connection = DBConnection
ParamCheck = True
Params = <>
Options = [doCalcDefaults]
Left = 72
Top = 24
end
end

{end unit1.dfm}

Hope this helps someone in the future


Regards
Martin B

.

Quantcast