银行取款.frm

财务信息管理系统,适合做毕业论文的人使用

                End Select
            End If
            If xf Then
                Ckdappe
                Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
                Tlbckd.Buttons("CopyRecord").Image = "PasteRecord"
                Tlbckd.Buttons("CopyRecord").Caption = "粘贴"
                Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+V"
            End If
        Case Is = "SaveRecord"  '存盘
            If Ckdquit() Then
                CkdSave
                If isSave Then
                    Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                    Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                    Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
                    Tlbckd.Buttons("CopyRecord").Image = "CopyRecord"
                    Tlbckd.Buttons("CopyRecord").Caption = "复制"
                    Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+C"
                    Combo1_GotFocus 'cuidong 2001.08.24
                End If
'                Combo1_GotFocus    'cuidong 2001.08.24 'Cuidong 2000/08/30
            End If
'            Combo1_GotFocus        'Cuidong 2000/08/30
        Case Is = "DeleteRecord"  '删除
            If IsNew Or isSave Then
                If PromptDel = vbYes Then
                    Ckddele
                    Tlbckd.Buttons("CopyRecord").Image = "CopyRecord"
                    Tlbckd.Buttons("CopyRecord").Caption = "复制"
                    Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+C"
                    Getckd IIf(IsNew, 4, 2), Editbh.Text
                End If
            Else
                Getckd 3, IIf(Editbh.Text = "00000000", "0", right(str(99999999 + Editbh.Text), 8))
                Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
            End If
            Combo1_GotFocus
        Case Is = "CopyRecord"
            Setdjcopy IsNew
        Case Is = "FirstPage"     '首页
            Getckd 1, Editbh.Text
         Case Is = "PriorPage"     '上页
            Getckd 2, Editbh.Text
        Case Is = "NextPage"     '下页
            Getckd 3, Editbh.Text
        Case Is = "LastPage"     '末页
            Getckd 4, Editbh.Text
        Case Is = "Check"     '复核
            InitFrmCheck_xz True
            If CheckStatus = 0 Then
                Check "One"
            ElseIf CheckStatus = 1 Then
                Check "All"
            End If
        Case Is = "CheckCancel"   '取消复核
            InitFrmCheck_xz False
            If CheckStatus = 0 Then
                UnCheck "One"
            ElseIf CheckStatus = 1 Then
                UnCheck "All"
            End If
        Case Is = "PingZheng"   '凭证
            With pzInfo
               .pDjrq = Editrq.Text
               .pMoney = Editje(0)
               .pYwID = rsTckd![cFetID]
               .pZhID1 = Edityhzh.Text
               .pZhID2 = pzZhID2
               .pDigest = Editzy.Text
               .pHl = Editje(1)
               .blnFind = False
            End With
            If Err.Number <> 0 Then
                Gen_Key "NextPage"
                Exit Sub
            Else
                If ZjAccInfo.zjPrnCtrl Then Exit Sub
                ZjAccInfo.zjPrnCtrl = True
                DoVouch
                ZjAccInfo.zjPrnCtrl = False
            End If
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Exit"      '退出
            Unload Me
            Exit Sub
    End Select
    ckdbutt
End Sub
' 新增单据存盘合法性检查
Private Function Ckdquit() As Boolean
    If isSave Then
        Ckdquit = True
        Exit Function
    End If
    
    Ckdquit = False
    
    If Editbh.Text = "" Then
        Beep
        MsgBox "业务编号不能为空，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editbh
        Exit Function
    Else
        Editbh.Text = right("0000000000" & Editbh.Text, 10)
    End If
    
    If Editrq.Text = "" Then
        Beep
        MsgBox "业务日期不能为空，请检查！", vbCritical, zjGl_Name
        Editrq.SetFocus
        Exit Function
    End If
    
    Editrq.Text = ForDate(Editrq.Text)
    If Not IsDate(Editrq.Text) Then
        Beep
        MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editrq
        isEnt(0) = False
        Exit Function
    End If
    
    If CDate(Editrq.Text) > zjLogInfo.curDate Then
        Beep
        MsgBox "业务日期不能超过系统登录时间！", vbCritical, zjGl_Name
        SetTxtFocus Editrq
        Exit Function
    End If
    
    If Qkzh_err(Me, True, djnwb, IIf(Option1(0).Value, 0, 1), IsNew) Then
        SetTxtFocus Edityhzh
        isEnt(2) = False
        Exit Function
    End If
    
    If Editje(0).Text = "" Then
        Beep
        MsgBox "取款金额不能为空，请检查！", vbCritical, zjGl_Name
        Editje(0).SetFocus
        Exit Function
    End If
    
    If val(Editje(0).Text) = 0 Then
        Beep
        MsgBox "取款金额不能为0，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editje(0)
        Exit Function
    End If
    
    If Editje(1).Text = "" Then
        Beep
        MsgBox "汇率不能为空，请检查！", vbCritical, zjGl_Name
        Editje(1).SetFocus
        Exit Function
    End If
    
    If val(Editje(1).Text) = 0 Then
        Beep
        MsgBox "汇率不能为0，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editje(1)
        Exit Function
    End If
    
    If CheckCurrencyOut(CDbl(Textje.Text)) Then
         SetTxtFocus Editje(0)
         Exit Function
    End If
    
    Dim ye As Currency, tmplx As Variant
    If Option1(1).Value = True Then
        ye = 0
        On Error GoTo err2
        If Not IsNew Then
            If rsTckd![cAccId] = Edityhzh.Text Then
                ye = Vround(rsTckd![mMoney], 2)
            End If
        End If
err2:
        ye = ye + Gethqzhye(Edityhzh.Text)
        If ye = CCur(Editje(0).Text) Then
            Select Case PromptSettle
                Case vbYes:
                    tmplx = hq_lx(Edityhzh.Text, CDate(Editrq.Text), True)
                    Editje(0).Text = Format(CCur(Editje(0).Text) + IIf(IsNull(tmplx), 0, tmplx), "#0.00")
                Case vbNo:
                    Editje(0).SetFocus
                    Exit Function
            End Select
        ElseIf ye < CCur(Editje(0).Text) Then
            Beep
            If HqzhRedcx(Edityhzh.Text, ye - CCur(Editje(0).Text)) Then
                SetTxtFocus Editje(0)
                Exit Function
            End If
        End If
    Else
        tmplx = Wget_dqlx
        Editje(0).Text = Format(CCur(Editje(0).Text) + IIf(IsNull(tmplx), 0, tmplx), "#0.00")
    End If
    
    Ckdquit = True
    
End Function
'计算定期利息
Private Function Wget_dqlx() As Variant
'    Dim rst As New adodb.Recordset     'Cuidong 2000/06/21
    Dim Rst As New UfRecordset         'Cuidong 2000/06/21
    Set Rst = dbsZJ.OpenRecordset("select mmoney from FD_CadAcr where iDanType = 1 and cGAccID = '" & Edityhzh.Text & "'", dbOpenSnapshot)
    If Rst.EOF Then
        Wget_dqlx = dq_lx(Edityhzh.Text, CDate(Editrq.Text), True)
    Else
        Wget_dqlx = Rst!mMoney
    End If
    'rst.Close                         'Cuidong 2000/06/21
    CloseRS Rst                        'Cuidong 2000/06/21
End Function
''''' 新增单据时，获取最大业务号
''''Private Function getMaxbh()
''''    Dim rsTemp As New adodb.Recordset, i As Long
''''    Set rsTemp = dbsZJ.OpenRecordset("FD_Fetch", dbOpenTable)
''''    With rsTemp
''''        .Index = "PrimaryKey"
''''        If djnwb = 1 Then
''''            FindFirst rsTemp, "cfetid<='" + "03" + "'"
''''            If .EOF Then
''''                oV.getMaxID = "00000001"
''''            Else
''''                oV.getMaxID = Right(str(100000001 + Right(![cfetid], 8)), 8)
''''            End If
''''        Else
''''            If .EOF Then
''''                oV.getMaxID = "00000001"
''''            Else
''''                .MoveLast
''''                If ![cfetid] Like "04*" Then
''''                    oV.getMaxID = Right(str(100000001 + Right(![cfetid], 8)), 8)
''''                Else
''''                    oV.getMaxID = "00000001"
''''                End If
''''            End If
''''        End If
''''        If oV.getMaxID = "00000000" Then
''''            For i = 1 To 99999998
''''                oV.getMaxID = Right(str(100000000 + i), 8)
''''                .oSeek "=", IIf(djnwb = 1, "02", "04") & oV.getMaxID
''''                If .eof Then
''''                    Exit Function
''''                End If
''''            Next
''''        End If
''''        .Close
''''    End With
''''End Function
' 新增一张单据
Private Sub Ckdappe()
    Textqk
    Editbh.Text = oV.getMaxID(IIf(djnwb = 1, "02", "04"))
    IsNew = True
End Sub

Private Sub CkdSave()
    On Error Resume Next
    Dim sav_js As Integer
    If isSave Then Exit Sub
    sav_js = 0
cf: CkdSave1
    'cuidong 2001.08.24
    '------------------------
'    If Not isSave Then
'        sav_js = sav_js + 1
'        If sav_js < 1000 Then GoTo cf
'        Beep
'        MsgBox "其他工作站正在保存，请过一会儿再试！", vbOKOnly + vbInformation, zjGl_Name
'    End If
    '------------------------
End Sub
' 新单据存盘
Private Sub CkdSave1()
'    Dim newmaxbh As String, rsTemp As New adodb.Recordset, oldbh As String 'Cuidong 2000/06/21
    Dim newmaxbh As String, rsTemp As New UfRecordset, oldbh As String 'Cuidong 2000/06/21
    On Error GoTo er1
    newmaxbh = IIf(djnwb = 1, "02", "04") & Editbh.Text
    BillSaveLock IIf(djnwb = 1, "02", "04") 'cuidong 2001.08.28
    If IsNew Then
''''        Set rsTemp = dbsZJ.OpenRecordset("FD_Fetch", dbOpenTable)
''''        With rsTemp
''''            .Index = "PrimaryKey"
''''            .Find "cFetID='" + newmaxbh + "'"
''''            If Not .EOF Then
''''                If djnwb = 1 Then
''''                    FindFirst rsTckd, " <= " + "03"
''''                Else
''''                    .MoveLast
''''                End If
''''                newmaxbh = IIf(djnwb = 1, "02", "04") & Right(str(100000001 + Right(![cfetid], 8)), 8)
''''            End If
''''            .Close
''''        End With
''''        rsTckd.AddNew
        If Not oV.ValidateBillID(newmaxbh) Then Exit Sub      'cuidong 2001.08.22
        Editbh.Text = right(newmaxbh, 10)                      'cuidong 2001.08.24
    Else
        Label1(15).Caption = IIf(IsNull(rsTckd![cCheckCode]), "", rsTckd![cCheckCode])
        If Label1(15).Caption <> "" Then
            Beep
            MsgBox "对不起，这张单子已被审核过！", vbOKOnly + vbInformation, zjGl_Name
            Carddata
            isSave = True
            Exit Sub
        End If
''''        rsTckd.edit
    End If
    Savdata newmaxbh
    BillSaveUnLock IIf(djnwb = 1, "02", "04") 'cuidong 2001.08.28
    Exit Sub
er1:
    Select Case Err.Number
    Case 3167
        rsTckd.AddNew
        IsNew = True
        Savdata newmaxbh
    Case 3022
        Savdata IIf(djnwb = 1, "02", "04") & oV.getMaxID(IIf(djnwb = 1, "02", "04"))
    End Select
    BillSaveUnLock IIf(djnwb = 1, "02", "04") 'cuidong 2001.08.28
    
End Sub
' 给窗体赋值
Private Sub Carddata()
    With rsTckd
        If Not .EOF Then
            Frtin = True
            Editrq.Text = Format(![dbill_date], "yyyy-mm-dd")
            Editbh.Text = right(![cFetID], 10)
            Edityhzh.Text = ![cAccId]
            Edityhmc.Text = Zhbhtodwmc(Edityhzh.Text)
            Textlldm.Text = Wgetlldm(Edityhzh.Text)
            Textbb.Text = Wgetwbb(Edityhzh.Text)
            Editzy.Text = IIf(IsNull(![cDigest]), "", ![cDigest])
            Editje(1).Text = ![nFrat]
            Editje(0).Text = Format(![mMoney], "#0.00")
            Textje.Text = Format(![mMoney_F], "#0.00")
            Editmonth.Text = IIf(![iMonth] = 0, "", ![iMonth])
            Editjbr.Text = IIf(IsNull(![ctran_name]), "", ![ctran_name])
            Label1(15).Caption = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
            Label1(17).Caption = IIf(IsNull(![cBookCode]), "", ![cBookCode])
            Label1(19).Caption = ![cBillCode]
            Option1(0).Value = IIf(![isc] = 0, True, False)
            Option1(1).Value = IIf(![isc] = 0, False, True)
            Frtin = False
        Else
            Textqk
        End If
    End With
    isSave = True
    IsNew = False
End Sub
' 给表赋值
Private Sub Savdata(bh As String)
''''    With rsTckd
''''        ![dbill_date] = Editrq.Text
''''        ![cFetID] = bh
''''        ![cAccID] = Edityhzh.Text
''''        ![nfrat] = CDbl(Editje(1).Text)
''''        ![mMoney] = CDbl(Editje(0).Text)
''''        ![mmoney_f] = CDbl(Textje.Text)
''''        ![iMonth] = IIf(Option1(0).Value, Editmonth.Text, 0)
''''        ![isc] = IIf(Option1(0).Value, 0, 1)
''''        ![ctran_name] = IIf(Editjbr.Text = "", Null, Editjbr.Text)