VB财务软件系统下载源代码提供自由下载使用学习

Private Sub Edityhzh_Change(Index As Integer)
    Tbr_Change
    isEnt(Index + 4) = True
End Sub
' 计算汇率小数位
Private Sub Textbb_Change()
    Editje(1).NumPoint = Gethldec(Textbb.Text)
    Editje(1).Locked = IIf(Textbb.Text = ZjAccInfo.zjStandExch, True, False)
    If Not Frtin And Textbb.Text <> "" Then
        Editje(1).Text = GetCurHl(Textbb.Text, Editrq.Text)
    End If
End Sub
' 汇率按键
Private Sub Editje_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Editje_Change(Index As Integer)
    If Not Frtin Then
        If IsNumeric(Editje(1).Text) And IsNumeric(Editje(0).Text) Then
            Textje.Text = Format(CDbl(Editje(0).Text) * CDbl(Editje(1).Text), "#0.00")
        Else
            Textje.Text = ""
        End If
    End If
    Tbr_Change
End Sub
' 经办人按键
Private Sub Editzy_Change(Index As Integer)
    Tbr_Change
End Sub

Private Sub Editzy_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If Index < 5 And KeyCode = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Editzy_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index < 3 Then
        Editzy(Index).ToolTipText = Editzy(Index).Text
    End If
End Sub
' 收、付款设置
Private Sub Option1_Click(Index As Integer)
    Tbr_Change
End Sub
' 窗体初始
Private Sub Form_Load()
    Screen.MousePointer = vbHourglass
    CenterForm Me
    InjsForm                           ' 窗体标题中、英文设置
    Label2.Caption = Ywbhtoname("14")  '业务编号赋值
'''''    Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '14*' and isnull(CbookCode) order by cSetid", dbOpenDynaset)
 Set rsTckd = oV.getUnBookRst
    If Not rsTckd.EOF Then
        rsTckd.MoveLast
        rsTckd.MoveFirst
    End If
    Carddata
    ckdbutt
    isEnt(0) = True
    isEnt(1) = True
    isEnt(2) = True
    isEnt(3) = True
    isEnt(4) = True
    isEnt(5) = True
    Combo1_GotFocus
'''    Edityhzh(1).
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    If Not isSave Then
        Select Case PromptSav
            Case vbYes:
                If Ckdquit() Then
                    CkdSave
                    If isSave Then
                        rsTckd.Close
                    Else
                        Cancel = True
                    End If
                Else
                    Cancel = True
                End If
            Case vbNo:
                rsTckd.Close
            Case vbCancel
                Cancel = True
        End Select
    Else
        rsTckd.Close
    End If
End Sub
'工具栏
Private Sub tlbckd_ButtonClick(ByVal Button As ComctlLib.Button)
    Gen_Key Button.key
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF3
            If Shift = 0 And Tlbckd.Buttons("Check").Enabled Then
                Gen_Key "Check"
            End If
        Case vbKeyF4
            If Shift = 4 Then
                Gen_Key "Exit"
            ElseIf Shift = 0 And Tlbckd.Buttons("CheckCancel").Enabled Then
                Gen_Key "CheckCancel"
            End If
        Case vbKeyF5
            If Shift = 0 And Tlbckd.Buttons("AddRecord").Enabled Then
                Gen_Key "AddRecord"
            End If
        Case vbKeyF6
            If Shift = 0 And Tlbckd.Buttons("SaveRecord").Enabled Then
                Gen_Key "SaveRecord"
            End If
        Case vbKeyF7
            If Shift = 4 And Tlbckd.Buttons("PingZheng").Enabled Then
                Gen_Key "PingZheng"
            End If
        Case vbKeyC
            If Shift = 2 And Tlbckd.Buttons("CopyRecord").Enabled And Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+C" Then
                Gen_Key "CopyRecord"
                KeyCode = 0
            End If
        Case vbKeyV
            If Shift = 2 And Tlbckd.Buttons("CopyRecord").Enabled And Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+V" Then
                Gen_Key "CopyRecord"
                KeyCode = 0
            End If
        Case vbKeyY
            If Shift = 2 And Tlbckd.Buttons("DeleteRecord").Enabled And Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y" Then
                Gen_Key "DeleteRecord"
                KeyCode = 0
            End If
        Case vbKeyR
            If Shift = 2 And Tlbckd.Buttons("DeleteRecord").Enabled And Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+R" Then
                Gen_Key "DeleteRecord"
                KeyCode = 0
            End If
        Case vbKeyP
            If Shift = 2 And Tlbckd.Buttons("Print").Enabled Then
                Gen_Key "Print"
                KeyCode = 0
            End If
        Case vbKeyS
            'cuidong 2001.01.15
            'If Shift = 2 And Tlbckd.Buttons("Preview").Enabled Then
            '    Gen_Key "Preview"
            '    KeyCode = 0
            'End If
        Case vbKeyW
            If Shift = 2 And Tlbckd.Buttons("Dataout").Enabled Then
                Gen_Key "Dataout"
                KeyCode = 0
            End If
        Case vbKeyPageUp
            If Shift = 0 And Tlbckd.Buttons("PriorPage").Enabled Then
                Gen_Key "PriorPage"
            ElseIf Shift = 2 And Tlbckd.Buttons("FirstPage").Enabled Then
                Gen_Key "FirstPage"
            End If
        Case vbKeyPageDown
            If Shift = 0 And Tlbckd.Buttons("NextPage").Enabled Then
                Gen_Key "NextPage"
            ElseIf Shift = 2 And Tlbckd.Buttons("LastPage").Enabled Then
                Gen_Key "LastPage"
            End If
    End Select
End Sub

Private Sub Gen_Key(TLB_Key As String)
    On Error Resume Next
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjPrnViewOut Me, "ybjsdj", TLB_Key
        Case Is = "AddRecord"   '增加
            Dim xf As Boolean
            xf = True
            If Not isSave Then
                Select Case PromptSav
                    Case vbYes:
                        If Ckdquit() Then
                            CkdSave
                            xf = isSave
                        Else
                            xf = False
                        End If
                    Case vbNo:
                    
                    Case vbCancel:
                        xf = False
                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
                End If
            End If
        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
        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![cSetid]
               .pZhID1 = Edityhzh(0).Text
               .pZhID2 = Edityhzh(1).Text
               .pDigest = Editzy(0).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 Jsfs_err(Me, True) Then
        SetTxtFocus Textjsfs
        isEnt(0) = False
        Exit Function
    End If
    
    If Editbh.Text = "" Then
        Beep
        MsgBox "业务编号不能为空，请检查！", vbCritical, zjGl_Name
        Editbh.SetFocus
        Exit Function
    Else
        Editbh.Text = Right("00000000" & Editbh.Text, 8)
    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(1) = False
        Exit Function
    End If
    
    If CDate(Editrq.Text) > zjLogInfo.curDate Then
        Beep
        MsgBox "业务日期不能超过系统登录时间！", vbCritical, zjGl_Name
        SetTxtFocus Editrq
        Exit Function
    End If
    
    If Jszh_err(Editrq.Text, True, Edityhmc(0), Edityhzh(0), Edityhzh(1), Textbb, 2, 1, Option1(0).Value, False) Then
        SetTxtFocus Edityhzh(0)
        isEnt(4) = False
        Exit Function
    End If
    
    If Jszh_err(Editrq.Text, True, Edityhmc(1), Edityhzh(1), Edityhzh(0), Textbb, 1, 0, Option1(0).Value, True) Then
        SetTxtFocus Edityhzh(1)
        isEnt(5) = 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
    
    If Option1(1).Value = True Then
        Dim ye As Double
        ye = 0
        On Error GoTo err2
        If Not IsNew Then