frmaccountinitdetail.frm

金算盘软件代码

                dblOldValue(intCount - 30) = 0
            Else
                dblOldValue(intCount - 30) = CDbl(.TextMatrix(intRow, intCount))
            End If
        Next
    End With
    GetValue = True
End Function

'保存期初明细
Private Function SaveBalance(ByVal intRow As Integer) As Boolean
    Dim intCount As Integer
    Dim lngID(5) As Long, lngOldID(5) As Long
    Dim dblValue(8) As Double, dblOldValue(3) As Double
    Dim dblZero(8) As Double, dblTempValue(3) As Double
    Dim strSQL As String, strSql1 As String, strsql2 As String, strSql3 As String
    Dim strSql4 As String, strSql5 As String
    Dim blnIsCashBank As Boolean
    Dim intFlag As Integer
    
    If Not GetValue(intRow, dblValue, dblOldValue, lngID, lngOldID) Then
        SaveBalance = False
        Exit Function
    End If
    For intCount = 0 To 8
        dblZero(intCount) = 0
    Next
    blnIsCashBank = ListModule.IsCashBank(mlngAccountID)
    '该明细记录存在
    If msgAccountInitDetail(1).RowData(intRow) And &H3 Then
        strSQL = GetUpdateBalance(dblZero, lngOldID, blnIsCashBank)
        strSql4 = GetUpdateDaily(dblZero, lngOldID, blnIsCashBank)
    End If
    strsql2 = GetInsertBalance(dblValue, lngID, blnIsCashBank)
    strSql5 = GetInsertDaily(dblValue, lngID, blnIsCashBank)
    
    On Error GoTo errhandel:
    intFlag = 1
    If strSQL <> "" Then gclsBase.BaseDB.Execute strSQL
    intFlag = 3
    If strsql2 <> "" Then gclsBase.BaseDB.Execute strsql2
    intFlag = 5
    If strSql4 <> "" Then gclsBase.BaseDB.Execute strSql4
    intFlag = 6
    If strSql5 <> "" Then gclsBase.BaseDB.Execute strSql5
    SaveBalance = True
    Exit Function
errhandel:
    Select Case Err.Number
        Case 3022, 40002
            Select Case intFlag
                Case 3
                    strsql2 = GetUpdateBalance(dblValue, lngID, blnIsCashBank)
                    Resume
                Case 6
                    strSql5 = GetUpdateDaily(dblValue, lngID, blnIsCashBank)
                    Resume
                Case Else
                    ShowMsg Me.hwnd, "科目期初明细保存失败！", vbOKOnly + vbCritical, "科目期初明细"
                    SaveBalance = False
                    Exit Function
            End Select
        Case Else
            ShowMsg Me.hwnd, "科目期初明细保存失败！", vbOKOnly + vbCritical, "科目期初明细"
            SaveBalance = False
            Exit Function
    End Select
End Function

'删除期初明细
Private Function DeleteInit(ByVal intRow As Integer) As Boolean
    Dim intCount As Integer
    Dim lngID(5) As Long
    Dim dblValue(2) As Double
    Dim strSQL As String
    Dim strSql1 As String
    Dim strsql2 As String
    Dim blnIsCashBank As Boolean
    
    With msgAccountInitDetail(1)
        For intCount = 24 To 29
            lngID(intCount - 24) = .TextMatrix(intRow, intCount)
        Next
        blnIsCashBank = ListModule.IsCashBank(mlngAccountID)
        If blnIsCashBank Then
            If gclsBase.FirstDate <> gclsBase.BeginDate Then
                strSQL = "Update AccountDaily Set dblCurrencyPostedDebit=0" _
                    & ",dblPostedDebit=0,dblQuantityPostedDebit=0,dblCurrencyPostedCredit=0" _
                    & ",dblPostedCredit=0,dblQuantityPostedCredit=0,dblCurrencyUnVoucherDebit=0" _
                    & ",dblUnVoucherDebit=0,dblQuantityUnVoucherDebit=0,dblCurrencyUnVoucherCredit=0" _
                    & ",dblUnVoucherCredit=0,dblQuantityUnVoucherCredit=0" _
                    & " 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
            
            strsql2 = "Update AccountDaily Set dblCurrencyPostedDebit=0" _
                & ",dblPostedDebit=0,dblQuantityPostedDebit=0,dblCurrencyPostedCredit=0" _
                & ",dblPostedCredit=0,dblQuantityPostedCredit=0,dblCurrencyUnVoucherDebit=0" _
                & ",dblUnVoucherDebit=0,dblQuantityUnVoucherDebit=0,dblCurrencyUnVoucherCredit=0" _
                & ",dblUnVoucherCredit=0,dblQuantityUnVoucherCredit=0" _
                & " Where 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
            If gclsBase.FirstDate <> gclsBase.BeginDate Then
                strSQL = "Update AccountDaily Set dblCurrencyPostedDebit=0" _
                    & ",dblPostedDebit=0,dblQuantityPostedDebit=0,dblCurrencyPostedCredit=0" _
                    & ",dblPostedCredit=0,dblQuantityPostedCredit=0" _
                    & " 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
            
            strsql2 = "Update AccountDaily Set dblCurrencyPostedDebit=0" _
                & ",dblPostedDebit=0,dblQuantityPostedDebit=0,dblCurrencyPostedCredit=0" _
                & ",dblPostedCredit=0,dblQuantityPostedCredit=0" _
                & " Where 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 With
    On Error GoTo errhandel:
    gclsBase.BaseWorkSpace.BeginTrans
    If strSQL <> "" Then gclsBase.BaseDB.Execute strSQL
    If strsql2 <> "" Then gclsBase.BaseDB.Execute strsql2
    gclsBase.BaseWorkSpace.CommitTrans
    '发出科目期初消息
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgAccountInit
    DeleteInit = True
    Exit Function
errhandel:
    ShowMsg Me.hwnd, "科目期初明细删除失败！", vbOKOnly + vbCritical, "科目期初明细"
    gclsBase.BaseWorkSpace.RollBacktrans
    DeleteInit = False
    Exit Function
End Function

'删除
Private Sub Delete(ByVal lngRow As Long)
    Dim intOld As Integer
    
    With msgAccountInitDetail(1)
        intOld = .RowData(lngRow)
        If .Rows > 1 And .RowHeight(lngRow) > 0 Then
            If .RowData(lngRow) And &H3 Then
                If DeleteInit(lngRow) Then
                    .RemoveItem lngRow
                Else
                    .RowData(lngRow) = intOld
                End If
            Else
                .RemoveItem lngRow
            End If
        End If
    End With
End Sub

'设置参照
Private Sub SetListText(ByVal Index As Integer)
    Dim strSQL As String
    
    Select Case Index
        Case 0  '单位
            strSQL = "Select lngCustomerID,strCustomerCode,strCustomerName From Customer Where blnIsInActive=0 Order By strCustomerCode"
        Case 1  '部门
            strSQL = "Select lngDepartmentID,strDepartmentCode,strDepartmentName From Department Where blnIsInActive=0 And blnIsDetail=1 Order By strDepartmentCode"
        Case 2  '职员
            strSQL = "Select lngEmployeeID,strEmployeeCode,strEmployeeName From Employee Where blnIsInActive=0 Order By strEmployeeCode"
        Case 3  '工程
            strSQL = "Select lngJobID,strJobCode,strJobName From Job Where blnIsInActive=0 Order By strJobCode"
        Case 4  '统计
            strSQL = "Select lngClassID,strClassCode,strClassName From Class1 Where blnIsInActive=0 And blnIsDetail=1 Order By strClassCode"
        Case 5  '项目
            strSQL = "Select lngClassID,strClassCode,strClassName From Class2 Where blnIsInActive=0 And blnIsDetail=1 Order By strClassCode"
        Case 10  '科目
            strSQL = "Select lngAccountID,strAccountCode,strAccountName From Account Where blnIsDetail=1  Order By strAccountCode"
        Case 11  '币种
            If mblnIsAllCurrency Then
                strSQL = "Select lngCurrencyID,strCurrencyCode,strCurrencyName From Currencys Where blnIsInActive=0"
            End If
    End Select
    Select Case Index
        Case 0, 1, 2, 3, 4, 5
            With lstAccountInitDetail(2)
                .ClearRefer
                .SeekCol = "1,2,3"
                Set .Recordset = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                .AddRefer "<新增>", 0, 1  '设置固定选项
                .AddRefer "<修改>", 1, 1
                .AddRefer "<删除>", 2, 1
            End With
        Case 10
            With lstAccountInitDetail(0)
                .ClearRefer
                .SeekCol = "1,2,3"
                Set .Recordset = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                .AddRefer "<新增>", 0, 1  '设置固定选项
                .AddRefer "<修改>", 1, 1
                .AddRefer "<删除>", 2, 1
            End With
        Case 11
            With lstAccountInitDetail(1)
                .ClearRefer
                .SeekCol = "1,2,3"
                If mblnIsAllCurrency Then
                    Set .Recordset = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                Else
                    strSQL = "Select Currencys.lngCurrencyID,strCurrencyCode,strCurrencyName From Currencys,WrAcntCurrency Where Currencys.lngCurrencyID=WrAcntCurrency.CurrencyID And WrAcntCurrency.lngAccountID=" & mlngAccountID
                    Set lstAccountInitDetail(1).Recordset = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                End If
                If mblnIsMultCurrency Or mblnIsAllCurrency Then
                    .AddRefer "<新增>", 0, 1  '设置固定选项
                    .AddRefer "<修改>", 1, 1
                    .AddRefer "<删除>", 2, 1
                End If
                .ColWidth(2) = .width / 2
                .ColWidth(3) = .width / 2
                .ReferWidth = .width
            End With
    End Select
End Sub

'更新按钮状态
Private Sub UpdateCmdStatus()
    Dim intCount As Integer
    
    If mblnClose Or lstAccountInitDetail(0).ID = 0 Or lstAccountInitDetail(1).ID = 0 Then
        cmdAccountInitDetail(0).Enabled = False
        cmdAccountInitDetail(1).Enabled = False
        cmdAccountInitDetail(2).Enabled = False
    Else
        cmdAccountInitDetail(0).Enabled = True
        If msgAccountInitDetail(1).Rows > 2 Then
            cmdAccountInitDetail(2).Enabled = True
            cmdAccountInitDetail(1).Enabled = True
        Else
            cmdAccountInitDetail(2).Enabled = False
            cmdAccountInitDetail(1).Enabled = False
        End If
    End If
End Sub

'设置GRID
Private Sub SetFlexGrid()
    Dim intCount As Integer
    
    With msgAccountInitDetail(0)
        .RowHeight(2) = 0
        .Cols = 33
        For intCount = 0 To .Cols - 1
            .ColAlignment(intCount) = 4
        Next
        For intCount = 0 To 1
            .TextMatrix(intCount, 0) = "单位"
            .TextMatrix(intCount, 1) = "部门"
            .TextMatrix(intCount, 2) = "职员"
            .TextMatrix(intCount, 3) = "工程"
            .TextMatrix(intCount, 4) = "统计"
            .TextMatrix(intCount, 5) = "项目"
        Next
        .MergeCells = flexMergeFree
        .MergeRow(0) = True
        .MergeRow(1) = True
        .MergeCol(0) = True
        For intCount = 1 To .Cols - 1
            .MergeCol(intCount) = True
        Next
        For intCount = 18 To 32
            .ColWidth(intCount) = 0
        Next
    End With
End Sub

'因科目改变设置GRID中辅助核算列的可见性
Private Sub SetFlexGridByAccount()
    Dim intCount As Integer