frmaccountinterest.frm

金算盘软件代码

                    Set recDebit = Nothing
                End If
            End If
            If (Not blnCheck And ltxtCreditAccount.ID > 0 Or blnCheck And C2lng(.TextMatrix(lngRow, 2)) > 0) And Not recAccount.EOF Then
                strSql = "SELECT * FROM Account WHERE lngAccountID=" & IIf(blnCheck, .TextMatrix(lngRow, 2), ltxtCreditAccount.ID) & " AND blnIsDetail=1"
                Set recCredit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recCredit.EOF Then
                    If Not ((recAccount!blnIsCustomer = recCredit!blnIsCustomer Or recAccount!blnIsCustomer = 1) And _
                        (recAccount!blnIsDepartment = recCredit!blnIsDepartment Or recAccount!blnIsDepartment = 1) And _
                        (recAccount!blnIsEmployee = recCredit!blnIsEmployee Or recAccount!blnIsEmployee = 1) And _
                        (recAccount!blnIsClass1 = recCredit!blnIsClass1 Or recAccount!blnIsClass1 = 1) And _
                        (recAccount!blnIsClass2 = recCredit!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 (recCredit!blnIsMultCurrency = 1 Or recCredit!blnIsAllCurrency = 1) Then
                                If recCredit!blnIsMultCurrency = 1 Then
                                    If recAccount!blnIsAllCurrency = 1 Then
                                        blnCancel = True
                                        strMsg = "贷方科目必须与本金科目有相同的外币辅助核算！"
                                    ElseIf recAccount!lngAccountID <> recCredit!lngAccountID Then
                                        strSql = "SELECT lngCurrencyID FROM AccountCurrency WHERE lngAccountID=" & recAccount!lngAccountID & " OR lngAccountID=" & recCredit!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 (recCredit!blnIsMultCurrency = 1 Or recCredit!blnIsAllCurrency = 1) Then
                                blnCancel = True
                                strMsg = "贷方科目必须与本金科目有相同的外币辅助核算！"
                            End If
                        End If
                        If Not blnCancel And Not blnCheck Then
                            .TextMatrix(lngRow, 6) = ltxtCreditAccount.Text
                            .TextMatrix(lngRow, 2) = ltxtCreditAccount.ID
                            strSql = "UPDATE Account SET lngCreditAccountID=" & ltxtCreditAccount.ID _
                                & " WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
                            gclsBase.ExecSQL strSql
                        End If
                    End If
                    recCredit.Close
                    Set recCredit = Nothing
                End If
            End If
            recAccount.Close
            Set recAccount = Nothing
        Else
            If Not blnCheck Then
                .TextMatrix(lngRow, 5) = ""
                .TextMatrix(lngRow, 6) = ""
                .TextMatrix(lngRow, 1) = 0
                .TextMatrix(lngRow, 2) = 0
                strSql = "UPDATE Account SET lngDebitAccountID=0,lngCreditAccountID=0 " _
                    & "WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
                gclsBase.ExecSQL strSql
            End If
        End If
    End With
    If strMsg <> "" And Not blnCheck Then
        ShowMsg hwnd, strMsg, vbOKOnly + vbExclamation, Caption
    End If
    ChoiceOne = (strMsg = "")
End Function

Private Sub stabWizard_Click(PreviousTab As Integer)
    Dim intCnt As Integer
    Dim objHwnd As Long
    
    For intCnt = 0 To stabWizard.Tabs - 1
        fraWizard(intCnt).Visible = (intCnt = stabWizard.Tab)
    Next intCnt
    
    ' 若向导进入其他步骤，进行该步骤合法检查
    If stabWizard.Tab > mintStep And mintStep < mintStepNum Then
        If ValidStep(mintStep, objHwnd) Then
            mintStep = stabWizard.Tab
            
            '初始向导步骤
            InitStep mintStep
            
        End If
    Else
        mintStep = stabWizard.Tab
        InitStep mintStep
        RefreshCmd
    End If
    
    If stabWizard.Tab = stabWizard.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    End If
    If objHwnd > 0 Then
        SendMessage objHwnd, WM_SETFOCUS, 0, 0
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'向导公用过程
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 向导每步合法检查
Private Function ValidStep(ByVal TabIndex As Integer, Optional objHwnd As Long) As Boolean
    Dim strMsg As String, lngBottom As Integer
    
    objHwnd = 0
    
    Select Case TabIndex
    Case 0: ValidStep = ValidRate(strMsg, objHwnd)         '期末汇率
    Case 1: ValidStep = ValidAccount(strMsg)       '损益科目
    Case 2: ValidStep = ValidOption(strMsg)        '凭证选项
    Case 3: ValidStep = True
    Case 4: ValidStep = ValidResult(strMsg)        '执行调汇
    Case Else
        ValidStep = True
    End Select
    
    '返回上一步
    If Not ValidStep Then
        If mintStep < stabWizard.Tab Then
            stabWizard.Tab = mintStep
        Else
            mintStep = stabWizard.Tab
            RefreshCmd
        End If
        ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
    End If
    
    '设置每步合法性
    If TabIndex <> -1 Then
        mblnValid(TabIndex) = ValidStep
    End If
    
End Function

' 向导每步初始设置
Private Sub InitStep(TabIndex As Integer)
    Dim lngCnt As Long
    
    Me.MousePointer = vbHourglass
    Select Case TabIndex
    Case 0: InitRate          '期末汇率
    Case 1: InitAccount       '损益科目
    Case 2: InitOption        '凭证选项
    Case 3, 4:
        For lngCnt = 0 To TabIndex - 1
            If Not mblnValid(lngCnt) Then
                stabWizard.Tab = lngCnt
            End If
        Next lngCnt
        InitResult        '执行调汇
    End Select
    RefreshCmd
    Me.MousePointer = vbDefault
End Sub

' 向导完成后需执行的操作
Private Sub Execute()
    Dim lngCnt As Long, lngCntDetail As Long
    Dim errNo As Long
    Dim blnSave As Boolean
    
    On Error GoTo ErrHandle
    
    For lngCnt = 0 To UBound(VoucherData)
        If VoucherData(lngCnt).Used Then
            VoucherData(lngCnt).TemplateID = lstxtTemplate.TextMatrix(lstxtTemplate.ReferRow, 1)
            VoucherData(lngCnt).VoucherTypeID = lstxtType.TextMatrix(lstxtType.ReferRow, 1)
            For lngCntDetail = 0 To UBound(VoucherData(lngCnt).Detail)
                VoucherData(lngCnt).Detail(lngCntDetail).Remark = lstxtRemark.Text
            Next lngCntDetail
        End If
    Next lngCnt
    
    gclsBase.BaseWorkSpace.BeginTrans
    blnSave = SaveVoucher(VoucherData)
    If blnSave Then
        gclsBase.BaseWorkSpace.CommitTrans
    Else
        gclsBase.BaseWorkSpace.RollBacktrans
    End If
    
    If Not blnSave Then
        If VoucherData(0).ErrorString <> "" Then
            ShowMsg hwnd, "凭证生成失败：" & VoucherData(0).ErrorString, vbOKOnly + vbCritical, Caption
        Else
            ShowMsg hwnd, "没有凭证生成！", vbOKOnly + vbCritical, Caption
        End If
    Else
        SaveSet 1, "科目计息", "开始日期", cldEndDate.Text, True, "String"
        Me.Hide
        gclsSys.SendMessage Me.hwnd, msgReceipt41
        If gclsBase.ControlAccount Then
            gclsSys.SendMessage Me.hwnd, msgReceipt36
        End If
        BillPublic.ShowBill 50, VoucherData(0).VoucherID
    End If
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
End Sub

Private Sub cmdStep_Click(Index As Integer)
    Dim blnUnload As Boolean
    Dim strMsg As String
    
    blnUnload = False
    
    Select Case Index
    Case 0  '取消
        blnUnload = True
    Case 1  '上一步
        If stabWizard.Tab > 0 Then
            stabWizard.Tab = stabWizard.Tab - 1
        End If
    Case 2  '下一步
        If stabWizard.Tab < mintStepNum Then
            stabWizard.Tab = stabWizard.Tab + 1
        End If
    Case 3, 4: '完成
        If ValidStep(mintStepNum) Then
            cmdStep(3).Enabled = False
            Execute
            blnUnload = True
        End If
    End Select
    
    If blnUnload Then
       Unload Me
    End If
End Sub

'重设按扭显示属性
Private Sub RefreshCmd()
    Dim lngCnt As Long
    
    Select Case stabWizard.Tab
    Case 0
        cmdStep(1).Enabled = False
        cmdStep(2).Enabled = True
    Case mintStepNum
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = False
    Case Else
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = True
    End Select
    
    '是否每步都合法
    For lngCnt = 0 To mintStepNum
        If Not mblnValid(lngCnt) Then
            Exit For
        End If
    Next lngCnt
    cmdStep(3).Enabled = (lngCnt > mintStepNum)
    
    '若是最后一步，把完成按扭变为有效
    If Not cmdStep(3).Enabled Then
        If stabWizard.Tab = mintStepNum Then
            cmdStep(3).Enabled = True
        End If
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  向导步骤初始化
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步：结转损益科目初始
Private Function InitRate()
    If fraWizard(0).Tag <> "已设置" Then
        fraWizard(0).Tag = "已设置"
        
        txtRate.Text = GetSet(1, "科目计息", "利率", 0)
        If C2Dbl(txtRate.Text) = 0 Then txtRate.Text = ""
        cldBeginDate.Text = GetSet(1, "科目计息", "开始日期", Format(gclsBase.BaseDate, "yyyy-mm-dd"))
        cldEndDate.Text = Format(gclsBase.BaseDate, "yyyy-mm-dd")
    End If

    fraWizard(3).Tag = ""

End Function

'第二步：损益科目初始
Private Function InitAccount()
    Dim lngID As Long