frmaccountinterest.frm

金算盘软件代码

    End If
    If Not ltxtCreditAccount.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtAccount
    End If

    '删除凭证类型参照
    If Not lstxtType.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If

End Sub

'更新与子窗体相关的菜单项的可用性
Private Sub UpdateMenuStatus()
    With frmMain
        ' 设置MDI主窗口菜单可用标志
        .mnuEditUndo.Enabled = False
        .mnuEditCut.Enabled = False
        .mnuEditCopy.Enabled = False
        .mnuEditPaste.Enabled = False
        .mnuEditInsLine.Enabled = False
        .mnuEditDelLine.Enabled = False
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditInActive.Enabled = False
        .mnuEditShowAll.Enabled = False
        .mnuEditShowList.Enabled = False
        .mnuEditUse.Enabled = False
        .mnuEditNotepad.Enabled = False
        .mnuEditFilter.Enabled = False
        .mnuEditColumn.Enabled = False
        .mnuFilePrintSetup.Enabled = False
        .mnuFilePrint.Enabled = False
        .mnuReportQuick.Enabled = False
        .mnuToolRefresh.Enabled = False
        .SetToolBar
    End With
End Sub


Private Sub mclsGrid_DataValid(blnCancel As Boolean)
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim recDebitCredit As rdoResultset
    Dim recCurrency As rdoResultset
    Dim lngCnt As Long, intRow1 As Integer, intRow2 As Integer
    Dim lngID As Long
    Dim blnMuti As Boolean
    
    If ltxtAccount.ID <= 0 Then
        If ltxtAccount.Text <> "" Then
            If frmMsgAdd.MsgAddShow("增加科目", "科目“" & Trim(ltxtAccount.Text) & "”不存在，是否新增?") = vbOK Then
                lngID = Card.AddCard(msgAccount, ltxtAccount.Text)
                RefreshAccount lngID, ltxtDebitAccount.ID, ltxtCreditAccount.ID
            Else
                blnCancel = True
                ltxtAccount.Text = ""
                Exit Sub
            End If
        Else
            blnCancel = True
            Exit Sub
        End If
    End If
    
    strSql = "SELECT * FROM Account WHERE lngAccountID=" & msgAcc.TextMatrix(msgAcc.Row, 0)
    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recAccount.EOF Then
        strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAccount.ID
        Set recDebitCredit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recDebitCredit.EOF Then
            If Not recAccount!blnIsDetail = 1 Then
                blnCancel = True
                If ltxtAccount.Visible Then
                    ShowMsg hwnd, "科目必须是明细科目！", vbOKOnly + vbExclamation, Caption
                End If
            Else
                If Not ((recAccount!blnIsCustomer = recDebitCredit!blnIsCustomer Or recAccount!blnIsCustomer = 1) And _
                    (recAccount!blnIsDepartment = recDebitCredit!blnIsDepartment Or recAccount!blnIsDepartment = 1) And _
                    (recAccount!blnIsEmployee = recDebitCredit!blnIsEmployee Or recAccount!blnIsEmployee = 1) And _
                    (recAccount!blnIsClass1 = recDebitCredit!blnIsClass1 Or recAccount!blnIsClass1 = 1) And _
                    (recAccount!blnIsClass2 = recDebitCredit!blnIsClass2 Or recAccount!blnIsClass2 = 1)) Then
                    blnCancel = True
                    If ltxtAccount.Visible Then
                        ShowMsg hwnd, IIf(msgAcc.col = 5, "借方", "贷方") & "科目与本金科目的辅助核算必须相同(或只有本金科目的部分辅助核算)！", vbOKOnly + vbExclamation, Caption
                    End If
                Else
                    If recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                        If (recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1) And (recDebitCredit!blnIsMultCurrency = 1 Or recDebitCredit!blnIsAllCurrency = 1) Then
                            If recDebitCredit!blnIsMultCurrency = 1 Then
                                If recAccount!blnIsAllCurrency = 1 Then
                                    blnCancel = True
                                    If ltxtAccount.Visible Then
                                        ShowMsg hwnd, IIf(msgAcc.col = 5, "借方", "贷方") & "科目必须与本金科目有相同的外币辅助核算！", vbOKOnly + vbExclamation, Caption
                                    End If
                                ElseIf recAccount!lngAccountID <> recDebitCredit!lngAccountID Then
                                    strSql = "SELECT lngCurrencyID FROM AccountCurrency WHERE lngAccountID=" & recAccount!lngAccountID & " OR lngAccountID=" & recDebitCredit!lngAccountID _
                                        & " ORDER BY lngCurrencyID"
                                    Set recCurrency = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                    Do While Not recCurrency.EOF
                                        lngID = recCurrency!lngCurrencyID
                                        recCurrency.MoveNext
                                        If Not recCurrency.EOF Then
                                            If lngID = recCurrency!lngCurrencyID Then
                                                lngID = 0
                                            Else
                                                Exit Do
                                            End If
                                            recCurrency.MoveNext
                                        End If
                                    Loop
                                    If lngID > 0 Then
                                        blnCancel = True
                                        If ltxtAccount.Visible Then
                                            ShowMsg hwnd, IIf(msgAcc.col = 5, "借方", "贷方") & "科目必须与本金科目指定相同的外币辅助核算！", vbOKOnly + vbExclamation, Caption
                                        End If
                                    End If
                                    recCurrency.Close
                                    Set recCurrency = Nothing
                                End If
                            End If
                        Else
                            blnCancel = True
                            If ltxtAccount.Visible Then
                                ShowMsg hwnd, IIf(msgAcc.col = 5, "借方", "贷方") & "科目必须与本金科目有相同的外币辅助核算！", vbOKOnly + vbExclamation, Caption
                            End If
                        End If
                    Else
                        If (recDebitCredit!blnIsMultCurrency = 1 Or recDebitCredit!blnIsAllCurrency = 1) Then
                            blnCancel = True
                            If ltxtAccount.Visible Then
                                ShowMsg hwnd, IIf(msgAcc.col = 5, "借方", "贷方") & "科目必须与本金科目有相同的外币辅助核算！", vbOKOnly + vbExclamation, Caption
                            End If
                        End If
                    End If
                End If
                recDebitCredit.Close
                Set recDebitCredit = Nothing
            End If
        End If
        If Not blnCancel Then
            With msgAcc
                .TextMatrix(.Row, .col) = ""
                .TextMatrix(.Row, 3) = "√"
                If .RowSel - .Row >= 0 Then
                    blnMuti = True
                    intRow1 = .Row
                    intRow2 = .RowSel
                Else
                    blnMuti = False
                    intRow1 = 1
                    intRow2 = .Rows - 1
                End If
                For lngCnt = intRow1 To intRow2
                    If Trim$(.TextMatrix(lngCnt, .col)) = "" Or blnMuti Then
                        If .TextMatrix(lngCnt, 3) = "√" Then
                            .TextMatrix(lngCnt, .col) = ltxtAccount.Text
                            .TextMatrix(lngCnt, .col - 4) = ltxtAccount.ID
                        End If
                    End If
                Next lngCnt
                For lngCnt = intRow1 To intRow2
                    If .TextMatrix(lngCnt, 3) = "√" Then
                        strSql = "UPDATE Account SET " & IIf(.col = 5, "lngDebitAccountID", "lngCreditAccountID") _
                            & "=" & .TextMatrix(lngCnt, .col - 4) _
                            & " WHERE lngAccountID=" & .TextMatrix(lngCnt, 0)
                        gclsBase.ExecSQL strSql
                    End If
                Next lngCnt
            End With
        End If
    Else
        blnCancel = True
        If ltxtAccount.Visible Then
'        ShowMsg hwnd, "科目不存在！", vbOKOnly + vbCritical, Caption
        End If
    End If
    recAccount.Close
    Set recAccount = Nothing
    
    '设置默认科目
    If Not blnCancel Then
        If msgAcc.col = 5 Then
            If ltxtDebitAccount.ID = 0 Then
                ltxtDebitAccount.SeekId ltxtAccount.ID
            End If
        ElseIf msgAcc.col = 6 Then
            If ltxtCreditAccount.ID = 0 Then
                ltxtCreditAccount.SeekId ltxtAccount.ID
            End If
        End If
    End If
End Sub

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '响应消息
    If fraWizard(1).Tag = "已设置" Then
        For Each vntMessage In mclsMainControl.Messages
            Select Case vntMessage
            Case Message.msgVoucherType
                RefreshVoucherType lstxtType.ID
            Case Message.msgTemplate
                RefreshTemplate lstxtTemplate.ID
            End Select
        Next
    End If
    
    gclsSys.CurrFormName = hwnd
    UpdateMenuStatus
End Sub

Private Sub msgAcc_Click()
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim recLoss As rdoResultset
    Dim lngRow As Long
    Dim strMsg As String
    
    With msgAcc
        If .MouseCol = 3 And .MouseRow >= .FixedRows And .MouseRow < .Rows Then
            lngRow = .MouseRow
            ChoiceOne lngRow
        End If
    End With
End Sub

Private Sub msgAcc_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgAcc
        If .MouseCol = 3 Then
            .MousePointer = flexCustom
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub

Private Function ChoiceOne(ByVal lngRow As Long, Optional strMsg As String, Optional blnCheck As Boolean = False) As Boolean
    Dim strSql As String
    Dim lngID As Long
    Dim blnCancel As Boolean
    Dim recAccount As rdoResultset
    Dim recDebit As rdoResultset
    Dim recCredit As rdoResultset
    Dim recCurrency As rdoResultset
    
    With msgAcc
        If Not blnCheck Then
            If Trim$(.TextMatrix(lngRow, 3)) = "" Then
                .TextMatrix(lngRow, 3) = "√"
            Else
                .TextMatrix(lngRow, 3) = ""
            End If
        End If
        
        If .TextMatrix(lngRow, 3) = "√" Then
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If (Not blnCheck And ltxtDebitAccount.ID > 0 Or blnCheck And C2lng(.TextMatrix(lngRow, 1)) > 0) And Not recAccount.EOF Then
                strSql = "SELECT * FROM Account WHERE lngAccountID=" & IIf(blnCheck, C2lng(.TextMatrix(lngRow, 1)), ltxtDebitAccount.ID) & " AND blnIsDetail=1"
                Set recDebit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recDebit.EOF Then
                    If Not ((recAccount!blnIsCustomer = recDebit!blnIsCustomer Or recAccount!blnIsCustomer = 1) And _
                        (recAccount!blnIsDepartment = recDebit!blnIsDepartment Or recAccount!blnIsDepartment = 1) And _
                        (recAccount!blnIsEmployee = recDebit!blnIsEmployee Or recAccount!blnIsEmployee = 1) And _
                        (recAccount!blnIsClass1 = recDebit!blnIsClass1 Or recAccount!blnIsClass1 = 1) And _
                        (recAccount!blnIsClass2 = recDebit!blnIsClass2 Or recAccount!blnIsClass2 = 1)) Then
                        strMsg = "借方科目与本金科目的辅助核算必须相同(或只有本金科目的部分辅助核算)！"
                    Else
                        If recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                            If (recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1) And (recDebit!blnIsMultCurrency = 1 Or recDebit!blnIsAllCurrency = 1) Then
                                If recDebit!blnIsMultCurrency = 1 Then
                                    If recAccount!blnIsAllCurrency = 1 Then
                                        blnCancel = True
                                        strMsg = "借方科目必须与本金科目有相同的外币辅助核算！"
                                    ElseIf recAccount!lngAccountID <> recDebit!lngAccountID Then
                                        strSql = "SELECT lngCurrencyID FROM AccountCurrency WHERE lngAccountID=" & recAccount!lngAccountID & " OR lngAccountID=" & recDebit!lngAccountID _
                                            & " ORDER BY lngCurrencyID"
                                        Set recCurrency = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                        Do While Not recCurrency.EOF
                                            lngID = recCurrency!lngCurrencyID
                                            recCurrency.MoveNext
                                            If Not recCurrency.EOF Then
                                                If lngID = recCurrency!lngCurrencyID Then
                                                    lngID = 0
                                                Else
                                                    Exit Do
                                                End If
                                                recCurrency.MoveNext
                                            End If
                                        Loop
                                        If lngID > 0 Then
                                            blnCancel = True
                                            strMsg = "借方科目必须与本金科目指定相同的外币辅助核算！"
                                        End If
                                        recCurrency.Close
                                        Set recCurrency = Nothing
                                    End If
                                End If
                            Else
                                blnCancel = True
                                strMsg = "借方科目必须与本金科目有相同的外币辅助核算！"
                            End If
                        Else
                            If (recDebit!blnIsMultCurrency = 1 Or recDebit!blnIsAllCurrency = 1) Then
                                blnCancel = True
                                strMsg = "借方科目必须与本金科目有相同的外币辅助核算！"
                            End If
                        End If
                        If Not blnCancel And Not blnCheck Then
                            .TextMatrix(lngRow, 5) = ltxtDebitAccount.Text
                            .TextMatrix(lngRow, 1) = ltxtDebitAccount.ID
                            strSql = "UPDATE Account SET lngDebitAccountID=" & ltxtDebitAccount.ID _
                                & " WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
                            gclsBase.ExecSQL strSql
                        End If
                    End If
                    recDebit.Close