dbaseIII或foxplus的简化的弹出菜单实现方式
dbaseIII中的菜单功能羸弱；foxplus提供了光带菜单、弹出菜单以及下拉菜单，但要编制出来都有一定的难度。
其实，菜单大体可分为两种，光带菜单和弹出菜单。下拉菜单可视为光带菜单和弹出菜单的融合，顶部横向的可视为光带菜单，下部竖向拉出的可视为弹出菜单。光带菜单其实也可视为是一种弹出菜单。这样看，其实菜单的根本的形式就是弹出菜单。所以，我们重点就是研究弹出菜单，侧重于竖向的弹出菜单。灵活应用这种弹出菜单就解决了诸多的交互选择问题。
《用pascal编写的dos下的菜单程序及其应用》（在https://blog.csdn.net/gcbjoy/article/details/148811492?spm=1001.2014.3001.5502文中所引用）中详细提供了dos下的下拉菜单的实现及其应用，那里的菜单是二维结构，且支持鼠标操作。早期的dbaseIII以及foxplus本身就不支持鼠标；另，上面提到只需要弹出菜单。所以，我们的工作就是对原来二维结构的菜单变为一维；再除去支持鼠标的功能部分，就得到了用于dbaseIII或foxplus的弹出菜单，当然也可用于dbaseIV和foxpro。开发时用了一个单元模块（foxmenu.tpu），在其中实现弹出菜单以及有关的子例程和函数。实际的运行程序为foxm.exe，在其中实现对菜单文本文件的解析、弹出菜单展现、对用户交互的响应、用户选择后自动生成内存变量文件exitcode.mem。
一、菜单文本文件
菜单文本文件决定了弹出菜单展现的起始位置、菜单项数、最大宽度（推荐为实际最大宽度+2，文字前后各加一个空格）、各菜单项的名称。结构如下：
<X>
<Y>
<N>
<Width>
<第一项菜单名称>
<第二项菜单名称>
<......>
<第N-1项菜单名称>
<第N项菜单名称>
其中：X、Y、N、Width------分别为起始列坐标、起始行坐标、菜单项数、最大宽度。
文本文件的结构非常简单，比写光带菜单、弹出菜单prg程序要简单太多了。
二、foxm.exe的运行方法
foxm.exe的运行方式只有两种：
1、不带命令行参数运行
run foxm------此时foxm.exe会自动读取文件名为foxmenu.mnu的文本文件。若文件存在，且格式合规，则程序正常运行展现弹出菜单；若文件不存在，会显示“Runtime error 002 at ......”。
2、带一个命令行参数运行
即，run foxm <格式化的菜单文本文件名>
这是最通常的调用方式，命令行参数不同，弹出菜单就不同，以实现不同的功能。有此可见，利用这种调用方式，可以形成多层级的菜单功能，层级的多少完全在于使用者，且层数没有限制。
三、传递参数的内存变量文件
传递参数的内存变量文件固定为exitcode.mem（意即返回码），由foxm.exe在用户选择了菜单项，即按下了“回车键”或“空格键”后自动将选择的“顺序号”（字符串）和选择的“某项菜单名称”按dbaseIII的内存变量文件格式写入文件中，对应的内存变量名分别为exitcode、exitstr。
四、在dbaseIII或foxplus中的调用
调用foxm.exe，然后读取返回值的方式是固定的，即：
RUN FOXM <格式化的菜单文本文件名>
RESTORE FROM EXITCODE ADDITIVE
即RUN命令和RESTORE命令是成双成对出现的。
后面可以用VAL(exitcode) 将返回码转为数值，exitstr则可直接按字符串变量引用。
五、总结
本文开发的这种弹出菜单方法某种程度上极大地简化了数据库系统的编程难度，将编程工作变得“傻瓜化”，值得系统开发人员借鉴、参考。文后附foxmenu.tpu和foxm.exe的源代码，供有兴趣的同仁参考。
附一：foxmenu.pas
unit foxmenu;
interface
uses dos,crt;
type
zcd=array[1..21] of string[78]; {弹出菜单字符串数组}
var
stat:byte;
ff :file of byte;
xb,yb,hb:byte;
r:registers;
code,xx,yy:integer;
hh:integer; {hh____弹出菜单序号}
i,j,n,num:integer;
SCANCODE,status:BYTE;
X,Y:word; {弹出菜单位置控制参数}
menu:zcd; {弹出菜单字符串数组}
subprocname:zcd;
menunum:integer; {弹出菜单各项的功能数}
menuwide:integer; {弹出菜单各项的宽度}
p:pointer;
dd:array[1..2] of word absolute p;
ssf_color,ssb_color,sef_color,seb_color:byte;
{ ssf_color--子菜单标准前景
ssb_color--子菜单标准背景
sef_color--子菜单增强前景
seb_color--子菜单增强背景 }
frame_b_color,frame_f_color:byte;
procedure mode;
procedure screenon;
procedure screenoff;
FUNCTION SCAN:BYTE;
procedure frame(upperleftx,upperlefty,lowerrightx,lowerrighty:integer);
procedure menuproc(x,y:integer;var menu:zcd;menunum,menuwide:integer;var hh:integer);
procedure run(subproc:string);
procedure ctrlbreakon;
procedure ctrlbreakoff;
procedure lockkbd;
procedure unlockkbd;
function kbdstatus:byte;
procedure setcur(x1,x2:byte);
implementation
procedure setcur(x1,x2:byte);
begin
r.ah:=1;
r.ch:=x1;
r.cl:=x2;
intr($10,r);
end;
function kbdstatus:byte;assembler;
asm
mov ah,1
int 16h
jz @1
mov al,0
jmp @2
@1: mov al,1
@2:
end;
procedure lockkbd;
begin
port[$61]:=port[$61] or $80;
end;
procedure unlockkbd;
begin
port[$61]:=port[$61] and $7f;
end;
procedure ctrlbreakon;assembler;
asm
push ax
push dx
mov ah,33h
mov al,1
mov dl,1
int 21h
pop dx
pop ax
end;
procedure ctrlbreakoff;assembler;
asm
push ax
push dx
mov ah,33h
mov al,1
mov dl,0
int 21h
pop dx
pop ax
end;
procedure mode;
begin
window(1,1,80,25);
textbackground(black);
textcolor(7);
clrscr;
setcur(12,14);
end;
procedure screenon;
begin
port[$3d8]:=$2d;
end;
procedure screenoff;
begin
port[$3d8]:=$25;
end;
FUNCTION SCAN:BYTE;ASSEMBLER;
ASM
MOV AL,0
INT 16H
MOV AL,AH
END;
procedure frame(upperleftx,upperlefty,lowerrightx,lowerrighty:integer);
var i:integer;
begin
IF LOWERRIGHTX+1>80 THEN
window(upperleftx,upperlefty,80,lowerrighty)
ELSE
window(upperleftx,upperlefty,lowerrightx,lowerrighty);
textbackground(frame_b_color);
textcolor(frame_f_color);
clrscr;
window(1,1,80,25);
gotoxy(upperleftx,upperlefty);
write(chr(218));
for i:=(upperleftx+1) to (lowerrightx-1) do write('-');
write(chr(191));
for i:=(upperlefty+1) to (lowerrighty-1) do begin
gotoxy(upperleftx,i); write(chr(179));
gotoxy(lowerrightx,i); write(chr(179));
end;
gotoxy(upperleftx,lowerrighty);
write(chr(192));
for i:=(upperleftx+1) to (lowerrightx-1) do write('-');
write(chr(217));
end;
procedure menuproc(x,y:integer;var menu:zcd; menunum,menuwide:integer;var hh:integer);
label 100,200,300,400,10;
var i:word;
k:integer;
ch:char;
procedure listall; {显示某一个完整的下拉菜单各项}
var i:word;
begin
k:=1;
frame(x-1,y+1,x+menuwide,y+menunum+2);
window(x,y+2,x+menuwide-1,y+1+menunum);
textbackground(ssb_color);
textcolor(ssf_color);
clrscr;
for i:=1 to menunum do begin
gotoxy(1,i);
write(menu[i]);
end;
end;
procedure listone; {显示某一个下拉菜单的下一项或上一项}
begin
window(x,hh+y+1,x+menuwide-1,
hh+y+1);
textbackground(seb_color);
textcolor(sef_color);
clrscr;
write(menu[hh]);
end;
procedure clearone; { 重新显示某一个下拉菜单当前项}
begin
window(x,hh+y+1,x+menuwide-1,hh+y+1);
textbackground(ssb_color);
textcolor(ssf_color);
clrscr;
write(menu[hh]);
end;
begin
hh:=1;
300: WHILE TRUE DO BEGIN
listall;
listone;
setcur($ff,$ff);
100: r.ah:=$0b;
msdos(r);
status:=r.al;
write('');
if status<>0 then
case scan of
80:begin
hh:=hh mod menunum;
if hh=0 then hh:=menunum;
clearone;
hh:=hh+1;
hh:=hh mod menunum;
if hh=0 then hh:=menunum;
listone;
goto 100;
end;
72:begin
hh:=hh mod menunum;
if hh=0 then hh:=menunum;
clearone;
hh:=hh-1;
if hh=0 then hh:=menunum;
hh:=hh mod menunum;
if hh=0 then hh:=menunum;
listone;
goto 100;
end;
28,57:BEGIN goto 200; END;
{ ELSE begin goto 100; end; }
END { end of case}
else begin goto 100; end ;
end; {end of while}
200:
setcur(12,14);
end; {end of proc}
procedure run(subproc:string);
begin
if (subproc='halt')or(subproc='stop')or(subproc='end')OR
(subproc='HALT')or(subproc='STOP')or(subproc='END') then
begin setcur(12,14); halt; end
else if subproc='' then begin
setcur(12,14);
exec(getenv('comspec'),'');
end
else begin
window(1,2,80,23);
textcolor(7);
textbackground(0);
clrscr;
setcur(12,14);
exec(getenv('comspec'),'/c '+subproc);
end;
end;
begin {begin of initial}
ssb_color:=lightcyan;
ssf_color:=white;
seb_color:=magenta; {red;}
sef_color:=white;
frame_b_color:=lightgreen;
frame_f_color:=black;
lockkbd;
setcbreak(false);
dd[1]:=$ff53;
dd[2]:=$f000;
setintvec($23,p);
unlockkbd;
assign(input,'');reset(input);
assign(output,''); rewrite(output);
hh:=1;
END. {end of unit}
附二：foxm.pas
{$m,2048,0,0}
program foxm;
uses foxmenu,dos,crt;
var
VAR_NAME:STRING[10]; {变量名}
VAR_VALUE:STRING[78]; {变量值}
BUF:ARRAY[1..300] OF BYTE; {缓冲区}
F:FILE OF BYTE; {字节文件}
I,J,K,SUM_L,l:WORD;
ff:text; {文本文件}
STRINGG:ARRAY[1..78] OF STRING[1];
BEGIN
if paramcount=0 then begin
assign(ff,'foxmenu.mnu');
reset(ff);
end;
if paramcount=1 then begin
assign(ff,paramstr(1));
reset(ff);
end;
IF PARAMCOUNT>1 THEN HALT;
readln(ff,xx); {读起始列坐标，在foxmenu单元中定义}
readln(ff,yy); {读起始行坐标，定义同上}
readln(ff,menunum); {读弹出菜单的功能数，定义同上}
readln(ff,menuwide); {读弹出菜单的宽度，定义同上}
for i:=1 to menunum do readln(ff,menu[i]); {读各菜单项的标题}
close(ff);
ASSIGN(INPUT,'');RESET(INPUT);
ASSIGN(OUTPUT,''); REWRITE(OUTPUT);
FOR I:=1 TO 300 DO BUF[I]:=0;
VAR_NAME:='EXITCODE';
I:=LENGTH(VAR_NAME);
FOR J:=1 TO I DO BUF[J]:=ORD(VAR_NAME[J]);
BUF[12]:=ORD('C');
hh:=1;
MENUPROC(xx,yy,MENU,MENUNUM,MENUWIDE,hh);
i:=hh;
STR(i,VAR_VALUE);
K:=LENGTH(VAR_VALUE);
BUF[17]:=K+1;
FOR J:=1 TO K DO BUF[32+J]:=ORD(VAR_VALUE[J]);
SUM_L:=32+K+2;
BUF[SUM_L-1]:=0;
BUF[SUM_L]:=$1A;
for i:=SUM_L to sum_l+31+32 do buf[i]:=0;
var_name:='EXITSTR';
I:=LENGTH(VAR_NAME);
FOR J:=1 TO I DO BUF[SUM_L-1+J]:=ORD(VAR_NAME[J]);
BUF[SUM_L+11]:=ORD('C');
K:=LENGTH(MENU[HH]);
FOR I:=1 TO K DO STRINGG[I]:=MENU[HH][I];
VAR_VALUE:='';
FOR I:=1 TO K DO IF STRINGG[I]<>' ' THEN VAR_VALUE:=VAR_VALUE+STRINGG[I];
K:=LENGTH(VAR_VALUE);
BUF[SUM_L+16]:=K+1;
FOR J:=1 TO K DO BUF[SUM_L+32-1+J]:=ORD(VAR_VALUE[J]);
BUF[SUM_L+31+K+1]:=0;
BUF[SUM_L+31+K+2]:=$1A;
ASSIGN(F,'EXITCODE.MEM');
REWRITE(F);
FOR I:=1 TO SUM_L+(31+K+2) DO WRITE(F,BUF[I]);
CLOSE(F);
setcur(13,14);
END.
扫一扫
612
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
