main.prg

我自己用VFP编写的查看指定数据库中的相关数据的程序供大家参考

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: MAIN.PRG(主文件) <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 SET ESCAPE ON
 SET SYSMENU TO
 SET TALK OFF
 SET ECHO OFF
 SET STEP OFF
 SET SAFETY OFF
 SET EXCLUSIVE OFF
 SET DATE TO ANSI
 SET CENTURY ON
 SET HOURS TO 24
 SET MULTILOCKS ON
 SET DELETED ON
 LCTEMP = SYS(2023)
 LNTEMP = LEN(LCTEMP)
 LCDEFA = SET('DEFAULT')
 LCDEFAULTNOW = JUSTPATH(SYS(16))
 IF RIGHT(LCDEFAULTNOW,1) <> '\'
    LCDEFAULTNOW = LCDEFAULTNOW + '\'
 ENDIF 
 LLCALLAPP = IIF(TYPE('LCCALLAPP') = 'C',LCCALLAPP == 'CALLAPP',.F.)
 IF  .NOT. LLCALLAPP
    ON SHUTDOWN DO ONSHUTD
    ON ESCAPE DO ONESCAPE
    ON ERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
    ON READERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
    ON KEY LABEL F12 DO ONESCAPEF12
    _SCREEN.WINDOWSTATE = 2
    _SCREEN.CAPTION = '查找数据'
    _SCREEN.ICON = 'SEARCH.ICO'
 ENDIF 
 CLOSE DATABASES ALL
 CLOSE TABLE ALL
 PUBLIC USERNAME , SHORTNAME , FULLNAME , ADDR
 SELECT 0
  USEDBFCOMPANY()
 M.SHORTNAME = COMPANY.NAME
 M.FULLNAME = COMPANY.FULLNAME
 M.ADDR = COMPANY.ADDR
 USE 
 USERNAME = ''
 DO FORM MAINFORM NAME FORMMAINFORM LINKED 
 SET SYSMENU TO DEFAULT
 CLOSE DATABASES ALL
 CLOSE TABLE ALL
 IF LLCALLAPP
    RETURN 
 ELSE 
    ON SHUTDOWN 
    QUIT 
 ENDIF 

PROCEDURE ONERROR
 PARAMETER MERROR , MESS , MESS1 , MPROG , MLINENO
 DO CASE 
 CASE MERROR = 0
    WAIT WINDOW TIMEOUT 6  ;
         '错 误 号：' + ALLTRIM(STR(MERROR)) + '  出错信息：' + MESS +  ;
   '  数据超出指定范围，需要重新输入。'
    RETURN 
 CASE MERROR = 1707
    WAIT WINDOW TIMEOUT 6  ;
         '错 误 号：' + ALLTRIM(STR(MERROR)) + '  出错信息：' + MESS + '  忽略索引。'
    RETRY  
 ENDCASE 
 ERRMSG =  ;
      MESSAGEBOX('错 误 号：' + LTRIM(STR(MERROR)) + CHR(13) + '出错信息：' + MESS + CHR(13) +  ;
'出错代码：' +  ;
MESS1 +  ;
CHR(13) +  ;
'出错程序：' +  ;
MPROG +  ;
CHR(13) +  ;
'出错行号：' +  ;
LTRIM(STR(MLINENO)) +  ;
CHR(13) +  ;
'是否要终止？' +  ;
CHR(13) +  ;
'(建议终止本程序并与程序设计或数据管理人员联系)    ',50,'出错信息')
 DO CASE 
 CASE ERRMSG = 4
    SET DEBUG ON
    SET ECHO ON
    RETRY  
 CASE ERRMSG = 5
    SET DEBUG ON
    SET ECHO ON
    RETURN 
 CASE ERRMSG = 3
    DO ONSHUTD
 ENDCASE 
 RETURN 
ENDPROC
*------
PROCEDURE ONSHUTD
 IF MESSAGEBOX('是否要退出本系统?    ',33,'退出') = 1
    CLEAR WINDOW
    CLOSE ALTERNATE 
    CLOSE DATABASES ALL
    CLOSE FORM
    CLOSE INDEXES 
    CLOSE TABLE ALL
    CLEAR READ ALL
    CLEAR EVENTS 
    SET SYSMENU TO DEFAULT
    ON SHUTDOWN 
    QUIT 
 ENDIF 
ENDPROC
*------
PROCEDURE ONESCAPE
 = MESSAGEBOX('ESCAPE键中止！    ',52,'中止')
 DO ONSHUTD
 RETURN 
ENDPROC
*------
PROCEDURE ONESCAPEF12
 = MESSAGEBOX('F12 键中止！    ',52,'中止')
 DO ONSHUTD
 RETURN 
ENDPROC
*------*