grid.cls

金算盘软件代码

            '当前排序列及排序方式
            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
    
    If mblnTotal Then
        TotalRowAdjust
        DrawTotalBox
    End If
    mFlex.Redraw = True
End Sub

'根据Grid设置ListSet对象中列宽度、当前排序列及排序方式
Public Sub GridToListSet()
    Dim lngCnt As Long
    
    If mclsListSet.ViewId = 0 Then Exit Sub
    
    On Error Resume Next
    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(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
                If Not .RowIsVisible(.Row) Then
                    .TopRow = .Row
                End If
                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 lngRowPos As Long, lngRowheight As Long
    Dim lngColWidth As Long
    Dim lngClientWidth As Long, lngClientHeight As Long
    Dim intDX As Integer, intDY As Integer
    Dim lngWhite As Long, lngBlack As Long
    Dim lngOffset As Long
    
    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内部区域高度、宽度
        lngOffset = IIf(.Appearance = flex3D, 0, 0)
        If blnIsVScroll Then
            lngClientWidth = .width - gclsEniv.VScrollWidth - lngOffset * intDX
        Else
            lngClientWidth = .width - lngOffset * intDX
        End If
        If blnIsHScroll Then
            lngClientHeight = .Height - gclsEniv.HScrollHeight - lngOffset * intDY
        Else
            lngClientHeight = .Height - lngOffset * intDY
        End If
        
        '画Grid标题区域与数据区域之间横线
        lngColWidth = GetColsWidth(.Cols - 1)
        lngColWidth = IIf(lngColWidth > lngClientWidth, lngClientWidth, lngColWidth)
        
        GridDrawLine 0, 0, lngColWidth, 0, lngWhite
        
        lngRowPos = .RowPos(0) + .RowHeight(0) - intDY
        GridDrawLine 0, lngRowPos, lngColWidth, lngRowPos, lngBlack
        
        '画Grid固定区域竖线
        lngRowheight = .RowHeight(0)
        lngColWidth = 0
        intCols = .FixedCols - 1
        For intCnt = 0 To intCols
            lngColWidth = lngColWidth + .ColWidth(intCnt)
            If lngColWidth > lngClientWidth Then
                Exit For
            End If
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - 2 * intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - 2 * intDX, lngClientHeight, lngBlack
            If intCnt < intCols Then
                GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, lngRowheight, lngWhite
            Else
                GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, lngClientHeight, 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
            lngColWidth = lngColWidth + .ColWidth(intCnt)
            If lngColWidth > lngClientWidth Then
                Exit For
            End If
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt) - intDX, 0, .ColPos(intCnt) + .ColWidth(intCnt) - intDX, lngClientHeight, lngBlack
            GridDrawLine .ColPos(intCnt) + .ColWidth(intCnt), 0, .ColPos(intCnt) + .ColWidth(intCnt), lngRowheight, lngWhite
        Next intCnt
        
        ReleaseDC .hwnd, hdc
    End With
End Sub

'返回至制定列宽度之和
Private Function GetColsWidth(ByVal intCol As Integer) As Long
    Dim intCnt As Integer
    Dim intSum As Long
    Dim intFixedCol As Integer
        
    With mFlex
        intFixedCol = .FixedCols - 1
        If intCol > intFixedCol Then
            For intCnt = 1 To intFixedCol
                intSum = intSum + .ColWidth(intCnt)
            Next intCnt
            For intCnt = .LeftCol To intCol
                intSum = intSum + .ColWidth(intCnt)
            Next intCnt
        Else
            For intCnt = 1 To intCol
                intSum = intSum + .ColWidth(intCnt)
            Next
        End If
    End With
    GetColsWidth = intSum
End Function

'判定是否出现水平和垂直滚动条
Private Sub ISScroll(ByRef blnHscroll As Boolean, ByRef blnVscroll As Boolean)
    If mFlex.Cols = mFlex.FixedCols + 1 Then
        blnHscroll = False
        blnVscroll = IsVScroll(0)
    Else
        blnHscroll = IsHScroll(gclsEniv.VScrollWidth)
        blnVscroll = IsVScroll(gclsEniv.HScrollHeight)
        If blnVscroll Then
            If blnHscroll Then
                If Not IsVScroll(0) Then
                    If Not IsHScroll(0) Then
                        blnHscroll = False
                        blnVscroll = False
                    End If
                End If
            Else
                blnVscroll = IsVScroll(0)
            End If
        Else
            If blnHscroll Then blnHscroll = IsHScroll(0)
        End If
    End If
    
    With mFlex
        If .ScrollBars = flexScrollBarNone Then
            blnHscroll = False
            blnVscroll = False
        ElseIf .ScrollBars = flexScrollBarVertical Then
            blnHscroll = False
        ElseIf .ScrollBars = flexScrollBarHorizontal Then
            blnVscroll = False
        End If
    End With
End Sub


'判定水平滚动条是否出现
Private Function IsHScroll(ByVal intVScrollWidth As Integer) As Boolean
    Dim intCnt As Integer
    Dim lngSum As Long
    Dim lngOffset As Long
    
    lngOffset = IIf(mFlex.Appearance = flex3D, 4, 0) * Screen.TwipsPerPixelX
    
    With mFlex
        For intCnt = 1 To .Cols - 1
            lngSum = lngSum + .ColWidth(intCnt)
        Next
        If .width - lngOffset - intVScrollWidth >= lngSum Then
            IsHScroll = False
        Else
            IsHScroll = True
        End If
    End With
End Function

'判定垂直滚动条是否出现
Private Function IsVScroll(ByVal intHScrollHeight As Integer) As Boolean
    Dim lngSum As Long
    Dim i As Integer
    
    With mFlex
        If .Rows < 20 Then
            For i = 0 To .Rows - 1
                lngSum = lngSum + .RowHeight(i)
            Next i
        Else
            lngSum = .Rows * .RowHeight(0)
        End If
        If .Height - intHScrollHeight >= lngSum + 42.5 Then
            IsVScroll = False
        Else
            IsVScroll = True
        End If
    End With
End Function

'画线
Private Sub GridDrawLine(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal Color As Long)
    Dim hPen As Long, hSavePen As Long
    Dim Point As POINTAPI
    Dim blnIsVisible As Boolean
    
    x1 = x1 / Screen.TwipsPerPixelX
    x2 = x2 / Screen.TwipsPerPixelX
    y1 = y1 / Screen.TwipsPerPixelY
    y2 = y2 / Screen.TwipsPerPixelY
    
    '裁减作图区域
    blnIsVisible = True
    With mClipRect
        If x1 = x2 Then
            If (x1 < .Left Or x1 > .Right) Then