mutigrid.cls

金算盘软件代码

End Property

'判断指定单元是否可以粘贴控件
Public Property Get CellPaste(ByVal lngRow As Long, ByVal lngCol As Long) As Boolean
    Dim blnIsHScroll As Boolean, blnIsVScroll As Boolean
    Dim lngClientWidth As Long, lngClientHeight As Long
    Dim intOffset As Integer
    
    CellPaste = False
    
    With mBodyFlex
        If lngRow >= .FixedRows And lngRow < .Rows And lngCol >= .FixedCols And lngCol < .Cols And _
            .RowHeight(lngRow) > 0 And .ColWidth(lngCol) > 0 And Not ReadOnlyCol(lngCol) Then
            
            '判断水平滚动条和垂直滚动条
            ISScroll blnIsHScroll, blnIsVScroll
            
            ' 计算Grid内部区域高度、宽度
            intOffset = IIf(.Appearance = flex3D, 4, 0)
            If blnIsVScroll Then
                lngClientWidth = .width - gclsEniv.VScrollWidth - intOffset * Screen.TwipsPerPixelX
            Else
                lngClientWidth = .width - intOffset * Screen.TwipsPerPixelX
            End If
            If blnIsHScroll Then
                lngClientHeight = .Height - gclsEniv.HScrollHeight - intOffset * Screen.TwipsPerPixelY
            Else
                lngClientHeight = .Height - intOffset * Screen.TwipsPerPixelY
            End If
    
            If .RowPos(lngRow) + .RowHeight(lngRow) < lngClientHeight And _
                .ColPos(lngCol) + .ColWidth(lngCol) < lngClientWidth Then
                CellPaste = True
            End If
        End If
    End With
End Property

Public Property Get RowSelected() As Boolean
    RowSelected = mblnRowSel
End Property


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  方法
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'设置GRID风格
Public Sub SetupStyle()
    Dim lngCol As Long, lngCols As Long, lngRow As Long
    Dim lngHeight As Long, strColType As String
    
    If mFlex Is Nothing Then Exit Sub
     
    '设置MSFlexGrid风格
    With mBodyFlex
        .Redraw = False
        .AllowBigSelection = False
        .AllowUserResizing = flexResizeColumns
        .BorderStyle = flexBorderSingle
        .BackColorBkg = .BackColor
        .GridColorFixed = .BackColor
        .BackColorFixed = .BackColor
        .GridLines = flexGridNone
        .GridLinesFixed = flexGridNone
        .TabStop = True
        .RowHeight(0) = 0
        
        Set .DragIcon = GetFormResPicture(101, vbResIcon)
        Set .MouseIcon = GetFormResPicture(101, vbResCursor)
        
        '设置固定行颜色
        If mHeadFlex Is Nothing Then
            mHeadFlex.Redraw = False
            If .FixedRows > 1 Then .FixedRows = 1
            .FixedRows = 1
            mblnCancelRowColChange = True
            .Row = 0
            lngCols = .Cols - 1
            For lngCol = 0 To lngCols
                .col = lngCol
                .CellBackColor = &H8000000F
            Next lngCol
            mblnCancelRowColChange = False
            mHeadFlex.Redraw = True
        End If

        '设置固定列
        If mclsListSet.ViewId = 0 Then
            .FixedCols = mlngColOfs
        Else
            .FixedCols = mclsListSet.FixColumns + mlngColOfs
        End If
        .ColWidth(0) = 0
        
        '初始化光标
        If .Rows < .FixedRows Then
            .HighLight = flexHighlightNever
'            .Row = 0
        Else
            mblnRowSel = True
            .HighLight = flexHighlightAlways
            .Row = IIf(.Rows > .FixedRows, .FixedRows, 0)
            If .SelectionMode = flexSelectionByRow Then
                .col = 0
                .ColSel = .Cols - 1
            Else
                If .FixedCols > 1 Then
                    .col = .FixedCols
                    .ColSel = .FixedCols
                Else
                    .col = 1
                    .ColSel = 1
                End If
            End If
        End If
        
        If ListSet.ViewId <> 0 Then
            For lngCol = 1 To ListSet.Columns
                strColType = UCase(ListSet.ColumnFieldType(lngCol))
                If strColType = "DOUBLE" Or strColType = "SINGLE" Or _
                    strColType = "LONG" Or strColType = "INTEGER" Then
                    .ColAlignment(lngCol + mlngColOfs - 1) = flexAlignRightCenter
                End If
            Next lngCol
        End If
        
        .Redraw = True
    End With
    
    If Not (mHeadFlex Is Nothing) Then
        With mHeadFlex
            .Redraw = False
            lngHeight = 0
            .MergeCells = flexMergeFree
            For lngRow = 0 To .FixedRows - 1
                lngHeight = lngHeight + .RowHeight(lngRow)
                .MergeRow(lngRow) = True
            Next lngRow
            For lngRow = .FixedRows To .Rows - 1
                .RowHeight(lngRow) = 0
            Next lngRow
            .Cols = mBodyFlex.Cols
            .FixedCols = mBodyFlex.FixedCols
            .Row = 0
            For lngCol = 0 To .Cols - 1
                .col = lngCol
                .MergeCol(lngCol) = True
                .ColAlignment(lngCol) = flexAlignCenterCenter
            Next lngCol
            .TabStop = False
            .ScrollBars = flexScrollBarHorizontal
            .BackColorBkg = RGB(192, 192, 192)
            lngHeight = lngHeight - Screen.TwipsPerPixelY
            .top = mBodyFlex.top - lngHeight
            .Left = mBodyFlex.Left + Screen.TwipsPerPixelX
            .width = mBodyFlex.width
            .Height = lngHeight * 2
            .Redraw = True
            .LeftCol = mBodyFlex.LeftCol
        End With
    End If
    
    RefreshGridData
End Sub

'指定列的编辑对象
Public Sub SetEditText(ByVal EditColTitle As String, Optional ByVal FormatStr As String = "", _
        Optional ByVal RalationColTitle As String = "", Optional ByVal RalationValue As String = "", _
        Optional EditObject As Object)
    
    Dim lngColCnt As Integer
    
    If mBodyFlex Is Nothing Then Exit Sub
    mstrFormat = FormatStr
    mstrRalationValue = RalationValue
    
    For lngColCnt = 0 To mBodyFlex.Cols - 1
        If mBodyFlex.TextMatrix(0, lngColCnt) = EditColTitle Then
            ReadOnlyCol(lngColCnt) = False
            If Not EditObject Is Nothing Then
                If TypeOf EditObject Is TextBox Then
                    Set mEditText = EditObject
                    mEditText.Visible = False
                    mEditText.Tag = "Saved"
                    EditType(lngColCnt) = GridEditText
                ElseIf TypeOf EditObject Is CalEdit Then
                    Set mCalEdit = EditObject
                    mCalEdit.Visible = False
                    mCalEdit.Tag = "Saved"
                    EditType(lngColCnt) = GridCalEdit
                ElseIf TypeOf EditObject Is ListText Then
                    Set mListText = EditObject
                    mListText.Visible = False
                    mListText.Tag = "Saved"
                    EditType(lngColCnt) = GridListText
                ElseIf TypeOf EditObject Is GACALENDARLibCtl.calendar Then
                    Set mCalendar = EditObject
                    mCalendar.Visible = False
                    mCalendar.Tag = "Saved"
                    EditType(lngColCnt) = GridCalendar
                ElseIf TypeOf EditObject Is TEdit Then
                    Set mTEditText = EditObject
                    mTEditText.Visible = False
                    mTEditText.Tag = "Saved"
                    EditType(lngColCnt) = GridTeditText
                End If
            End If
        End If
        If mBodyFlex.TextMatrix(0, lngColCnt) = RalationColTitle Then
            mintRalationCol = lngColCnt
        End If
    Next lngColCnt
End Sub

'设置可修改列
Public Sub SetWriteCol(ByVal col As Variant)
    Dim lngCol As Long
    
    If TypeName(col) = "String" Then
        For lngCol = 0 To mBodyFlex.Cols - 1
            If mBodyFlex.TextMatrix(0, lngCol) = col Then
                Exit For
            End If
        Next lngCol
    Else
        lngCol = col
    End If
    
    If lngCol > 0 And lngCol < mBodyFlex.Cols Then
        ReadOnlyCol(lngCol) = False
    End If
End Sub

'排序方法
Public Sub Sort(ByVal lngCol As Long, ByVal lngSortedType As Integer)
    Dim lngSaveCol As Long, lngSaveColSel As Long
    Dim intColType As Integer
    Dim lngCnt As Long

    With mBodyFlex
        If lngCol >= 1 And lngCol <= .Cols - 1 And .Rows > 1 Then
            If ColSort(lngCol) Then
                .Redraw = False
                mblnCancelRowColChange = True
                
                lngSaveCol = .col
                lngSaveColSel = .ColSel

                
                For lngCnt = 0 To mFlex.FixedRows - 1
                    '设置排序列标题的黑体属性
                    mFlex.Row = lngCnt
                        
                    '清除以前排序列标题的黑体属性
                    .col = mlngSortedCol
                    mFlex.CellFontBold = False
                Next lngCnt
                    
                For lngCnt = 0 To mFlex.FixedRows - 1
                    '设置排序列标题的黑体属性
                    mFlex.Row = lngCnt
                    
                    '更新当前排序列标题的黑体属性
                    mFlex.col = lngCol
                    mFlex.CellFontBold = True
                Next lngCnt
                    
                '设置排序列
                mlngSortedCol = lngCol

                '设置排序方式
                mlngSortedType = lngSortedType
                
                mFlex.Row = .FixedRows
                .TopRow = .FixedRows
                .Row = .FixedRows
                .RowSel = .FixedRows
                .col = lngCol
                intColType = ColType(lngCol)
                If mlngSortedType = GridAscOrder Then
                    '降序
                    If intColType = GridNumericType Then
                        .Sort = 3
                    Else
                        .Sort = 5
                    End If
                Else
                    If intColType = GridNumericType Then
                        .Sort = 4
                    Else
                        .Sort = 6
                    End If
                End If

                If .SelectionMode = flexSelectionByRow Then
                    .col = 0
                    .ColSel = .Cols - 1
                Else
                    .col = lngSaveCol
                    .ColSel = lngSaveColSel
                End If
                mblnCancelRowColChange = False
                .Redraw = True
            End If
        End If
    End With
End Sub

'查找方法
Public Sub FindKey(ByVal strKey As String)
    Dim blnIsFound As Boolean
    
    If mlngSortedType = GridNoOrder Or mlngSortedCol = 0 Then Exit Sub
        
    With mBodyFlex
        If GridQuickFind(strKey, mlngSortedCol, ColType(mlngSortedCol) = GridTextType, (mlngSortedType = GridAscOrder)) Then
            If .SelectionMode = flexSelectionByRow Then
                .col = 0
                .ColSel = .Cols - 1
            Else
                If .FixedCols > 1 Then
                    .col = .FixedCols
                    .ColSel = .FixedCols
                Else
                    .col = 1
                    .ColSel = 1
                End If
            End If
        End If
    End With
End Sub


'根据ListSet对象设置Grid中列类型、可排序列、列宽度、当前排序列及排序方式
Public Sub ListSetToGrid()
    Dim lngCol As Long, lngCols As Long
    Dim lngSortedCol As Long, lngSortedType As Long
    Dim strFieldType As String, strTitle As String
    
    If mclsListSet.ViewId = 0 Then Exit Sub
    
    mBodyFlex.Redraw = False
    
    With ListSet
        lngCols = .Columns
        lngSortedCol = 0
        lngSortedType = 0
            
        For lngCol = 1 To lngCols
            '列类型
            strFieldType = UCase(.ColumnFieldType(lngCol))
            If strFieldType = "STRING" Or strFieldType = "CODE" Or strFieldType = "DATE" Or strFieldType = "MEMO" Then
                ColType(lngCol + mlngColOfs - 1) = GridTextType
            Else
                ColType(lngCol + mlngColOfs - 1) = GridNumericType
            End If
            
            '可排序列
            If strFieldType = "BOOLEAN" And .ColumnIsFind(lngCol) Then
                ColSort(lngCol + mlngColOfs - 1) = False
            Else
                ColSort(lngCol + mlngColOfs - 1) = .ColumnIsFind(lngCol)
            End If