捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
基于数据库的动态菜单
关键字:Menu 数据库 树 动态菜单
来 自:原创
平 台:Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:中级 完成时间:2006/11/23
发布者:ahlkj 发布时间:2007/5/7
编辑器:DELPHI7 语  种:简体中文
分 类:窗体 下载浏览:0/16049
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
无图片
{
    标题:基于数据库的动态菜单
    说明:
         通过数据表信息来动态创建菜单(此段代码主要起到抛砖引玉.菜单的数据的读取略显拙劣有待于改进.同志们可以讨论优化此段代码)。
         目前笔者正在做业务基础平台的开发,有那伟仁兄有好的想法意见欢迎互相学习沟通!
    作者:ABCDE(李克俭)
    日期:2006-11-22
    QQ:39839655
    EMAIL:JulyXDay@QQ.COM

    数据结构:
  CREATE TABLE [dbo].[SysMenu](
   [Id] [int] IDENTITY(1,1) NOT NULL,
   [Name] [varchar](20) COLLATE Chinese_PRC_CI_AS NULL,
   [Title] [varchar](50) COLLATE Chinese_PRC_CI_AS NULL,
   [ImgIdx] [int] NULL CONSTRAINT [DF_SysMenu_ImgIndex]  DEFAULT ((-1)),
   [ShortCut] [int] NULL CONSTRAINT [DF_SysMenu_ShortCut]  DEFAULT ((-1)),
   [OperMode] [int] NULL CONSTRAINT [DF_SysMenu_OperMode]  DEFAULT ((-1)), --操作模式:-1.无操作; 1.打开窗体; 2.运行通用查询; 3.运行脚本; 4.调用系统过程
   [OperContext] [varchar](50) COLLATE Chinese_PRC_CI_AS NULL, --根据不同操作模式,来编写不同操作文本,可以是:窗体的类名,通用查询标示,脚本,系统中一个过程的名称(TNotifyEvent = procedure(Sender: TObject) of object;)
   [PermId] [int] NULL CONSTRAINT [DF_SysMenu_PermId]  DEFAULT ((-1)),
   [ParentId] [int] NULL CONSTRAINT [DF_SysMenu_ParentId]  DEFAULT ((-1)),
   [Priority] [int] NULL CONSTRAINT [DF_SysMenu_Priority]  DEFAULT ((0)),
   [CreateDate] [datetime] NULL CONSTRAINT [DF_SysMenu_CreateDate]  DEFAULT (getdate()),
   [EditDate] [datetime] NULL,
   [State] [int] NULL CONSTRAINT [DF_SysMenu_State]  DEFAULT ((0)),
   CONSTRAINT [PK_SysMenu] PRIMARY KEY CLUSTERED 
  (
   [Id] ASC
  )WITH (IGNORE_DUP_KEY = OFF) ON [PRIMARY]
  ) ON [PRIMARY]

}
//---------- 结构体、常量的声明部分 ----------
  ShortCuts: array[0..108] of TShortCut = (
    scNone,
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    Byte('A') or scCtrl or scAlt,
    Byte('B') or scCtrl or scAlt,
    Byte('C') or scCtrl or scAlt,
    Byte('D') or scCtrl or scAlt,
    Byte('E') or scCtrl or scAlt,
    Byte('F') or scCtrl or scAlt,
    Byte('G') or scCtrl or scAlt,
    Byte('H') or scCtrl or scAlt,
    Byte('I') or scCtrl or scAlt,
    Byte('J') or scCtrl or scAlt,
    Byte('K') or scCtrl or scAlt,
    Byte('L') or scCtrl or scAlt,
    Byte('M') or scCtrl or scAlt,
    Byte('N') or scCtrl or scAlt,
    Byte('O') or scCtrl or scAlt,
    Byte('P') or scCtrl or scAlt,
    Byte('Q') or scCtrl or scAlt,
    Byte('R') or scCtrl or scAlt,
    Byte('S') or scCtrl or scAlt,
    Byte('T') or scCtrl or scAlt,
    Byte('U') or scCtrl or scAlt,
    Byte('V') or scCtrl or scAlt,
    Byte('W') or scCtrl or scAlt,
    Byte('X') or scCtrl or scAlt,
    Byte('Y') or scCtrl or scAlt,
    Byte('Z') or scCtrl or scAlt,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);

type
  PMenuData = ^TMenuData;
  TMenuData = record
    Id: Integer;
    Name: string;
    OperMode: Integer;
    OperContext: string;
    PermId: Integer;
    ShortCut: TShortCut;
  end;



//---------- TMenuItemEx 类的声明部分 ----------
type
  TMenuItemEx = class(TMenuItem)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    Data: Pointer;
  published
    { Published declarations }
  end;


//---------- 相关函数的声明 ----------
function GetSingleValue(ACon: TADOConnection; ASQL: string; AFieldName: string=''): string;
var
  fTmp: Fields;
begin
  Result := '';

  fTmp := GetSingleRow(ACon, ASQL);

  if not Assigned(fTmp) then Exit;

  if AFieldName = '' then
    Result := VarToStr(fTmp[0].Value)
  else
    Result := VarToStr(fTmp[AFieldName].Value);
end;


//---------- 动态菜单实现部分----------
//mmMain 为窗体上的菜单控件...
procedure TMainFrm.CreateSysMenu(AMenuId: Integer; AMenuItem: TMenuItem);
var
  i: Integer;
  oRs: _Recordset;

  oMenuItem: TMenuItemEx;

  pMenuDataA: PMenuData;

  MenuItemMethod: TMethod;
begin
  oRs := FrmData.conMain.Execute('SELECT * FROM SysMenu WHERE ParentId=' + IntToStr(AMenuId) + ' ORDER BY Priority');
  
  for i := 0 to oRs.RecordCount - 1 do
  begin
    New(pMenuDataA);
    pMenuDataA^.Id := oRs.Fields['Id'].Value;
    pMenuDataA^.Name := VarToStr(oRs.Fields['Name'].Value);
    pMenuDataA^.OperMode := oRs.Fields['OperMode'].Value;
    pMenuDataA^.OperContext := VarToStr(oRs.Fields['OperContext'].Value);
    pMenuDataA^.PermId := oRs.Fields['PermId'].Value;
    pMenuDataA^.ShortCut := oRs.Fields['ShortCut'].Value;

    oMenuItem := TMenuItemEx.Create(mmMain);
    oMenuItem.Caption := VarToStr(oRs.Fields['Title'].Value);
    oMenuItem.ImageIndex := oRs.Fields['ImgIdx'].Value;
    oMenuItem.ShortCut := oRs.Fields['ShortCut'].Value;
    if pMenuDataA^.PermId <> -1 then
      oMenuItem.Visible := ck(pMenuDataA^.PermId);
    oMenuItem.Enabled := oMenuItem.Visible;

    oMenuItem.Data := pMenuDataA;

    if pMenuDataA^.OperMode <> -1 then
      oMenuItem.OnClick := AMenuItemClick;

    if (pMenuDataA^.OperMode = 3) and (Assigned(Self.MethodAddress(pMenuDataA^.OperContext))) then
    begin
      MenuItemMethod.Code := Self.MethodAddress(pMenuDataA^.OperContext);
      MenuItemMethod.Data := oMenuItem;
      oMenuItem.OnClick := TNotifyEvent(MenuItemMethod);
    end;

    if not Assigned(AMenuItem) then
      mmMain.Items.Add(oMenuItem)
    else
      AMenuItem.Add(oMenuItem);

    if StrToIntDef(GetSingleValue(FrmData.conMain, 'SELECT COUNT(*) FROM SysMenu WHERE ParentId=' + IntToStr(AMenuId)), 0) > 0 then
      CreateSysMenu(oRs.Fields['Id'].Value, oMenuItem);

    oRs.MoveNext;
  end;
end;

function TMainFrm.AdjustMenuSplit(AMenuItem: TMenuItem): Boolean;
  function IsSubItemVisible(BMenuItem: TMenuItem): Boolean;
  var
    j: Integer;
  begin
    Result := False;

    for j := 0 to BMenuItem.Count - 1 do
      if (BMenuItem.Items[j].Caption <> '-') and (BMenuItem.Items[j].Visible) then
        Result := True;
  end;
var
  i: Integer;
  IsPrevSplit: Boolean;
begin
  Result := False;

  if AMenuItem = nil then
    AMenuItem := mmMain.Items;

  IsPrevSplit := True;
  for i := 0 to AMenuItem.Count -1 do
  begin

    if AMenuItem.Items[i].Count > 0 then
    begin
      if (AMenuItem.Items[i].Visible) and (not IsSubItemVisible(AMenuItem.Items[i])) then
        Result := True;
        
      AMenuItem.Items[i].Visible := IsSubItemVisible(AMenuItem.Items[i]);
      AdjustMenuSplit(AMenuItem.Items[i]);
    end;

    if AMenuItem.Items[i].Visible then
      if AMenuItem.Items[i].Caption = '-' then
      begin
        if IsPrevSplit then
          AMenuItem.Items[i].Visible := False;

        IsPrevSplit := True;
      end
      else
        IsPrevSplit := False;
  end;
end;

procedure TMainFrm.AdjustMenuSplit_(AMenuItem: TMenuItem);
  function GetNextVisbleItem(CMenuItem: TMenuItem; AItemIndex: Integer) :TMenuItem;
  var
    k: Integer;
  begin
    Result := nil;

    for k := AItemIndex to CMenuItem.Count - 1 do
      if CMenuItem.Items[k].Visible then
      begin
        Result := CMenuItem.Items[k];
        Exit;
      end;
  end;
var
  i: Integer;
  NextVisbleItem: TMenuItem;
begin
  if AMenuItem = nil then
    AMenuItem := mmMain.Items;

  for i := 0 to AMenuItem.Count -1 do
  begin

    if AMenuItem.Items[i].Count > 0 then
      AdjustMenuSplit_(AMenuItem.Items[i]);

    if (AMenuItem.Items[i].Visible) and (AMenuItem.Items[i].Caption = '-') then
    begin
      NextVisbleItem := GetNextVisbleItem(AMenuItem, i + 1);

      if Assigned(NextVisbleItem) then
        AMenuItem.Items[i].Visible := not (NextVisbleItem.Caption = '-')
      else
        AMenuItem.Items[i].Visible := False;
    end;
  end;
end;

procedure TMainFrm.InitiSysMenu;
begin
  mmMain.Items.Clear;
  CreateSysMenu;

  while AdjustMenuSplit do
    AdjustMenuSplit_;
end;

procedure TMainFrm.AMenuItemClick(Sender: TObject);
var
  pMenuDataA: PMenuData;
begin
  if (Assigned(Sender)) and (Sender is TMenuItemEx) then
  begin
    pMenuDataA := TMenuItemEx(Sender).Data;

   case pMenuDataA^.OperMode of
    0: OpenFrm(pMenuDataA^.OperContext);
    1: OpenQry(pMenuDataA^.OperContext);
    2: ExecScript(pMenuDataA^.OperContext);
   end;
  end;
end;

procedure TMainFrm.OpenFrm(AFrmClsName: string);
var
  clsFrm: TFormClass;
  oFrm: TForm;
begin
  clsFrm := TFormClass(GetClass(AFrmClsName));
  if Assigned(clsFrm) then
  begin
    if not FrmExist(AFrmClsName) then
    begin
      oFrm := clsFrm.Create(Self);
      oFrm.Show;
    end;
  end
  else
    raise Exception.Create('无法打开窗体,窗体类 ' + AFrmClsName + ' 没有注册。');
end;

procedure TMainFrm.OpenQry(AQryName: string);
var
  ofrmQry: TfrmPubQry;
begin
  ofrmQry := TfrmPubQry.Create(Self, AQryName);
  ofrmQry.Show;
end;

procedure TMainFrm.ExecCustomMethod(AMethod: string; Sender: TObject);
begin
  //
end;

procedure TMainFrm.ExecScript(AScript: string);
begin
  //可以使用常规的 Script 引擎来实现比如 FastScript .....
end;
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
没有相关文章
相关评论
共有评论5条 当前显示最后4条评论
jueschen 2007/5/8 7:55:41
谢谢分享。能不能提供一个demo?
tilly 2007/5/8 10:57:27
建议楼主作个示例文件供大家学习!
ahlkj 2007/5/8 14:09:35
// 
function GetSingleRow(ACon: TADOConnection; ASQL: string): Fields;
var
  rsTmp: _Recordset;
begin
  Result := nil;

  rsTmp := ACon.Execute(ASQL);

  if rsTmp.RecordCount > 0 then
    Result := rsTmp.Fields;
end;
mumuc521 2007/6/3 19:06:24
还没有做到那个程度,不过看的挺好的
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 1999-2023 V4.01 粤ICP备10103342号-1 更新RSS列表