fixedmethodlist.frm

金算盘软件代码

End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
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

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList.TextFind txtfind.Text
End Sub
'
' FLEXGRID控件
'
'双击FLEXGRID调用卡片
Private Sub msgFixedMethod_DblClick()
    With msgFixedMethod
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
            mclsMainControl_EditEdit
        End If
    End With
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgFixedMethod_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        Form_MouseDown Button, Shift, x, y
    End If
End Sub

'恢复“停用”列光标
Private Sub msgFixedMethod_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgFixedMethod
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
               If x > .ColPos(1) And x < .ColPos(2) Then
                   mclsMainControl_EditInActive
               End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'
'响应主控对象事件
'
'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Me.Enabled = False
    If FixedMethodID > 0 Then frmFixedMethodListCard.EditCard FixedMethodID
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    frmFixedMethodListCard.AddCard
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = FixedMethodID
    If mIsShowCard Then
'        If lngID = frmfixedmethodcard.getID Then
'            MessageBox Me.hWnd, "不能删除当前编辑的固资变动方式！", "固资变动方式删除", &H40&
'            frmfixedmethodcard.SetFocus
'            Exit Sub
'        End If
    End If
    If frmFixedMethodListCard.DelCard(FixedMethodID) Then
        With msgFixedMethod
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            mclsList.SetFlexRow
        End With
        gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedMethod
    End If
    UpdateMenuStatus
    'If Not frmFixedMethodListCard.Visible Then
    Unload frmFixedMethodListCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    If UpdateInActiveByFixedMethod(FixedMethodID, Not FixedMethodIsInActive) Then
       With msgFixedMethod
            If chkShowAll.Value Then
                If .TextMatrix(.Row, 1) = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
            Else
                .TextMatrix(.Row, 1) = "√"
                .RowHeight(.Row) = 0
                mclsList.SetFlexRow
            End If
            '发出付款方式消息
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedMethod
      End With
    End If
    UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
    UseCode Message.msgFixedMethod, FixedMethodID
    Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
     Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    With msgFixedMethod
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        mclsList.SaveListColWidth '保存列宽
        .Redraw = False
        '刷新列表记录
        .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
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        .Redraw = False
        If .Rows > 1 Then
            txtfind.Text = strOldText
        End If
        If chkShowAll.Value = 0 Then mclsList.DoShowAll False
        '更新菜单状态
        UpdateMenuStatus
        .Redraw = True
    End With
    Me.MousePointer = vbDefault
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 28, Me.Caption & "," & gclsBase.BaseName & "," & gclsBase.OperatorName
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0:
        mclsMainControl_EditEdit
    Case 1:
        mclsMainControl_EditNew
    Case 2:
        mclsMainControl_EditDel
    Case 4:
        mclsMainControl_EditInActive
    Case 5:
        mclsMainControl_EditShowAll
    Case 7:
        mclsMainControl_EditUse
    Case 8:
        mclsMainControl_EditSearch
    Case 10:
        mclsMainControl_EditFilter
    Case 11:
        mclsMainControl_EditColumn
    Case 13:
        mclsMainControl_ToolRefresh
    Case 14:
        mclsMainControl_FilePrint
    End Select
End Sub

'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
'        Load .mnuListEditMenu(9)
'        Utility.CloneMenu .mnuEditNotepad, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    End With
End Sub


'
' 报表菜单
'
Private Sub MakeListReportMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'
'        Load .mnuListReportMenu(1)
'        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
       ' Load .mnuListReportMenu(0)
        .mnuListReportMenu(0).Caption = "变动方式一览表(&p)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        
    End With
End Sub

'变动方式一览表
Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    If KeyCode = 8 Then
        intSelLen = txtfind.SelLength
        If txtfind.SelStart > 0 Then txtfind.SelStart = txtfind.SelStart - 1
        txtfind.SelLength = intSelLen + 1
    End If
End Sub
Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "固资变动方式编码" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "固资变动方式名称" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function
Public Sub BindingResultset()
    Me.Hide
     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
    Me.Show
    Me.ZOrder 0
End Sub