mutigrid.cls

金算盘软件代码

                Next lngCnt
                
                If Not blnIsOnCol Then
                    lngCols = .Cols - 1
                    For lngCnt = .LeftCol To lngCols
                        If lngX > GetRealColPos(lngCnt) + intDX And lngX < GetRealColPos(lngCnt) + .ColWidth(lngCnt) - intDX Then
                            blnIsOnCol = True
                            Exit For
                        End If
                    Next lngCnt
                End If
                
                If blnIsOnCol Then
                    If mHeadFlex.TextMatrix(mHeadFlex.FixedRows - 1, lngCnt) = mHeadFlex.TextMatrix(0, lngCnt) Then
                        mlngMouseDownCol = lngCnt
                    Else
                        mlngMouseDownCol = 0
                    End If
                    '光标没有位于列分割线上，取消该消息
                    blnCancel = True
                Else
                    lngCols = .Cols - 1
                    For lngCnt = 0 To lngCols
                        If lngX >= GetRealColPos(lngCnt) + .ColWidth(lngCnt) - 2 * intDX And lngX <= GetRealColPos(lngCnt) + .ColWidth(lngCnt) + intDX Then
                            Exit For
                        End If
                    Next lngCnt
                    If lngCnt <= lngCols And lngCnt > 0 Then
                        If .MouseRow > 0 Or .TextMatrix(0, lngCnt) <> .TextMatrix(0, lngCnt - 1) Then
                            mHeadFlex.ColData(lngCnt) = 1
                            mblnColResize = True
                        Else
                            blnCancel = True
                        End If
                    Else
                        blnCancel = True
                    End If
                End If
            Else
                mblnMouseDownOnFixedRow = True
                mlngMouseDownCol = 0
                mblnColResize = True
                lngCols = .Cols - 1
                For lngCnt = .LeftCol To lngCols
                    If lngX > GetRealColPos(lngCnt) + .ColWidth(lngCnt) - intDX And lngX < GetRealColPos(lngCnt) + .ColWidth(lngCnt) + 2 * intDX Then
                        Exit For
                    End If
                Next lngCnt
                If lngCnt <= lngCols Then
                    mHeadFlex.ColData(lngCnt) = 1
                    mblnColResize = True
                Else
                    blnCancel = True
                End If
            End If
        End With
        If Not blnCancel Then Result = mclsSubClassHead.CallWndProc(Msg, wParam, lParam)
    Case WM_LBUTTONUP
        If mblnMouseDownOnFixedRow Then
            mblnMouseDownOnFixedRow = False
            If mblnColResize Then
                mblnColResize = False
                mblnSaveList = True
                mBodyFlex.Redraw = False
                For lngCnt = 1 To mHeadFlex.Cols - 1
                     If mHeadFlex.ColData(lngCnt) = 1 Then
                        mHeadFlex.ColData(lngCnt) = 0
                        Result = mclsSubClassHead.CallWndProc(Msg, wParam, lParam)
                        If mHeadFlex.ColWidth(lngCnt) < mHeadFlex.Parent.TextWidth(mHeadFlex.TextMatrix(mHeadFlex.FixedRows - 1, lngCnt)) Then
                            mHeadFlex.ColWidth(lngCnt) = mHeadFlex.Parent.TextWidth(mHeadFlex.TextMatrix(mHeadFlex.FixedRows - 1, lngCnt))
                        End If
                        mBodyFlex.ColWidth(lngCnt) = mHeadFlex.ColWidth(lngCnt)
                        Exit For
                     End If
                Next lngCnt
                mBodyFlex.Redraw = True
                RaiseEvent AfterColResize(mlngMouseDownCol)
                mBodyFlex_Scroll
            ElseIf ColSort(mlngMouseDownCol) Then
                With mBodyFlex
                    '排序
                    If mlngMouseDownCol = mlngSortedCol And mlngSortedType = GridAscOrder Then
                        Sort mlngMouseDownCol, GridDescOrder
                    Else
                        Sort mlngMouseDownCol, GridAscOrder
                    End If
                    RaiseEvent AfterSort(mlngMouseDownCol)
                End With
            End If
        Else
            Result = mclsSubClassHead.CallWndProc(Msg, wParam, lParam)
        End If
    Case Else
        Result = mclsSubClassHead.CallWndProc(Msg, wParam, lParam)
    End Select
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  mFlex的事件处理程序
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub mFlex_DragDrop(Source As Control, x As Single, y As Single)
    Dim lngCol As Long, lngCnt As Long
    Dim lngStartCol As Long, lngEndCol As Long
    
    '拖动
    With mFlex
        If mlngMouseDownCol < .FixedCols Then
            lngStartCol = 1
            lngEndCol = .FixedCols - 1
        Else
            lngStartCol = .FixedCols
            If lngStartCol < 1 Then lngStartCol = 1
            lngEndCol = .Cols - 1
        End If
        
        If x <= .ColPos(lngStartCol) Then
            lngCol = lngStartCol
        ElseIf x >= .ColPos(lngEndCol) + .ColWidth(lngEndCol) Then
            lngCol = lngEndCol
        Else
            For lngCnt = lngStartCol To lngEndCol
                If x >= .ColPos(lngCnt) And x < .ColPos(lngCnt) + .ColWidth(lngCnt) Then
                    lngCol = lngCnt
                    Exit For
                End If
            Next
        End If
        
        If lngCol < mlngColOfs Or (lngCol < .FixedCols And mlngMouseDownCol >= .FixedCols) _
            Or (lngCol >= .FixedCols And mlngMouseDownCol < .FixedCols) Then
            mFlex.Drag vbCancel
            Exit Sub
        End If
        
        .ColPosition(mlngMouseDownCol) = lngCol
    End With
    
    If Not mclsListSet.ViewId <> 0 Then
        mblnSaveList = True
        lngCnt = 0
        If mlngMouseDownCol > lngCol Then
            For lngCnt = 1 To mlngMouseDownCol - lngCol
                mclsListSet.ExChangeColumn mlngMouseDownCol - lngCnt - mlngColOfs + 1, mlngMouseDownCol - lngCnt - mlngColOfs + 2
            Next lngCnt
        Else
            For lngCnt = 1 To lngCol - mlngMouseDownCol
                mclsListSet.ExChangeColumn mlngMouseDownCol + lngCnt - mlngColOfs, mlngMouseDownCol + lngCnt - mlngColOfs + 1
            Next lngCnt
        End If
    End If
End Sub

Private Sub mBodyFlex_RowColChange()
    Dim blnVisible As Boolean
    
    If Not mblnCancelRowColChange Then
        With mBodyFlex
            If .SelectionMode = flexSelectionByRow And .Row >= .FixedRows And .col <> 0 Then
                .col = 0
                mblnRowSel = True
            End If
        End With
    End If
End Sub

'快速定位
Private Sub mBodyFlex_KeyPress(KeyAscii As Integer)
    Static sngStartTime As Single
    Dim sngEndTime As Single
    Static strFind As String
    
    If mlngSortedType <> GridNoOrder And mlngSortedCol = mBodyFlex.col Then
        sngEndTime = Timer
        If sngEndTime - sngStartTime > 0.5 Then
            strFind = Chr(KeyAscii)
        Else
            strFind = strFind & Chr(KeyAscii)
        End If
        sngStartTime = sngEndTime
        
        FindKey strFind
    Else
        If mFlex.SelectionMode = flexSelectionFree Then
            SelectEditObject
            If Not (mEditObject Is Nothing) And Not ReadOnlyCol(mBodyFlex.col) Then
                MFlexEdit mEditObject, KeyAscii
            End If
        End If
    End If
End Sub

Private Sub mBodyFlex_Scroll()
    Dim lngCol As Long
   
    If Not (mEditObject Is Nothing) Then
        If mEditObject.Visible Then
            mEditObject.Visible = False
        End If
    End If
    
    mHeadFlex.Redraw = False
    For lngCol = 0 To mBodyFlex.Cols - 1
        mHeadFlex.ColWidth(lngCol) = mBodyFlex.ColWidth(lngCol)
    Next lngCol
    mHeadFlex.Redraw = True
    mHeadFlex.LeftCol = mBodyFlex.LeftCol
    If mHeadFlex.LeftCol <> mBodyFlex.LeftCol Then
         mBodyFlex.LeftCol = mHeadFlex.LeftCol
    End If
    RefreshGridData
End Sub

Private Sub mBodyFlex_LeaveCell()
    If Not (mEditObject Is Nothing) Then
        If mEditObject.Visible = False Then
            Exit Sub
        Else
            If Valid Then
                SaveText
            End If
            mEditObject.Visible = False
        End If
    End If
End Sub

Private Function GetRealColPos(ByVal intCol As Integer) As Long
  Dim intCount As Integer
    With mHeadFlex
        For intCount = 0 To intCol - 1
             If intCount < .FixedCols Or intCount >= .LeftCol Then
                If intCount = 0 Then
                   GetRealColPos = .ColPos(0) + .ColWidth(intCount)
                Else
                   GetRealColPos = GetRealColPos + .ColWidth(intCount)
                End If
             End If
        Next intCount
    End With
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 编辑控件方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub mBodyFlex_DblClick()
    If mBodyFlex.SelectionMode = flexSelectionFree And mBodyFlex.Rows > mBodyFlex.FixedRows Then
        SelectEditObject
        If Not (mEditObject Is Nothing) And Not ReadOnlyCol(mBodyFlex.col) Then
            MFlexEdit mEditObject, 32 '模拟一个空格。
        End If
    End If
End Sub

'为初始化文本框并将焦点从 MSFlexGrid 控件转移到 TextBox，可添加下列例程：
Sub MFlexEdit(Edt As Control, KeyAscii As Integer)
    Dim blnCancel As Boolean
    
    If mintRalationCol > 0 And mintRalationCol < mBodyFlex.Cols Then
        If mBodyFlex.TextMatrix(mBodyFlex.Row, mintRalationCol) <> mstrRalationValue Or mBodyFlex.SelectionMode = flexSelectionByRow Then
            Exit Sub
        End If
    End If
    
    If mBodyFlex.Rows <= mBodyFlex.FixedRows Or mBodyFlex.CellWidth <= 0 Or mBodyFlex.CellHeight <= 0 Then Exit Sub
    
    '在合适的位置显示 Edt。
'    Edt.Move mBodyFlex.Left + mBodyFlex.CellLeft - 15, mBodyFlex.top + mBodyFlex.CellTop, mBodyFlex.CellWidth, mBodyFlex.CellHeight
    Edt.Move mBodyFlex.Left + mBodyFlex.CellLeft - 15, mBodyFlex.top + mBodyFlex.CellTop - 15, mBodyFlex.CellWidth, mBodyFlex.CellHeight
    '使用已输入的字符。
    Select Case KeyAscii

    '空格表示编辑当前的文本。
    Case 0 To 32
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then Edt.Text = mBodyFlex
    
    Case 48 To 57
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then
            SendKeys Chr(KeyAscii)
        End If
    
    Case 65 To 90, 97 To 122
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then
            If Not (TypeOf Edt Is CalEdit) Then
                SendKeys Chr(KeyAscii)
            Else
                Edt.Text = ""
            End If
        End If
    
    '其它所有字符表示取代当前的文本。
    Case Else
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then
            Edt.Text = ""
        End If
    End Select

    Edt.Visible = True

    '启动工作。
    Edt.SetFocus
    Edt.SelStart = 1
    '清除保存标志
    Edt.Tag = ""
End Sub

Private Sub mFlex_Scroll()
    If Not (mEditObject Is Nothing) Then
        If mEditObject.Visible Then
            mEditObject.Visible = False
        End If
    End If
    RefreshGridData
End Sub


Private Sub mEditText_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode mEditObject, KeyCode, Shift
End Sub
Private Sub mListText_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode mEditObject, KeyCode, Shift
End Sub
Private Sub mCalendar_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    EditKeyCode mEditObject, KeyCode, Shift
End Sub
Private Sub mCalEdit_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    EditKeyCode mEditObject, KeyCode, Shift
End Sub
Private Sub mTEditText_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode mEditObject, KeyCode, Shift
End Sub

Private Sub mEditText_LostFocus()
    If Not mblnEdit Then
        mEditObject.Visible = False
        If Not mblnCancel Then
            If Valid Then SaveText
        End If
    End If
End Sub
Private Sub mListText_LostFocus()
    If Not mblnEdit Then
        mEditObject.Visible = False
        If Not mblnCancel Then
            If Valid Then SaveText
        End If
    End If
End Sub
Private Sub mCalendar_LostFocus()
    If Not mblnEdit Then
        mEditObject.Visible = False
        If Not mblnCancel Then
            If Valid Then SaveText
        End If
    End If
End Sub
Private Sub mCalEdit_LostFocus()
    If Not mblnEdit Then
        mEditObject.Visible = False
        If Not mblnCancel T