mutigrid.cls

金算盘软件代码

            '列宽度
            mBodyFlex.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
        
        mBodyFlex.FixedCols = .FixColumns + mlngColOfs
        mBodyFlex.ColWidth(0) = 0
    End With
    
    mBodyFlex.Redraw = True
    
    If Not (mHeadFlex Is Nothing) Then
        mHeadFlex.Redraw = False
        
        With ListSet
            lngCols = .Columns
            For lngCol = 1 To lngCols
                '列宽度
                mHeadFlex.ColWidth(lngCol + ColOfs - 1) = mBodyFlex.ColWidth(lngCol + ColOfs - 1)
                
                '去掉Title的前缀(??_)
                strTitle = .ColumnDesc(lngCol)
                If InStr(strTitle, "_") > 0 Then
                    strTitle = Mid(strTitle, InStr(strTitle, "_") + 1, Len(strTitle))
                End If
                
                If mHeadFlex.FixedRows > 1 Then
                    mHeadFlex.TextMatrix(1, lngCol + ColOfs - 1) = strTitle
                    If Trim$(.ColumnCombine(lngCol)) <> "" Then
                        mHeadFlex.TextMatrix(0, lngCol + ColOfs - 1) = .ColumnCombine(lngCol)
                    Else
                        mHeadFlex.TextMatrix(0, lngCol + ColOfs - 1) = strTitle
                    End If
                Else
                    mHeadFlex.TextMatrix(0, lngCol + ColOfs - 1) = strTitle
                End If
            Next lngCol
            mHeadFlex.ColWidth(0) = 0
        End With
        
        mHeadFlex.Redraw = True
    End If
End Sub

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

    If mclsListSet.ViewId = 0 Then Exit Sub
    
    With mBodyFlex
        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

Public Sub SetTitle(recRecordset As rdoResultset)
    Dim lngCol As Long
    Dim lngCols As Long
    Dim strTitle As String
    Dim strTitle0 As String
    
    If Not (recRecordset Is Nothing) Then
        mHeadFlex.Redraw = False
        For lngCol = 0 To mlngColOfs - 1
            mHeadFlex.ColWidth(lngCol) = mBodyFlex.ColWidth(lngCol)
            mHeadFlex.TextMatrix(0, lngCol) = mBodyFlex.TextMatrix(0, lngCol)
            If mHeadFlex.FixedRows > 1 Then
                mHeadFlex.TextMatrix(1, lngCol) = mBodyFlex.TextMatrix(0, lngCol)
            End If
        Next lngCol
        With ListSet
            lngCols = .Columns
            For lngCol = 1 To lngCols
                '列宽度
                mHeadFlex.ColWidth(lngCol + ColOfs - 1) = mBodyFlex.ColWidth(lngCol + ColOfs - 1)
                
                '去掉Title的前缀(??_)
                strTitle = .ColumnDesc(lngCol)
                If InStr(strTitle, "_") > 0 Then
                    strTitle0 = Left(strTitle, InStr(strTitle, "_") - 1)
                    strTitle = Mid(strTitle, InStr(strTitle, "_") + 1, Len(strTitle))
                Else
                    strTitle0 = strTitle
                End If
                
                If mHeadFlex.FixedRows > 1 Then
                    mHeadFlex.TextMatrix(1, lngCol + ColOfs - 1) = strTitle
                    mHeadFlex.TextMatrix(0, lngCol + ColOfs - 1) = strTitle0
                Else
                    mHeadFlex.TextMatrix(0, lngCol + ColOfs - 1) = strTitle
                End If
            Next lngCol
            mHeadFlex.ColWidth(0) = 0
        End With
        mHeadFlex.Redraw = True
    End If
End Sub

Public Sub ReSetColWidth()
    Dim lngCol As Long
    
    If mHeadFlex.Cols = mBodyFlex.Cols Then
        mBodyFlex.Redraw = False
        For lngCol = 0 To mBodyFlex.Cols - 1
            mBodyFlex.ColWidth(lngCol) = mHeadFlex.ColWidth(lngCol)
'            mBodyFlex.ColPosition(lngCol) = mHeadFlex.ColPosition(lngCol)
        Next lngCol
        mBodyFlex.Redraw = True
    End If
End Sub

Public Sub FormResize()
    Dim lngCol As Long
    On Error Resume Next
    RefreshGridData
'    If Not mHeadFlex Is Nothing And Not mBodyFlex Is Nothing Then
'        mHeadFlex.Redraw = False
'        For lngCol = 0 To mBodyFlex.Cols - 1
'            If mBodyFlex.ColIsVisible(lngCol) Then
'                mHeadFlex.ColWidth(lngCol) = mBodyFlex.ColWidth(lngCol)
'            Else
'                mHeadFlex.ColWidth(lngCol) = 0
'            End If
'        Next lngCol
'        mHeadFlex.Redraw = True
'    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 mBodyFlex
        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(Left(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(Left(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(Left(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
        If Not .RowIsVisible(.Row) Then
            .TopRow = .Row
        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 lngRowPos As Long, intRowheight As Long
    Dim intColWidth As Integer
    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
    Dim rcRect As RECT
    Dim hBmp As Long, hOldBmp As Long
    Dim hBrush As Long
    
    hdc = GetDC(mBodyFlex.hwnd)
    
    intDX = Screen.TwipsPerPixelX
    intDY = Screen.TwipsPerPixelY
    lngWhite = RGB(255, 255, 255)
    lngBlack = RGB(128, 128, 128)
    
    '判断水平滚动条和垂直滚动条
    ISScroll blnIsHScroll, blnIsVScroll
    
    With mBodyFlex
        ' 计算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 And False Then
            intClientHeight = .Height - gclsEniv.HScrollHeight - intOffset * intDY
        Else
            intClientHeight = .Height - intOffset * intDY
        End If
        
        If mHeadFlex Is Nothing Then
            '画Grid标题区域与数据区域之间横线
            intColWidth = GetColsWidth(.Cols - 1)
            intColWidth = IIf(intColWidth > intClientWidth, intClientWidth, intColWidth)
            
            GridDrawLine 0, 0, intColWidth, 0, lngWhite
            
            lngRowPos = .RowPos(0) + .RowHeight(0) - intDY
            GridDrawLine 0, lngRowPos, intColWidth, lngRowPos, lngBlack
        End If
            
        '画Grid固定区域竖线
        If .Rows > 0 Then
            intRowheight = .RowHeight(0)
        End If
        intColWidth = 0
        intCols = .FixedCols - 1
        For intCnt = 1 To intCols
            If .ColIsVisible(intCnt) Then
                intColWidth = intColWidth + .ColWidth(intCnt)
            End If
            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只读区域
'        If .Rows > 0 Then
'            lngRowPos = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) - intDY
'        End If
'        If lngRowPos < 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), lngRowPos, .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
    End With
    
    
    'Debug
    'GridDrawLine mClipRect.Left * intDX, mClipRect.Top * intDY, mClipRect.Right * intDX, mClipRect.Bottom * intDY, RGB(255, 0, 0)
    
    ReleaseDC mBodyFlex.hwnd, hdc