📄 gzjs.prg

📁 包括了6个VFP程序设计实例
💻 PRG
字号:
********************************************************
*
*         程序名：C:\RSGL\PRG\GZJS.PRG
*
*       功能描述：屏幕格式程序
*
*           日期：1999年07月24日
*
********************************************************

*** 设置系统开关
SET ESCAPE OFF
SET TALK OFF
SET SAFETY OFF
SET HELP OFF

*** 清除键盘定义
CLEAR MACROS
PUSH  KEY CLEAR

PRIVATE m.__QMFlag__, m.PRGFile

m.__QMFlag__ = .F.

m.PRGFile = ''

*** ESCAPE键退出
ON KEY LABEL ESCAPE DO ExitProc

*** 定义屏幕格式窗口
DO WHILE NOT m.__QMFlag__
   DO DefWin
   IF (NOT EMPTY(m.PRGFile))
       DO &PRGFile
   ENDIF
ENDDO

POP KEY
ON KEY LABEL ESCAPE DO ExitProc
SET HELP ON

RETURN

******************************************************************
*
*    过    程：DefWin
*
*    功    能：定义屏幕格式窗口
*
*    参    数：无
*
******************************************************************
PROCEDURE DefWin

  SET PROC TO PGSUBPRG.APP

  m.PRGFile = ''

  PRIVATE m.ScrFontWidth, m.ScrFontHeight, m.WinFontWidth, m.WinFontHeight, m.ObjFontWidth, m.ObjFontHeight, m.button

  m.button = 0
  m.ScrFontWidth = 0
  m.ScrFontHeight = 0
  m.WinFontWidth = 0
  m.WinFontHeight = 0
  m.ObjFontWidth = 0
  m.ObjFontHeight = 0

  *** 计算屏幕窗口字体宽度和高度
  DO GetWFontWH WITH 'SCREEN', m.ScrFontWidth, m.ScrFontHeight

  IF WEXIST('LrWindow') AND WTITLE('LrWindow') == '屏幕格式窗口'
     RELEASE WINDOW LrWindow
  ENDIF

  SET PALETTE OFF
  DEFINE WINDOW LrWindow IN SCREEN ;
     FROM 0 / m.ScrFontHeight, 10 / m.ScrFontWidth TO 412 / m.ScrFontHeight, 634 / m.ScrFontWidth ;
     FONT 'System', 10 ;
     STYLE 'B' ;
     NOCLOSE NOMINIMIZE SYSTEM GROW ;
     FILL FILE LOCFILE('RSMAIN.BMP', 'BMP|ICO', '窗口壁纸文件?') ;
     COLOR RGB(, , , 192, 192, 192)

  SET PALETTE ON
  ACTIVATE WINDOW LrWindow NOSHOW
  MOVE WINDOW LRWINDOW CENTER

  *** 计算窗口LrWindow字体宽度和高度
  DO GetWFontWH WITH 'LrWindow', m.WinFontWidth, m.WinFontHeight

  @ 234 / m.WinFontHeight, 101 / m.WinFontWidth TO 356 / m.WinFontHeight, 507 / m.WinFontWidth ;
    PATTERN 1 PEN 1, 0 ;
    COLOR RGB(, , , 192, 192, 192)

  DO Draw3DFrame WITH 234 / m.WinFontHeight, 101 / m.WinFontWidth, 354 / m.WinFontHeight, 505 / m.WinFontWidth, 0, 4, 192, 192, 192, 0

  DO Draw3DPanel WITH 241 / m.WinFontHeight, 143 / m.WinFontWidth, 346 / m.WinFontHeight, 498 / m.WinFontWidth, 0, 1, 192, 192, 192, 0, .F.

  DO Draw3DPanel WITH 241 / m.WinFontHeight, 108 / m.WinFontWidth, 346 / m.WinFontHeight, 139 / m.WinFontWidth, 0, 1, 192, 192, 192, 0, .F.

  DO Draw3DText WITH 244 / m.WinFontHeight, 112 / m.WinFontWidth, '工', '方正魏碑简体', 16, 'TN', 0, 128, 192, 255, 255, 255, 1

  DO Draw3DText WITH 269 / m.WinFontHeight, 112 / m.WinFontWidth, '资', '方正魏碑简体', 16, 'TN', 0, 128, 192, 255, 255, 255, 1

  DO Draw3DText WITH 294 / m.WinFontHeight, 112 / m.WinFontWidth, '晋', '方正魏碑简体', 16, 'TN', 0, 128, 192, 255, 255, 255, 1

  DO Draw3DText WITH 319 / m.WinFontHeight, 112 / m.WinFontWidth, '升', '方正魏碑简体', 16, 'TN', 0, 128, 192, 255, 255, 255, 1

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 16, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 248 / m.WinFontHeight, 154 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 工资现状' ;
    FONT '楷体_GB2312', 16 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('ZGGZ', 4, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 281 / m.WinFontHeight, 154 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 晋升登记' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('JSGZ', 4, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 248 / m.WinFontHeight, 266 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 调标工资表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('TZBZ.PRG', 1, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 281 / m.WinFontHeight, 266 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 正常升级表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('ZSSJ.PRG', 1, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 248 / m.WinFontHeight, 378 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 晋升审批表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    DISABLE;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('JSSPB.PRG', 1, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 281 / m.WinFontHeight, 378 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 工资补发表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('JSBFB.PRG', 1, .F.)

  *** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 313 / m.WinFontHeight, 154 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 提前晋升表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('TQJS.PRG', 1, .F.)

*** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 313 / m.WinFontHeight, 266 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 职务晋升表' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('ZWJS', 4, .F.)

*** 计算对象字体宽度和高度
  DO GetFontWH WITH '楷体_GB2312', 15, 'N', m.ObjFontWidth, m.ObjFontHeight
  @ 313 / m.WinFontHeight, 378 / m.WinFontWidth GET m.button ;
    PICTURE '@*HN 执行晋升' ;
    FONT '楷体_GB2312', 15 ;
    STYLE 'N' ;
    SIZE 28 / m.ObjFontHeight, 107 / m.ObjFontWidth ;
    VALID ButtonValid('ZXJS.PRG', 1, .F.)

  ACTIVATE WINDOW LrWindow

  READ MODAL CYCLE
  
  RELEASE WINDOW LrWindow

  SET PROC TO

RETURN

******************************************************************
*
*    函    数：ButtonValid
*
*    功    能：命令按钮Valid函数
*
*    参    数：RunFileName -- 按钮运行文件名
*             RunFileType -- 按钮运行文件类型
*             TerminateRead -- 退出标志
*
******************************************************************
FUNCTION  ButtonValid
PARAMETER RunFileName, RunFileType, TerminateRead

  m.__QMFlag__ = m.TerminateRead

  *** 按钮运行文件为空则返回
  IF EMPTY(m.RunFileName)
     RETURN
  ENDIF

  DO CASE

     CASE m.RunFileType = 1 && FoxPro程序
          m.PRGFile = m.RunFileName
          CLEAR READ

     CASE m.RunFileType = 2 && Windos程序
          RUN /N1 &RunFileName

     CASE m.RunFileType = 3 && Dos程序
          RUN &RunFileName

     CASE m.RunFileType = 4 && 表单
          DO FORM &RunFileName

  ENDCASE

RETURN

******************************************************************
*
*    过    程：ExitProc
*
*    功    能：退出处理
*
*    参    数：无
*
******************************************************************
PROCEDURE ExitProc

  m.__QMFlag__ = .T.
  CLEAR READ

RETURN
💿 文件大小 5831 K
👤 上传用户 snowpilce
📂 所属分类教育系统应用
🏷️ 相关标签

#VFP #程序 #设计实例
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -