标题:怎样分月结账?
只看楼主
pylyh
Rank: 1
等 级:新手上路
帖 子:59
专家分:0
注 册:2013-8-26
结帖率:56.25%
已结贴  问题点数:20 回复次数:7 
怎样分月结账?
以下是一个程序的结账,怎样做到分月自动结账,结账日期为每月25号?

PROCEDURE jzsf
 PUBLIC JZFORM , LCZFARY , LHTARY , LJZARY , JZHZH , JZRQ
 DIMENSION LCZFARY( 17 ) , LHTARY( 21 ) , LJZARY( 13 )
 PUSH KEY CLEAR
 ON KEY LABEL ESC DO getout IN jzsf
 SET SKIP OF MENU _MSYSMENU .T.
 JZRQ = DATE()
 JZFORM = CREATEOBJECT('jzform')
  JZFORM.SHOW
 READ EVENTS
ENDPROC
*------
PROCEDURE getout
 RELEASE JZFORM
ENDPROC
*------
DEFINE CLASS jzform AS Form
 TOP = 0
 LEFT = 0
 HEIGHT = 405
 WIDTH = 635
 BACKCOLOR = RGB(192,192,192)
 BORDERSTYLE = 2
 KEYPREVIEW = .T.
 ALWAYSONTOP = .F.
 CAPTION = '货主号本月结帐收费'
 CLOSABLE = .F.
 CONTROLBOX = .T.
 MAXBUTTON = .F.
 MINBUTTON = .F.
 MOVABLE = .F.
 VISIBLE = .T.
 NAME = 'jzform'
 ADD OBJECT HZHLABEL AS LABEL WITH TOP = 10 , LEFT = 10 , HEIGHT = 25 , FONTSIZE = 12 ,  ;
      WIDTH = 85 , CAPTION = '结帐货主号:' , BACKCOLOR = RGB(192,192,192) ,  ;
      NAME = 'hzhlabel'
 ADD OBJECT HZHTEXT AS TEXTBOX WITH TOP = 8 , LEFT = 95 , HEIGHT = 25 , WIDTH = 85 ,  ;
      FONTSIZE = 12 , INPUTMASK = 'XXXXXXX' , CONTROLSOURCE = 'jzhzh' , NAME  ;
      = 'hzhtext'
 ADD OBJECT QLABEL AS LABEL WITH TOP = 120 , LEFT = 20 , HEIGHT = 55 , FONTSIZE = 22 ,  ;
      WIDTH = 480 , CAPTION = '       请先结本月25号或上月25号的账!!!' ,  ;
      BACKCOLOR = RGB(192,192,30)
 ADD OBJECT RQLABEL AS LABEL WITH TOP = 10 , LEFT = 260 , HEIGHT = 25 , WIDTH = 70 ,  ;
      FONTSIZE = 12 , CAPTION = '结帐日期:' , BACKCOLOR = RGB(192,192,192) ,  ;
      NAME = 'rqlabel'
 ADD OBJECT RQTEXT AS TEXTBOX WITH TOP = 8 , LEFT = 330 , HEIGHT = 25 , WIDTH = 90 ,  ;
      FONTSIZE = 11 , CONTROLSOURCE = 'jzrq' , NAME = 'rqtext'
 ADD OBJECT LCFMXGRID AS GRID WITH TOP = 110 , LEFT = 0 , WIDTH = 520 , HEIGHT = 210 ,  ;
      SCROLLBARS = 3 , COLUMNCOUNT = 10 , GRIDLINES = 2 , VISIBLE = .F. ,  ;
      DELETEMARK = .F. , RECORDMARK = .T. , HEADERHEIGHT = 25 , ROWHEIGHT =  ;
      22 , NAME = 'lcfmxgrid'
 ADD OBJECT BYFMXGRID AS GRID WITH TOP = 110 , LEFT = 0 , WIDTH = 520 , HEIGHT = 210 ,  ;
      SCROLLBARS = 3 , COLUMNCOUNT = 8 , GRIDLINES = 2 , VISIBLE = .F. ,  ;
      DELETEMARK = .F. , RECORDMARK = .T. , HEADERHEIGHT = 25 , ROWHEIGHT =  ;
      22 , NAME = 'byfmxgrid'
 ADD OBJECT JZBUTTON AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '结  帐' ,  ;
      HEIGHT = 25 , TOP = 330 , LEFT = 220 , WIDTH = 60 , VISIBLE = .F. , NAME =  ;
      'jzbutton'
 ADD OBJECT GETOUT AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '退  出' , VISIBLE  ;
      = .T. , HEIGHT = 25 , TOP = 330 , LEFT = 340 , WIDTH = 60 , NAME =  ;
      'getout'
 ADD OBJECT FINISH AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '完  成' , HEIGHT  ;
      = 25 , TOP = 330 , LEFT = 120 , WIDTH = 60 , VISIBLE = .F. , NAME =  ;
      'finish'
 ADD OBJECT CMXBUTTON AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '查明细' ,  ;
      HEIGHT = 25 , TOP = 330 , LEFT = 220 , WIDTH = 60 , VISIBLE = .F. , NAME =  ;
      'cmxbutton'
 ADD OBJECT CANCBUTTON AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '取  消' ,  ;
      HEIGHT = 25 , TOP = 330 , LEFT = 320 , WIDTH = 60 , VISIBLE = .F. , NAME  ;
      = 'cancbutton'
 ADD OBJECT PRINTBUTTON AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '打印结帐单' ,  ;
      VISIBLE = .F. , HEIGHT = 25 , TOP = 330 , LEFT = 100 , WIDTH = 80 ,  ;
      NAME = 'printbutton'
 ADD OBJECT CANCPRINT AS COMMANDBUTTON WITH FONTSIZE = 11 , CAPTION = '取消打印' ,  ;
      VISIBLE = .F. , HEIGHT = 25 , TOP = 330 , LEFT = 320 , WIDTH = 70 , NAME  ;
      = 'cancprint'

PROCEDURE Init
 JZHZH = SPACE(7)
 IF USED('LHT')
    SELECT LHT
 ELSE
    SELECT 0
    USE (PATH + 'lht')
 ENDIF
 SCATTER BLANK TO LHTARY
 USE IN LHT
 IF USED('lczf')
    SELECT LCZF
 ELSE
    SELECT 0
    USE (PATH + 'lczf')
 ENDIF
 SCATTER BLANK TO LCZFARY
 USE IN LCZF
 IF USED('ljz')
    SELECT LJZ
 ELSE
    SELECT 0
    USE (PATH + 'ljz')
 ENDIF
 SCATTER BLANK TO LJZARY
 USE IN LJZ
ENDPROC
*------

PROCEDURE Unload
 CLEAR
 CLOSE ALL
 POP KEY
 SET SKIP OF MENU _MSYSMENU .F.
 RELEASE JZFORM , LCZFARY , LHTARY , LJZARY , JZHZH , JZRQ
ENDPROC
*------

PROCEDURE hzhtext.Valid
 IF LASTKEY() <> 13 AND  .NOT. MDOWN()
    RETURN 0
 ELSE
    IF EMPTY(THISFORM.HZHTEXT.VALUE)
       IF MDOWN()
          IF MCOL() > 68 AND MROW() > 22
             RETURN
          ELSE
             RETURN 0
          ENDIF
       ELSE
          RETURN 0
       ENDIF
    ENDIF
 ENDIF
 IF USED('lhzmc')
    SELECT LHZMC
 ELSE
    SELECT 0
    USE (PATH + 'lhzmc')
 ENDIF
 LOCATE FOR DHZH = JZHZH
 IF FOUND()
    LHTARY( 4 ) = DHZMC
 ELSE
    LHTARY( 4 ) = '佚名'
 ENDIF
 USE IN LHZMC
ENDPROC
*------

PROCEDURE rqtext.Valid
 IF EMPTY(THISFORM.RQTEXT.VALUE)
    IF LASTKEY() = 5 .OR. LASTKEY() = 19
       RETURN -1
    ELSE
       RETURN 0
    ENDIF
 ENDIF
 IF LASTKEY() = 9 AND  .NOT. MDOWN()
    JZRQ = JZRQ - 1
     THISFORM.RQTEXT.REFRESH
    RETURN 0
 ELSE
    IF LASTKEY() = 148 AND  .NOT. MDOWN()
       JZRQ = JZRQ + 1
        THISFORM.RQTEXT.REFRESH
       RETURN 0
    ELSE
       IF ABS(JZRQ - DATE()) >= 10
          ?? CHR(7)
          IF ABS(JZRQ - DATE()) > 365
             WAIT WINDOW '日期有错!请检查。'
             RETURN 0
          ELSE
             WAIT WINDOW '日期是否有错,请检查。'
             IF LASTKEY() <> 13
                RETURN 0
             ENDIF
          ENDIF
       ELSE
          IF LASTKEY() <> 13 AND  .NOT. MDOWN()
             IF LASTKEY() = 5 .OR. LASTKEY() = 19
                RETURN -1
             ELSE
                RETURN 0
             ENDIF
          ENDIF
       ENDIF
    ENDIF
 ENDIF
 THISFORM.JZBUTTON.VISIBLE = .T.
ENDPROC
*------

PROCEDURE lcfmxgrid.When
 THISFORM.LCFMXGRID.COLUMNCOUNT = 10
 THISFORM.LCFMXGRID.COLUMN8.FORECOLOR = RGB(0,0,255)
 THISFORM.LCFMXGRID.COLUMN1.WIDTH = 65
 THISFORM.LCFMXGRID.COLUMN1.HEADER1.CAPTION = ' 合同号'
 THISFORM.LCFMXGRID.COLUMN2.WIDTH = 35
 THISFORM.LCFMXGRID.COLUMN2.HEADER1.CAPTION = ' 次数'
 THISFORM.LCFMXGRID.COLUMN3.WIDTH = 75
 THISFORM.LCFMXGRID.COLUMN3.HEADER1.CAPTION = ' 起日期'
 THISFORM.LCFMXGRID.COLUMN4.WIDTH = 30
 THISFORM.LCFMXGRID.COLUMN4.HEADER1.CAPTION = ' 天数'
 THISFORM.LCFMXGRID.COLUMN5.WIDTH = 65
 THISFORM.LCFMXGRID.COLUMN5.HEADER1.CAPTION = ' 租仓'
 THISFORM.LCFMXGRID.COLUMN6.WIDTH = 40
 THISFORM.LCFMXGRID.COLUMN6.HEADER1.CAPTION = ' 单价'
 THISFORM.LCFMXGRID.COLUMN7.WIDTH = 35
 THISFORM.LCFMXGRID.COLUMN7.HEADER1.CAPTION = ' 折扣'
 THISFORM.LCFMXGRID.COLUMN8.WIDTH = 70
 THISFORM.LCFMXGRID.COLUMN8.HEADER1.CAPTION = ' 冷藏费'
 THISFORM.LCFMXGRID.COLUMN9.WIDTH = 75
 THISFORM.LCFMXGRID.COLUMN9.HEADER1.CAPTION = ' 日期'
 THISFORM.LCFMXGRID.COLUMN10.WIDTH = 35
 THISFORM.LCFMXGRID.COLUMN10.HEADER1.CAPTION = ' 类型'
ENDPROC
*------

PROCEDURE byfmxgrid.When
 THISFORM.BYFMXGRID.COLUMNCOUNT = 8
 THISFORM.BYFMXGRID.COLUMN3.FORECOLOR = RGB(0,0,255)
 THISFORM.BYFMXGRID.COLUMN4.DYNAMICFORECOLOR =  ;
      'IIF(DIZF<>0,RGB(0,0,0),RGB(255,255,255))'
 THISFORM.BYFMXGRID.COLUMN5.DYNAMICFORECOLOR =  ;
      'IIF(DBYF<>0,RGB(0,0,0),RGB(255,255,255))'
 THISFORM.BYFMXGRID.COLUMN6.DYNAMICFORECOLOR =  ;
      'IIF(DJBF<>0,RGB(0,0,0),RGB(255,255,255))'
 THISFORM.BYFMXGRID.COLUMN7.DYNAMICFORECOLOR =  ;
      'IIF(DQTF<>0,RGB(0,0,0),RGB(255,255,255))'
 THISFORM.BYFMXGRID.COLUMN1.WIDTH = 75
 THISFORM.BYFMXGRID.COLUMN1.HEADER1.CAPTION = ' 日  期'
 THISFORM.BYFMXGRID.COLUMN2.WIDTH = 30
 THISFORM.BYFMXGRID.COLUMN2.HEADER1.CAPTION = ' 类型'
 THISFORM.BYFMXGRID.COLUMN3.WIDTH = 70
 THISFORM.BYFMXGRID.COLUMN3.HEADER1.CAPTION = ' 小  计'
 THISFORM.BYFMXGRID.COLUMN4.WIDTH = 65
 THISFORM.BYFMXGRID.COLUMN4.HEADER1.CAPTION = ' 处置费'
 THISFORM.BYFMXGRID.COLUMN5.WIDTH = 65
 THISFORM.BYFMXGRID.COLUMN5.HEADER1.CAPTION = ' 搬运费'
 THISFORM.BYFMXGRID.COLUMN6.WIDTH = 65
 THISFORM.BYFMXGRID.COLUMN6.HEADER1.CAPTION = ' 加班费'
 THISFORM.BYFMXGRID.COLUMN7.WIDTH = 65
 THISFORM.BYFMXGRID.COLUMN7.HEADER1.CAPTION = ' 其它费'
 THISFORM.BYFMXGRID.COLUMN8.WIDTH = 60
 THISFORM.BYFMXGRID.COLUMN8.HEADER1.CAPTION = ' 序号'
ENDPROC
*------

PROCEDURE jzbutton.Click
 PUSH KEY CLEAR
 RESTORE FROM (PATH + 'DJF') ADDITIVE
 THISFORM.HZHTEXT.ENABLED = .F.
 THISFORM.RQTEXT.ENABLED = .F.
 THISFORM.GETOUT.VISIBLE = .F.
 THISFORM.JZBUTTON.VISIBLE = .F.
 IF  .NOT. USED('ljz')
    SELECT 0
    USE (PATH + 'ljz')
 ENDIF
 IF  .NOT. USED('lysf')
    SELECT 0
    USE (PATH + 'lysf')
 ENDIF
 IF  .NOT. USED('lczf')
    SELECT 0
    USE (PATH + 'lczf')
 ENDIF
 IF  .NOT. USED('pzh')
    SELECT 0
    USE (PATH + 'pzh')
 ENDIF
 IF USED('lht')
    SELECT LHT
 ELSE
    SELECT 0
    USE (PATH + 'lht')
 ENDIF
 SELECT DXZC , DCH , DSFQRQ , RECNO() AS RECN FROM lht WHERE  ;
      DHZH = JZHZH AND DSFQRQ <= JZRQ AND (DXZC <> 0 .OR. DCH <> 0) INTO CURSOR jfhttmp
 IF _TALLY > 0
    SELECT JFHTTMP
    GO TOP
    DO WHILE  .NOT. EOF()
       SELECT LHT
       GO JFHTTMP.RECN
       IF DSFQRQ <= JZRQ
          SCATTER TO LHTARY
          SELECT LCZF
          SCATTER BLANK TO LCZFARY
          LCZFARY( 1 ) = JZRQ
          LCZFARY( 2 ) = LHTARY(17)
          IF LHTARY(6) = 0
             LCZFARY( 6 ) = LHTARY(16)
             IF LHTARY(12) = LHTARY(17)
                LHTARY( 17 ) = LHTARY(17) + LKLYQTS
                DO WHILE LHTARY(17) <= LCZFARY(1)
                   LHTARY( 17 ) = LHTARY(17) + LKLHQTS
                ENDDO
             ELSE
                DO WHILE LHTARY(17) <= LCZFARY(1)
                   LHTARY( 17 ) = LHTARY(17) + LKLHQTS
                ENDDO
             ENDIF
          ELSE
             LCZFARY( 6 ) = LHTARY(15) * 1000
             DO WHILE LHTARY(17) <= LCZFARY(1)
                LHTARY( 17 ) = LHTARY(17) + LKBYQTS
             ENDDO
          ENDIF
          LCZFARY( 3 ) = LHTARY(17) - LCZFARY(2)
          LHTARY( 18 ) = LHTARY(18) + 1
          SELECT PZH
          LOCATE FOR LEI = 'JZ'
          FOR I = 1 TO 200
             IF RLOCK()
                LCZFARY( 9 ) = HAO + 1
                REPLACE HAO WITH HAO + 1
                UNLOCK
                EXIT
             ENDIF
          ENDFOR
          SELECT LHT
          FOR I = 1 TO 200
             IF RLOCK()
                REPLACE DSFQRQ WITH LHTARY(17) , DSFXH WITH LHTARY(18)
                UNLOCK
                EXIT
             ENDIF
          ENDFOR
          LCZFARY( 12 ) = '结帐'
          LCZFARY( 4 ) = LHTARY(10)
          LCZFARY( 5 ) = LHTARY(11)
          LCZFARY( 8 ) = LHTARY(2)
          LCZFARY( 10 ) = LHTARY(3)
          LCZFARY( 11 ) = LHTARY(5)
          LCZFARY( 14 ) = LHTARY(18)
       LCZFARY( 18 ) = LHTARY(21)
          SELECT LCZF
          INSERT INTO lczf ( DRQ , DQRQ , DTS , DDJ , DDJXS , DZC , DHTH , DPZH , DHZH , DKH ,  ;
               DLX , DSFXH , DPM,GH ) VALUES ( LCZFARY(1) , LCZFARY(2) ,  ;
               LCZFARY(3) , LCZFARY(4) , LCZFARY(5) , LCZFARY(6) , LCZFARY(8) ,  ;
               LCZFARY(9) , LCZFARY(10) , LCZFARY(11) , LCZFARY(12) ,  ;
               LCZFARY(14) , LHTARY(20),LHTARY(21))
          SELECT JFHTTMP
          SKIP
       ELSE
          SELECT JFHTTMP
          SKIP
       ENDIF
    ENDDO
 ENDIF
 USE IN JFHTTMP
 SELECT DLCF , DQRQ , RECNO() AS RECN FROM lczf WHERE  ;
      DHZH = JZHZH AND DJDH = 0 AND DQRQ <= JZRQ INTO CURSOR jflcftmp
 IF _TALLY > 0
    SELECT PZH
    LOCATE FOR LEI = 'SF'
    FOR I = 1 TO 200
       IF RLOCK()
          LCZFARY( 13 ) = HAO + 1
          REPLACE HAO WITH HAO + 1
          UNLOCK
          EXIT
       ENDIF
    ENDFOR
    SELECT JFLCFTMP
    GO TOP
    DO WHILE  .NOT. EOF()
       SELECT LCZF
       GO JFLCFTMP.RECN
       IF JFLCFTMP.DLCF = 0
          DO CASE
          CASE DZC / 1000 > LKZXZC
             REPLACE DLCF WITH  ;
                  CEILING(CEILING(DZC / 1000 / LKZCJD) * LKZCJD * DTS * DDJ * DDJXS / LKLCFJD) *  ;
            LKLCFJD
          CASE DZC / 1000 <= LKZXZC AND DZC > 0
             REPLACE DLCF WITH CEILING(LKZXZC * DTS * DDJ * DDJXS / LKLCFJD) * LKLCFJD
          CASE DZC / 1000 < -LKZXZC
             REPLACE DLCF WITH  ;
                  FLOOR(FLOOR(DZC / 1000 / LKZCJD) * LKZCJD * DTS * DDJ * DDJXS / LKLCFJD) * LKLCFJD
          CASE DZC < 0 AND DZC / 1000 >= -LKZXZC
             REPLACE DLCF WITH FLOOR(-LKZXZC * DTS * DDJ * DDJXS / LKLCFJD) * LKLCFJD
          ENDCASE
          REPLACE DJDH WITH LCZFARY(13)
          LJZARY( 4 ) = LJZARY(4) + DLCF
          SELECT JFLCFTMP
          SKIP
       ELSE
          REPLACE DJDH WITH LCZFARY(13)
          LJZARY( 4 ) = LJZARY(4) + DLCF
          SELECT JFLCFTMP
          SKIP
       ENDIF
    ENDDO
 ENDIF
 USE IN JFLCFTMP
 SELECT LYSF
 SET ORDER TO 3
 SUM FOR DHZH = JZHZH AND DJDH = 0 AND DRQ <= JZRQ TO LJZARY( 5 ) , LJZARY( 6 ) ,  ;
      LJZARY( 7 ) , LJZARY( 9 ) DBYF , DIZF , DJBF , DQTF
 LJZARY( 10 ) = LJZARY(4) + LJZARY(5) + LJZARY(6) + LJZARY(7) + LJZARY(9)
 IF LJZARY(10) - LJZARY(4) <> 0
    IF LCZFARY(13) = 0
       SELECT PZH
       LOCATE FOR LEI = 'SF'
       FOR I = 1 TO 200
          IF RLOCK()
             LCZFARY( 13 ) = HAO + 1
             REPLACE HAO WITH HAO + 1
             UNLOCK
             EXIT
          ENDIF
       ENDFOR
    ENDIF
    SELECT LYSF
    REPLACE DJDH WITH LCZFARY(13) FOR DHZH = JZHZH AND DJDH = 0 AND DRQ <= JZRQ
 ENDIF
 USE IN PZH
 USE IN LHT
 USE IN LCZF
 USE IN LYSF
 USE IN LJZ
 IF LJZARY(10) = 0
    ?? CHR(7)
    WAIT WINDOW '此货主无费用发生.'
    POP KEY
    THISFORM.HZHTEXT.ENABLED = .T.
    THISFORM.RQTEXT.ENABLED = .T.
    THISFORM.GETOUT.VISIBLE = .T.
    THISFORM.HZHTEXT.VALUE = SPACE(7)
     JZFORM::INIT
     THISFORM.HZHTEXT.SETFOCUS
 ELSE
    IF LJZARY(10) - LJZARY(4) <> 0
       IF USED('lysf')
          SELECT LYSF
       ELSE
          SELECT 0
          USE (PATH + 'lysf')
       ENDIF
       SELECT DRQ , DLX , DXJ , DIZF , DBYF , DJBF , DQTF , DPM , DSPPH , DXH , DSL,GH FROM lysf  ;
            WHERE DJDH = LCZFARY(13) ORDER BY DSPPH INTO CURSOR lysftmp
       USE IN LYSF
       THISFORM.BYFMXGRID.VISIBLE = .T.
       THISFORM.BYFMXGRID.RECORDSOURCE = 'lysftmp'
    ENDIF
    IF LJZARY(4) <> 0
       IF USED('lczf')
          SELECT LCZF
       ELSE
          SELECT 0
          USE (PATH + 'lczf')
       ENDIF
       SELECT DHTH , DSFXH , DQRQ , DTS , DZC / 1000 AS ZC , DDJ , DDJXS , DLCF , DRQ , DLX ,  ;
            DPM,GH FROM lczf WHERE DJDH = LCZFARY(13) ORDER BY DHTH INTO  ;
            CURSOR lczftmp
       USE IN LCZF
       IF  .NOT. THISFORM.BYFMXGRID.VISIBLE
          THISFORM.LCFMXGRID.VISIBLE = .T.
       ENDIF
       THISFORM.LCFMXGRID.RECORDSOURCE = 'lczftmp'
    ENDIF
    SET COLOR  TO  RGB( 0 , 0 , 255 , 192 , 192 , 192)
    @ 3 , 30 SAY '新昌冷库电脑结帐单' FONT '宋体' , 11
    @ 5 , 1 SAY '货主号:' FONT '宋体' , 11
    @ 5 , 12 SAY JZHZH FONT '宋体' , 11
    @ 6 , 12 SAY LHTARY(4) FONT '宋体' , 11
    @ 5 , 35 SAY '日期:' FONT '宋体' , 11
    @ 5 , 43 SAY DATE() FONT '宋体' , 11
    @ 5 , 65 SAY '№:' FONT '宋体' , 11
    @ 5 , 70 SAY LCZFARY(13) FONT '宋体' , 11 PICTURE '@L 9999999'
    @ 3 , 105 SAY '处置费:' FONT '宋体' , 11
    @ 4 , 108 SAY LJZARY(6) FONT '宋体' , 11 PICTURE '99999999.99'
    @ 6 , 105 SAY '搬运费:' FONT '宋体' , 11
    @ 7 , 110 SAY LJZARY(5) FONT '宋体' , 11 PICTURE '9999999.99'
    @ 9 , 105 SAY '加班费:' FONT '宋体' , 11
    @ 10 , 110 SAY LJZARY(7) FONT '宋体' , 11 PICTURE '9999999.99'
    @ 12 , 105 SAY '其它费:' FONT '宋体' , 11
    @ 13 , 110 SAY LJZARY(9) FONT '宋体' , 11 PICTURE '9999999.99'
    @ 15 , 105 SAY '冷藏费:' FONT '宋体' , 11
    @ 16 , 108 SAY LJZARY(4) FONT '宋体' , 11 PICTURE '99999999.99'
    @ 18 , 105 SAY '合  计:' FONT '宋体' , 11
    @ 19 , 108 SAY LJZARY(10) FONT '宋体' , 11 PICTURE '99999999.99'
    SET COLOR  TO  RGB( 0 , 0 , 0 , 255 , 255 , 255)
    THISFORM.FINISH.VISIBLE = .T.
    THISFORM.CMXBUTTON.VISIBLE = .T.
    THISFORM.CANCBUTTON.VISIBLE = .T.
    IF USED('lczftmp') AND USED('lysftmp')
       THISFORM.CMXBUTTON.ENABLED = .T.
    ELSE
       THISFORM.CMXBUTTON.ENABLED = .F.
    ENDIF
 ENDIF
ENDPROC
*------

PROCEDURE finish.Click
 IF USED('ljz')
    SELECT LJZ
 ELSE
    SELECT 0
    USE (PATH + 'ljz')
 ENDIF
 LJZARY( 1 ) = LCZFARY(13)
 LJZARY( 2 ) = JZRQ
 LJZARY( 3 ) = JZHZH
 LJZARY( 11 ) = CZY
 INSERT INTO ljz ( DJDH , DRQ , DHZH , DLCF , DBYF , DIZF , DJBF , DQTF , DHJ , DSFR ,  ;
      DHZMC ) VALUES ( LJZARY(1) , LJZARY(2) , LJZARY(3) , LJZARY(4) ,  ;
      LJZARY(5) , LJZARY(6) , LJZARY(7) , LJZARY(9) , LJZARY(10) , LJZARY(11) ,  ;
      LHTARY(4) )
 USE IN LJZ
 THISFORM.FINISH.VISIBLE = .F.
 THISFORM.CANCBUTTON.VISIBLE = .F.
 THISFORM.PRINTBUTTON.VISIBLE = .T.
 THISFORM.PRINTBUTTON.ENABLED = .T.
 THISFORM.CANCPRINT.VISIBLE = .T.
 POP KEY
ENDPROC
*------

PROCEDURE cmxbutton.Click
 IF THISFORM.LCFMXGRID.VISIBLE
    THISFORM.LCFMXGRID.VISIBLE = .F.
    THISFORM.BYFMXGRID.VISIBLE = .T.
 ELSE
    THISFORM.BYFMXGRID.VISIBLE = .F.
    THISFORM.LCFMXGRID.VISIBLE = .T.
 ENDIF
ENDPROC
*------

PROCEDURE cancbutton.Click
 POP KEY
 IF THISFORM.LCFMXGRID.VISIBLE
    THISFORM.LCFMXGRID.VISIBLE = .F.
 ENDIF
 IF THISFORM.BYFMXGRID.VISIBLE
    THISFORM.BYFMXGRID.VISIBLE = .F.
 ENDIF
 @ 3 , 0 CLEAR TO 20 , 127
 CLOSE ALL
 IF USED('lczf')
    SELECT LCZF
 ELSE
    SELECT 0
    USE (PATH + 'lczf')
 ENDIF
 REPLACE DJDH WITH 0 FOR DJDH = LCZFARY(13)
 USE IN LCZF
 IF USED('lysf')
    SELECT LYSF
 ELSE
    SELECT 0
    USE (PATH + 'lysf')
 ENDIF
 REPLACE DJDH WITH 0 FOR DJDH = LCZFARY(13)
 USE IN LYSF
 ?? CHR(7)
 WAIT WINDOW '结帐已解除.'
 THISFORM.FINISH.VISIBLE = .F.
 THISFORM.CMXBUTTON.VISIBLE = .F.
 THISFORM.CANCBUTTON.VISIBLE = .F.
  JZFORM::INIT
 THISFORM.GETOUT.VISIBLE = .T.
 THISFORM.HZHTEXT.ENABLED = .T.
 THISFORM.RQTEXT.ENABLED = .T.
  THISFORM.HZHTEXT.SETFOCUS
ENDPROC
*------

PROCEDURE printbutton.Click
 IF  .NOT. PRINTSTATUS()
    ?? CHR(7)
    WAIT WINDOW '打印机没有准备好! 请检查.'
    RETURN
 ENDIF
 RESTORE FROM (PATH + 'DJF') ADDITIVE
 WAIT WINDOW NOWAIT '正在打印...'
 THISFORM.PRINTBUTTON.ENABLED = .F.
 SET DEVICE TO PRINTER
 SET PRINTER FONT '宋体' , 10
 P = PROW() + 1
 @ P , 3 SAY '№:'
 @ P , 6 SAY LJZARY(1) PICTURE '@B 9999999'
 @ P , 35 SAY '     电脑结帐单'
 @ P , 70 SAY '打印日期:'
 @ P , 81 SAY DATE()
 P = P + 2
 @ P , 3 SAY '公司名称:'
 @ P , 13 SAY LHTARY(4)
 @ P , 70 SAY '结帐日期:'
 @ P , 81 SAY LJZARY(2)
 P = P + 2
 @ P , 3 SAY '冷藏费'
 @ P , 10 SAY LJZARY(4) PICTURE '999999.99'
 @ P , 21 SAY '搬运费'
 @ P , 28 SAY LJZARY(5) PICTURE '99999.99'
 @ P , 38 SAY '处置费'
 @ P , 45 SAY LJZARY(6) PICTURE '999999.99'
 @ P , 56 SAY '加班其它费'
 @ P , 67 SAY LJZARY(7) + LJZARY(9) PICTURE '999999.99'
 @ P , 78 SAY '合计'
 @ P , 82 SAY LJZARY(10) PICTURE '9999999.99'
 IF USED('lczftmp')
    SELECT LCZFTMP
    P = P + 2
    @ P , 3 SAY '№:'
    @ P , 6 SAY LJZARY(1) PICTURE '@B 9999999'
    @ P , 38 SAY '冷藏费明细'
    P = P + 2
    @ P , 3 SAY '编   号'
    @ P , 15 SAY '品     名'
    @ P , 28 SAY '次'
    @ P , 33 SAY '起 日 期'
    @ P , 43 SAY '止 日 期'
    @ P , 53 SAY '天数'
    @ P , 60 SAY '租  仓'
    @ P , 69 SAY '单价'
    @ P , 78 SAY '折扣'
    @ P , 86 SAY '冷藏费'
* @ P , 95 SAY '柜     号'

    P = P + 1
    GO TOP
    DO WHILE  .NOT. EOF()
* @ P , 97 SAY GH
       @ P , 3 SAY DHTH
       @ P , 15 SAY DPM
       @ P , 26 SAY DSFXH PICTURE '999'
       @ P , 33 SAY SUBSTR(DTOC(DQRQ),3)
       @ P , 43 SAY SUBSTR(DTOC(DQRQ + DTS - 1),3)
       @ P , 52 SAY DTS PICTURE '999'
       @ P , 58 SAY  ;
            IIF(ZC > 0,IIF(ZC > LKZXZC,CEILING(ZC / LKZCJD) * LKZCJD,LKZXZC),IIF(ZC < 0,IIF(ZC < -LKZXZC,FLOOR(ZC / LKZCJD) * LKZCJD,-LKZXZC),0))  ;
            PICTURE '9999.999'
       @ P , 68 SAY DDJ PICTURE '99.99'
       @ P , 77 SAY DDJXS PICTURE '@Z 9.99'
       @ P , 82 SAY DLCF PICTURE '999999.99'
       IF P > 55
          SET PRINTER TO
          SET PRINTER FONT '宋体' , 10
          P = 1
       ELSE
          P = P + 1
       ENDIF
       SKIP
    ENDDO
 ENDIF
 IF USED('lysftmp')
    SELECT LYSFTMP
    P = P + 2
    IF P > 52
       SET PRINTER TO
       SET PRINTER FONT '宋体' , 10
       P = 1
    ENDIF
    @ P , 3 SAY '№:'
    @ P , 6 SAY LJZARY(1) PICTURE '@B 9999999'
    @ P , 30 SAY '处置费 搬运费 加班费 其它费  明细'
    P = P + 2
    @ P , 3 SAY '日     期'
    @ P , 17 SAY '编    号'
    @ P , 28 SAY '品    名'
    @ P , 42 SAY '类型'
    @ P , 48 SAY '件  数'
    @ P , 57 SAY '搬运费'
    @ P , 68 SAY '处置费'
    @ P , 79 SAY '加班费'
    @ P , 90 SAY '其它费'
    @ P , 101 SAY '小 . 计'
*  @ P , 106 SAY '柜     号'
    P = P + 1
    GO TOP
    DO WHILE  .NOT. EOF()
 *   @ P , 106 SAY GH
       @ P , 3 SAY DRQ
       @ P , 17 SAY DSPPH
       @ P , 28 SAY DPM
       @ P , 42 SAY DLX
       @ P , 49 SAY DSL PICTURE '@Z 99999'
       @ P , 55 SAY DBYF PICTURE '@Z 99999.99'
       @ P , 66 SAY DIZF PICTURE '@Z 99999.99'
       @ P , 77 SAY DJBF PICTURE '@Z 99999.99'
       @ P , 88 SAY DQTF PICTURE '@Z 99999.99'
       @ P , 98 SAY DXJ PICTURE '@Z 9999999.99'
       IF P > 55
          SET PRINTER TO
          SET PRINTER FONT '宋体' , 10
          P = 1
       ELSE
          P = P + 1
       ENDIF
       SKIP
    ENDDO
 ENDIF
 SET PRINTER TO
 SET DEVICE TO SCREEN
 WAIT WINDOW '完成. '
  JZFORM.CANCPRINT::CLICK
ENDPROC
*------

PROCEDURE cancprint.Click
 IF THISFORM.LCFMXGRID.VISIBLE
    THISFORM.LCFMXGRID.VISIBLE = .F.
 ENDIF
 IF THISFORM.BYFMXGRID.VISIBLE
    THISFORM.BYFMXGRID.VISIBLE = .F.
 ENDIF
 @ 3 , 0 CLEAR TO 20 , 127
 CLOSE ALL
 THISFORM.PRINTBUTTON.VISIBLE = .F.
 THISFORM.CMXBUTTON.VISIBLE = .F.
 THISFORM.CANCPRINT.VISIBLE = .F.
 THISFORM.GETOUT.VISIBLE = .T.
  JZFORM::INIT
 THISFORM.HZHTEXT.ENABLED = .T.
 THISFORM.RQTEXT.ENABLED = .T.
  THISFORM.HZHTEXT.SETFOCUS
ENDPROC
*------

PROCEDURE getout.Click
  THISFORM.RELEASE
ENDPROC
*------
ENDDEFINE
*------*
搜索更多相关主题的帖子: PUBLIC 
2015-05-30 15:14
pylyh
Rank: 1
等 级:新手上路
帖 子:59
专家分:0
注 册:2013-8-26
得分:0 
现在是不分月结账的,现在只有记住有几个月未结账,一个月一个月输入才行,我想一次性做到自动分月结账。


[ 本帖最后由 pylyh 于 2015-5-30 15:19 编辑 ]
2015-05-30 15:16
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:323
帖 子:9621
专家分:26174
注 册:2012-2-5
得分:3 
上传相关数据表
长篇小说看着太累人了。
VFP版本情况

坚守VFP最后的阵地
2015-05-30 17:27
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:323
帖 子:9621
专家分:26174
注 册:2012-2-5
得分:0 
应该是:上月26日到本月25日,否则会发生数据重复统计情况。

坚守VFP最后的阵地
2015-05-30 17:29
hu9jj
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:红土地
等 级:贵宾
威 望:396
帖 子:11713
专家分:43267
注 册:2006-5-13
得分:3 
根据日期来判断,将指定日期范围内的记录进行“结帐”处理。
收到的鲜花
  • qingfameng2015-05-30 22:34 送鲜花  10朵   附言:发布问题的楼主,如果有这种思路,几句简单 ...

活到老,学到老! http://www. E-mail:hu-jj@
2015-05-30 19:46
tlliqi
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:204
帖 子:15453
专家分:65956
注 册:2006-4-27
得分:3 
传点数据表
2015-05-30 21:55
hepingfly
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:195
专家分:657
注 册:2015-5-21
得分:3 
如果不牵扯数据结转,而只是统计汇总,可以搞成任意时间段汇总就是了。无所谓按不按月份,因为是个任意时间段的,任何时候都可以对某一段时间内的业务汇总,当然包括每个月的业务。

星际花草
2015-06-01 23:30
wp231957
Rank: 16Rank: 16Rank: 16Rank: 16
来 自:神界
等 级:版主
威 望:422
帖 子:13681
专家分:53296
注 册:2012-10-18
得分:3 
(用dbf或者其他)设置一个结账标志  一旦标志了  那么该月(或者某个节点之前)的业务部不可以继续做

DO IT YOURSELF !
2015-06-02 08:22



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-445997-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.451615 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved