grid.cls

金算盘软件代码

        mlngDragOverCol = lngCol
        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
        
        SetROP2 hdc, intMode
        SelectObject hdc, hSavePen
        DeleteObject hPen
        ReleaseDC .hwnd, hdc
    End With
End Sub

Private Sub mFlex_DragDrop(Source As Control, x As Single, y As Single)
    Dim lngCol As Long, lngCnt As Long
    
    '拖动
    With mFlex
        If mlngDragOverCol > mlngMouseDownCol Then
            lngCol = mlngDragOverCol - 1
        Else
            lngCol = mlngDragOverCol
        End If
        
        If lngCol < mlngColOfs Then
            lngCol = mlngColOfs
        End If
        
        .ColPosition(mlngMouseDownCol) = lngCol
    End With
    
    If mclsListSet.ViewId > 0 Then
        mblnSaveList = True
        lngCnt = 0
        If mlngMouseDownCol > lngCol Then
            For lngCnt = 1 To mlngMouseDownCol - lngCol
                If mlngMouseDownCol - lngCnt - mlngColOfs + 1 > 0 And mlngMouseDownCol - lngCnt - mlngColOfs + 2 <= mclsListSet.Columns Then
                    mclsListSet.ExChangeColumn mlngMouseDownCol - lngCnt - mlngColOfs + 1, mlngMouseDownCol - lngCnt - mlngColOfs + 2
                End If
            Next lngCnt
        Else
            For lngCnt = 1 To lngCol - mlngMouseDownCol
                If mlngMouseDownCol + lngCnt - mlngColOfs > 0 And mlngMouseDownCol + lngCnt - mlngColOfs + 1 <= mclsListSet.Columns Then
                    mclsListSet.ExChangeColumn mlngMouseDownCol + lngCnt - mlngColOfs, mlngMouseDownCol + lngCnt - mlngColOfs + 1
                End If
            Next lngCnt
        End If
    End If
    
    RaiseEvent AfterColChange(mlngMouseDownCol, lngCol)
    If mlngSortedCol = mlngMouseDownCol Then
        mlngSortedCol = lngCol
    ElseIf mlngSortedCol = lngCol Then
        mlngSortedCol = mlngMouseDownCol
    End If
End Sub


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

Private Sub mFlex_RowColChange()
    If Not mblnCancelRowColChange Then
        With mFlex
            If .SelectionMode = flexSelectionByRow And .Row >= .FixedRows And (.col <> 0 Or .ColSel <> .Cols - 1) Then
                mblnCancelRowColChange = True
                .col = 0
                .ColSel = .Cols - 1
                mblnCancelRowColChange = False
                mblnRowSel = True
            Else
'                If Not ReadOnlyCol(.col) Then
'                    If Not mEditObject Is Nothing Then
'                        SelectEditObject
'                        BeginEdit
'                    End If
'                Else
'                    Set mEditObject = Nothing
'                End If
            End If
        End With
    End If
    If mblnTotal Then
        TotalRowAdjust
        DrawTotalBox
    End If
End Sub

'快速定位
Private Sub mFlex_KeyPress(KeyAscii As Integer)
    Static sngStartTime As Single
    Dim sngEndTime As Single
    Dim blnModify As Boolean
    Static strFind As String
    Dim lngCnt As Long, lngCol As Long
    
    On Error Resume Next
    If mlngSortedType <> GridNoOrder And mlngSortedCol = mFlex.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
            If KeyAscii <> vbKeyReturn Then
                If KeyAscii <> vbKeyEscape Then
                    SelectEditObject
                    If Not (mEditObject Is Nothing) And Not ReadOnlyCol(mFlex.col) Then
                        MFlexEdit mEditObject, KeyAscii
                    End If
                End If
            Else
                blnModify = False
                For lngCnt = mFlex.FixedCols To mFlex.Cols - 1
                    If Not ReadOnlyCol(lngCnt) Then
                        blnModify = True
                        Exit For
                    End If
                Next lngCnt
                If blnModify Then
                    If mFlex.col < mFlex.Cols - 1 Then
                        lngCnt = mFlex.col
                        mFlex.Redraw = False
                        For lngCol = mFlex.col + 1 To mFlex.Cols - 1
                            If mFlex.ColWidth(lngCol) > 100 And Not ReadOnlyCol(lngCol) Then
                                Exit For
                            End If
                        Next lngCol
                        If lngCol <= mFlex.Cols - 1 Then
                            mFlex.col = lngCol
                        End If
                        If lngCnt = mFlex.col And mFlex.Row < mFlex.Rows - 1 Then
                            mFlex.Row = mFlex.Row + 1
                            For lngCol = mFlex.FixedCols To mFlex.Cols - 1
                                If mFlex.ColWidth(lngCol) > 100 And Not ReadOnlyCol(lngCol) Then
                                    Exit For
                                End If
                            Next lngCol
                            If lngCol <= mFlex.Cols - 1 Then
                               mFlex.col = lngCol
                            End If
                        End If
                        mFlex.Redraw = True
                        If Not mFlex.ColIsVisible(mFlex.col) Then
                            mFlex.LeftCol = mFlex.col
                        End If
                        If Not mFlex.RowIsVisible(mFlex.Row) Then
                            mFlex.TopRow = mFlex.TopRow + 1
                        Else
                            If Not CellPaste(mFlex.Row, mFlex.col) Then
                                mFlex.TopRow = mFlex.TopRow + 1
                            End If
                        End If
                        mFlex.SetFocus
                    ElseIf mFlex.Row < mFlex.Rows - 1 Then
                        mFlex.Redraw = False
                        mFlex.Row = mFlex.Row + 1
                        For lngCol = mFlex.FixedCols To mFlex.Cols - 1
                            If mFlex.ColWidth(lngCol) > 100 And Not ReadOnlyCol(lngCol) Then
                                Exit For
                            End If
                        Next lngCol
                        If lngCol <= mFlex.Cols - 1 Then
                           mFlex.col = lngCol
                        End If
                        mFlex.Redraw = True
                        If Not mFlex.ColIsVisible(mFlex.col) Then
                            mFlex.LeftCol = mFlex.col
                        End If
                        If Not mFlex.RowIsVisible(mFlex.Row) Then
                            mFlex.TopRow = mFlex.TopRow + 1
                        Else
                            If Not CellPaste(mFlex.Row, mFlex.col) Then
                                mFlex.TopRow = mFlex.TopRow + 1
                            End If
                        End If
                        mFlex.SetFocus
                    End If
                End If
            End If
        End If
    End If
End Sub

        

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 编辑控件方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub mFlex_DblClick()
    If mFlex.SelectionMode = flexSelectionFree And mFlex.Rows > mFlex.FixedRows And mFlex.MouseRow >= mFlex.FixedRows And mFlex.MouseCol = mFlex.col Then
        SelectEditObject
        If Not (mEditObject Is Nothing) And Not ReadOnlyCol(mFlex.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 < mFlex.Cols Then
        If mFlex.TextMatrix(mFlex.Row, mintRalationCol) <> mstrRalationValue Or mFlex.SelectionMode = flexSelectionByRow Then
            Exit Sub
        End If
    End If
    
    If mFlex.Rows <= mFlex.FixedRows Or mFlex.CellWidth <= 0 Or mFlex.CellHeight <= 0 Then Exit Sub
    
    '在合适的位置显示 Edt。
    If TypeOf Edt Is ComboBox Then
        Edt.width = mFlex.CellWidth
        Edt.Move mFlex.Left + mFlex.CellLeft - 15, mFlex.top + mFlex.CellTop - 15
    Else
        Edt.Move mFlex.Left + mFlex.CellLeft - 15, mFlex.top + mFlex.CellTop - 15, mFlex.CellWidth, mFlex.CellHeight
    End If
    
    '使用已输入的字符。
    Select Case KeyAscii

    '空格表示编辑当前的文本。
    Case 32
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then
'            If Not (TypeOf mEditObject Is ListText) Then
                Edt.Text = Trim(mFlex)
'            End If
        End If
    
    Case 45, 48 To 57
        RaiseEvent BeforeEdit(blnCancel)
        If Not blnCancel Then
            Edt.Text = ""
            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

    If Not blnCancel Then
        mlngEditRow = mFlex.Row
        mlngEditCol = mFlex.col
        Edt.Visible = True
        Edt.ZOrder 0
        '启动工作。
        Edt.SetFocus
        Edt.SelStart = 0
        '清除保存标志
        Edt.Tag = ""
    End If
End Sub

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


Private Sub mEditText_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If Not mEditObject Is Nothing Then
        EditKeyCode mEditObject, KeyCode, Shift
        If KeyCode = vbKeyReturn Then
            mEditObject.Visible = False
            mFlex_KeyPress vbKeyReturn
        End If
    End If
End Sub
Private Sub mListText_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If Not mEditObject Is Nothing Then
        EditKeyCode mEditObject, KeyCode, Shift
        If KeyCode = vbKeyReturn Then
            mEditObject.Visible = False
            mFlex_KeyPress vbKeyReturn
        End If
    End If
End Sub
Private Sub mCalendar_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    On Error Resume Next
    If Not mEditObject Is Nothing Then
        EditKeyCode mEditObject, KeyCode, Shift
        If KeyCode = vbKeyReturn Then
            mEditObject.Visible = False
            mFlex_KeyPress vbKeyReturn
        End If
    End If
End Sub
Private Sub mCalEdit_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    On Error Resume Next
    If Not mEditObject Is Nothing Then
        EditKeyCode mEditObject, KeyCode, Shift
        If KeyCode = vbKeyReturn Then
            mEditObject.Visible = False
            mFlex_KeyPress vbKeyReturn
        End If
    End If
End Sub
Private Sub mTEditText_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If Not mEditObject Is Nothing Then
        EditKeyCode mEditObject, KeyCode, Shift
        If KeyCode = vbKeyReturn Then
            mEditObject.Visible = False
            mFlex_KeyPress vbKeyReturn
        End If
    End If
End Sub

Private Sub mEditText_LostFocus()
'    If Not mblnEdit Then
'        If Not mEditObject Is Nothing Then mEditObject.Visible = False
'        If Not mblnCancel Then
'            If Valid Then SaveText
'        End If
'    End If
'    Dim blnCancel As Boolean
'
'    If mEditObject Is Nothing Then Exit Sub
'
'    '若