newgrid.cls

金算盘软件代码

            LineTo hdc, lngX, lngY
        End If
        
        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
    Dim strTmp As String
    '拖动
    With mFlex
        If mlngDragOverCol > mlngMouseDownCol Then
            lngCol = mlngDragOverCol - 1
        Else
            lngCol = mlngDragOverCol
        End If
        
        .ColPosition(mlngMouseDownCol) = lngCol
    End With
    
    If mclsListSet.ViewId > 0 Then
        lngCnt = 0
        If mlngMouseDownCol > lngCol Then
            For lngCnt = 1 To mlngMouseDownCol - lngCol
                mclsListSet.ExChangeColumn mlngMouseDownCol - lngCnt - mlngColOfs + 1, mlngMouseDownCol - lngCnt - mlngColOfs + 2
            Next lngCnt
            strTmp = frmName.hLb(mlngMouseDownCol).Caption
            For lngCnt = mlngMouseDownCol To lngCol + 1 Step -1
                frmName.hLb(lngCnt).Caption = frmName.hLb(lngCnt - 1).Caption
            Next lngCnt
            frmName.hLb(lngCol).Caption = strTmp
        Else
            For lngCnt = 1 To lngCol - mlngMouseDownCol
                mclsListSet.ExChangeColumn mlngMouseDownCol + lngCnt - mlngColOfs, mlngMouseDownCol + lngCnt - mlngColOfs + 1
            Next lngCnt
            strTmp = frmName.hLb(mlngMouseDownCol).Caption
            For lngCnt = mlngMouseDownCol To lngCol - 1
                frmName.hLb(lngCnt).Caption = frmName.hLb(lngCnt + 1).Caption
            Next lngCnt
            frmName.hLb(lngCol).Caption = strTmp
        End If
    End If
    
    For lngCnt = 1 To mFlex.Cols - 1
        If mFlex.TextMatrix(0, lngCnt) = mstrEditColTitle Then
            mintEditCol = lngCnt
        End If
        If mFlex.TextMatrix(0, lngCnt) = mstrRalationColTitle Then
            mintRalationCol = lngCnt
        End If
    Next lngCnt
    
    mFlex_RowColChange
End Sub


Private Sub mFlex_RowColChange()
    If Not mblnCancelRowColChange Then
        With mFlex
            If .SelectionMode = flexSelectionByRow And .Row > 0 And .col <> 0 Then
                .col = 0
            End If
        End With
    End If
    TotalRowAdjust
    DrawTotalBox
End Sub

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

        

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 编辑控件方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub mFlex_DblClick()
    If Not (EditObject Is Nothing) And Not ReadOnlyCol(mFlex.col) Then
         MFlexEdit EditObject, 32 '模拟一个空格。
    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 Then
            Exit Sub
        End If
    End If
    
    '使用已输入的字符。
    Select Case KeyAscii

    '空格表示编辑当前的文本。
    Case 0 To 32
        
        RaiseEvent BeforeEdit(blnCancel)
        
        If Not blnCancel Then Edt.Text = mFlex

    '其它所有字符表示取代当前的文本。
    Case Else
        Edt.Text = Chr(KeyAscii)
    End Select

    If mFlex.Left + mFlex.CellLeft < 0 Or mFlex.top + mFlex.CellTop < 0 Or mFlex.CellWidth < 0 Or mFlex.CellHeight < 0 Then
    Else
        mblnNotKillText = True
        '在合适的位置显示 Edt。
        Edt.Move mFlex.Left + mFlex.CellLeft, mFlex.top + mFlex.CellTop, mFlex.CellWidth, mFlex.CellHeight
        Edt.Visible = True
        '启动工作。
        Edt.SetFocus
        Edt.SelStart = 1
        mblnNotKillText = False
    End If
End Sub

'为更新数据向 TextBox 添加新的功能
Sub mEditText_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode EditObject, KeyCode, Shift
End Sub

Private Sub mFlex_Scroll()
    If Not (EditObject Is Nothing) Then
        If EditObject.Visible Then
            EditObject.Visible = False
        End If
    End If
    TotalRowAdjust
    DrawTotalBox
End Sub

Private Sub mListText_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode EditObject, KeyCode, Shift
End Sub
Private Sub mCalendar_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    EditKeyCode EditObject, KeyCode, Shift
End Sub
Private Sub mCalcEdit_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    EditKeyCode EditObject, KeyCode, Shift
End Sub

Sub EditKeyCode(Edt As Control, KeyCode As Integer, Shift As Integer)

    '标准编辑控件处理。
    Select Case KeyCode

    Case 27 'ESC:隐藏焦点并将其返回 MSFlexGrid。
        Edt.Visible = False
        mFlex.SetFocus

    Case 13 'ENTER 将焦点返回 MSFlexGrid。
        If Valid Then mFlex.SetFocus

    Case 38     '向上。
        If Valid Then
            mFlex.SetFocus
            DoEvents
            If mFlex.Row > mFlex.FixedRows Then
                mFlex.Row = mFlex.Row - 1
            End If
        End If

    Case 40     '向下。
        If Valid Then
            mFlex.SetFocus
            DoEvents
            If mFlex.Row < mFlex.Rows - 1 Then
                mFlex.Row = mFlex.Row + 1
            End If
        End If
    End Select
End Sub
    
'将 TextBox 的数据复制到 MSFlexGrid
'最后，当把数据输入到 TextBox 中时，先告诉 MSFlexGrid 控件应该对数据做什么。当用户输入数据并按 ENTER 键，或用鼠标单击 MSFlexGrid 控件中的另一个单元时，焦点将返回此控件。这时 TextBox 中的文本被复制到活动单元中。将下列代码添加到 GotFocus 和 LeaveCell 事件过程中：
Sub mFlex_GotFocus()
    If Not (EditObject Is Nothing) Then
        If EditObject.Visible = False Then
            Exit Sub
        Else
            If Valid() Then
                SaveText
                EditObject.Visible = False
            End If
        End If
    End If
End Sub

Sub mFlex_LeaveCell()
    If Not (EditObject Is Nothing) Then
        If EditObject.Visible = False Then
            Exit Sub
        Else
            SaveText
            EditObject.Visible = False
        End If
    End If
End Sub
    
Private Function Valid() As Boolean
    Dim blnCancel As Boolean
    mblnNotKillText = True
    
    RaiseEvent DataValid(blnCancel)
    
    Valid = Not blnCancel
    mblnNotKillText = True
End Function

Private Function SaveText()
    Dim blnCancel As Boolean
    Dim lngCol As Long, lngRow As Long
    
    RaiseEvent BeforeSave(blnCancel)
    
    If Not blnCancel Then
        For lngRow = mFlex.Row To mFlex.RowSel
            For lngCol = mFlex.col To mFlex.ColSel
                mFlex.TextMatrix(lngRow, lngCol) = EditObject.Text
            Next lngCol
        Next lngRow
    End If
    EditObject.Text = ""
    
    FormatCell mFlex.Row, mFlex.col
End Function

'重新格式数据单元内容
Public Sub FormatCell(ByVal lngRow As Long, ByVal lngCol1 As Long, Optional lngCol2 As Long = 0)
    Dim lngCol As Long
    
    If ListSet.ViewId > 0 Then
        If lngCol2 = 0 Then lngCol2 = lngCol1
         
        If ListSet.ColumnFieldDec(lngCol) > 0 Then
            With mFlex
                For lngCol = lngCol1 To lngCol2
                    .TextMatrix(lngRow, lngCol + mlngColOfs - 1) = Format(.TextMatrix(lngRow, lngCol + mlngColOfs - 1), "#0." + Replicate("0", ListSet.ColumnFieldDec(lngCol)))
                Next lngCol
            End With
        End If
    End If
End Sub

Private Sub RefreshGridData()
    Dim lngCol As Long
    Dim lngRow As Long
    
    If Not mblnNoRefresh And ListSet.ViewId > 0 Then
        With mFlex
            lngRow = .TopRow
            Do While lngRow <= .Rows - 1
                If .RowData(lngRow) = 0 Then
                    '未格式化
                    .RowData(lngRow) = 1
                    RaiseEvent BeforeRefresh(lngRow)
                    For lngCol = 1 To ListSet.Columns
                        If ListSet.ColumnFieldDec(lngCol) > 0 Then
                            .TextMatrix(lngRow, lngCol + mlngColOfs - 1) = Format(.TextMatrix(lngRow, lngCol + mlngColOfs - 1), "#0." + Replicate("0", ListSet.ColumnFieldDec(lngCol)))
                        End If
                    Next lngCol
                    RaiseEvent AfterRefresh(lngRow)
                End If
                If Not .RowIsVisible(lngRow) Then
                    Exit Do
                Else
                    lngRow = lngRow + 1
                End If
            Loop
        End With
    End If
End Sub

Private Function Replicate(ByVal Char As String, ByVal RepeatCount As Integer) As String
    Dim lngCnt As Long
    For lngCnt = 1 To RepeatCount
        Replicate = Replicate & Char
    Next lngCnt
End Function

Private Sub mclsHook_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
Static blnIn As Boolean
    If Msg = WM_PAINT Then
            '取Paint事件矩形区域
            GetUpdateRect frmName.hwnd, FormClipRect, False
            mclsHook.CallWndProc Msg, wParam, lParam
            If mFlex.Visible And blnRefresh Then
                If Not blnIn Then
                    blnIn = True
'                    TotalRowAdjust
                    DrawTotalBox
                    blnIn = False
                End If
            End If
    Else
        mclsHook.CallWndProc Msg, wParam, lParam
    End If
End Sub
Private Sub DrawTotalBox()
    Dim intI As Integer

'    画GRID下的表格
'    DrawABox frmName.hWnd, mFlex.Left - Screen.TwipsPerPixelX, mFlex.top + mFlex.Height - 1 * Screen.TwipsPerPixelY, mFlex.Left + mFlex.Width - 1 * Screen.TwipsPerPixelX, mFlex.top + mFlex.Height + mFlex.RowHeight(0) - 1 * Screen.TwipsPerPixelY, RGB(255, 255, 255), True
'    画GRID下的表格
   FrameBox frmName.hwnd, mFlex.Left - Screen.TwipsPerPixelX, mFlex.top - 1 * Screen.TwipsPerPixelY, mFlex.Left + mFlex.width - 0 * Screen.TwipsPerPixelX, mFlex.top + mFlex.Height + mFlex.RowHeight(0) + 2 * Screen.TwipsPerPixelY
'画合计栏上的竖线
    For intI = 0 To mFlex.Cols - 1
        If mFlex.ColPos(intI) + mFlex.ColWidth(intI) >= mFlex.width - Screen.TwipsPerPixelX Or (Not mFlex.ColIsVisible(intI)) Then
        Else
            DrawALine frmName.hwnd, 15 + mFlex.Left + mFlex.ColPos(intI) + mFlex.ColWidth(intI), mFlex.top + mFlex.Height, _
                        15 + mFlex.Left + mFlex.ColPos(intI) + mFlex.ColWidth(intI), mFlex.top + mFlex.Height + mFlex.RowHeight(0) + 2 * Screen.TwipsPerPixelY, _
                        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, RGB(128, 128, 128)
        End If
    Next intI
End Sub
Public Sub TotalRowAdjust()
 '合计行位置及宽度及当前可视性调整
    Dim i As Integer
    Dim lngWidth As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    Dim lngHeight As Long
    Dim j As Integer
    blnRefresh = False
'    On Error Resume Next
    lngHeight = mFlex.RowHeight(0) - 5
    lngTop = mFlex.top + mFlex.Height + 1 * Screen.TwipsPerPixelY
    j = frmName.hLb.UBound + 1
    For i = j To mFlex.Cols
        If frmName.hLb.UBound < i Then
            Load frmName.hLb(i)
            frmName.hLb(i).Caption = ""
        End If
    Next i
    
    For i = 0 To mFlex.Cols - 1
        If i > frmName.hLb.UBound Then
            Exit For
        End If
        If i = 0 Then
            lngLeft = mFlex.Left + 1 * Screen.TwipsPerPixelX
            lngWidth = 4 * frmName.FontSize * 10
            frmName.hLb(0).Move lngLeft, lngTop, lngWidth, lngHeight
            frmName.hLb(0).Caption = "合计"
            frmName.hLb(0).Visible = True
        Else
            If mFlex.ColIsVisible(i) And mFlex.ColWidth(i) > 0 Then
                If mFlex.ColPos(i) + mFlex.ColWidth(i) > mFlex.width Then
                    lngLeft = mFlex.Left + mFlex.ColPos(i) + 2 * 15
                    lngWidth = IIf(mFlex.width - mFlex.ColPos(i) - 4 * 15 > 0, _
                                    mFlex.width - mFlex.ColPos(i) - 4 * 15, 0)
                Else
                    lngLeft = mFlex.Left + mFlex.ColPos(i) + 2 * 15
                    lngWidth = IIf(mFlex.ColWidth(i) - 2 * 15 > 0, _
                                    mFlex.ColWidth(i) - 2 * 15, 0)
                End If
            End If
'            If mFlex.LeftCol = i Or (mFlex.LeftCol = mFlex.FixedCols And i = mFlex.FixedCols) Then
'                lngLeft = lngLeft + 5 * frmName.FontSize * 10
 '               lngWidth = lngWidth - 5 * frmName.FontSize * 10
  '          End If
            frmName.hLb(i).Move lngLeft, lngTop, lngWidth, lngHeight
            frmName.hLb(i).Visible = mFlex.ColIsVisible(i) And _
                                mFlex.ColWidth(i) > 0
        End If
    Next i
    If mFlex.ColPos(mFlex.Cols - 1) + mFlex.ColWidth(mFlex.Cols - 1) < mFlex.width Then
        lngLeft = mFlex.Left + mFlex.ColPos(mFlex.Cols - 1) + mFlex.ColWidth(mFlex.Cols - 1) + 2 * 15
        lngWidth = IIf(mFlex.width - mFlex.ColPos(mFlex.Cols - 1) - mFlex.ColWidth(mFlex.Cols - 1) - 2 * 15 > 0, _
                              mFlex.width - mFlex.ColPos(mFlex.Cols - 1) - mFlex.ColWidth(mFlex.Cols - 1) - 2 * 15, 0)
        frmName.hLb(mFlex.Cols).Move lngLeft, lngTop, lngWidth, lngHeight
        frmName.hLb(mFlex.Cols).Visible = True
    Else
        frmName.hLb(mFlex.Cols).Visible = False
    End If
    blnRefresh = True
End Sub