frmfixedinit.frm

金算盘软件代码

    If chkShowAll.Enabled Then
        With msgGrid
            If chkShowAll.Value Then
                lngHeight = .RowHeight(0)
                .ColWidth(0) = 480
            Else
                lngHeight = 0
                .ColWidth(0) = 0
            End If
            For lngRow = 1 To .Rows - 1
                If .TextMatrix(lngRow, 0) = "√" Then
                    .RowHeight(lngRow) = lngHeight
                End If
            Next lngRow
        End With
    End If
End Sub


Private Sub msgGrid_DblClick()
    Dim strSql As String
    Dim recAlter As rdoResultset
    Dim strDate As String
    Dim intYear As Integer
    Dim intPeriod As Integer
    
    If msgGrid.Row > 0 And IsCanDo(119, gclsBase.OperatorID) Then
        strDate = Format(gclsBase.BeginDate, "yyyy-mm-dd")
        intYear = gclsBase.FYearOfDate(strDate)
        intPeriod = gclsBase.PeriodOfDate(strDate)
        If gclsBase.PeriodClosed(gclsBase.BeginDate) Then
            ShowMsg hWnd, "启用期间已结帐，不能修改期初资料！", vbExclamation, Me.Caption
            Exit Sub
        ElseIf PeriodDepection(intYear, intPeriod, 0, False) Then
            ShowMsg hWnd, "固定资产已计提过折旧，不能修改期初资料！", vbExclamation, Me.Caption
            Exit Sub
        Else
            strSql = "SELECT * FROM FixedAlter WHERE lngLastFixedAlterID=" & GetValue(msgGrid.Row, 1)
            Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAlter.EOF Then
                ShowMsg hWnd, "该固定资产在以后期间又发生过变动，不能修改！", vbExclamation, Me.Caption
                recAlter.Close
                Exit Sub
            End If
            recAlter.Close
        End If
        Me.MousePointer = vbHourglass
        With msgGrid
            Select Case GetValue(.Row, 3)
            Case 1 '增加
                frmFixedAdd.EditCard GetValue(.Row, 1), GetValue(.Row, 2), , mblnInit
            End Select
            Form_Activate
        End With
        Me.MousePointer = vbDefault
    End If
End Sub

Private Sub CopyCard()
    Dim strSql As String
    Dim recAlter As rdoResultset
    Dim strDate As String
    Dim intYear As Integer
    Dim intPeriod As Integer
    Dim intCount As Integer
    Dim strName  As String
    
    If msgGrid.Row > 0 And IsCanDo(119, gclsBase.OperatorID) Then
        strDate = Format(gclsBase.BeginDate, "yyyy-mm-dd")
        intYear = gclsBase.FYearOfDate(strDate)
        intPeriod = gclsBase.PeriodOfDate(strDate)
        If gclsBase.PeriodClosed(gclsBase.BeginDate) Then
            ShowMsg hWnd, "启用期间已结帐，不能复制卡片！", vbExclamation, Me.Caption
            Exit Sub
        ElseIf PeriodDepection(intYear, intPeriod, 0, False) Then
            ShowMsg hWnd, "固定资产已计提过折旧，不能复制卡片！", vbExclamation, Me.Caption
            Exit Sub
        End If
        Me.MousePointer = vbHourglass
        With msgGrid
            Set frmCopyCard = Nothing
            frmCopyCard.Copy GetValue(.Row, 2), mblnInit
            Set frmCopyCard = Nothing
            Form_Activate
        End With
        Me.MousePointer = vbDefault
    End If
End Sub

Private Sub msgGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim intCount As Integer
    Dim intTmp As Integer
    
    '处理右键菜单
    If Button = vbRightButton Then
        GetListEditMenu '生成菜单
        PopupMenu frmMain.mnuListEdit
        AfterListEdit mintAction
    '处理左键事件
    ElseIf Button = vbLeftButton Then
        With msgGrid
            If .Rows = 1 Then
                Exit Sub
            End If
            '鼠标在有效位置
            If y > .RowPos(1) And y < .RowPos(.Rows - 1) + .RowHeight(0) Then
                With frmMain
                    .mnuEditEdit.Enabled = True
                    .mnuEditDel.Enabled = True
                    .SetToolBar
                End With
            Else
                '鼠标在无效位置
                With frmMain
                    .mnuEditEdit.Enabled = False
                    .mnuEditDel.Enabled = False
                    .SetToolBar
                End With
            End If
        End With
    End If
End Sub

'显示编辑菜单
Private Sub cmdEdit_Click()
    Dim lngX As Long
    Dim lngY As Long
    
    lngX = cmdEdit.Left
    lngY = cmdEdit.top + cmdEdit.Height
    
    GetListEditMenu
    PopupMenu frmMain.mnuListEdit, , lngX, lngY
    AfterListEdit mintAction
End Sub

Private Sub AfterListEdit(intIndex As Integer)
    Dim strDate As String
    Dim intYear As Integer
    Dim intPeriod As Integer
    
    If ExclusiveIn("计提折旧", 0, "您现在不能编辑固定资产资料，以下用户正在计提折旧：") Then
        Select Case intIndex
        Case 0
            '修改
            msgGrid_DblClick
        Case 1
            '增加固资
            strDate = Format(gclsBase.BeginDate, "yyyy-mm-dd")
            intYear = gclsBase.FYearOfDate(strDate)
            intPeriod = gclsBase.PeriodOfDate(strDate)
            If gclsBase.PeriodClosed(gclsBase.BeginDate) Then
                ShowMsg hWnd, "启用期间已结帐，不能增加期初资料！", vbExclamation, Me.Caption
                Exit Sub
            ElseIf PeriodDepection(intYear, intPeriod, 0, False) Then
                ShowMsg hWnd, "固定资产已计提过折旧，不能增加期初资料！", vbExclamation, Me.Caption
                Exit Sub
            End If
            Me.MousePointer = vbHourglass
            frmFixedAdd.AddNew mblnInit
            Me.MousePointer = vbDefault
            Form_Activate
        End Select
        intIndex = -1
    End If
End Sub

Private Sub mclsMainControl_EditColumn()
    mclsMainControl_ListEditMenu (7)
End Sub

Private Sub mclsMainControl_EditDel()
    mclsMainControl_ListEditMenu (2)
End Sub

Private Sub mclsMainControl_EditEdit()
    msgGrid_DblClick
End Sub

Private Sub mclsMainControl_EditFilter()
    mclsMainControl_ListEditMenu (6)
End Sub

Private Sub mclsMainControl_EditNew()
    AfterListEdit 1
End Sub

Private Sub mclsMainControl_EditShowAll()
    chkShowAll_Click
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim clsPrint As PrintClass
    
    mclsList.ClearSortColArrow
    Set clsPrint = New PrintClass
    clsPrint.PrintList gclsBase.BaseDB, msgGrid, 12, "固定资产期初列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set clsPrint = Nothing
    mclsList.AddSortColArrow
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim clsPrint As New PrintClass
    
    clsPrint.PrintSetUp gclsBase.BaseDB, msgGrid, , , , 12, "固定资产期初列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set clsPrint = Nothing
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt 38
End Sub

'编辑菜单的click事件处理
Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim lngCnt As Long
    
    With frmMain
        For lngCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
                .mnuListEditMenu(lngCnt).Visible = False
        Next lngCnt
    End With
    
    mintAction = intIndex
    Select Case intIndex
        Case 2
            '删除
            If ExclusiveIn("计提折旧", 0, "您现在不能删除固定资产资料，以下用户正在计提折旧：") Then
                If DeleteFix() Then
                    If msgGrid.Rows = 2 Then
                        RefreshAlterGrid
                    Else
                        msgGrid.RemoveItem msgGrid.Row
                    End If
                End If
            End If
        Case 4
            CopyCard
        Case 6
            '筛选
            SelWithFilter
        Case 7
            '栏目设置
            If mclsList.ListSet.ShowListSet(ViewID_Alter) Then
                RefreshAlterGrid
                chkShowAll_Click
            End If
        Case 9
            '刷新
            RefreshAlterGrid
        Case 10
            '打印
            mclsList.ClearSortColArrow
            Dim clsPrint As New PrintClass
            clsPrint.PrintList gclsBase.BaseDB, msgGrid, _
            12, "固定资产期初列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Set clsPrint = Nothing
            mclsList.AddSortColArrow
        Case 11
            mclsMainControl_FilePrintReceipt
    End Select
End Sub

'返回用于填充固定资产变动资料列表的记录集
Private Function GetFixedAlterList() As rdoResultset
    Dim strSql As String
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim dtmStart As Date
    Dim dtmEnd As Date
    Dim rec As rdoResultset
    
    mclsList.FormatData = False
    
    With mclsList.ListSet
        strSelectOfSql = "SELECT DECODE(FixedAlter.blnIsVoid,1,'√',' ') 作废," _
            & "FixedAlter.lngFixedAlterID,FixedAlter.lngFixedCardID,FixedAlter.bytAlterType," & .SelectOfSql
        strFromOfSql = .FromOfSql
        strWhereOfSql = .WhereOfSql
        If .ListID > 0 Then
            If strWhereOfSql = "" Then
                strWhereOfSql = "1=1"
            End If
        End If
    End With
    If strWhereOfSql <> "" Then
        strWhereOfSql = " WHERE " & strWhereOfSql
    Else
        gclsBase.PeriodOfDate gclsBase.BaseDate, dtmStart, dtmEnd
        strWhereOfSql = " WHERE (1=1) "
    End If
    strWhereOfSql = strWhereOfSql & " AND FixedAlter.bytAlterType = 1 AND " _
        & "TO_DATE(FixedAlter.strDate,'YYYY-MM-DD') < TO_DATE('" _
        & Format(gclsBase.BeginDate, "yyyy-mm-dd") & "','YYYY-MM-DD')"
    
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    Set GetFixedAlterList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If GetFixedAlterList.EOF Then
        cmdSeekAgain.Enabled = False
        chkShowAll.Enabled = False
    Else
        cmdSeekAgain.Enabled = True
        Set rec = GetFixedAlterList
        Do While Not rec.EOF
            If rec("作废").Value = "√" Then Exit Do
            rec.MoveNext
        Loop
        chkShowAll.Enabled = IIf(GetFixedAlterList.EOF, False, 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
        .mnuListEditMenu(0).Caption = "修改(&E)"
        Load .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "新增(&N)"
        Load .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "复制卡片(&A)"
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(5)
        Load .mnuListEditMenu(6)
        .mnuListEditMenu(6).Caption = "筛选(&F)"
        Load .mnuListEditMenu(7)
        .mnuListEditMenu(7).Caption = "栏目设置(&M)"
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(8)
        Load .mnuListEditMenu(9)
        .mnuListEditMenu(9).Caption = "刷新(&R)"
        Load .mnuListEditMenu(10)
        .mnuListEditMenu(10).Caption = "打印(&P)..."
        Load .mnuListEditMenu(11)
        .mnuListEditMenu(11).Caption = "打印单据(&T)..."
        
        If IsCanDo(119, gclsBase.OperatorID) Then
            .mnuListEditMenu(0).Enabled = (msgGrid.Row > 0 And msgGrid.Row < msgGrid.Rows And msgGrid.ColSel = msgGrid.Cols - 1)
            .mnuListEditMenu(1).Enabled = True
            .mnuListEditMenu(2).Enabled = (msgGrid.Row > 0 And msgGrid.Row < msgGrid.Rows And msgGrid.ColSel = msgGrid.Cols - 1)
            .mnuListEditMenu(4).Enabled = (msgGrid.Row > 0 And msgGrid.Row < msgGrid.Rows And msgGrid.ColSel = msgGrid.Cols - 1)
        Else
            .mnuListEditMenu(0).Enabled = False