[ ratko83 @ 28.12.2009. 20:49 ] @
Code: 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] |