list.cls

金算盘软件代码

    mclsListSet.SaveList
End Sub

'保存列宽
Public Sub SaveListColWidth()
    Dim intCoutnt As Integer
    
    With mFlex
        For intCoutnt = 2 To mclsListSet.Columns + 1
            If .ColWidth(intCoutnt) < 30 Then .ColWidth(intCoutnt) = 30
            mclsListSet.ColumnWidth(intCoutnt - 1) = .ColWidth(intCoutnt)
        Next
    End With
End Sub

'“全部显示”处理
Public Sub DoShowAll(ByVal blnShowall As Boolean)
    Dim intRow As Integer
    Dim intRowheight As Integer
    
    With mFlex
        If blnShowall <> mblnShowAll Then
            If blnShowall Then
                .ColWidth(1) = 450
                intRowheight = .RowHeight(0)
                intRow = 0
                Do While True
                    If .RowData(intRow) <> 1 And .RowHeight(intRow) = 0 Then
                        .RowHeight(intRow) = intRowheight
                    End If
                    intRow = intRow + 1
                    If intRow > .Rows - 1 Then Exit Do
                Loop
            Else
                .ColWidth(1) = 0
                intRow = 0
                Do While True
                    If .TextMatrix(intRow, 1) = "√" Then
                        .RowHeight(intRow) = 0
                    End If
                    intRow = intRow + 1
                    If intRow > .Rows - 1 Then Exit Do
                Loop
            End If
            mblnShowAll = blnShowall
            SetFlexRow
        End If
    End With
End Sub

'重新设置当前行
Public Sub SetFlexRow()
    Dim i As Integer
    
    With mFlex
        Do While .RowHeight(.Row + i) = 0
            i = i + 1
            If .Row + i = .Rows Then
                i = 0
                Do While .RowHeight(.Row + i) = 0
                    i = i - 1
                    If .Row + i = 0 Then
                        Exit Do
                    End If
                Loop
             Exit Do
             End If
        Loop
        If .Row + i > 0 Then
            If .Row = .Row + i Then
                mFlex_RowColChange
            Else
                .Row = .Row + i
            End If
            .ColSel = .Cols - 1
        Else
            If Not mctlFind Is Nothing Then mctlFind.Text = ""
        End If
    End With
End Sub

Public Sub ReGetColCaption()
    With mFlex
        If mintSortCol > .Cols - 1 Then Exit Sub
        If Right(.TextMatrix(0, mintSortCol), 1) = "↑" Or _
            Right(.TextMatrix(0, mintSortCol), 1) = "↓" Then
            .TextMatrix(0, mintSortCol) = Left(.TextMatrix(0, mintSortCol), Len(.TextMatrix(0, mintSortCol)) - 1)
        End If
    End With
End Sub
Public Sub AddReGetColCaption()
    With mFlex
        If mintSortCol > .Cols - 1 Then Exit Sub
        If Right(.TextMatrix(0, mintSortCol), 1) <> "↑" Or _
            Right(.TextMatrix(0, mintSortCol), 1) <> "↓" Then
            If mclsListSet.ColumnOrderType(mintSortCol - 1) = 1 Then
                .TextMatrix(0, mintSortCol) = .TextMatrix(0, mintSortCol) + "↑"
            ElseIf mclsListSet.ColumnOrderType(mintSortCol - 1) = 2 Then
                .TextMatrix(0, mintSortCol) = .TextMatrix(0, mintSortCol) + "↓"
            End If
        End If
    End With
End Sub
'
'查找下一满足条件行按钮控件
'
Private Sub mcmdAgain_Click()
    Dim strTextFind As String
    Dim intResult As Integer
    Dim intRow As Integer
    Dim IsFind As Boolean
    Dim blnFindNoChange As Boolean
    
    With mFlex
        '判断下一行是否满足查找条件
        intRow = .Row + 1
        Do While intRow <= .Rows - 1
            If .RowHeight(intRow) = 0 Then
                intRow = intRow + 1
            Else
                Select Case mcboFindKind.ItemData(mcboFindKind.ListIndex)
                    Case 1
                        IsFind = (CLng(mctlFind.Text) = CLng(.TextMatrix(intRow, mintSortCol)))
                    Case 2
                        
                    Case Else
                        strTextFind = Left$(mctlFind.Text, Len(mctlFind.Text) - mctlFind.SelLength)
                        intResult = StrComp(Left$(.TextMatrix(intRow, mintSortCol), Len(strTextFind)), strTextFind, vbTextCompare)
                        If intResult = 0 Then
                            IsFind = True
                        End If
                End Select
                Exit Do
            End If
        Loop
        '根据查找结果改变当前行
        If IsFind Then
            Select Case mcboFindKind.ItemData(mcboFindKind.ListIndex)
                Case 1
                    .Row = intRow
                    .ColSel = .Cols - 1
                Case 2
                    
                Case Else
                    blnFindNoChange = mblnFindNoChange
                    mblnFindNoChange = True
                    mctlFind.Text = strTextFind
                    mblnFindNoChange = blnFindNoChange
                    mIsSelChange = True
                    .Row = intRow
                    mIsSelChange = False
                    .ColSel = .Cols - 1
                    mctlFind.SetFocus
            End Select
        Else
            mcmdAgain.Enabled = False
        End If
    End With
End Sub

Private Sub mFlex_Click()
    If mFlex.Rows > 1 And mFlex.RowHeight(mFlex.Row) > 0 Then
        mFlex.SetFocus
    End If
End Sub

Private Sub mFlex_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    Dim blnIsHScroll As Boolean, blnIsVScroll As Boolean
    Dim lngX As Long, lngY As Long
    Dim intDX As Integer, intDY As Integer
    Dim intOffset As Integer
    Dim hdc As Long
    Dim hPen As Long, hSavePen As Long
    Dim Point As POINTAPI
    Dim intMode As Integer
    Dim lngCol As Long, lngCnt As Long
    Dim lngStartCol As Long, lngEndCol As Long
    
    intDX = Screen.TwipsPerPixelX
    intDY = Screen.TwipsPerPixelY
    With mFlex
        If mOldCol < .FixedCols Then
            lngStartCol = 1
            lngEndCol = .FixedCols - 1
        Else
            For lngCnt = .FixedCols To .Cols - 1
                If .ColIsVisible(lngCnt) Then Exit For
            Next
            lngStartCol = lngCnt
            If lngStartCol < 1 Then lngStartCol = 1
            lngEndCol = .Cols - 1
        End If
        
        For lngCnt = 1 To .Cols - 1
            If x >= .ColPos(lngCnt) And x < .ColPos(lngCnt) + .ColWidth(lngCnt) Then
                lngCol = lngCnt
                Exit For
            End If
        Next
        
        If mlngDragOverCol = lngCol Then
            Exit Sub
        End If
        
        '判断水平滚动条和垂直滚动条
        ISScroll blnIsHScroll, blnIsVScroll
        
        intOffset = IIf(.Appearance = flex3D, 4, 0)
        If blnIsHScroll Then
            lngY = (.Height - gclsEniv.HScrollHeight) / intDY - intOffset
        Else
            lngY = .Height / intDY - intOffset
        End If
        
        hdc = GetDC(.hwnd)
        hPen = CreatePen(PS_SOLID, 3, RGB(255, 255, 255))
        hSavePen = SelectObject(hdc, hPen)
        intMode = SetROP2(hdc, R2_XORPEN)
        
        If mlngDragOverCol >= lngStartCol And mlngDragOverCol <= lngEndCol + 1 Then
            If mlngDragOverCol >= .Cols Then
                lngX = (.ColPos(mlngDragOverCol - 1) + .ColWidth(mlngDragOverCol - 1)) / intDX - 1
            Else
                lngX = .ColPos(mlngDragOverCol) / intDX - 1
            End If
            MoveToEx hdc, lngX, 0, Point
            LineTo hdc, lngX, lngY
        End If
            
        mlngDragOverCol = lngCol
        
        If mlngDragOverCol >= lngStartCol And mlngDragOverCol <= lngEndCol + 1 Then
            If mlngDragOverCol >= .Cols Then
                lngX = (.ColPos(mlngDragOverCol - 1) + .ColWidth(mlngDragOverCol - 1)) / intDX - 1
            Else
                lngX = .ColPos(mlngDragOverCol) / intDX - 1
            End If
            MoveToEx hdc, lngX, 0, Point
            LineTo hdc, lngX, lngY
        End If
        
        SetROP2 hdc, intMode
        SelectObject hdc, hSavePen
        DeleteObject hPen
        ReleaseDC .hwnd, hdc
    End With

End Sub

'
'FLEXGRID控件
'
'快速定位
Private Sub mFlex_KeyPress(KeyAscii As Integer)
    Static sngStartTime As Single
    Dim sngEndTime As Single
    Static strFindText As String
    
    sngEndTime = Timer
    If sngEndTime - sngStartTime >= 0.5 Then
        strFindText = Chr(KeyAscii)
    Else
        strFindText = strFindText + Chr(KeyAscii)
    End If
    sngStartTime = sngEndTime
    mIsKeyFind = True
    If Not (mctlFind Is Nothing) Then mctlFind.Text = strFindText    '引发txtFind_Change事件进行查找
    mIsKeyFind = False
End Sub

'交换列
Private Sub mFlex_DragDrop(Source As Control, x As Single, y As Single)
    Dim intCol As Integer
    Dim intCount As Integer
    
    mblnColDrag = False
    mblnDownFixedRow = False
    With mFlex
        If x > .ColPos(.Cols - 1) + .ColWidth(.Cols - 1) Then
            For intCount = .Cols - 1 To 2 Step -1
                If .ColWidth(intCount) > 0 Then Exit For
            Next
            intCol = intCount
        Else
            If x < .ColPos(2) Then
                intCol = 1
            Else
                For intCount = 2 To .Cols - 1
                    If x <= .ColPos(intCount) + .ColWidth(intCount) And x >= .ColPos(intCount) Then
                        intCol = intCount
                        Exit For
                    End If
                Next
            End If
        End If
        If mOldCol = 1 Or intCol = 1 Then Exit Sub  '“停用”列不能移动
        If mOldCol < mclsListSet.FixColumns + 2 And intCol < mclsListSet.FixColumns + 2 _
            Or mOldCol >= mclsListSet.FixColumns + 2 And intCol >= mclsListSet.FixColumns + 2 Then
            .ColPosition(mOldCol) = intCol
            Debug.Print mOldCol, intCol
            intCount = 0
            If mOldCol > intCol + 1 Then
                Do While mOldCol > intCol + intCount
                    mclsListSet.ExChangeColumn mOldCol - 1, intCol + intCount - 1
                    intCount = intCount + 1
                Loop
            Else
                If mOldCol + 1 < intCol Then
                    Do While mOldCol < intCol - intCount
                        mclsListSet.ExChangeColumn mOldCol - 1, intCol - intCount - 1
                        intCount = intCount + 1
                    Loop
                Else
                    mclsListSet.ExChangeColumn mOldCol - 1, intCol - 1
                End If
            End If
        End If
    End With
    For intCount = 1 To mclsListSet.Columns
        If mclsListSet.ColumnOrderType(intCount) <> 0 Then
            mintSortCol = intCount + 1
        End If
    Next
End Sub

Private Sub mFlex_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If gclsBase Is Nothing Then Exit Sub
    With mFlex
        mOldCol = .MouseCol
    End With
    mblnColDrag = False
End Sub

Private Sub mFlex_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With mFlex
        If mblnShowAll And .Rows > 1 Then
            If .MouseCol = 1 And .MouseRow <> 0 Then
                .MousePointer = vbCustom
            Else
                If Not mblnColDrag Then .MousePointer = vbDefault
            End If
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub mFlex_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If mblnReSort And Not mblnNoSort Then      '是否重新排序
        If ISSortCol Then
            With mFlex
                If Right(.TextMatrix(0, mintSortCol), 1) = "↑" Or _
                    Right(.TextMatrix(0, mintSortCol), 1) = "↓" Then
                    .TextMatrix(0, mintSortCol) = Left(.TextMatrix(0, mintSortCol), Len(.TextMatrix(0, mintSortCol)) - 1)
                End If
            End With
            mcboFindKind.Text = mclsListSet.ColumnDesc(mOldCol - 1)
        End If
        mblnReSort = False
    End If
End Sub

'当前行发生改变，相应改变txtFind的内容
Private Sub mFlex_RowColChange()
    Dim intSelStart As Integer
    Dim blnFindNoChange As Boolean
    
    With mFlex
        If mblnFlexNoChange Or .Rows < 2 Or .RowHeight(.Row) = 0 Then Exit Sub
        blnFindNoChange = mblnFindNoChange
        mblnFindNoChange = True
        If Not (mctlFind Is Nothing) Then
            If mIsSelChange Then    '当该事件由查找引发
                intSelStart = Len(mctlFind.Text)
                mctlFind.Text = .TextMatrix(.Row, mintSortCol)
                If TypeOf mctlFind Is TextBox Then
                    mctlFind.SelStart = intSelStart
                    mctlFind.SelLength = IIf(Len(mctlFind.Text) - intSelStart < 0, 0, Len(mctlFind.Text) - intSelStart)
                End If
            Else    '当该事件由鼠标点击引发
                mctlFind.Text = .TextMatrix(.Row, mintSortCol)
                If Not (mcmdAgain Is Nothing) Then mcmdAgain.Enabled = True
            End If
        End If
        If Not .RowIsVisible(.Row) Then     '当前行为不可见则让其可见
            If .Row < .TopRow Then
                .TopRow = IIf(.Row - 3 < 1, 1, .Row - 3)
            Else
                .TopRow = .Row
            End If
        End If
        mblnFindNoChange = blnFindNoChange
    End With
End Sub

Private Sub Class_Initialize()
    Set mclsListSet = New ListSet
End Sub