精华区文章阅读

发信人: Sun (大灯泡), 信区: VisualBasic
标  题: 设计通用 MessageBox 窗口函数
发信站: 哈工大紫丁香 (Sat Sep  4 17:09:45 1999), 转信

　　
　　李森

在Windows环境下编写程序的程序员都知道：Windows有一个很有用的API函数
MessageBox。通过MessageBox某些参数的传递我们可以做出诸如“选择”、“警
告”、“提示”等等用户界面效果。Foxpro for DOS 却缺少这么一个有用的函数。
那么，我们可以给它增加一个类似的函数。
以下为此函数源程序：

＊＊选择窗口主程序

FUNCTION YESNO

＊＊＊＊＊＊＊＊＊＊＊＊

＊＊我们预定义可以输入至多5个参数

PARAMETERS MESSAGE1,MESSAGE2,MESSAGE3,MESSAGE4,MESSAGE5

＊＊将以前定义的热键压入堆栈

PUSH KEY CLEAR

＊＊关闭 ESC 热键

SET ESCA OFF

＊＊关闭回显设置

SET TALK OFF

private delay_time

＊＊如果参数不符合规定

IF PARAMETERS()==0 or parameters() 〉 5

MESSAGE1="Zigzag Software Group"

messagenum=1 ＆＆参数个数为1

else

messagenum=parameters() ＆＆得到参数个数

ENDIF

wlength=0 ＆＆窗口可能的长度

for n=1 to messagenum

messtemp="MESSAGE"＋str(n,1)

WLENGTHtemp=LEN(＆MESStemp)＋4

if wlength〈wlengthtemp

wlength=wlengthtemp ＆＆得到窗口可能的最大长度

endif

endfor

wheight=9＋messagenum ＆＆窗口的最大高度

IF WLENGTH〈40 ＆＆如果窗口长度小于40

WLENGTH=40

ENDIF

IF MOD(WLENGTH,2) ＃ 0 ＆＆如果长度不是2的倍数

WLENGTH=WLENGTH＋1

ENDIF

IF MOD(WLENGTH,4) ＃ 0 ＆＆保持汉字的兼容性，使不会出现半个汉字的现像

WLENGTH=WLENGTH＋2

ENDIF

YESNOCOLOR="13" ＆＆窗口的颜色模式，可以按爱好更改

＊＊定义弹出窗口，使之处于屏幕中间

DEFINE WINDOW W_YESNO ;

FROM ;

int((srow()－wheight)/2),int((scol()－WLENGTH)/2) ;

to int((srow()－wheight)/2)＋wheight－1,int((scol()－WLENGTH)/2)＋WLENGTH－1
;

NONE SHADOW COLOR SCHEME ＆YESNOCOLOR

＊＊激活窗口，但是不显示，避免闪烁

ACTIVATE WINDOW W_YESNO NOSHOW

＊＊以下几行美化窗口

@0,0 say replicate(chr(223),wcols()) color w＋/w

@1,0 say padc("〉确认窗〈" , wcols()) COLOR GR＋/W

@1,1 say "＊" color r/w

@2,0 say replicate(chr(220),wcols()) color n＋/W

@WROWS()－2,0 say replicate(chr(223),wcols()) color w＋/W

@WROWS()－1,0 say replicate(chr(220),wcols()) color n＋/w

＊＊显示通过参数传递的消息

for n=1 to messagenum

messtemp="message"＋str(n,1)

@n＋3,1 SAY PADC(＆MESStemp,wcols()－2)

endfor

＊＊定义按键

PRIVATE USER_MENU

DIMENSION USER_MENU[2,2]

USER_MENU[1,1]=" 确认 "

USER_MENU[1,2]="〉确认〈"

USER_MENU[2,1]=" 取消 "

USER_MENU[2,2]="〉取消〈"

PRIVATE SHADOW_COLOR

SHADOW_COLOR=SHADOW(YESNOCOLOR) ＆＆按键的阴影颜色

MENUROW=WROWS()－4

＊＊描绘按键的阴影

@MENUROW＋1, INT((WCOLS()/2－10)/2)＋1 SAY replicate(chr(223),10) COLOR
＆SHADOW_COLOR

@MENUROW , INT((WCOLS()/2－10)/2) SAY replicate(chr(20),10)＋chr(220)
COLOR ＆SHADOW_COLOR

@MENUROW＋1, INT(WCOLS()/2)＋INT((WCOLS()/2－10)/2)＋1 SAY
replicate(chr(223),10) COLOR ＆SHADOW_COLOR

@MENUROW, INT(WCOLS()/2)＋INT((WCOLS()/2－10)/2) SAY
replicate(chr(20),10)＋chr(220) COLOR ＆SHADOW_COLOR

＊＊显示窗口

show window w_yesno

＊＊预定义返回变量

PRIVATE CHOICE_VALUE

CHOICE_VALUE=1

DO WHILE .T.

DO CASE ＆＆描绘按键

CASE CHOICE_VALUE==1

@MENUROW, INT((WCOLS()/2－10)/2) SAY USER_MENU[1,2] color
(scheme(18,6))

@MENUROW, INT(WCOLS()/2)＋INT((WCOLS()/2－10)/2) SAY
USER_MENU[2,1] color (scheme(18,2))

CASE CHOICE_VALUE==2

@MENUROW, INT((WCOLS()/2－10)/2) SAY USER_MENU[1,1] color
(scheme(18,2))

@MENUROW, INT(WCOLS()/2)＋INT((WCOLS()/2－10)/2) SAY
USER_MENU[2,2] color (scheme(18,6))

ENDCASE

PRIVATE KEYPUT

KEYPUT=INKEY(0) ＆＆捕获键盘输入

DO CASE

CASE KEYPUT==27 ＆＆ ESC 键

CHOICE_VALUE=0

EXIT

CASE KEYPUT==13 ＆＆回车键

EXIT

CASE KEYPUT==4 OR KEYPUT==19 ＆＆左右方向键

IF CHOICE_VALUE==1

CHOICE_VALUE=2

ELSE

CHOICE_VALUE=1

ENDIF

OTHERWISE

?? chr(7) ＆＆若是其他键则响铃

ENDCASE

ENDDO

RELEASE WINDOW W_YESNO

POP KEY

RETURN CHOICE_VALUE ＆＆返回值：0: ESC, 1: 确定, 2: 取消

＊＊获取颜色序列中的阴影颜色

FUNCTION SHADOW

＊＊＊＊＊＊＊＊＊＊＊＊＊＊

PARAMETERS COLOR_SET ＆＆颜色序列号

PRIVATE SHADOW_COLOR

F TYPE('COLOR_SET')=="C"

COLOR_SET=VAL(COLOR_SET)

ENDIF

＆＆获取阴影颜色对

SHADOW_COLOR=SUBSTR(SCHEME(COLOR_SET,1),ATC('/',SCHEME(COLO
R_SET),1)＋1)

IF ATC('＊',SHADOW_COLOR)!=0

SHADOW_COLOR=LEFT(SHADOW_COLOR,LEN(SHADOW_COLOR)－1)＋"/"
＋SHADOW_COLOR

ELSE

SHADOW_COLOR="N/"＋SHADOW_COLOR

ENDIF

RETURN SHADOW_COLOR ＆＆返回阴影颜色

以上程序在作者编写的“住院处收费网络系统”中运行正常。

读者也可以根据以上程序稍作修改，就可以做出“警告”、“提示”之类的窗口。
这样，对于以后的编程工作来说会事半功倍的。


--
〖小糊涂虫２０００灌水机〗

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: sun@hope.hit.edu.cn]

VB 版 (精华区)