dhsw.prg

vfp 中_screen功能的简单使用

*!* 用于设置系统环境和指定错误处理程序
SET TALK OFF           &&关闭命令显示
SET ESCAPE OFF         &&禁止运行的程序在按 Esc 键后被中断
SET EXCLUSIVE OFF      &&允许网络上的任何用户共享和修改网络上打开的表
SET HELP ON            &&当按下 F1 键或在命令窗口中执行 HELP 命令时，显示帮助窗口
&&SET HELP TO MediHelp.chm  &&指定帮助文件
SET CONSOLE ON         &&将所有的结果输出到 Visual FoxPro 主窗口或活动的用户自定义窗口中
SET DATE LONG          &&指定日期表达式的显示格式为长日期格式
SET CENTURY ON         &&设定日期中的年为4位数
SET SAFETY OFF         &&指定在改写已有文件时不显示对话框
SET STATUS BAR OFF     &&打开VFP状态栏
SET COLOR TO           &&设置颜色为默认状态
SET HOURS TO 24
SET SYSMENU OFF        &&关闭系统菜单
SET NOTIFY OFF 
SET NOTIFY CURSOR OFF  &&不在状态栏中显示数据信息
SET MESSAGE TO ""
CLEAR                  &&清理主窗口显示
CLEAR ALL              &&清除变量

DECLARE INTEGER FindWindow IN WIN32API STRING,STRING
DECLARE INTEGER ShowWindow IN WIN32API INTEGER nHWND,INTEGER nCmdShow

RELEASE cFullpath,cTitle,oToolbar,oStatusbar
PUBLIC cFullpath,cTitle,oToolbar,oStatusbar

cTitle="阳泉大恒电子有限公司商务管理系统"
cCurrentProcedure = SYS(16,1)
cFullpath=ADDBS(JUSTPATH(cCurrentProcedure))
SET PATH TO d:\cw,d:\cw\bin,d:\cw\prg,d:\cw\scx,d:\cw\mymenu,d:\cw\dbf,d:\cw\txt
cScreenoldcaption=_Screen.caption
v_height=sysmetric(2) 
v_width=sysmetric(1)
cOldError = ON("ERROR")
ON ERROR DO SolutionErrHandle
if FindWindow(0,cTitle)<>0
   WITH _Screen
     .sizebox=.t.
     .icon="dh.ico"
     .Height=v_height-120
     .Width=v_width-15
     .Caption="阳泉大恒电子有限公司商务管理系统"            && Set a caption
     .autocenter=.t.
   ENDWITH
   messagebox("程序已运行！",48)
   quit
else
   on shutdown do myquit
   WITH _Screen
     .BackColor=rgb(255,255,255)         && Change the background to grey
     .BorderStyle=3                      && Change the border to double
     .ControlBox=.T.
     .sizebox=.t.
     .icon="dh.ico"
     .MaxButton=.t.
     .MinButton=.T.
     .picture=""
     .Movable=.T.
     .Height=v_height-220
     .Width=v_width-15
     .Caption="阳泉大恒电子有限公司商务管理系统"            && Set a caption
     &&.autocenter=.t.
     .top=105
   ENDWITH
   oToolbar=NEWOBJECT("cmytools","maintools.vcx")                 &&建立工具栏对象
   oToolbar.command1.enabled=.f.
   oToolbar.command2.enabled=.f.
   oToolbar.command3.enabled=.f.
   oToolbar.command4.enabled=.f.
   oToolbar.command5.enabled=.f.
   oToolbar.command6.enabled=.f.
   oToolbar.Show()                                           &&显示对象
   oToolbar.Dock(0)                                          &&在VFP主窗口上方停放
   oStatusbar=NEWOBJECT("cmystatus","maintools.vcx")
   WITH oStatusbar
       .height=2
       .width=_screen.Width-20
       .mystatus.height=2
       .mystatus.width=_screen.Width-25
       .mystatus.panels(1).text="登录用户："
       .mystatus.panels(1).bevel=0
       .mystatus.panels(1).width=10
       .mystatus.panels(2).text="未注册"
       .mystatus.panels(2).bevel=1
       .mystatus.panels(2).width=14
       .mystatus.panels(3).text="操作状态："
       .mystatus.panels(3).bevel=0
       .mystatus.panels(3).width=10
       .mystatus.panels(4).bevel=1
       .mystatus.panels(4).width=40
       .mystatus.panels(4).text=""
       .mystatus.panels(5).text="操作日期："
       .mystatus.panels(5).bevel=0
       .mystatus.panels(5).width=10
       .mystatus.panels(6).style=6
       .mystatus.panels(6).bevel=1
       .mystatus.panels(6).width=14
       .mystatus.panels(7).text="操作时间："
       .mystatus.panels(7).bevel=0
       .mystatus.panels(7).width=10
       .mystatus.panels(8).style=5
       .mystatus.panels(8).bevel=1
       .mystatus.panels(8).width=8
       .mystatus.panels(9).text="帐套号："
       .mystatus.panels(9).bevel=0
       .mystatus.panels(9).width=8
       .mystatus.panels(10).text=""
       .mystatus.panels(10).bevel=1
       .mystatus.panels(10).width=8
       .mystatus.panels(11).text=""
       .mystatus.panels(11).bevel=0
       .mystatus.panels(11).width=3
       .mystatus.panels(12).text=""
       .mystatus.panels(12).bevel=0
       .mystatus.panels(12).width=3
       .mystatus.panels(11).visible=.f.
       .mystatus.panels(12).visible=.f.
       .movable=.t.
   ENDWITH
   oStatusbar.show()
   oStatusbar.dock(3)
   _SCREEN.AddObject("Image1","BackImage") 
   do swmain.mpr
   &&BINDEVENT()
   _screen.show
   DO FORM begin
   READ EVENTS 
ENDIF
PROCEDURE SolutionErrHandle
LOCAL lnChoice
	#DEFINE ERR_LOC "Error: "
	#DEFINE FILEINUSE_LOC "程序正在使用中。"
	#DEFINE FILEREADONLY_LOC "文件为只读." + CHR(13) + "确定权限."

	DO CASE
		CASE ERROR() = 3 && File is in use
			=MESSAGEBOX( ERR_LOC + MESSAGE() + CHR(13) + ;
				FILEINUSE_LOC, 0 + 48)
				
		CASE ERROR() = 1718 && File is read-only
			=MESSAGEBOX( ERR_LOC + MESSAGE() + CHR(13) + ;
				 FILEREADONLY_LOC, 0 + 48)
			RETRY
		CASE ERROR() = 1881 && Trying to load DE of solution.scx when table is already open
			CLOSE DATA ALL
		OTHERWISE
			lnChoice = MESSAGEBOX(ERR_LOC + ALLTRIM(STR(ERROR())) + CHR(13) + ;
				MESSAGE(), 1 + 48)
			IF lnChoice = 2 && Cancel
				ON ERROR &cOldError
				CLEAR EVENTS
				CLOSE ALL
				RELEASE ALL
				CLEAR ALL
			ENDIF	
	ENDCASE
ENDPROC
PROCEDURE myquit
   _Screen.Caption=cScreenoldcaption
   CLEAR EVENTS
   SET SYSMENU TO DEFAULT 
   QUIT
ENDPROC    
DEFINE CLASS BackImage AS Image
    Name="Image1"
    Top=(_Screen.Height-159)/2-70
    Left=(_Screen.Width-600)/2
    Height=90
    Width=660
    Picture="ds.jpg"
    BackStyle=0
    Stretch=2
    Visible=.T.
ENDDEFINE   
*set procedure to mainproc.prg