frmaccountfixedasset.frm

金算盘软件代码

    
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
        Me.Left = 300
    End If
    
    If Me.WindowState <> vbMinimized Then
        With Me
            If .Width < 7200 Then
                .Width = 7200
            End If
            If .Height < 4500 Then
                .Height = 4500
            End If
        End With
        
        Frame1.Width = Me.ScaleWidth - 2 * ListFormLeft
        Frame1.Left = ListFormLeft
        tabList.Left = ListFormLeft
        tabList.Width = Me.ScaleWidth - ListFormLeft - ListFormRight
        msgGrid.Width = tabList.Width - 300
        msgGrid.Left = tabList.Left + 150
        cmdEdit.Left = ListFormLeft
        cmdEdit.Top = Me.ScaleHeight - cmdEdit.Height - ListFormBottom
        cmdReport.Top = cmdEdit.Top
        cmdReport.Left = cmdEdit.Left + cmdEdit.Width
        tabList.Height = cmdEdit.Top - 80 - tabList.Top
        msgGrid.Top = tabList.Top + 450
        msgGrid.Height = tabList.Height - 600
        chkShowAll.Top = cmdEdit.Top
        chkShowAll.Left = Me.Width - 200 - chkShowAll.Width
        txtFind.Width = Frame1.Left + Frame1.Width - txtFind.Left - cmdSeekAgain.Width - 45
        cmdSeekAgain.Left = txtFind.Left + txtFind.Width + 45
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    gclsSys.MainControls.Remove Me
    Set mclsSubClassform = Nothing
    Set mclsList = Nothing
    Set mclsMainControl = Nothing
End Sub


Private Sub mclsMainControl_ChildActive()
    Form_Activate
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt IIf(tabList.Tab = 0, 36, 37)
End Sub

Private Sub mclsMainControl_ToolRefresh()
    tabList_Click 0
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)

        MinMax.ptMinTrackSize.x = 430
        MinMax.ptMinTrackSize.y = 250

        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

'显示全部卡片资料
Private Sub chkShowAll_Click()
    Dim lngRow As Long
    Dim lngHeight As Long
    
    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
    
    Select Case tabList.TabCaption(tabList.Tab)
    Case "固资卡片(&D)"
        If msgGrid.Row > 0 Then
            frmScanFixCard.EditCard GetValue(msgGrid.Row, GetGridCol("lngFixedCardID", msgGrid))
        End If
    Case "变动资料(&Z)"
        If msgGrid.Row > 0 And IsCanDo(119, gclsBase.OperatorID) Then
            strDate = GetValue(msgGrid.Row, GetGridCol("变动日期", msgGrid), "String")
            intYear = gclsBase.FYearOfDate(strDate)
            intPeriod = gclsBase.PeriodOfDate(strDate)
            If gclsBase.PeriodClosed(strDate) Then
                ShowMsg hwnd, intYear & "." & intPeriod & "期已结帐，不能修改变动资料！", vbExclamation, Me.Caption
                Exit Sub
            ElseIf PeriodDepection(intYear, intPeriod, 1, False) Then
                NextPeriod intYear, intPeriod, 1
                ShowMsg hwnd, intYear & "." & intPeriod & "期(或以后期间)已计提折旧，不能修改变动资料！", 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)
                Case 2 '减少
                    frmFixedDec.EditCard GetValue(.Row, 1), GetValue(.Row, 2)
                Case Else '其它变动
                    Set frmFixedOtherAlter = Nothing
                    frmFixedOtherAlter.EditCard GetValue(.Row, 1), GetValue(.Row, 2)
                End Select
                Form_Activate
            End With
            Me.MousePointer = vbDefault
        End If
    End Select
End Sub

Private Sub CopyCard()
    Dim strSql As String
    Dim strDate As String
    Dim intYear As Integer
    Dim intPeriod As Integer
    Dim intCount As Integer
    Dim strName  As String
    
    On Error Resume Next
    
    If msgGrid.Row > 0 And IsCanDo(119, gclsBase.OperatorID) Then
        strDate = GetValue(msgGrid.Row, GetGridCol("变动日期", msgGrid), "String")
        intYear = gclsBase.FYearOfDate(strDate)
        intPeriod = gclsBase.PeriodOfDate(strDate)
        If gclsBase.PeriodClosed(strDate) Then
            ShowMsg hwnd, intYear & "." & intPeriod & "期已结帐，不能复制卡片！", vbExclamation, Me.Caption
            Exit Sub
        ElseIf PeriodDepection(intYear, intPeriod, 1, False) Then
            NextPeriod intYear, intPeriod, 1
            ShowMsg hwnd, intYear & "." & intPeriod & "期(或以后期间)已计提折旧，不能复制卡片！", vbExclamation, Me.Caption
            Exit Sub
        End If
        Me.MousePointer = vbHourglass
        With msgGrid
            frmCopyCard.Copy GetValue(msgGrid.Row, 2), False
            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 '生成菜单
        If txtEdit.Visible Then
            txtEdit.Tag = ""
            txtEdit.Visible = False
        End If
        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
                If tabList.Tab = 0 Then
                    With frmMain
                        .mnuEditEdit.Enabled = True
                        .mnuEditDel.Enabled = True
                        .SetToolBar
                    End With
                End If
            Else
                '鼠标在无效位置
                If tabList.Tab = 0 Then
                    With frmMain
                        .mnuEditEdit.Enabled = False
                        .mnuEditDel.Enabled = False
                        .SetToolBar
                    End With
                End If
            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 cmdReport_Click()
    Dim lngX As Long
    Dim lngY As Long
    
    lngX = cmdReport.Left
    lngY = cmdReport.Top + cmdReport.Height
    
    GetListReportMenu
    PopupMenu frmMain.mnuListReport, , lngX, lngY
End Sub

Private Sub mclsMainControl_EditColumn()
    Select Case tabList.TabCaption(tabList.Tab)
        Case "变动资料(&Z)"
            mclsMainControl_ListEditMenu (11)
        Case "工作量(&W)"
            mclsMainControl_ListEditMenu (5)
        Case "固资卡片(&D)"
            mclsMainControl_ListEditMenu (3)
    End Select
End Sub

Private Sub mclsMainControl_EditCopy()
'    mclsMainControl_ListEditMenu (11)
End Sub

Private Sub mclsMainControl_EditDel()
    mclsMainControl_ListEditMenu (5)
End Sub

Private Sub mclsMainControl_EditEdit()
    msgGrid_DblClick
End Sub

Private Sub mclsMainControl_EditFilter()
    Select Case tabList.TabCaption(tabList.Tab)
        Case "变动资料(&Z)"
            mclsMainControl_ListEditMenu (10)
        Case "工作量(&W)"
            mclsMainControl_ListEditMenu (4)
        Case "固资卡片(&D)"
            mclsMainControl_ListEditMenu (2)
    End Select
End Sub

Private Sub mclsMainControl_EditNew()
    AfterListEdit 0
End Sub

Private Sub mclsMainControl_EditShowAll()
    chkShowAll_Click
End Sub

Private Sub mclsMainControl_EditUndo()
'    mclsMainControl_ListEditMenu (2)
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim clsPrint As PrintClass
    
    mclsList.ClearSortColArrow
    
    Set clsPrint = New PrintClass
    Select Case tabList.TabCaption(tabList.Tab)
    Case "变动资料(&Z)"
        clsPrint.PrintList gclsBase.BaseDB, msgGrid, 12, "固定资产变动资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Case "工作量(&W)"
        clsPrint.PrintList gclsBase.BaseDB, msgGrid, 13, "固定资产工作量资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Case "固资卡片(&D)"
        clsPrint.PrintList gclsBase.BaseDB, msgGrid, 14, "固定资产卡片资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End Select
    Set clsPrint = Nothing
    
    mclsList.AddSortColArrow
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim clsPrint As New PrintClass
    
    Select Case tabList.TabCaption(tabList.Tab)
    Case "变动资料(&Z)"
        clsPrint.PrintSetUp gclsBase.BaseDB, msgGrid, , , , 12, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Case "工作量(&W)"
        clsPrint.PrintSetUp gclsBase.BaseDB, msgGrid, , , , 13, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Case "固资卡片(&D)"
        clsPrint.PrintSetUp gclsBase.BaseDB, msgGrid, , , , 14, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End Select
    Set clsPrint = Nothing
End Sub

'编辑菜单的click事件处理
Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim lngCnt As Long
    Dim lngRow As Long
    Dim lngColumn As Long
    Dim strDate As String
    Dim strSql As String
    Dim strFixedCode As String
    Dim strFixedCardCode As String
    Dim recCard As rdoResultset
    Dim clsPrint As New PrintClass
    Dim bytPeriod As Integer