box01.prg

来自「使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用」· PRG 代码 · 共 227 行

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BOX01.PRG <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 PARAMETER BDATNAME , XMKNAME
 SET SAFETY OFF
 SET ESCAPE OFF
 SET COLOR OF SCHEME 2 TO  GR+/BG,W+/BG,GR/BG,GR/BG,GR+/B,GR+/B,GR+/W,R+/N,N/N,W/N,N+/N
 SET COLOR OF SCHEME 3 TO RGB( 0 , 0 , 0 , 192 , 192 , 192) ,  ;
       W+/BG,GR/BG,GR/BG,GR+/B,GR+/B,GR+/W,R+/N,N/N,W/N,N+/N
 DEFINE WINDOW WINM FROM 1 , 3 TO 16 , 123 FONT 'Courier' , 12 COLOR SCHEME 3 FLOAT  ;
      TITLE  ;
      '数据录入/修改--' + IIF(LEN(ALLTRIM(XSYK)) <> 0,XSBM + '--' + XSYK,XSBM) + '--' +  ;
XSLX + '--' + XSDQ + '----- ESC 退出' IN SCREEN  ;
      DOUBLE
 ACTIVATE WINDOW WINM
 TCPD = 0
 IF M_QZBZ = .T.
 QPP = 1
 M_99 = '9999,999,999,999,999'
 ELSE 
 M_99 = '9,999,999,999,999.99'
 QPP = 100
 ENDIF 
 DEFINE WINDOW WINB01_1 FROM 1 , 3 TO 14 , 83 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 MOVE WINDOW WINB01_1 CENTER 
 SELECT BLK
 FOR M = 1 TO M_LS
 DAXA = 'da' + ALLTRIM(STR(M))
 M_LENX = 'm_len' + ALLTRIM(STR(M))
 LOCATE FOR BH = M_BH AND FIELD_NAME = DAXA
  &m_lenx=FIELD_len
 ENDFOR 
 ACTIVATE WINDOW WINB01_1
 N = 0
 @ N + 2 , 3 SAY '┏━━━━━━━━━━━━━┯━━━━━━━━━━━━━━━━┓'
 @ N + 3 , 3 SAY '┃   项    目    名    称   │                                ┃'
 @ N + 4 , 3 SAY '┠─────────────┼────────────────┨'
 @ N + 5 , 3 SAY '┃                          │                                ┃'
 @ N + 6 , 3 SAY '┠─────────────┼────────────────┨'
 @ N + 7 , 3 SAY '┃                          │                                ┃'
 @ N + 8 , 3 SAY '┗━━━━━━━━━━━━━┷━━━━━━━━━━━━━━━━┛'
 DAXQIN = ''
 M_SHU = 0
 QQ = 11
 NN = 1
 YY = 41
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da1'
 @ N + 3 , 35 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 SELECT (XMKNAME)
 GO TOP
 M_XMDH = '000000'
 DHX = '      '
 DO WHILE .T.
 SELECT (XMKNAME)
 IF M_XMDH <> '000000'
 LOCATE FOR ALLTRIM(XMDH) == DHX
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 ENDIF 
 DO WHILE .T.
 IF RECCOUNT() < 1
 RETURN 
 ENDIF 
 IF LRBZ = .T.
 EXIT 
 ENDIF 
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 ENDDO 
 M_DHX_M = 0
 DHX = ALLTRIM(XMDH)
 @ 1 , 1 SAY '项目代号: '
 @ 1 , 12 SAY '      '
 @ 1 , 12 SAY DHX
 DO WHILE .T.
 S_TMP = INKEY('MS')
 DO CASE 
 CASE (S_TMP > 47 AND S_TMP < 58 .OR. S_TMP = 45 .OR. S_TMP > 96 AND S_TMP < 100) AND  ;
M_DHX_M < 6
 IF M_DHX_M = 0
 @ 1 , 12 SAY '      '
 DHX = ''
 ENDIF 
 M_DHX_M = M_DHX_M + 1
 DHX = DHX + CHR(S_TMP)
 @ 1 , 12 SAY DHX
 CASE S_TMP = 127 .OR. S_TMP = 19
 IF M_DHX_M <> 0
 M_DHX_M = M_DHX_M - 1
 DHX = LEFT(DHX,LEN(DHX) - 1)
 @ 1 , 12 SAY '      '
 @ 1 , 12 SAY DHX
 ENDIF 
 CASE S_TMP = 43
 M_DHX_M = 0
 DO WHILE .T.
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 IF LRBZ = .T.
 EXIT 
 ENDIF 
 ENDDO 
 DHX = ALLTRIM(XMDH)
 @ 1 , 12 SAY '      '
 @ 1 , 12 SAY DHX
 CASE S_TMP = 13
 IF DHX = '999999'
 DEACTIVATE WINDOW WINB01_1
 RELEASE WINDOW WINB01_1 , WINM
 RETURN 
 ENDIF 
 M_DHX_M = 0
 EXIT 
 CASE S_TMP = 27
 DEACTIVATE WINDOW WINB01_1
 RELEASE WINDOW WINB01_1 , WINM
 TCPD = 1
 EXIT 
 ENDCASE 
 ENDDO 
 IF TCPD = 1
 EXIT 
 ENDIF 
 @ 1 , 12 SAY '      '
 @ 1 , 12 SAY DHX
 SELECT (XMKNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX
 M_XMDH = XMDH
 IF LRBZ = .T.
 SELECT (BDATNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX AND DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 DO ACCDAT
 ENDSCAN 
 ELSE 
 ?? CHR(7)
 WAIT WINDOW '本行数据不录入'
 ENDIF 
 ENDSCAN 
 IF M_XMDH <> DHX
 ?? CHR(7)
 WAIT WINDOW '无此代号'
 ENDIF 
 ENDDO 
 DEACTIVATE WINDOW WINB01_1
 RELEASE WINDOW WINB01_1 , WINM
 DO JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 RETURN 

PROCEDURE ACCDAT
 DA1 = ''
 @ N + 7 , 5 SAY '                         '
 @ N + 7 , YY - 5 SAY '                      '
  @ N+7,5 SAY LTRI(&XMKNAME->XMMC) PICT "XXXXXXXXXXXXXXXXXXXXXXXXX"
 DO LRPD
 @ N + 7 , YY SAY DA1 PICTURE M_99
 @ N + 7 , YY - 5 SAY '                      '
 DO WHILE .T.
 IF  .NOT. NN > 1
 M_TMP = INKEY('MS')
 DO CASE 
 CASE M_TMP > 47 AND M_TMP < 58 .OR. M_TMP = 45
 DO M_SHUZI
 CASE M_TMP = 127 .OR. M_TMP = 19
 DO M_BSP
 CASE M_TMP = 13
 DO M_ENTER
 ENDCASE 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 @ N + 5 , 5 SAY '                         '
  @ N+5,5 SAY LTRI(&xmkname->xmmc) PICT "XXXXXXXXXXXXXXXXXXXXXXXXX"
 @ N + 5 , YY SAY '                      '
 @ N + 5 , YY SAY DA1 PICTURE M_99
 @ N + 7 , 5 SAY '                          '
 @ N + 7 , YY - 5 SAY '                      '
 NN = 1
 RETURN 
ENDPROC
*------
PROCEDURE M_SHUZI
 IF M_SHU < M_LEN1 - 1
 @ N + 7 , YY - 5 CLEAR TO N + 7 , YY + 19
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ N + 7 , YY - 5 SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
ENDPROC
*------
PROCEDURE M_BSP
 IF M_SHU <> 0
 M_SHU = M_SHU - 1
 DAXQIN = LEFT(DAXQIN,LEN(DAXQIN) - 1)
 @ N + 7 , YY - 5 SAY '                      '
 @ N + 7 , YY - 5 SAY DAXQIN
 ENDIF 
ENDPROC
*------
PROCEDURE M_ENTER
 IF QQ = 22
 QQ = 11
 M_SHU = 0
 SELECT (BDATNAME)
 DAX = 'da' + LTRIM(STR(NN))
  REPLACE &dax WITH VAL(DAXQIN)/QPP  
 DAXQIN = ''
 ENDIF 
 NN = NN + 1
ENDPROC
*------*