-+

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

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 软件著作权: 北京用友软件（集团）有限公司
' 系统名称: 资金计息8。0
' 功能说明: 内部结算单据录入
' 作者: 魏小黎

Option Explicit
Private rsTckd As New ADODB.Recordset
Private isSave As Boolean
Private IsNew As Boolean
Private isFh As Boolean
Private isEnt(4) As Boolean
Private Frtin As Boolean
Private Checkqx As Boolean
Private Djcopy(11) As String
' 日期参照
Private Sub cmdrq_Click()
    View_Calendar Me, Editrq, Picture1.Top
End Sub

Private Sub Combo1_Click()
    On Error GoTo reqer1
    If Combo1.Text <> "" Then
        If Combo1.Text = Editbh.Text Then
            Exit Sub
        End If
        If rsTckd Is Nothing Then
'reqer1:     Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '15*' and isnull(CbookCode) order by cSetid", dbOpenDynaset) 'cuidong % 2001.11.05
reqer1:     Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '15%' and isnull(CbookCode) order by cSetid", dbOpenDynaset)  'cuidong % 2001.11.05
        Else
            rsTckd.Requery
        End If
        With rsTckd
            If .EOF Then
                Textqk
                ckdbutt
                Exit Sub
            Else
                .MoveLast
                .MoveFirst
            End If
            Dim dqbh As String
            dqbh = Combo1.Text
            Combo1.clear
            Do While Not .EOF
                Combo1.AddItem Right(![cSetid], 8)
                .MoveNext
            Loop
            FindFirst rsTckd, "cSetid >= '15" & dqbh & "'"
            If .EOF Then
                .MoveLast
            End If
            Editrq.SetFocus
        End With
        Carddata
        ckdbutt
    End If
End Sub

Private Sub Combo1_GotFocus()
    On Error GoTo reqer2
    Combo1.clear
    If rsTckd Is Nothing Then
'reqer2: Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '15*' and isnull(CbookCode) order by cSetid", dbOpenDynaset) 'cuidong % 2001.11.05
reqer2: Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '15%' and isnull(CbookCode) order by cSetid", dbOpenDynaset)  'cuidong % 2001.11.05
    Else
        rsTckd.Requery
    End If
    With rsTckd
        If .EOF Then
            Textqk
            ckdbutt
            Exit Sub
        Else
            .MoveLast
            .MoveFirst
        End If
        Do While Not .EOF
            Combo1.AddItem Right(![cSetid], 8)
            .MoveNext
        Loop
        If Editbh.Text <> "" Then
            FindFirst rsTckd, "cSetid >= '15" & Editbh.Text & "'"
            If .EOF Then
                .MoveLast
            End If
            Carddata
            ckdbutt
        End If
    End With
End Sub

Private Sub Editje_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 45 And Index = 1 Then
        KeyAscii = 0
    End If
End Sub

Private Sub Refyhmc_Initialize(Index As Integer)
    Refyhmc(Index).InitSys 0, dbsZJ
    Refyhmc(Index).InitSys 1, Edityhmc(Index).Text
    
    Refyhmc(Index).RefUnitMode = RefNotBank        'Cuidong 2000/06/26
End Sub

Private Sub Refyhmc_RefCancel(Index As Integer)
    Edityhmc(Index).SetFocus
End Sub

Private Sub Refyhzh_RefCancel(Index As Integer)
    Edityhzh(Index).SetFocus
End Sub

Private Sub Refyhzh_Initialize(Index As Integer)
    refyhzh(Index).InitSys 0, dbsZJ
    refyhzh(Index).InitSys 1, Edityhzh(Index).Text
    refyhzh(Index).InitSys 2, Edityhmc(Index).Text
End Sub

Private Sub Refyhmc_RefOK(Index As Integer, code As String)
    Edityhmc(Index).Text = code
    Edityhmc(Index).SetFocus
End Sub

Private Sub Refyhzh_RefOK(Index As Integer, code As String)
    Edityhzh(Index).Text = code
    Edityhzh(Index).SetFocus
End Sub
' 业务编号按键
Private Sub Editbh_LostFocus()
    If IsNew Then
        If Len(Editbh.Text) > 0 Then
            Editbh.Text = Right("00000000" & Editbh.Text, 8)
        End If
    End If
End Sub
' 业务日期按键
Private Sub Editrq_Keyup(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And isEnt(0) Then
        SendKeys "{Tab}"
    End If
    If Not isFh And KeyCode = 113 Then    'F2
        View_Calendar Me, Editrq, Picture1.Top
    End If
    isEnt(0) = True
End Sub

Private Sub Editrq_Change()
    Tbr_Change
    isEnt(0) = True
End Sub

Private Sub Editrq_LostFocus()
    If Not isSave And Editrq.Text <> "" And isEnt(0) Then
        Editrq.Text = ForDate(Editrq.Text)
        If IsDate(Editrq.Text) Then
            Editrq.Text = Format(Editrq.Text, "yyyy-mm-dd")
        Else
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editrq
            isEnt(0) = False
        End If
    End If
End Sub
' 内部单位按键
Private Sub Edityhmc_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And isEnt(Index + 1) Then
        SendKeys "{Tab}"
    End If
    If Not isFh And KeyCode = 113 Then    'F2
        Refyhmc(Index).RunReference
    End If
    isEnt(Index + 1) = True
End Sub

Private Sub Edityhmc_LostFocus(Index As Integer)
    If Not isSave And isEnt(Index + 1) And Edityhmc(Index).Text <> "" Then
        If Yhmc_err(Edityhmc(Index), Edityhzh(Index), 0, 1) Then
            SetTxtFocus Edityhmc(Index)
            isEnt(Index + 1) = False
        End If
    End If
End Sub

Private Sub Edityhmc_Change(Index As Integer)
    Tbr_Change
    isEnt(Index + 1) = True
End Sub

Private Sub Edityhmc_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Edityhmc(Index).ToolTipText = Edityhmc(Index).Text
End Sub
' 单位账号按键
Private Sub Edityhzh_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And isEnt(Index + 3) Then
        SendKeys "{Tab}"
    End If
    If Not isFh And KeyCode = 113 Then   'F2
        refyhzh(Index).RunReference
    End If
    isEnt(Index + 3) = True
End Sub

Private Sub Edityhzh_LostFocus(Index As Integer)
    If Not isSave And isEnt(Index + 3) And Edityhzh(Index).Text <> "" Then
        If Jszh_err(Editrq.Text, False, Edityhmc(Index), Edityhzh(Index), Edityhzh(1 - Index), Textbb, 0, 0, IIf(Index = 0, True, False), IIf(Index = 1, True, False)) Then
            SetTxtFocus Edityhzh(Index)
            isEnt(Index + 3) = False
        End If
    End If
End Sub

Private Sub Edityhzh_Change(Index As Integer)
    Tbr_Change
    isEnt(Index + 3) = 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 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 = 0 Then
        Editzy(Index).ToolTipText = Editzy(Index).Text
    End If
End Sub
'窗体初始化
Private Sub Form_Load()
    Screen.MousePointer = vbHourglass
    CenterForm Me
    InjsForm                           ' 窗体标题中、英文设置
    Label2.Caption = Ywbhtoname("15")  '业务编号赋值
''''    Set rsTckd = dbsZJ.OpenRecordset("select * from FD_Settacc where cSetid like '15*' 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
    Combo1_GotFocus
    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