list.cls

金算盘软件代码

                    Else
                        If .Row = .MouseRow Then
                            If .ColSel = 0 Then mFlex_RowColChange
                        Else
                            If .MouseRow < .Rows Then .Row = .MouseRow
                        End If
                        If .col <> 0 Then .col = 0
                        If .ColSel < .Cols - 1 Then .ColSel = .Cols - 1
                        bCancel = True
                    End If
                End If
            End With
            
        Case WM_LBUTTONUP
            mblnColDrag = False
            mblnDownFixedRow = False
            
        Case WM_MOUSEMOVE
            If wParam = MK_LBUTTON Then  '列表中多选行无效
                If mblnDownFixedRow Then
                    mblnReSort = False
                    If mblnColDrag Then
                        If mFlex.MouseRow = 0 Then
                            mblnColDrag = False
                            mlngDragOverCol = -1
                            mFlex.Drag vbBeginDrag
                        End If
                    End If
                    bCancel = False
                Else
                    bCancel = True
                End If
            End If
    
        Case WM_PAINT
            If mblnDoForm Then mfrmParent.HookPaint
            '取Paint事件矩形区域
            GetUpdateRect mFlex.hwnd, mClipRect, False
            clsSubClass.CallWndProc Msg, wParam, lParam
            If mFlex.Redraw Then gridLineRefresh
            bCancel = True
'        Case WM_KEYDOWN
'            If wParam = 65 Then
'                If mFlex.LeftCol < mFlex.Cols - 1 Then mFlex.LeftCol = mFlex.LeftCol + 1
'            ElseIf wParam = 90 Then
'               If mFlex.LeftCol > mFlex.FixedCols Then mFlex.LeftCol = mFlex.LeftCol - 1
'            End If
    End Select
  '  Debug.Print "KeyMessage:"
    If Not bCancel Then
        clsSubClass.CallWndProc Msg, wParam, lParam
    End If
End Sub

'判定是否出现水平和垂直滚动条
Private Sub ISScroll(blnHscroll As Boolean, 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
End Sub

'判定水平滚动条是否出现
Private Function IsHScroll(ByVal intVScrollWidth As Integer) As Boolean
    Dim i As Integer
    Dim lngSum As Long
    
    With mFlex
        For i = 1 To .Cols - 1
            lngSum = lngSum + .ColWidth(i)
        Next
        If .width - 80 - 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
    
    With mFlex
        lngSum = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1)
        If .Height - intHScrollHeight >= lngSum + 42.5 Then
            IsVScroll = False
        Else
            IsVScroll = True
        End If
    End With
End Function

'根据字符或数字查找当前行
Public Function TextFind(ByVal strText As String) As Integer
    Dim intCnt As Integer
    Dim intCount As Integer
    Dim intStart As Integer
    Dim intEnd As Integer
    Dim intMiddle As Integer
    Dim intResult As Integer
    Dim IsFind As Boolean
    Dim intFindRow As Integer
    Dim intSortType As Integer
    Dim blnIsStr As Boolean
    Dim dblStartSubStract As Double
    Dim dblEndSubStract As Double
    Dim strRow() As String
    Dim intRow() As Integer
    
    ReDim strRow(0) As String
    ReDim intRow(0) As Integer
    '如果txtFind_Change不要求进行查找，则退出
    If mblnFindNoChange Or mFlex.Rows < 2 Then Exit Function
    
   Select Case UCase(mclsListSet.ColumnFieldType(mintSortCol - 1))
        Case "INTEGER", "LONG", "DOUBLE"
            blnIsStr = False
        Case Else
            blnIsStr = True
    End Select
    With mFlex
        If blnIsStr Then    '按字符匹配方式查找
            If strText = "" Then
                IsFind = False
            Else
                '用二分法进行查找匹配
                intStart = 1
                intEnd = .Rows - 1
                For intCount = intStart To intEnd
                    If .RowHeight(intCount) > 0 Then
                        ReDim Preserve strRow(intCnt) As String
                        ReDim Preserve intRow(intCnt) As Integer
                        strRow(intCnt) = .TextMatrix(intCount, mintSortCol)
                        intRow(intCnt) = intCount
                        intCnt = intCnt + 1
                    End If
                Next intCount
                intStart = 0
                intEnd = UBound(strRow)
                intSortType = mclsListSet.ColumnOrderType(mintSortCol - 1)
                If intEnd = intStart Then
                    IsFind = False
                Else
                    Do While (intEnd - intStart) > 1
                        Debug.Print intEnd, intStart
                        intMiddle = intStart + intEnd
                        intMiddle = Int(intMiddle * 0.5)
                        intResult = StrComp(Left$(strRow(intMiddle), Len(strText)), strText, vbTextCompare)
                        Select Case intResult
                            Case -1
                                If intSortType = 1 Then    '升序排列
                                    intStart = intMiddle
                                Else                        '降序排列
                                    intEnd = intMiddle
                                End If
                            Case 0
                                intEnd = intMiddle
                            Case 1
                                If intSortType = 1 Then    '升序排列
                                    intEnd = intMiddle
                                Else                        '降序排列
                                    intStart = intMiddle
                                End If
                        End Select
                    Loop
                    intResult = StrComp(Left$(strRow(intStart), Len(strText)), strText, vbTextCompare)
                    If intResult = 0 Then
                        IsFind = True
                        intFindRow = intRow(intStart)
                    Else
                        intResult = StrComp(Left$(strRow(intEnd), Len(strText)), strText, vbTextCompare)
                        If intResult = 0 Then
                            IsFind = True
                            intFindRow = intRow(intEnd)
                        End If
                    End If
                End If
            End If
            '根据查找结果改变当前行
            If IsFind Then
                TextFind = intFindRow
                mIsSelChange = True
                If .Row = intFindRow Then
                    mFlex_RowColChange
                    mblnFlexNoChange = True
                    .col = 0
                    .ColSel = .Cols - 1
                    mblnFlexNoChange = False
                Else
                    .Row = intFindRow
                    mblnFlexNoChange = True
                    .col = 0
                    .ColSel = .Cols - 1
                    mblnFlexNoChange = False
                    mcmdAgain.Enabled = True
                End If
                
                mIsSelChange = False
            Else    '如果没有找到且为按键查找则恢复当前行内容到txtFind
                TextFind = 0
                If mIsKeyFind Then
                    mFlex_RowColChange
                Else
                    If .Row = 0 Then
                        .Row = 1
                        .col = 0
                        .ColSel = .Cols - 1
                    End If
                End If
                mcmdAgain.Enabled = False
            End If
        Else    '按数字匹配方式查找
            If Not IsNumeric(strText) Then
                IsFind = False
            Else
                '用二分法进行查找匹配
                intStart = 1
                intEnd = .Rows - 1
                For intCount = intStart To intEnd
                    If .RowHeight(intCount) > 0 Then
                        ReDim Preserve strRow(intCnt) As String
                        ReDim Preserve intRow(intCnt) As Integer
                        strRow(intCnt) = IIf(.TextMatrix(intCount, mintSortCol) <> "", .TextMatrix(intCount, mintSortCol), 0) 'ozj修改
                        intRow(intCnt) = intCount
                        intCnt = intCnt + 1
                    End If
                Next intCount
                intStart = 0
                intEnd = UBound(strRow)
                intSortType = mclsListSet.ColumnOrderType(mintSortCol - 1)
                If intStart = intEnd Then
                    IsFind = False
                Else
                    Do While (intEnd - intStart) > 1
                        intMiddle = intStart + (intEnd - intStart) / 2
                        If CDbl(strText) > CDbl(strRow(intMiddle)) Then
                            intResult = -1
                        Else
                            If CDbl(strText) = CDbl(strRow(intMiddle)) Then
                                intResult = 0
                            Else
                                intResult = 1
                            End If
                        End If
                        Select Case intResult
                            Case -1
                                If intSortType = 1 Then    '升序排列
                                    intStart = intMiddle
                                Else                        '降序排列
                                    intEnd = intMiddle
                                End If
                            Case 0
                                intEnd = intMiddle
                            Case 1
                                If intSortType = 1 Then    '升序排列
                                    intEnd = intMiddle
                                Else                        '降序排列
                                    intStart = intMiddle
                                End If
                        End Select
                    Loop
                    dblStartSubStract = Abs(CDbl(strText) - CDbl(strRow(intStart)))
                    If dblStartSubStract = 0 Then
                        IsFind = True
                        intFindRow = intRow(intStart)
                    Else
                        dblEndSubStract = Abs(CDbl(strText) - CDbl(strRow(intEnd)))
                        If dblEndSubStract = 0 Then
                            IsFind = True
                            intFindRow = intRow(intEnd)
                        Else
                            If dblStartSubStract <= dblEndSubStract Then
                                IsFind = True
                                intFindRow = intRow(intStart)
                            Else
                                IsFind = True
                                intFindRow = intRow(intEnd)
                            End If
                        End If
                    End If
                End If
            End If
            '根据查找结果改变当前行
            If IsFind Then
                TextFind = intFindRow
                If mIsKeyFind Then      '如果没有找到且为按键查找则恢复当前行内容到txtFind
                    mIsSelChange = False
                    mFlex_RowColChange
                    mIsSelChange = True
                Else
                    mblnFlexNoChange = True
                    .Row = intFindRow
                    .col = 0
                    .ColSel = .Cols - 1
                    mblnFlexNoChange = False
                End If
                mcmdAgain.Enabled = True
            Else
                TextFind = 0
                If .Row = 0 Then
                    .Row = 1
                    .col = 0
                    .ColSel = .Cols - 1
                End If
                mcmdAgain.Enabled = False
            End If
        End If
    End With
End Function

'排序
Public Sub FixrowSortBold(ByVal SortCol As Integer)
    Dim i As Integer
    Dim blnFlexNoChange As Boolean
    Dim intSortCol As Integer
    
    With mFlex
        If SortCol > 0 Then
            blnFlexNoChange = mblnFlexNoChange
            mblnFlexNoChange = True
            .col = SortCol
            If mintSortCol <> SortCol Then  '该列不是当前排序列
                .TextMatrix(0, SortCol) = .TextMatrix(0, SortCol) + "↑"
                mclsListSet.ColumnOrderType(mintSortCol - 1) = 0
                mintSortCol = SortCol
                intSortCol = mintSortCol - 1
                Select Case mcboFindKind.ItemData(mcboFindKind.ListIndex)
                    Case 1
                        .Sort = 3
                        mclsListSet.ColumnOrderType(intSortCol) = 1
                    Case Else
                        .Sort = 5
                        mclsListSet.ColumnOrderType(intSortCol) = 1
                End Select
            Else    '该列是当前排序列
                intSortCol = mintSortCol - 1
                Select Case mcboFindKind.ItemData(mcboFindKind.ListIndex)
                    Case 1
                        If mclsListSet.ColumnOrderType(intSortCol) = 1 Then
                            .Sort = 4
                            mclsListSet.ColumnOrderType(intSortCol) = 2
                            .TextMatrix(0, SortCol) = .TextMatrix(0, SortCol) + "↓"
                        Else
                            .Sort = 3
                            mclsListSet.ColumnOrderType(intSortCol) = 1
                            .TextMatrix(0, SortCol) = .TextMatrix(0, SortCol) + "↑"
                        End If
                    Case Else
                        If mclsListSet.ColumnOrderType(intSortCol) = 1 Then
                            .Sort = 6
                            mclsListSet.ColumnOrderType(intSortCol) = 2
                            .TextMatrix(0, SortCol) = .TextMatrix(0, SortCol) + "↓"
                        Else
                            .Sort = 5
                            mclsListSet.ColumnOrderType(intSortCol) = 1
                            .TextMatrix(0, SortCol) = .TextMatrix(0, SortCol) + "↑"
                        End If
                End Select
            End If
        mblnFlexNoChange = blnFlexNoChange
      End If
   End With
End Sub

'当前列是否为排序列
Private Function ISSortCol() As Boolean
    Dim i As Integer
    
    With mclsListSet
        If mOldCol > 0 Then
            If .ColumnIsFind(mOldCol - 1) Then
                ISSortCol = True
                Exit Function
            End If
        End If
    End With
    ISSortCol = False
End Function

'存储列表设置
Public Sub SaveListSet()
    SaveListColWidth