[分享] 由表结构生成系统主菜单
[ 2005-06-26 | 作者:hongpx | 来自:Microsoft Visual FoxPro Blog]
#define _DEBUG .T. && 作为调试用。
LOCAL i,j
LOCAL lcTableFuncList
lcTableFuncList = "FuncList"
* 表结构:
* nKey n (5)
* nParent n (5)
* cDesc c (20)
* cCommand c (50)
* lEnabled l
* nParent = 0 的记录作为顶层菜单
IF _DEBUG
IF USED (lcTableFuncList)
USE IN &lcTableFuncList
ENDIF
*-- 创建临时表存放功能信息
CREATE CURSOR &lcTableFuncList (;
nKey n (5),;
nParent n (5),;
cDesc c (20),;
cCommand c (50),;
lEnabled l DEFAULT .T.)
*-- 添加测试数据
FOR i=1 TO 5
INSERT INTO &lcTableFuncList (nKey,nParent,cDesc) VALUES (i,0,"功能(\<" + ALLTRIM(STR(i)) + ")" )
FOR j=1 TO 9
INSERT INTO &lcTableFuncList (nKey,nParent,cDesc,cCommand) VALUES ;
(i*10+(j-1),i,"(\<" + ALLTRIM(STR(j)) + ")功能" + ALLTRIM(STR(i)) + "-" + ALLTRIM(STR(j)), ;
"MESSAGEBOX ('" + ALLTRIM(STR(i)) + "-" + ALLTRIM(STR(j)) + "')" )
NEXT
NEXT
*-- 加入子菜单(在第一层菜单下面加入)
FOR i=0 TO 3
FOR j=1 TO 4
INSERT INTO &lcTableFuncList (nKey,nParent,cDesc,cCommand) VALUES (100+i*10+j,10+i,"子项1-" + ;
ALLTRIM(STR (i+1)) + "-" + ALLTRIM(STR(j)),;
"MESSAGEBOX('" + "子项1-" + ALLTRIM(STR(i+1)) + "-" + ALLTRIM(STR(j)) + "')" )
NEXT
NEXT
*-- 设置某些项目不能使用(随机将10个菜单项目设置为禁止)
FOR i=1 TO 10
j = INT (RAND() * RECCOUNT())
IF j>0
GOTO j
REPLACE lEnabled WITH .F.
ENDIF
ENDFOR
ELSE
*-- 打开本地的功能表
IF !USED(lcTableFuncList)
USE Common\data\FuncList ALIAS &lcTableFuncList SHARED IN 0
ENDIF
ENDIF
*-- 变量定义
LOCAL lcMenuName,lcMenuDesc
LOCAL lcPopMenu,lcSubPopMenu,lcDoCommand,lcSkipFor
LOCAL lnRecNo
*-- 初始
RELEASE POPUP mymenu0 extended
SET SYSMENU TO
SET SYSMENU AUTOMATIC
*-- 设置顶层菜单
DEFINE PAD _SysTopMenu OF _MSYSMENU PROMPT "文件(\<F)"
ON PAD _SysTopMenu OF _MSYSMENU ACTIVATE POPUP _SysPopMenu
DEFINE POPUP _SysPopMenu MARGIN RELATIVE
DEFINE BAR 1 OF _SysPopMenu PROMPT "退出 (\<X)"
ON SELECTION BAR 1 OF _SysPopMenu set sysmenu to default
*-- 动态菜单=====
*-- 设置顶层菜单项
SELECT DISTINCT nKey,cDesc FROM &lcTableFuncList WHERE nParent = 0 ORDER BY nKey INTO CURSOR temp_TopItem
SCAN
* 菜单名称
lcMenuName = "_TopMenu" + ALLTRIM(STR(nKey))
* 菜单显示名
lcMenuDesc = ALLTRIM(cDesc) && + "(\<" + ALLTRIM(STR(RECNO())) + ")"
* 顶层菜单弹出的菜单项的菜单名
lcPopMenu = "_PopMenu" + ALLTRIM(STR(nKey))
* 定义顶层菜单项
DEFINE PAD &lcMenuName OF _MSYSMENU PROMPT lcMenuDesc
* 设置顶层菜单项点击时弹出子菜单
ON PAD &lcMenuName OF _MSYSMENU ACTIVATE POPUP &lcPopMenu
ENDSCAN
USE IN temp_TopItem
*-- 定义所有的popup菜单以及所有的子菜单项
SELECT nParent FROM &lcTableFuncList GROUP BY nParent WHERE nParent > 0 INTO CURSOR temp_Popup
* temp_Popup 临时表是所有需要弹出子菜单的菜单项列表
SCAN
* 记下当前的记录号
lnRecNo = RECNO()
* 弹出菜单名
lcPopMenu = "_PopMenu" + ALLTRIM(STR(nParent))
* 定义弹出菜单
DEFINE POPUP &lcPopMenu MARGIN RELATIVE
* 查询当前弹出菜单下面所有的子菜单项
SELECT DISTINCT nKey,cDesc,cCommand,lEnabled FROM &lcTableFuncList WHERE nParent = temp_Popup.nParent ORDER BY nKey INTO CURSOR temp_MenuItem
SCAN
* 菜单项名(顺序编号)
lcMenuBar = ALLTRIM(STR(RECNO()))
* 菜单项显示名
lcMenuDesc = ALLTRIM(cDesc)
* 菜单项执行的命令
lcDoCommand = ALLTRIM(cCommand)
* 是否菜单可用
lcSkipFor = IIF(lEnabled,"","Skip")
* 如果子菜单含有子菜单,则这个子菜单的子菜单的名称
lcSubPopMenu = "_PopMenu" + ALLTRIM(STR(nKey))
* 定义当前子菜单项
DEFINE BAR &lcMenuBar OF &lcPopMenu PROMPT lcMenuDesc &lcSkipFor
* 查询所有弹出菜单表 ,如果找到,表示含有子菜单,找不到则只有单独菜单项
SELECT temp_Popup
LOCATE FOR nParent = temp_MenuItem.nKey
IF FOUND()
*-- 含有子菜单,激活子菜单
ON BAR &lcMenuBar OF &lcPopMenu ACTIVATE POPUP &lcSubPopMenu
ELSE
*-- 不含有子菜单,运行命令
ON SELECTION BAR &lcMenuBar OF &lcPopMenu &lcDoCommand
ENDIF
* 回到刚才的记录
SELECT temp_Popup
GOTO lnRecNo
ENDSCAN
USE IN temp_MenuItem
ENDSCAN
USE IN temp_Popup
USE IN &lcTableFuncList
*-- 帮助菜单
DEFINE PAD _HelpTopMenu OF _MSYSMENU PROMPT "帮助(\<H)"
ON PAD _HelpTopMenu OF _MSYSMENU ACTIVATE POPUP _HelpPopMenu
DEFINE POPUP _HelpPopMenu MARGIN RELATIVE
DEFINE BAR 1 OF _HelpPopMenu PROMPT "关于(\<A)..."
ON SELECTION BAR 1 OF _HelpPopMenu MESSAGEBOX("测试菜单")
*-- 菜单结束
RETURN