fixedmethodlist.frm

金算盘软件代码

    IsUseFixedMethodID = (recRecordset.RowCount >= 1)
    recRecordset.Close
End Function

' 变动方式ID
Public Property Get FixedMethodID() As Long
    With msgFixedMethod
    If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
        FixedMethodID = CLng(.TextArray(.Row * .Cols))
    Else
        FixedMethodID = 0
    End If
    End With
End Property

' 变动方式停用标志
Public Property Get FixedMethodIsInActive() As Boolean
    If chkShowAll.Value Then
        With msgFixedMethod
            FixedMethodIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        FixedMethodIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    With msgFixedMethod
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditEdit.Caption = "修改(&N)"
        .mnuEditNew.Caption = "新增(&E)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = blnIsnotEmpty
        .mnuEditInActive.Enabled = blnIsnotEmpty
        .mnuEditShowAll.Checked = chkShowAll.Value
        .mnuEditShowAll.Enabled = True
       
        .mnuEditUse.Enabled = blnIsnotEmpty
'        .mnuEditNotepad.Enabled = blnIsNotEmpty
        .mnuEditSearch.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    
    If msgFixedMethod.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList.FindNoChange
        mclsList.FindNoChange = True
        txtfind.Text = ""
        mclsList.FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
End Sub

'重画Form
Private Sub RedrawForm()
    '重画MS FlexGrid 控件
    On Error Resume Next
    With msgFixedMethod
        .Left = ListFormLeft
        .Width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画其余控件
    txtfind.Width = Me.ScaleWidth - txtfind.Left - ListFormBottom - cmdAgain.Width - 15
    cmdAgain.Left = txtfind.Left + txtfind.Width
    cmdFixedMethod(0).top = Me.ScaleHeight - cmdFixedMethod(0).Height - ListFormBottom
    cmdFixedMethod(1).top = cmdFixedMethod(0).top
    
    chkShowAll.top = cmdFixedMethod(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
End Sub


Private Sub cmdFixedMethod_Click(Index As Integer)
    Dim PosX, PosY As Integer
    
    PosX = cmdFixedMethod(Index).Left
    PosY = cmdFixedMethod(Index).top + cmdFixedMethod(Index).Height
    With frmMain
        Select Case Index
               Case 0
                    MakeListEditMenu
                    PopupMenu .mnuListEdit, , PosX, PosY
             
               Case 1
                    MakeListReportMenu
                    PopupMenu .mnuListReport, , PosX, PosY
        End Select
    End With
    
End Sub


'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID Me.hwnd, 20005
    '付款方式列表窗体初始化
    Debug.Print "start load form time:", Timer
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = msgFixedMethod
    Set mclsList.FindKind = cboFindKind
    Set mclsList.Find = txtfind
    Set mclsList.Again = cmdAgain
    mclsList.ListSet.ViewId = intViewID
    mclsList.InitFlexGrid
    '得到固资变动方式列表记录集
    
'    Set datFixedMethod.Resultset = GetList()
'    If datFixedMethod.Resultset.RowCount > 0 Then
'       datFixedMethod.Resultset.MoveLast
'    End If
'    datFixedMethod.Resultset.Close
''    Set datFixedMethod.Recordset = Nothing
'    mclsList.SetFlexGrid
'    '初始化查找复合列表框
'    mclsList.InitcboFindKind
'    mclsList.FlexNoChange = False
'    mclsList.FindNoChange = False
'    '设置第一行为选定行
'    With msgFixedMethod
'        If .Rows > 1 Then .Row = 1
'        .col = 0
'        .ColSel = .Cols - 1
'    End With
'    chkShowAll.Value = 0
'    mclsList.DoShowAll False
'    UpdateMenuStatus
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = msgFixedMethod.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Debug.Print "last end form time:", Timer
    Unload MsgForm
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu And mIsShowCard Then
        ShowMsg Me.hwnd, "请先关闭固资变动方式卡片！", vbExclamation, Me.Caption
        Cancel = True
       If frmFixedMethodListCard.WindowState = 1 Then frmFixedMethodListCard.WindowState = 0
       frmFixedMethodListCard.Show
       frmFixedMethodListCard.ZOrder 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If mIsShowCard Then Unload frmFixedMethodListCard
    mclsList.SaveListSet
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
       Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Activate()
    mclsMainControl_ChildActive  ' 响应消息
    gclsSys.CurrFormName = Me.hwnd
    'msgFixedMethod.SetFocus
    msgFixedMethod.Redraw = True
    UpdateMenuStatus
    If (Me.Left + Me.Width < 0 Or Me.Left > Screen.Width) Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub



'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
    msgFixedMethod.Redraw = False
    mclsList.DoShowAll chkShowAll.Value
    'cboFindKind_Click
    UpdateMenuStatus
    msgFixedMethod.Redraw = True
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim strFind As String
        
    With msgFixedMethod
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                strFind = .TextMatrix(.Row, i)
                mclsList.FixrowSortBold i
                Exit For
            End If
       Next
    End With
       
    '恢复以前选定行
    If msgFixedMethod.Rows > 1 Then
        If txtfind.Text = strFind Then
            txtFind_Change
        Else
            txtfind.Text = strFind
        End If
    End If
    msgFixedMethod.Redraw = True
End Sub

'响应消息
Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    gclsSys.CurrFormName = Me.hwnd
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgFixedMethod Then '接收到付款方式改变消息
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款方式改变消息
        End If
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With msgFixedMethod
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            msgFixedMethod.Cols = 0
            Set datFixedMethod.Resultset = GetList()
            If datFixedMethod.Resultset.RowCount > 0 Then
               datFixedMethod.Resultset.MoveLast
            End If
            datFixedMethod.Resultset.Close
'            Set datFixedMethod.Recordset = Nothing
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtfind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub


Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
'    If Not mblnIsSaveListset Then
'        If Not FindlngViewID(intViewID) Then mclsList.ListSet.SaveList
'        mblnIsSaveListset = True
'    End If
    If mclsList.ListSet.ListID < 1 Then mclsList.ListSet.SaveList
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgFixedMethod.Cols = 0
    Set datFixedMethod.Resultset = GetList()
    If datFixedMethod.Resultset.RowCount > 0 Then
       datFixedMethod.Resultset.MoveLast
    End If
    datFixedMethod.Resultset.Close
'    Set datFixedMethod.Recordset = Nothing
    mclsList.SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll 0
End Sub



Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 28, " " & "," & gclsBase.BaseName & "," & gclsBase.OperatorName
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    '固定资产一览表
    Select Case intIndex
        Case 0
        
      '  Case 2
            Report.ShowListReport 316, 356
    End Select