frmaccountinitdetail.frm

金算盘软件代码

                    For intCount = 2 To .Rows - 1
                        '保存余额表
                        If .RowData(intCount) And &H1C Then
                            If Not SaveBalance(intCount) Then
                                SaveInit = False
                                gclsBase.BaseWorkSpace.RollBacktrans
                                Exit Function
                            End If
                        End If
                    Next
                    mblnIsChange = False
                    SaveInit = True
                    gclsBase.BaseWorkSpace.CommitTrans
                    '发出科目期初消息
                    gclsSys.SendMessage CStr(Me.hwnd), Message.msgAccountInit
                    For intCount = 2 To .Rows - 1
                        .RowData(intCount) = 0
                        If .TextMatrix(intCount, 6) <> "" Or .TextMatrix(intCount, 7) <> "" Or _
                            .TextMatrix(intCount, 8) <> "" Then
                            .RowData(intCount) = .RowData(intCount) Or &H1
                        End If
                        If .TextMatrix(intCount, 9) <> "" Or .TextMatrix(intCount, 10) <> "" Or _
                            .TextMatrix(intCount, 11) <> "" Or .TextMatrix(intCount, 12) <> "" Or _
                            .TextMatrix(intCount, 13) <> "" Or .TextMatrix(intCount, 14) <> "" Then
                            .RowData(intCount) = .RowData(intCount) Or &H2
                        End If
                        For intCnt = 0 To 5
                            .TextMatrix(intCount, intCnt + 24) = .TextMatrix(intCount, intCnt + 18)
                        Next
                    Next
                Else
                    mblnIsChange = False
                    SaveInit = True
                End If
            Else
                SaveInit = False
            End If
        Else
            SaveInit = True
        End If
    End With
End Function

'判断辅助核算是否为末级
Private Function IsDetail(intIndex As Integer, lngID As Long) As Boolean
    Dim strSQL As String
    Dim recTemp As rdoResultset
    
    Select Case intIndex
        Case 19
            strSQL = "SELECT blnIsDetail FROM Department WHERE lngDepartmentID=" & lngID
        Case 22
            strSQL = "SELECT blnIsDetail FROM Class1 WHERE lngClassID=" & lngID
        Case 23
            strSQL = "SELECT blnIsDetail FROM Class2 WHERE lngClassID=" & lngID
    End Select
    Select Case intIndex
        Case 19, 22, 23
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
            If recTemp.RowCount > 0 Then
                IsDetail = recTemp!blnIsDetail
            Else
                IsDetail = True
            End If
        Case Else
            IsDetail = True
    End Select
End Function

Private Function GetDirect(ByVal lngAccountID As Long) As Integer
  Dim strSQL As String, rstDirect As rdoResultset
    
    strSQL = "Select intDirection From Account Where Account.lngAccountID=" & lngAccountID
    Set rstDirect = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    With rstDirect
       If .EOF Then
          Set rstDirect = Nothing
          GetDirect = 0
          Exit Function
       Else
          GetDirect = !intDirection
       End If
    End With
    Set rstDirect = Nothing
End Function

'得到余额表新增SQL语句
Private Function GetInsertBalance(dblValue() As Double, lngID() As Long, blnIsCashBank As Boolean) As String
    Dim intCount As Integer
    Dim dblValueUnVocher(2) As Double
    Dim intDirect As Integer
    
    For intCount = 0 To 2
        If blnIsCashBank Then
            dblValueUnVocher(intCount) = dblValue(intCount)
        Else
            dblValueUnVocher(intCount) = 0
        End If
    Next
    
    intDirect = GetDirect(mlngAccountID)
    If intDirect = 0 Then
       Exit Function
    End If
    If intDirect = 1 Then
        GetInsertBalance = "Insert Into AccountDaily (strDate,lngAccountID,lngCurrencyID,lngCustomerID" _
            & ",lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2,dblCurrencyPostedDebit" _
            & ",dblPostedDebit,dblQuantityPostedDebit,dblCurrencyUnVoucherDebit,dblUnVoucherDebit" _
            & ",dblQuantityUnVoucherDebit) Values ('" & Format(DateAdd("D", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "'," & mlngAccountID & "," _
            & mlngCurrencyID & "," & lngID(0) & "," & lngID(1) & "," & lngID(2) & "," _
            & lngID(4) & "," & lngID(5) & "," & dblValue(0) & "," & dblValue(1) & "," & dblValue(2) & "," _
            & dblValueUnVocher(0) & "," & dblValueUnVocher(1) & "," & dblValueUnVocher(2) & ")"
    Else
        GetInsertBalance = "Insert Into AccountDaily (strDate,lngAccountID,lngCurrencyID,lngCustomerID" _
            & ",lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2,dblCurrencyPostedCredit" _
            & ",dblPostedCredit,dblQuantityPostedCredit,dblCurrencyUnVoucherCredit,dblUnVoucherCredit" _
            & ",dblQuantityUnVoucherCredit) Values ('" & Format(DateAdd("D", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "'," & mlngAccountID & "," _
            & mlngCurrencyID & "," & lngID(0) & "," & lngID(1) & "," & lngID(2) & "," _
            & lngID(4) & "," & lngID(5) & "," & dblValue(0) & "," & dblValue(1) & "," & dblValue(2) & "," _
            & dblValueUnVocher(0) & "," & dblValueUnVocher(1) & "," & dblValueUnVocher(2) & ")"
    End If
End Function

'得到余额表更改SQL语句
Private Function GetUpdateBalance(dblValue() As Double, lngID() As Long, blnIsCashBank As Boolean) As String
  Dim intDirect As Integer
    
    intDirect = GetDirect(mlngAccountID)
    If intDirect = 0 Then
       Exit Function
    End If
    If intDirect = 1 Then
        If blnIsCashBank Then
            GetUpdateBalance = "Update AccountDaily Set dblCurrencyPostedDebit=" & dblValue(0) _
                & ",dblPostedDebit=" & dblValue(1) & ",dblQuantityPostedDebit=" & dblValue(2) _
                & ",dblCurrencyUnVoucherDebit=" & dblValue(0) _
                & ",dblUnVoucherDebit=" & dblValue(1) & ",dblQuantityUnVoucherDebit=" & dblValue(2) _
                & " Where strDate='" & Format(DateAdd("d", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "' And lngAccountID=" & mlngAccountID _
                & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
                & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
                & lngID(4) & " And lngClassID2=" & lngID(5)
        Else
            GetUpdateBalance = "Update AccountDaily Set dblCurrencyPostedDebit=" & dblValue(0) _
                & ",dblPostedDebit=" & dblValue(1) & ",dblQuantityPostedDebit=" & dblValue(2) _
                & " Where strDate='" & Format(DateAdd("d", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "' And lngAccountID=" & mlngAccountID _
                & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
                & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
                & lngID(4) & " And lngClassID2=" & lngID(5)
        End If
    Else
        If blnIsCashBank Then
            GetUpdateBalance = "Update AccountDaily Set dblCurrencyPostedCredit=" & dblValue(0) _
                & ",dblPostedCredit=" & dblValue(1) & ",dblQuantityPostedCredit=" & dblValue(2) _
                & ",dblCurrencyUnVoucherCredit=" & dblValue(0) _
                & ",dblUnVoucherCredit=" & dblValue(1) & ",dblQuantityUnVoucherCredit=" & dblValue(2) _
                & " Where strDate='" & Format(DateAdd("d", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "' And lngAccountID=" & mlngAccountID _
                & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
                & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
                & lngID(4) & " And lngClassID2=" & lngID(5)
        Else
            GetUpdateBalance = "Update AccountDaily Set dblCurrencyPostedCredit=" & dblValue(0) _
                & ",dblPostedCredit=" & dblValue(1) & ",dblQuantityPostedCredit=" & dblValue(2) _
                & " Where strDate='" & Format(DateAdd("d", -1, gclsBase.FirstDate), "yyyy-mm-dd") & "' And lngAccountID=" & mlngAccountID _
                & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
                & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
                & lngID(4) & " And lngClassID2=" & lngID(5)
        End If
    End If
End Function

'得到发生额表新增SQL语句
Private Function GetInsertDaily(dblValue() As Double, lngID() As Long, blnIsCashBank As Boolean) As String
    Dim intCount As Integer
    Dim dblValueUnVoucher(8) As Double
    
    For intCount = 3 To 8
        If blnIsCashBank Then
            dblValueUnVoucher(intCount) = dblValue(intCount)
        Else
            dblValueUnVoucher(intCount) = 0
        End If
    Next
    GetInsertDaily = "Insert Into AccountDaily (strDate,lngAccountID,lngCurrencyID,lngCustomerID" _
        & ",lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2,dblCurrencyPostedDebit" _
        & ",dblPostedDebit,dblQuantityPostedDebit,dblCurrencyPostedCredit,dblPostedCredit" _
        & ",dblQuantityPostedCredit,dblCurrencyUnVoucherDebit" _
        & ",dblUnVoucherDebit,dblQuantityUnVoucherDebit,dblCurrencyUnVoucherCredit,dblUnVoucherCredit" _
        & ",dblQuantityUnVoucherCredit) Values ('" & mstrDate & "'," & mlngAccountID & "," _
        & mlngCurrencyID & "," & lngID(0) & "," & lngID(1) & "," & lngID(2) & "," _
        & lngID(4) & "," & lngID(5) & "," & dblValue(3) & "," & dblValue(4) & "," & dblValue(5) _
        & "," & dblValue(6) & "," & dblValue(7) & "," & dblValue(8) & "," & dblValueUnVoucher(3) & "," _
        & dblValueUnVoucher(4) & "," & dblValueUnVoucher(5) _
        & "," & dblValueUnVoucher(6) & "," & dblValueUnVoucher(7) & "," & dblValueUnVoucher(8) & ")"
End Function

'得到发生额表更改SQL语句
Private Function GetUpdateDaily(dblValue() As Double, lngID() As Long, blnIsCashBank As Boolean) As String
    If blnIsCashBank Then
        GetUpdateDaily = "Update AccountDaily Set dblCurrencyPostedDebit=" & dblValue(3) & ",dblPostedDebit=" _
            & dblValue(4) & ",dblQuantityPostedDebit=" & dblValue(5) & ",dblCurrencyPostedCredit=" _
            & dblValue(6) & ",dblPostedCredit=" & dblValue(7) & ",dblQuantityPostedCredit=" & dblValue(8) _
            & ",dblCurrencyUnVoucherDebit=" & dblValue(3) & ",dblUnVoucherDebit=" _
            & dblValue(4) & ",dblQuantityUnVoucherDebit=" & dblValue(5) & ",dblCurrencyUnVoucherCredit=" _
            & dblValue(6) & ",dblUnVoucherCredit=" & dblValue(7) & ",dblQuantityUnVoucherCredit=" _
            & dblValue(8) & " Where strDate>='" & gclsBase.FirstDate & "' And strDate<='" & mstrDate & "' And lngAccountID=" & mlngAccountID _
            & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
            & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
            & lngID(4) & " And lngClassID2=" & lngID(5)
    Else
        GetUpdateDaily = "Update AccountDaily Set dblCurrencyPostedDebit=" & dblValue(3) & ",dblPostedDebit=" _
            & dblValue(4) & ",dblQuantityPostedDebit=" & dblValue(5) & ",dblCurrencyPostedCredit=" _
            & dblValue(6) & ",dblPostedCredit=" & dblValue(7) & ",dblQuantityPostedCredit=" & dblValue(8) _
            & " Where  strDate>='" & gclsBase.FirstDate & "' And strDate='" & mstrDate & "' And lngAccountID=" & mlngAccountID _
            & " And lngCurrencyID=" & mlngCurrencyID & " And lngCustomerID=" & lngID(0) & " And lngDepartmentID=" _
            & lngID(1) & " And lngEmployeeID=" & lngID(2) & " And lngClassID1=" _
            & lngID(4) & " And lngClassID2=" & lngID(5)
    End If
End Function

'得到核算项目ID及金额
Private Function GetValue(ByVal intRow As Integer, dblValue() As Double, dblOldValue() As Double, lngID() As Long _
    , lngOldID() As Long) As Boolean
    
    Dim intCount As Integer
    
    If lstAccountInitDetail(0).ID = 0 Then
        ShowMsg Me.hwnd, "科目不能为空，必须选择！", vbInformation, "科目期初明细"
        lstAccountInitDetail(0).SetFocus
        GetValue = False
        Exit Function
    End If
    If lstAccountInitDetail(1).ID = 0 Then
        ShowMsg Me.hwnd, "币种不能为空，必须选择！", vbInformation, "科目期初明细"
        lstAccountInitDetail(0).SetFocus
        GetValue = False
        Exit Function
    End If
    With msgAccountInitDetail(1)
        For intCount = 18 To 23
            If .ColWidth(intCount - 18) > 0 And .ColData(intCount - 18) = 1 And .TextMatrix(intRow, intCount) = 0 Then
                ShowMsg Me.hwnd, msgAccountInitDetail(0).TextMatrix(0, intCount - 18) _
                     & "不能为空，必须选择！", vbInformation, "科目期初明细"
                InputStart intRow, intCount - 18
                GetValue = False
                Exit Function
            Else
                If .TextMatrix(intRow, intCount) > 0 Then
                    If Not IsDetail(intCount, .TextMatrix(intRow, intCount)) Then
                        ShowMsg Me.hwnd, .TextMatrix(intRow, intCount - 18) & "不是末级" _
                             & msgAccountInitDetail(0).TextMatrix(0, intCount - 18) & "，请重新选择！", vbInformation, "科目期初明细"
                        InputStart intRow, intCount - 18
                        GetValue = False
                        Exit Function
                    End If
                End If
            End If
        Next
        For intCount = 6 To 14
            If .TextMatrix(intRow, intCount) <> "" Then
                Exit For
            End If
        Next
        If intCount > 14 Then
            ShowMsg Me.hwnd, "数额不能全部为0，请重新输入！", vbInformation, "科目期初明细"
            InputStart intRow, 7
            GetValue = False
            Exit Function
        End If
        For intCount = 0 To 5
            lngID(intCount) = .TextMatrix(intRow, intCount + 18)
            lngOldID(intCount) = .TextMatrix(intRow, intCount + 24)
        Next
        For intCount = 6 To 14
            If .TextMatrix(intRow, intCount) = "" Then
                dblValue(intCount - 6) = 0
            Else
                dblValue(intCount - 6) = CDbl(.TextMatrix(intRow, intCount))
            End If
        Next
        For intCount = 30 To 32
            If .TextMatrix(intRow, intCount) = "" Then