lr022.prg

使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用社会计报表系统

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


 PARAMETER BDATNAME , XMKNAME , BCZLCL , M_BCZL
 SET ESCAPE OFF
 DO WHILE .T.
 GDBLR = 'n'
 KKK_NIAN = NIAN
 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 
 STORE 0 TO SZ , QQQ
 IF M_LS > 7
 IF VAL(NIAN) > 90
 NIANA = '19' + NIAN
 ELSE 
 NIANA = '20' + NIAN
 ENDIF 
 NIAN1 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 3)),2)
 NIAN2 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 2)),2)
 NIAN3 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 1)),2)
 FOR N = 1 TO 3
 M_NIAN = 'NIAN' + ALLTRIM(STR(N))
 M_NIANA = 'NIANS' + ALLTRIM(STR(N))
 M_N1 = ' '
 M_NN = '  '
  M_N1=LEFT(&M_NIAN,1)
 DO NI
 PM = M_NN
  M_N1=RIGHT(&M_NIAN,1)
 DO NI
  &M_NIANA=LTRI(TRIM(PM+M_NN))
 ENDFOR 
 QQQ = 0
 DO FORM src\form\lrxz
 I = QQQ
 IF QQQ = 0
 LSLR = 1
 RETURN 
 ENDIF 
 DAX = 'da' + LTRIM(STR(QQQ))
 GO TOP
 LOCATE FOR BH = M_BH AND FIELD_NAME = DAX
 AA = LHY
 M_SS = AT('0A01',AA)
 IF M_SS <> 0
 AA = CHRTRAN(AA,'0A01 ','')
 AA = NIANS1 + AA
 ENDIF 
 M_SS = AT('0A02',AA)
 IF M_SS <> 0
 AA = CHRTRAN(AA,'0A02 ','')
 AA = NIANS2 + AA
 ENDIF 
 M_SS = AT('0A03',AA)
 IF M_SS <> 0
 AA = CHRTRAN(AA,'0A03 ','')
 AA = NIANS3 + AA
 ENDIF 
 M_LEN = FIELD_LEN
 RELEASE WINDOW WIN2_D , WIN2_L
 IF QQQ = 12
 DO FXBB4
 RETURN 
 ENDIF 
 IF M_BH = '13'
 WAIT WINDOW NOCLEAR NOWAIT '正 在 计 算 数 据' + '     请稍候       '
 DO src\prg\jsCL8
 WAIT CLEAR
 ENDIF 
 ELSE 
 IF BCZLCL = 0
 X = 0
 QQQ = 0
 DO FORM src\form\lrxz1
 I = QQQ
 IF QQQ = 0
 LSLR = 1
 RETURN 
 ENDIF 
 DAX = 'da' + LTRIM(STR(QQQ))
 GO TOP
 LOCATE FOR BH = M_BH AND FIELD_NAME = DAX
 AA = LHY
 M_LEN = FIELD_LEN
 DEACTIVATE WINDOW WIN2_L
 RELEASE WINDOW WIN2_L
 ELSE 
 DAX = 'da1'
 SELECT BLK
 GO TOP
 LOCATE FOR BH = M_BH AND FIELD_NAME = DAX
 M_LEN = FIELD_LEN
 I = 1
 AA = '补充资料数字'
 SRLX = '补充资料数字'
 ENDIF 
 IF M_BH = '04' AND (QQQ = 3 .OR. QQQ = 4)
 WAIT WINDOW NOCLEAR NOWAIT '正在进行比率计算' + CHR(13) + '   请稍候       '
 IF QQQ = 3
 M_CBJS = 0
 DO src\prg\CBJS3
 ELSE 
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 ENDIF 
 WAIT CLEAR
 ENDIF 
 IF M_BH = '04' AND QQQ = 6
 WAIT WINDOW NOCLEAR NOWAIT '正在计算应收(付)息' + CHR(13) + '      请稍候       '
 M_CBJS = 1
 DO src\prg\cbjs3
 WAIT CLEAR
 ENDIF 
 IF M_BH = '04' AND QQQ = 5
 WAIT WINDOW '正在计算执行利率' + CHR(13) + '     请稍候       '
 M_CBJS = 2
 DO src\prg\cbjs3
 WAIT CLEAR
 ENDIF 
 IF M_BH = '12' AND QQQ = 2
 WAIT WINDOW NOCLEAR NOWAIT '正在进行比重计算' + CHR(13) + '   请稍候       '
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 WAIT CLEAR
 ENDIF 
 IF M_BH = '12' AND QQQ = 4
 WAIT WINDOW NOCLEAR NOWAIT '正在计算月均余额' + CHR(13) + '   请稍候       '
 M_CBJS = 1
 DO src\prg\JSCL9
 WAIT CLEAR
 ENDIF 
 IF M_BH = '12' AND QQQ = 6
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在计算应收(付)利息额' + CHR(13) + '       请稍候       '
 M_CBJS = 2
 DO src\prg\JSCL9
 WAIT CLEAR
 ENDIF 
 IF M_BH = '12' AND QQQ = 5
 DO src\prg\jscl9
 ENDIF 
 ENDIF 
 SET COLOR OF SCHEME 2 TO RGB( 0 , 0 , 0 , 192 , 192 , 192),RGB(0,0,0,192,192,192) ,  ;
       GR/BG,GR/BG,GR+/B,GR+/B, 0 , 0 , 0 , 192 , 192 , 192 ,  R+/N,N/N,W/N,N+/N
 DEFINE WINDOW WIN1_L FROM 0 , 6 TO 27 , 130 FONT 'Courier' , 12 COLOR SCHEME 2 TITLE  ;
      ' 列式录入/修改--' + IIF(LEN(ALLTRIM(XSYK)) <> 0,XSBM + '--' + XSYK,XSBM) + '--' +  ;
XSLX + '--' + XSDQ + '-----按 Esc 键退出'  ;
      DOUBLE
 ACTIVATE WINDOW WIN1_L
 @ 0 , 0 SAY  ;
      '┏━━━━┯━━━━━━━━━━━━━━━━━━━━━┯━━━━━━━━━━┓'
 @ 1 , 0 SAY  ;
      '┃项目代号│         项     目     名      称         │                    ┃'
 @ 2 , 0 SAY  ;
      '┠────┼─────────────────────┼──────────┨'
 @ 3 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 4 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 5 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 6 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 7 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 8 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 9 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 10 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 11 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 12 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 13 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 14 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 15 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 16 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 17 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 18 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 19 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 20 , 0 SAY  ;
      '┃        │                                          │                    ┃'
 @ 21 , 0 SAY  ;
      '┗━━━━┷━━━━━━━━━━━━━━━━━━━━━┷━━━━━━━━━━┛'
 @ 1 , 60 SAY AA PICTURE 'XXXXXXXXXXXXXX'
 IF M_BCZL
 IF BCZLCL = 1
 SELECT (BDATNAME)
 INDEX ON XMDH TO lib\TMP FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND ISALPHA(XMDH) = .T.
 SELECT (XMKNAME)
 INDEX ON XMDH TO lib\XMTMP FOR ISALPHA(XMDH) = .T. AND UPPER(LEFT(XMDH,1)) = 'B'
 SET RELATION TO XMDH INTO (BDATNAME)
 ELSE 
 SELECT (BDATNAME)
 INDEX ON XMDH TO lib\TMP FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND ISALPHA(XMDH) = .F.
 SELECT (XMKNAME)
 INDEX ON XMDH TO lib\XMTMP FOR ISALPHA(XMDH) = .F.
 SET RELATION TO XMDH INTO (BDATNAME)
 ENDIF 
 ELSE 
 SELECT (BDATNAME)
 INDEX ON XMDH TO lib\TMP FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND ISALPHA(XMDH) = .F.
 SELECT (XMKNAME)
 SET RELATION TO XMDH INTO (BDATNAME)
 ENDIF 
 M = 3
 QQ = 11
 M_SHU = 0
 DAXQIN = ''
 WEI = 0
 GO TOP
 DO WHILE .T.
 IF LEN(LTRIM(RTRIM(XMMC))) = 0
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 FOR N = 1 TO 18
 IF  .NOT. EOF()
 IF LEFT(XMDH,1) <> 'a'
 @ N + 2 , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ N + 2 , 2 SAY '      '
 ENDIF 
 @ N + 2 , 13 SAY SPACE(40)
 @ N + 2 , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ N + 2 , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ N+2,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ N + 2 , 56 SAY '                    '
 ENDIF 
 DO M_SKIP
 ELSE 
 EXIT 
 ENDIF 
 ENDFOR 
 SET COLOR TO W+/B
 DO M_SKIP_18
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ m,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 @ M , 56 SAY ''
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
 DO WHILE .T.
 TC = 0
 M_TMP = INKEY('MS')
 DO CASE 
 CASE M_TMP = 5
 DO M_UP
 CASE M_TMP = 24
 DO M_DOWN
 CASE M_TMP = 18
 DO M_PGUP
 CASE M_TMP = 3
 DO M_PGDN
 CASE M_TMP > 47 AND M_TMP < 58 .OR. M_TMP = 45
 IF M_BH = '04' AND (QQQ = 3 .OR. QQQ = 4)
 ?? CHR(7)
 ?? CHR(7)
 ELSE 
 DO M_SHUZI
 ENDIF 
 CASE M_TMP = 127 .OR. M_TMP = 19
 DO M_BSP
 CASE M_TMP = 13
 DO M_ENTER
 CASE M_TMP = 27
 TC = 1
 DO TCCL
 ENDCASE 
 IF TC = 1
 DO ZBDP
 EXIT 
 ENDIF 
 ENDDO 
 ENDDO 

PROCEDURE M_UP
 IF QQ = 22
 M_SHU = 0
 QQ = 11
 DAXQIN = ''
 @ M , 56 CLEAR TO M , 63
 ENDIF 
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY SPACE(40)
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ m,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 IF  .NOT. BOF()
 DO M_SKIP_1
 IF M > 3
 M = M - 1
 SET COLOR TO W+/B
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY SPACE(40)
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ M,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 @ M , 56 SAY ''
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
 ELSE 
 FOR N = 1 TO 18
 IF  .NOT. EOF()
 IF LEFT(XMDH,1) <> 'a'
 @ N + 2 , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ N + 2 , 2 SAY '      '
 ENDIF 
 @ N + 2 , 13 SAY SPACE(40)
 @ N + 2 , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ N+2,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ N + 2 , 56 SAY '                    '
 ENDIF 
 DO M_SKIP
 ELSE 
 N = N
 EXIT 
 ENDIF 
 ENDFOR 
 FOR S = 1 TO N - 1
 IF  .NOT. BOF()
 DO M_SKIP_1
 ELSE 
 EXIT 
 ENDIF 
 ENDFOR 
 SET COLOR TO W+/B
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY SPACE(40)
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ m,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 @ M , 56 SAY ''
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
 ENDIF 
 ENDIF 
 SET COLOR TO W+/B
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY SPACE(40)
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ m,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 @ M , 56 SAY ''
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
ENDPROC
*------
PROCEDURE M_DOWN
 IF QQ = 22
 QQ = 11
 M_SHU = 0
 DAXQIN = ''
 @ M , 56 CLEAR TO M , 63
 ENDIF 
 SET COLOR  TO  RGB( 0 , 0 , 0 , 192 , 192 , 192) 
 IF LEFT(XMDH,1) <> 'a'
 @ M , 2 SAY XMDH PICTURE 'xxxxxx'
 ELSE 
 @ M , 2 SAY '      '
 ENDIF 
 @ M , 13 SAY SPACE(40)
 @ M , 13 SAY LTRIM(XMMC) PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
 @ M , 56 SAY '                    '
 DO LRPD
 IF LRBZ = .T. AND GDBLR = 'n'
  @ m,44+12 SAY &BDATNAME->&DAX PICT m_99
 ELSE 
 @ M , 56 SAY '                    '
 ENDIF 
 IF  .NOT. EOF()