newgrid.cls

金算盘软件代码

                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 = "")
    Dim lngColCnt As Integer
    
    If mFlex Is Nothing Then Exit Sub
    mstrFormat = FormatStr
    mstrRalationValue = RalationValue
    mstrEditColTitle = EditColTitle
    mstrRalationColTitle = RalationColTitle
    
    For lngColCnt = 0 To mFlex.Cols - 1
        If mFlex.TextMatrix(0, lngColCnt) = EditColTitle Then
            mintEditCol = lngColCnt
            ReadOnlyCol(lngColCnt) = False
        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

                '设置排序列标题的黑体属性
                .Row = 0
                    
                '清除以前排序列标题的黑体属性
                .col = mlngSortedCol
                .CellFontBold = False
                
                '更新当前排序列标题的黑体属性
                .col = lngCol
                .CellFontBold = True
                    
                '设置排序列
                mlngSortedCol = lngCol

                '设置排序方式
                mlngSortedType = lngSortedType
                
                .TopRow = 1
                .Row = 1
                .RowSel = 1
                .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 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 = "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
                
            '列宽度
            mFlex.ColWidth(lngCol + mlngColOfs - 1) = .ColumnWidth(lngCol)
                
            '当前排序列及排序方式
            If .ColumnOrderType(lngCol) <> GridNoOrder Then
                lngSortedCol = lngCol + mlngColOfs - 1
                lngSortedType = .ColumnOrderType(lngCol)
            End If
        Next lngCol
            
        '按照当前排序列及方式排序
        Sort lngSortedCol, lngSortedType
        
        mFlex.FixedCols = .FixColumns + mlngColOfs
        mFlex.ColWidth(0) = 0
    End With
    
    mFlex.Redraw = True
End Sub

'根据Grid设置ListSet对象中列宽度、当前排序列及排序方式
Public Sub GridToListSet()
    Dim lngCnt As Long

    If mclsListSet.ViewId = 0 Then Exit Sub
    
    With mFlex
        For lngCnt = mlngColOfs To .Cols - 1
            mclsListSet.ColumnWidth(lngCnt - mlngColOfs + 1) = .ColWidth(lngCnt)
            mclsListSet.ColumnOrderType(lngCnt - mlngColOfs + 1) = GridNoOrder
        Next lngCnt
    End With
        
    If mlngSortedCol >= mlngColOfs And mlngSortedType <> GridNoOrder Then
        mclsListSet.ColumnOrderType(mlngSortedCol - mlngColOfs + 1) = mlngSortedType
    End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  内部程序
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'在MSFLEXGRID的lngCol列快速定位并选择strkey所在行(lngCol列必须已排序)
Private Function GridQuickFind(ByVal strKey As String, ByVal lngCol As Long, _
    ByVal blnIsText As Boolean, ByVal blnIsAsc As Boolean) As Boolean
    Dim lngStart As Long, lngEnd As Long, lngMiddle As Long
    Dim intResult As Integer
    Dim strText As String
    Dim dblNumeric As Double, dblKey As Double
    
    
    GridQuickFind = False
    
    '用二分法进行查找匹配
    With mFlex
        If blnIsText Then
            If strKey = "" Then Exit Function
            strKey = UCase(strKey)
        Else
            If Not IsNumeric(strKey) Then
                Exit Function
            Else
                dblKey = CDbl(strKey)
            End If
        End If
        
        lngStart = 1
        lngEnd = .Rows - 1
        Do While (lngEnd - lngStart) > 1
            lngMiddle = lngStart + (lngEnd - lngStart) \ 2
            strText = UCase(.TextMatrix(lngMiddle, lngCol))
            If blnIsText Then
                intResult = StrComp(strLeft(strText, Len(strKey)), strKey, vbTextCompare)
            Else
                If Not IsNumeric(strText) Then
                    intResult = 1
                Else
                    dblNumeric = CDbl(strText)
                    If dblNumeric < dblKey Then
                        intResult = -1
                    ElseIf dblNumeric = dblKey Then
                        intResult = 0
                    Else
                        intResult = 1
                    End If
                End If
            End If
            
            Select Case intResult
            Case -1
                If blnIsAsc Then            '升序排列
                    lngStart = lngMiddle
                Else                        '降序排列
                    lngEnd = lngMiddle
                End If
            Case 0
                lngEnd = lngMiddle
            Case 1
                If blnIsAsc Then            '升序排列
                    lngEnd = lngMiddle
                Else                        '降序排列
                    lngStart = lngMiddle
                End If
            End Select
        Loop
        
        strText = UCase(.TextMatrix(lngStart, lngCol))
        If blnIsText Then
            intResult = StrComp(strLeft(strText, Len(strKey)), strKey, vbTextCompare)
        Else
            If Not IsNumeric(strText) Then
                intResult = 1
            Else
                dblNumeric = CDbl(strText)
                If dblNumeric < dblKey Then
                    intResult = -1
                ElseIf dblNumeric = dblKey Then
                    intResult = 0
                Else
                    intResult = 1
                End If
            End If
        End If
        
        If intResult = 0 Then
            .Row = lngStart
            GridQuickFind = True
        Else
            strText = UCase(.TextMatrix(lngEnd, lngCol))
            If blnIsText Then
                intResult = StrComp(strLeft(strText, Len(strKey)), strKey, vbTextCompare)
            Else
                If Not IsNumeric(strText) Then
                    intResult = 1
                Else
                    dblNumeric = CDbl(strText)
                    If dblNumeric < dblKey Then
                        intResult = -1
                    ElseIf dblNumeric = dblKey Then
                        intResult = 0
                    Else
                        intResult = 1
                    End If
                End If
            End If
            If intResult = 0 Then
                .Row = lngEnd
                GridQuickFind = True
            End If
        End If
    End With
    
End Function

'重画列表竖线及栏目横线
Private Sub DrawGridLine()
    Dim intCnt As Integer, intCol As Integer, intCols As Integer
    Dim blnIsHScroll As Boolean, blnIsVScroll As Boolean
    Dim intRowPos As Integer, intRowheight As Integer
    Dim intColWidth As Long
    Dim intClientWidth As Long, intClientHeight As Integer
    Dim intDX As Integer, intDY As Integer
    Dim lngWhite As Long, lngBlack As Long
    Dim intOffset As Integer
    
    intDX = Screen.TwipsPerPixelX
    intDY = Screen.TwipsPerPixelY
    lngWhite = RGB(255, 255, 255)
    lngBlack = RGB(128, 128, 128)
    
    '判断水平滚动条和垂直滚动条
    ISScroll blnIsHScroll, blnIsVScroll
    
    With mFlex
        hdc = GetDC(.hwnd)
    
        ' 计算Grid内部区域高度、宽度
        intOffset = IIf(.Appearance = flex3D, 4, 0)
        If blnIsVScroll Then
            intClientWidth = .width - gclsEniv.VScrollWidth - intOffset * intDX
        Else
            intClientWidth = .width - intOffset * intDX
        End If
        If blnIsHScroll Then
            intClientHeight = .Height - gclsEniv.HScrollHeight - intOffset * intDY
        Else
            intClientHeight = .Height - intOffset * intDY
        End If
        
        '画Grid标题区域与数据区域之间横线
        intColWidth = GetColsWidth(.Cols - 1)
        intColWidth = IIf(intColWidth > intClientWidth, intClientWidth, intColWidth)
        
        GridDrawLine 0, 0, intColWidth, 0, lngWhite
        
        intRowPos = .RowPos(0) + .RowHeight(0) - intDY
        GridDrawLine 0, intRowPos, intColWidth, intRowPos, lngBlack
        
        '画Grid固定区域竖线
        intRowheight = .RowHeight(0)
        intColWidth = 0
        intCols = .FixedCols - 1
        For intCnt = 1 To intCols
            intColWidth = intColWidth + .ColWidth(intCnt)
            If intColWidth > intClientWidth Then
                Exit For
            End If
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - 2 * intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - 2 * intDX, intClientHeight, lngBlack
            If intCnt < intCols Then
                GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, intRowheight, lngWhite
            Else
                GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, intClientHeight, lngBlack
            End If
        Next intCnt
        
        '填充Grid只读区域
'        intRowPos = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) - intDY
'        If intRowPos < intClientHeight Then
'            intCol = .LeftCol
'            If intCol < 1 Then intCol = 1
'            intCols = .Cols - 1
'            For intCnt = intCol To intCols
'                If ReadOnlyCol(intCnt) Then
'                    GridDrawSolidBox .ColPos(intCnt), intRowPos, .ColPos(intCnt) + .ColWidth(intCnt), intClientHeight, RGB(192, 192, 192)
'                End If
'            Next intCnt
'        End If
        
        '画Grid变动区域竖线
        intCol = .LeftCol
        If intCol < 1 Then intCol = 1
        intCols = .Cols - 1
        For intCnt = intCol To intCols
            intColWidth = intColWidth + .ColWidth(intCnt)
            If intColWidth > intClientWidth Then
                Exit For
            End If
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, intClientHeight, lngBlack
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt), 0, .ColPos(intCnt) + .ColWidth(intCnt), intRowheight, lngWhite
        Next intCnt
        
        ReleaseDC .hwnd, hdc
    End With
End Sub