frmaccountfixedasset.frm

金算盘软件代码

'返回用于填充固定资产卡片资料列表的记录集
Private Function GetFixedCardList() As rdoResultset
    Dim strSql As String
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strCondition As String
    
    mclsList.FormatData = False
    With mclsList.ListSet
        strSelectOfSql = "SELECT FixedCard.lngFixedCardID," & .SelectOfSql
        strFromOfSql = .FromOfSql
        strWhereOfSql = .WhereOfSql
    End With
    strSql = strSelectOfSql & strFromOfSql
    If Trim(strWhereOfSql) <> "" Then
        strSql = strSql & " WHERE " & strWhereOfSql
    End If
    Set GetFixedCardList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    
    If GetFixedCardList.EOF Then
        cmdSeekAgain.Enabled = False
    Else
        cmdSeekAgain.Enabled = True
    End If
End Function


'生成编辑菜单
Private Sub GetListEditMenu()
    Dim lngCnt As Long
    
    With frmMain
        For lngCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
                Unload .mnuListEditMenu(lngCnt)
        Next lngCnt
        Select Case tabList.TabCaption(tabList.Tab)
            Case "变动资料(&Z)"
                .mnuListEditMenu(0).Caption = "增加固定资产(&N)"
                Load .mnuListEditMenu(1)
                .mnuListEditMenu(1).Caption = "减少固定资产(&L)"
                Load .mnuListEditMenu(2)
                .mnuListEditMenu(2).Caption = "其它变动(&O)"
                Load .mnuListEditMenu(3)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(3)
                Load .mnuListEditMenu(4)
                .mnuListEditMenu(4).Caption = "修改(&E)"
                Load .mnuListEditMenu(5)
                .mnuListEditMenu(5).Caption = "删除(&D)"
                Load .mnuListEditMenu(6)
                .mnuListEditMenu(6).Caption = "复制卡片(&C)"
                Load .mnuListEditMenu(7)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(7)
                Load .mnuListEditMenu(8)
                .mnuListEditMenu(8).Caption = "卡片查阅(&S)"
                Load .mnuListEditMenu(9)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(9)
                Load .mnuListEditMenu(10)
                .mnuListEditMenu(10).Caption = "筛选(&F)"
                Load .mnuListEditMenu(11)
                .mnuListEditMenu(11).Caption = "栏目设置(&M)"
                Load .mnuListEditMenu(12)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(12)
                Load .mnuListEditMenu(13)
                .mnuListEditMenu(13).Caption = "刷新(&R)"
                Load .mnuListEditMenu(14)
                .mnuListEditMenu(14).Caption = "打印单据(&T)..."
                Load .mnuListEditMenu(15)
                .mnuListEditMenu(15).Caption = "打印(&P)..."
                
                If IsCanDo(119, gclsBase.OperatorID) Then
                    .mnuListEditMenu(0).Enabled = True
                    .mnuListEditMenu(1).Enabled = True
                    .mnuListEditMenu(2).Enabled = True
                    .mnuListEditMenu(4).Enabled = (msgGrid.Rows > 1)
                    .mnuListEditMenu(5).Enabled = (msgGrid.Rows > 1)
                    .mnuListEditMenu(6).Enabled = (msgGrid.Rows > 1)
                Else
                    .mnuListEditMenu(0).Enabled = False
                    .mnuListEditMenu(1).Enabled = False
                    .mnuListEditMenu(2).Enabled = False
                    .mnuListEditMenu(4).Enabled = False
                    .mnuListEditMenu(5).Enabled = False
                    .mnuListEditMenu(6).Enabled = False
                End If
                .mnuListEditMenu(7).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(8).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(10).Enabled = True
                .mnuListEditMenu(11).Enabled = True
                .mnuListEditMenu(13).Enabled = True
                .mnuListEditMenu(14).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(15).Enabled = (msgGrid.Rows > 1)
            Case "工作量(&W)"
                .mnuListEditMenu(0).Caption = "复制工作量(&C)"
                Load .mnuListEditMenu(1)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(1)
                Load .mnuListEditMenu(2)
                .mnuListEditMenu(2).Caption = "全部清除(&A)"
                Load .mnuListEditMenu(3)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(3)
                Load .mnuListEditMenu(4)
                .mnuListEditMenu(4).Caption = "筛选(&F)"
                Load .mnuListEditMenu(5)
                .mnuListEditMenu(5).Caption = "栏目设置(&M)"
                Load .mnuListEditMenu(6)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(6)
                Load .mnuListEditMenu(7)
                .mnuListEditMenu(7).Caption = "刷新(&R)"
                Load .mnuListEditMenu(8)
                .mnuListEditMenu(8).Caption = "打印(&P)..."
                
                .mnuListEditMenu(0).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(2).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(4).Enabled = True
                .mnuListEditMenu(5).Enabled = True
                .mnuListEditMenu(7).Enabled = True
                .mnuListEditMenu(8).Enabled = (msgGrid.Rows > 1)
                
            Case "固资卡片(&D)"
                .mnuListEditMenu(0).Caption = "卡片查阅(&S)"
                Load .mnuListEditMenu(1)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(1)
                Load .mnuListEditMenu(2)
                .mnuListEditMenu(2).Caption = "筛选(&F)"
                Load .mnuListEditMenu(3)
                .mnuListEditMenu(3).Caption = "栏目设置(&M)"
                Load .mnuListEditMenu(4)
                Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(4)
                Load .mnuListEditMenu(5)
                .mnuListEditMenu(5).Caption = "刷新(&R)"
                Load .mnuListEditMenu(6)
                .mnuListEditMenu(6).Caption = "打印单据(&T)..."
                Load .mnuListEditMenu(7)
                .mnuListEditMenu(7).Caption = "打印(&P)..."
        
                .mnuListEditMenu(0).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(2).Enabled = True
                .mnuListEditMenu(3).Enabled = True
                .mnuListEditMenu(5).Enabled = True
                .mnuListEditMenu(6).Enabled = (msgGrid.Rows > 1)
                .mnuListEditMenu(7).Enabled = (msgGrid.Rows > 1)
        End Select
    End With
End Sub

'生成报表菜单
Private Sub GetListReportMenu()
    Dim lngCnt As Long
    
    With frmMain
        For lngCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(lngCnt)
        Next lngCnt
        .mnuListReportMenu(0).Caption = "固定资产清单(&L)"
        .mnuListReportMenu(0).Enabled = True
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "固定资产汇总表(&H)"
        Load .mnuListReportMenu(2)
        .mnuListReportMenu(2).Caption = "固定资产变动情况明细表(&M)"
        If gclsBase.AccountSys <> "3" Then
            Load .mnuListReportMenu(3)
            .mnuListReportMenu(3).Caption = "固定资产折旧计算表(&C)"
            Load .mnuListReportMenu(4)
            .mnuListReportMenu(4).Caption = "固定资产及累计折旧明细帐(&Z)"
        End If
    End With
End Sub

'刷新MDI主窗体菜单
Private Sub RefreshMenu()
    Select Case tabList.TabCaption(tabList.Tab)
    Case "变动资料(&Z)"
        With frmMain
            .mnuEditCopy.Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuEditNew.Enabled = True
            .mnuEditDel.Enabled = False
            .mnuEditInActive.Enabled = False
            .mnuEditShowAll.Checked = False
            .mnuEditShowAll.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuEditColumn.Enabled = True
            .mnuEditFilter.Enabled = True
            .mnuEditSearch.Enabled = True
            .mnuEditNotepad.Enabled = False
            .mnuEditShowList.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuFilePrintSetup.Enabled = False
            .mnuFilePrint.Enabled = False
            .mnuFilePrintReceipt.Enabled = False
            .mnuToolRefresh.Enabled = True
            If msgGrid.Rows > 1 Then
                .mnuEditEdit.Enabled = True
                .mnuEditDel.Enabled = True
                .mnuFilePrint.Enabled = True
                .mnuFilePrintSetup.Enabled = True
                .mnuFilePrintReceipt.Enabled = True
                .SetToolBar
            End If
        End With
    Case "工作量(&W)"
        With frmMain
            .mnuEditCopy.Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuEditNew.Enabled = False
            .mnuEditDel.Enabled = False
            .mnuEditInActive.Enabled = False
            .mnuEditShowAll.Checked = False
            .mnuEditShowAll.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuEditColumn.Enabled = True
            .mnuEditFilter.Enabled = True
            .mnuEditSearch.Enabled = False
            .mnuEditNotepad.Enabled = False
            .mnuEditShowList.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuFilePrintSetup.Enabled = False
            .mnuFilePrint.Enabled = False
            .mnuFilePrintReceipt.Enabled = False
            .mnuToolRefresh.Enabled = True
            .SetToolBar
        End With
    Case "固资卡片(&D)"
        With frmMain
            .mnuEditCopy.Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuEditNew.Enabled = False
            .mnuEditDel.Enabled = False
            .mnuEditInActive.Enabled = False
            .mnuEditShowAll.Checked = False
            .mnuEditShowAll.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuEditColumn.Enabled = True
            .mnuEditFilter.Enabled = True
            .mnuEditSearch.Enabled = False
            .mnuEditNotepad.Enabled = False
            .mnuEditShowList.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuFilePrintSetup.Enabled = True
            .mnuFilePrint.Enabled = True
            .mnuFilePrintReceipt.Enabled = True
            .mnuToolRefresh.Enabled = True
            .SetToolBar
        End With
    End Select
End Sub

'删除选中的固资变动资料
Private Function DeleteFix() As Boolean
    Dim strSql As String
    Dim recAlter As rdoResultset
    Dim recCard As rdoResultset
    Dim recBalance As rdoResultset
    Dim recVoucher As rdoResultset
    Dim lngLastFixedAlterID As Long
    Dim intYear As Integer
    Dim bytPeriod As Integer
    Dim lngAlterID As Long
    Dim lngCardID As Long
    Dim strDate As String
    Dim errNo As Long
    
    With msgGrid
        strDate = GetValue(.Row, GetGridCol("变动日期", msgGrid), "String")
        lngAlterID = GetValue(.Row, 1)
        lngCardID = GetValue(.Row, 2)
    End With
    If Not IsDate(strDate) Then
        Exit Function
    End If
    bytPeriod = gclsBase.PeriodOfDate(CDate(strDate))
    intYear = gclsBase.FYearOfDate(CDate(strDate))
    If gclsBase.PeriodClosed(strDate) Then
        ShowMsg hwnd, intYear & "." & bytPeriod & "期已结帐，不能修改变动资料！", vbExclamation, Me.Caption
        Exit Function
    End If
    If PeriodDepection(intYear, bytPeriod, 1, False) Then
        NextPeriod intYear, bytPeriod, 1
        ShowMsg hwnd, intYear & "." & bytPeriod & "期(或以后期间)数据已提折旧，不能删除！", vbExclamation, Me.Caption
        Exit Function
    End If
    
    If AlterExistVoucher(lngAlterID) Then
        ShowMsg hwnd, "不能删除已生成凭证的变动资料！", vbExclamation, Me.Caption
        Exit Function
    End If
    
    strSql = "SELECT * FROM FixedAlter WHERE lngLastFixedAlterID=" & lngAlterID
    Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recAlter.EOF Then
        ShowMsg hwnd, "该固定资产在以后期间又发生过变动，不能删除！", vbExclamation, Me.Caption
        recAlter.Close
        Exit Function
    End If
    recAlter.Close
    
    strSql = "SELECT * FROM FixedCard WHERE NOT LTRIM(strStartDate) IS NULL AND lngCreateFixedAlterID=" & lngAlterID
    Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recAlter.EOF Then
        If PeriodDepection(intYear, bytPeriod, 0, False) Then
            If FixedDeprection(lngCardID, intYear, bytPeriod) Then
                ShowMsg hwnd, intYear & "." & bytPeriod & "期(或以后期间)数据已提折旧，不能删除！", vbExclamation, Me.Caption
                recAlter.Close
                Exit Function
            End If
        End If
    End If
    recAlter.Close
    
    If ShowMsg(hwnd, "你是否确定要删除该变动资料?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) <> vbYes Then
        Exit Function
    End If
    
    On Error GoTo HandleErr
    gclsBase.BaseWorkSpace.BeginTrans
    
    strSql = "SELECT * FROM FixedAlter WHERE lngFixedAlterID=" & lngAlterID & " FOR UPDATE NOWAIT"
    Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recAlter.EOF Then
        lngLastFixedAlterID = recAlter!lngLastFixedAlterID
        strSql = "DELETE FROM FixedAlter WHERE lngFixedAlterID=" & lngAlterID
        If Not gclsBase.ExecSQL(strSql) Then GoTo HandleErr
        strSql = "DELETE FROM FixedDepartment WHERE lngFixedAlterID=" & lngAlterID
        If Not gclsBase.ExecSQL(strSql) Then GoTo HandleErr
        strSql = "DELETE FROM FixedCost WHERE lngFixedAlterID=" & lngAlterID
        If Not gclsBase.ExecSQL(strSql) Then GoTo HandleErr
        strSql = "DELETE FROM FixedAccount WHERE lngFixedAlterID=" & lngAlterID
        If Not gclsBase.ExecSQL(strSql) Then GoTo HandleErr
        strSql = "SELECT * FROM FixedAlter WHERE lngFixedCardID=" & lngCardID _
            & " AND TO_DATE(strDate,'YYYY-MM-DD')>TO_DATE('" & strDate & "','YYYY-MM-DD') AND lngFixedAlterID>" & lngAlterID & " ORDER BY TO_DATE(strDate,'YYYY-MM-DD')"
        Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If lngLastFixedAlterID = 0 Then
            If Not recAlter.EOF Then
                '第一条变动记录删除
                strSql = "UPDATE FixedAlter SET lngLastFixedAlterID=0 WHERE lngFixedAlterID=" & recAlter!lngFixedAlterID
                If gclsBase.ExecSQL(strSql) Then GoTo HandleErr
                strSql = "UPDATE FixedCard SET lngCreateFixedAlterID=" & recAlter!lngFixedAlterID _