📄 main.prg
字号:
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* 文件名: MAIN.PRG(主文件)
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
CLEAR SCREEN
CLEAR
CLEAR ALL
CLOSE ALL
SET SYSMENU TO
SET EXCLUSIVE ON
PUBLIC YM , MM , YY , YM2 , GZB , BMB , BMHZB , LBHZB , LBB , GZXMB , GSB , DW , TAXB , ;
TAX_JS , TAX_XM1 , TAX_XM2
PUBLIC MENUFLAG , PATHNAME , SFGZ1 , SFGZ2 , RUN_NUM , INITOK
MENUFLAG = .F.
SET EXACT ON
SET TALK OFF
SET SAFETY OFF
SET DATE ansi
SET CENTURY ON
SET BRSTATUS OFF
SET STATUS BAR OFF
SET MESSAGE OFF
_SCREEN.CLOSABLE = .F.
_SCREEN.CAPTION = ' '
_SCREEN.WINDOWSTATE = 2
= SETPATH()
SET RESOURCE TO gzzywj
RESTORE FROM sfgzxm ADDITIVE
RESTORE FROM taxjs ADDITIVE
USE gzsys
INITOK = KA1
USE
DO REGISTRY
DO FACE
DO FORM f_login NAME F_LOGIN
F_LOGIN.SHOW
READ EVENTS
OPEN DATABASE gzk
USE IN 0 dwmc
IF RECNO() = 1 AND BOF() AND EOF()
DO FORM fdw NAME FDW
FDW.SHOW()
READ EVENTS
SELECT DWMC
DW = ALLTRIM(DWMC)
YM = SUBSTR(DTOS(QYRQ),1,6)
YY = SUBSTR(YM,1,4)
MM = SUBSTR(YM,5,2)
DD = SUBSTR(DTOS(QYRQ),7,2)
YM2 = '(' + YY + '年' + MM + '月)'
USE gzdate
GO BOTTOM
IF GZYY = YY AND GZMM = MM
REPLACE GZDD WITH DD
ELSE
APPEND BLANK
REPLACE GZYY WITH YY , GZMM WITH MM , GZDD WITH DD
ENDIF
USE
GZB = 'gz' + YM
BMB = 'bm' + YM
LBB = 'lb' + YM
GZXMB = 'xm' + YM
BMHZB = 'bh' + YM
LBHZB = 'lh' + YM
GSB = 'gs' + YM
TAXB = 'tb' + YM
USE bm
COPY STRUCTURE TO (BMB) DATABASE gzk SDF
FIELNAME = BMB + '.bmh'
= DBSETPROP(FIELNAME,'field','caption','部门编号')
FIELNAME = BMB + '.bmmc'
= DBSETPROP(FIELNAME,'field','caption','部门名称')
USE (BMB)
INDEX ON BMH TAG BMH
USE lb
COPY STRUCTURE TO (LBB) DATABASE gzk SDF
FIELNAME = LBB + '.lbh'
= DBSETPROP(FIELNAME,'field','caption','类别编号')
FIELNAME = LBB + '.lbmc'
= DBSETPROP(FIELNAME,'field','caption','类别名称')
USE (LBB)
INDEX ON LBH TAG LBH
USE gz
COPY TO GZSTRU STRUCTURE EXTENDED
USE GZSTRU
ZAP
USE IN 0 GZXM
SELECT GZXM
SET EXACT ON
SCAN
SELECT GZSTRU
APPEND BLANK
REPLACE FIELD_NAME WITH GZXM.FIELD_NAME , FIELD_TYPE WITH GZXM.FIELD_TYPE , FIELD_LEN ;
WITH GZXM.FIELD_LEN , FIELD_DEC WITH GZXM.FIELD_DEC
SELECT GZXM
ENDSCAN
SELECT GZSTRU
USE
SELECT GZXM
USE
CREATE (GZB) DATABASE gzk FROM gzstru
USE gzxm
GO 1
DO WHILE .NOT. EOF()
FILENAME = GZB + '.' + ALLTRIM(FIELD_NAME)
= DBSETPROP(FIELNAME,'field','caption',NAME)
SKIP
ENDDO
USE (GZB)
INDEX ON BMH + ZGBH TAG BMZGH
USE gzstru
DELETE NEXT 7
PACK
USE bmhz
COPY TO bmhz_stru STRUCTURE EXTENDED
USE bmhz_stru
DELETE FOR RECNO() >= 4
PACK
APPEND FROM gzstru
GO 1
REPLACE TABLE_NAME WITH BMHZB
CREATE (BMHZB) DATABASE gzk FROM bmhz_stru
FIELNAME = BMHZB + '.bmh'
= DBSETPROP(FIELNAME,'field','caption','部门编号')
FIELNAME = BMHZB + '.bmmc'
= DBSETPROP(FIELNAME,'field','caption','部门名称')
FIELNAME = BMHZB + '.bmrs'
= DBSETPROP(FIELNAME,'field','caption','人数')
USE (BMHZB)
INDEX ON BMH TAG BMH
USE lbhz
COPY TO bmhz_stru STRUCTURE EXTENDED
USE bmhz_stru
DELETE FOR RECNO() >= 4
PACK
APPEND FROM gzstru
GO 1
REPLACE TABLE_NAME WITH LBHZB
CREATE (LBHZB) DATABASE gzk FROM bmhz_stru
FIELNAME = LBHZB + '.lbh'
= DBSETPROP(FIELNAME,'field','caption','类别编号')
FIELNAME = LBHZB + '.lbmc'
= DBSETPROP(FIELNAME,'field','caption','类别名称')
FIELNAME = LBHZB + '.lbrs'
= DBSETPROP(FIELNAME,'field','caption','人数')
USE (LBHZB)
INDEX ON LBH TAG LBH
USE gzxm
COPY TO (GZXMB) DATABASE gzk SDF
USE IN 0 gzmc
SELECT GZMC
ZAP
APPEND BLANK
SELECT GZXM
SCAN
FNAME = FIELD_NAME
repl &fname with gzxm.name in gzmc
ENDSCAN
SELECT GZMC
USE
USE gs
COPY TO (GSB) DATABASE gzk STRUCTURE SDF
FIELNAME = GSB + '.xmm'
= DBSETPROP(FIELNAME,'field','caption','工资项目号')
FIELNAME = GSB + '.gs'
= DBSETPROP(FIELNAME,'field','caption','公式')
USE
DELETE File bmhz_stru.dbf
DELETE File bmhz_stru.fpt
DELETE File gzstru.dbf
DELETE File gzstru.fpt
CLOSE TABLE ALL
DO gzmenu.mpr
ELSE
PRIVATE GZRQ
DO WHILE .T.
GZRQ = DATE()
DO FORM frq NAME FRQ
FRQ.SHOW()
READ EVENTS
YM = SUBSTR(DTOS(GZRQ),1,6)
YY = SUBSTR(YM,1,4)
MM = SUBSTR(YM,5,2)
DD = SUBSTR(DTOS(GZRQ),7,2)
YM2 = '(' + YY + '年' + MM + '月)'
IF VAL(MM) = 1
Y1 = ALLTRIM(STR(VAL(YY) - 1))
YM1 = Y1 + '12'
ELSE
M1 = VAL(MM) - 1
IF M1 < 10
YM1 = YY + '0' + ALLTRIM(STR(M1))
ELSE
YM1 = YY + ALLTRIM(STR(M1))
ENDIF
ENDIF
GZB = 'gz' + YM1
if file('&gzb..dbf') or file('gz'+ym+'.dbf')
EXIT
ELSE
MESSAGEBOX(YY + '年' + MM + '月的工资数据库还未建立。' + CHR(13) + '请输入该月前的日期。',48,'错误')
ENDIF
ENDDO
USE gzdate
LOCATE FOR GZYY = YY AND GZMM = MM
IF FOUND()
REPLACE GZDD WITH DD
ELSE
APPEND BLANK
REPLACE GZYY WITH YY , GZMM WITH MM , GZDD WITH DD
ENDIF
USE
USE dwmc
DW = ALLTRIM(DWMC)
USE
GZB = 'gz' + YM
BMB = 'bm' + YM
LBB = 'lb' + YM
GZXMB = 'xm' + YM
BMHZB = 'bh' + YM
LBHZB = 'lh' + YM
GSB = 'gs' + YM
TAXB = 'tb' + YM
GZDBF = 'gz' + YM + '.dbf'
IF .NOT. FILE(GZDBF)
GZB1 = 'gz' + YM1
BMB1 = 'bm' + YM1
LBB1 = 'lb' + YM1
GZXMB1 = 'xm' + YM1
BMHZB1 = 'bh' + YM1
LBHZB1 = 'lh' + YM1
GSB1 = 'gs' + YM1
USE (BMB1)
COPY STRUCTURE TO (BMB) DATABASE gzk WITH CDX SDF
USE (LBB1)
COPY STRUCTURE TO (LBB) DATABASE gzk WITH CDX SDF
USE (BMHZB1)
COPY STRUCTURE TO (BMHZB) DATABASE gzk WITH CDX SDF
USE (LBHZB1)
COPY STRUCTURE TO (LBHZB) DATABASE gzk WITH CDX SDF
USE (GZB1)
COPY STRUCTURE TO (GZB) DATABASE gzk WITH CDX SDF
USE (GZXMB1)
COPY STRUCTURE TO (GZXMB) DATABASE gzk WITH CDX SDF
USE (GSB1)
COPY STRUCTURE TO (GSB) DATABASE gzk SDF
FIELNAME = BMB + '.bmh'
= DBSETPROP(FIELNAME,'field','caption','部门编号')
FIELNAME = BMB + '.bmmc'
= DBSETPROP(FIELNAME,'field','caption','部门名称')
FIELNAME = LBB + '.lbh'
= DBSETPROP(FIELNAME,'field','caption','类别编号')
FIELNAME = LBB + '.lbmc'
= DBSETPROP(FIELNAME,'field','caption','类别名称')
FIELNAME = BMHZB + '.bmh'
= DBSETPROP(FIELNAME,'field','caption','部门编号')
FIELNAME = BMHZB + '.bmmc'
= DBSETPROP(FIELNAME,'field','caption','部门名称')
FIELNAME = BMHZB + '.bmrs'
= DBSETPROP(FIELNAME,'field','caption','人数')
USE (GZXMB)
GO 8
DO WHILE .NOT. EOF()
FIELNAME = BMHZB + '.' + ALLTRIM(FIELD_NAME)
= DBSETPROP(FIELNAME,'field','caption',NAME)
SKIP
ENDDO
FIELNAME = LBHZB + '.lbh'
= DBSETPROP(FIELNAME,'field','caption','类别编号')
FIELNAME = LBHZB + '.lbmc'
= DBSETPROP(FIELNAME,'field','caption','类别名称')
FIELNAME = LBHZB + '.lbrs'
= DBSETPROP(FIELNAME,'field','caption','人数')
SELECT (GZXMB)
GO 8
DO WHILE .NOT. EOF()
FIELNAME = LBHZB + '.' + ALLTRIM(FIELD_NAME)
= DBSETPROP(FIELNAME,'field','caption',NAME)
SKIP
ENDDO
GO 1
DO WHILE .NOT. EOF()
FIELNAME = GZB + '.' + ALLTRIM(FIELD_NAME)
= DBSETPROP(FIELNAME,'field','caption',NAME)
SKIP
ENDDO
USE
FIELNAME = GSB + '.xmm'
= DBSETPROP(FIELNAME,'field','caption','工资项目号')
FIELNAME = GSB + '.gs'
= DBSETPROP(FIELNAME,'field','caption','公式')
ENDIF
USE (GZXMB)
USE IN 0 gzmc
SELECT GZMC
ZAP
APPEND BLANK
SELECT (GZXMB)
SCAN
FNAME = FIELD_NAME
NAME1 = NAME
repl &fname with name1 in gzmc
ENDSCAN
SELECT GZMC
USE
CLOSE TABLE ALL
DO gzmenu.mpr
ENDIF
IF REGOK
_SCREEN.CAPTION = DW + '工资管理系统 3.1版'
ELSE
_SCREEN.CAPTION = DW + '工资管理系统 3.1版(未注册版本----)'
ENDIF
CLOSE TABLE ALL
READ EVENTS
SET SYSMENU TO DEFAULT
CLOSE ALL
RETURN
PROCEDURE myquit
CLEAR EVENTS
CLEAR ALL
CLOSE ALL
CLEAR PROGRAM
IF _SCREEN.FORMCOUNT > 0
DIMENSION TMPFORM( _SCREEN.FORMCOUNT )
FOR I = 1 TO _SCREEN.FORMCOUNT
TMPFORM( I ) = _SCREEN.FORMS(I)
ENDFOR
FOR I = 1 TO _SCREEN.FORMCOUNT
TMPFORM( I ).RELEASE
ENDFOR
ENDIF
QUIT
ENDPROC
*------
PROCEDURE setpath
LOCAL LSYS16 , LPROG
LSYS16 = SYS(16)
LPROG = SUBSTR(LSYS16,AT(':',LSYS16) - 1)
PATHNAME = LEFT(LPROG,RAT('\',LPROG))
PATHNAME = SUBSTR(PATHNAME,1,LEN(PATHNAME) - 1)
set defa to &pathname.\gzdata
set path to &pathname;&pathname.\gzdata;&pathname.\reports
ENDPROC
*------*
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -