unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Menus;
type
TfrmMain = class(TForm)
mnuMain: TMainMenu;
tblMenu: TADOTable;
procedure FormCreate(Sender: TObject);
procedure MenuClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FormNames: TStringList;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
function FindMenuItem(Parent: TMenuItem; ACaption: String): TMenuItem;
var
I: Integer;
begin
I := 0;
Result := Parent.Find(ACaption);
while (Result = nil) and (I < Parent.Count) do
begin
Result := FindMenuItem(Parent.Items[I], ACaption);
Inc(I);
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
M, P: TMenuItem;
ParentName, MenuName, FormName: String;
begin
FormNames := TStringList.Create;
while not tblMenu.Eof do
begin
ParentName := tblMenu.FieldByName('Parent').AsString;
MenuName := tblMenu.FieldByName('Name').AsString;
FormName := tblMenu.FieldByName('Form').AsString;
P := FindMenuItem(mnuMain.Items, ParentName);
if P = nil then
begin
P := TMenuItem.Create(mnuMain);
P.Name := ParentName;
P.Caption := P.Name;
mnuMain.Items.Add(P);
end;
M := TMenuItem.Create(mnuMain);
M.Name := MenuName;
M.Caption := M.Name;
P.Add(M);
if FormName <> '' then
begin
FormNames.Add(FormName);
M.Tag := FormNames.Count - 1;
M.OnClick := MenuClick;
end;
tblMenu.Next;
end;
end;
procedure TfrmMain.MenuClick(Sender: TObject);
var
F: TForm;
C: TComponentClass;
begin
F := nil;
try
C := TComponentClass(FindClass(FormNames[TMenuItem(Sender).Tag]));
Application.CreateForm(C, F);
F.ShowModal;
finally
if Assigned(F) then
FreeAndNil(F);
end;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
if Assigned(FormNames) then
FreeAndNil(FormNames);
end;
end.
[Ovu poruku je menjao savkic dana 29.12.2009. u 01:24 GMT+1]