用于权限设置的动态菜单，欢迎大家批评指正……！！

Question

unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, ADODB, Grids, DBGrids;type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    QueryMenuInf: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ADOConnection1: TADOConnection;
    QueryMenu: TADOQuery;
    DataSource2: TDataSource;
    DBGrid2: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure MenuItemCloseClick(Sender: TObject);
    procedure MenuItemQuitClick(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
const
  ConnectParam = 'Provider=Microsoft.Jet.OLEDB.4.0;'+
      'Data Source=%s\MenuInf.mdb;Persist Security Info=False';implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
var i,j,iMenuNum1,iMenuNum2: integer;
    MenuArray1: array of TMenuItem;
    MenuArray2: array of TMenuItem;
    sMenuId: string;
begin
   ADOConnection1.ConnectionString:=Format(ConnectParam,
       [ExtractFileDir(Application.ExeName)]);
   ADOConnection1.LoginPrompt:=False;
   ADOConnection1.Connected:=True;
   with QueryMenuInf do
   begin
      Close;
      SQL.Text:='select * from menuinf where len(MenuId)=2'+
         ' and IsView=''1''';  //IsView：为1时显示；如果为0，则不显示，
      Open;
      iMenuNum1:=RecordCount;
      First;
   end;
   if iMenuNum1 > 0 then
   begin
      try
      GetMem(MenuArray1,iMenuNum1*SizeOf(TMenuItem));
      for i:=1 to iMenuNum1 do
      begin
         MenuArray1[i-1]:=TMenuItem.Create(Self);
         MenuArray1[i-1].Caption:=
         QueryMenuInf.FieldByName('MenuName').AsString;
         MainMenu1.Items.Add(MenuArray1[i-1]);
         if MenuArray1[i-1].Caption = '退出' then
            MenuArray1[i-1].OnClick:=MenuItemCloseClick;
         sMenuId:=Trim(IntToStr(i));
         if Length(sMenuId) = 1 then sMenuId:='0' + sMenuId;
         with QueryMenu do
         begin
            Close;
            SQL.Text:='select * from menuinf where len(MenuId)=4'+
            ' and left(MenuId,2)='''+sMenuId+''' and IsView=''1''';
            Open;
            iMenuNum2:=RecordCount;
            First;
         end;
         if iMenuNum2 > 0 then
         begin
            try
            GetMem(MenuArray2,iMenuNum2*SizeOf(TMenuItem));
            for j:=1 to iMenuNum2 do
            begin
               MenuArray2[j-1]:=TMenuItem.Create(Self);
               MenuArray2[j-1].Caption:=
               QueryMenu.FieldByName('MenuName').AsString;
               MenuArray1[i-1].Add(MenuArray2[j-1]);
               if MenuArray2[j-1].Caption = '退出' then
                  MenuArray2[j-1].OnClick:=MenuItemQuitClick;
               QueryMenu.Next;
            end;
            finally
               FreeMem(MenuArray2);
            end;
         end;
         QueryMenuInf.Next;
      end;
      finally
         FreeMem(MenuArray1);
      end;
   end;
end;procedure TForm1.MenuItemCloseClick(Sender: TObject);
begin
   Close;
end;procedure TForm1.MenuItemQuitClick(Sender: TObject);
begin
   Close;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if MessageBox(Handle,'您确认要退出程序吗？','提示',
      Mb_OKCancel + Mb_IconQuestion) = 1 then
      Action:=caFree
   else Action:=caNone;
end;end.

Answer 1

有缺陷，比如你设计时添加一个菜单项，你还需要在数据库中添加菜单名称，然后再添加到对应的权限中，如果有相同的菜单名称（多窗体）处理起来要麻烦一些。一句话维护困难，不太实用。
分配权限的时候，你根据程序中各个窗体的菜单来列表显示，但有些窗体都没有创建你无法取得对应菜单的清单。
建议用ActionList组织事件方法，利用菜单或按钮的Action属性来做权限。菜单或按钮会根据Action对应的ActionList中映射的事件方法的enable及visible及caption来控制菜单或按钮的可用不可用,可见不可见,菜单或按钮的caption。
ActionList放在主窗体中，分配的时候列表显示ActionList中Action的name,caption等等。