grid.cls

金算盘软件代码

'返回排序列
Public Property Get SortedCol() As Long
    SortedCol = mlngSortedCol
End Property

'列排序方式：0 没有排序/ 1 升序/ 2 降序
Public Property Get SortedType() As Integer
    SortedType = mlngSortedType
End Property

'Grid中ListSet列开始位置
Public Property Get ColOfs() As Long
    ColOfs = mlngColOfs
End Property

Public Property Let ColOfs(ByVal vNewValue As Long)
    If vNewValue >= 1 Then
        mlngColOfs = vNewValue
    
        If Not mFlex Is Nothing Then
            If mclsListSet.ViewId = 0 Then
                mFlex.FixedCols = mlngColOfs
            Else
                mFlex.FixedCols = mclsListSet.FixColumns + mlngColOfs
            End If
        End If
    End If
End Property

'返回ListSet对象
Public Property Get ListSet() As ListSet
    Set ListSet = mclsListSet
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 mFlex
        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 ColExchange() As Boolean
    ColExchange = mblnColExchange
End Property

Public Property Let ColExchange(vNewValue As Boolean)
    mblnColExchange = vNewValue
End Property

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


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

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

        '设置固定列
        If mclsListSet.ViewId = 0 Then
            .FixedCols = mlngColOfs
        Else
            .FixedCols = mclsListSet.FixColumns + mlngColOfs
            .AllowUserResizing = flexResizeColumns
        End If
        .ColWidth(0) = 0
        
        '初始化光标
        If .Rows <= 1 Then
            .HighLight = flexHighlightNever
            .Row = 0
        Else
            mblnRowSel = True
            .HighLight = flexHighlightAlways
            .Row = 1
            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

    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 mFlex Is Nothing Then Exit Sub
    mstrFormat = FormatStr
    mstrRalationValue = RalationValue
    
    For lngColCnt = 0 To mFlex.Cols - 1
        If mFlex.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
                ElseIf TypeOf EditObject Is ComboBox Then
                    Set mComboBox = EditObject
                    mComboBox.Visible = False
                    mComboBox.Tag = "Saved"
                    EditType(lngColCnt) = GridComboBox
                End If
            End If
        End If
        If mFlex.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 mFlex.Cols - 1
            If mFlex.TextMatrix(0, lngCol) = col Then
                Exit For
            End If
        Next lngCol
    Else
        lngCol = col
    End If
    
    If lngCol > 0 And lngCol < mFlex.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

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

                '清除以前排序列标题的排序标志
                If Right(.TextMatrix(0, mlngSortedCol), 1) = "↑" Or Right(.TextMatrix(0, mlngSortedCol), 1) = "↓" Then
                    .TextMatrix(0, mlngSortedCol) = Left(.TextMatrix(0, mlngSortedCol), Len(.TextMatrix(0, mlngSortedCol)) - 1)
                End If
                    
                '设置排序列
                mlngSortedCol = lngCol

                '设置排序方式
                mlngSortedType = lngSortedType
                
                .TopRow = 1
                .Row = 1
                .RowSel = 1
                .col = lngCol
                intColType = ColType(lngCol)
                If mlngSortedType = GridAscOrder Then
                    '降序
                    If Right(.TextMatrix(0, mlngSortedCol), 1) <> "↑" Then
                        .TextMatrix(0, mlngSortedCol) = .TextMatrix(0, mlngSortedCol) + "↑"
                    End If
                    If intColType = GridNumericType Then
                        .Sort = 3
                    Else
                        .Sort = 5
                    End If
                Else
                    If Right(.TextMatrix(0, mlngSortedCol), 1) <> "↓" Then
                        .TextMatrix(0, mlngSortedCol) = .TextMatrix(0, mlngSortedCol) + "↓"
                    End If
                    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 mFlex
        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
    
    If mclsListSet.ViewId = 0 Then Exit Sub
    
    mFlex.Redraw = False
    
    With ListSet
        lngCols = .Columns
        lngSortedCol = 0
        lngSortedType = 0
            
        For lngCol = 1 To lngCols
            '列类型
            strFieldType = UCase(.ColumnFieldType(lngCol))
            If strFieldType = "INTEGER" Or strFieldType = "LONG" Or strFieldType = "DOUBLE" Or strFieldType = "SINGLE" Then
                ColType(lngCol + mlngColOfs - 1) = GridNumericType
            Else
                ColType(lngCol + mlngColOfs - 1) = GridTextType
            End If
            
            '可排序列
            If strFieldType = "BOOLEAN" And .ColumnIsFind(lngCol) Then
                ColSort(lngCol + mlngColOfs - 1) = False
            Else
                ColSort(lngCol + mlngColOfs - 1) = .ColumnIsFind(lngCol)
            End If
                
            '列宽度
            mFlex.ColWidth(lngCol + mlngColOfs - 1) = .ColumnWidth(lngCol)