grid.cls

金算盘软件代码

                blnIsVisible = False
            ElseIf y1 < .top And y2 < .top Then
                blnIsVisible = False
            ElseIf y1 > .Bottom And y2 > .Bottom Then
                blnIsVisible = False
            Else
                If y1 < .top Then y1 = .top
                If y2 > .Bottom Then y2 = .Bottom
            End If
        ElseIf y1 = y2 Then
            If (y1 < .top Or y1 > .Bottom) Then
                blnIsVisible = False
            ElseIf x1 < .Left And x2 < .Left Then
                blnIsVisible = False
            ElseIf x1 > .Right And x2 > .Right Then
                blnIsVisible = False
            Else
                If x1 < .Left Then x1 = .Left
                If x2 > .Right Then x2 = .Right
            End If
        End If
    End With
    
    If blnIsVisible Then
        hPen = CreatePen(PS_SOLID, 1, Color)
        hSavePen = SelectObject(hdc, hPen)
        MoveToEx hdc, x1, y1, Point
        LineTo hdc, x2, y2
        SelectObject hdc, hSavePen
        DeleteObject hPen
    End If
End Sub


'画实心区域
Private Sub GridDrawSolidBox(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal Color As Long)
    Dim hPen As Long, hSavePen As Long
    Dim hBrush As Long, hSaveBrush As Long
    Dim blnIsVisible As Long
    
    x1 = x1 / Screen.TwipsPerPixelX
    x2 = x2 / Screen.TwipsPerPixelX
    y1 = y1 / Screen.TwipsPerPixelY
    y2 = y2 / Screen.TwipsPerPixelY
    
    '裁减作图区域
    blnIsVisible = True
    With mClipRect
        If x1 < .Left And x2 < .Left Then
            blnIsVisible = False
        ElseIf x1 > .Right And x2 > .Right Then
            blnIsVisible = False
        ElseIf y1 < .top And y2 < .top Then
            blnIsVisible = False
        ElseIf y1 > .Bottom And y2 > .Bottom Then
                blnIsVisible = False
        Else
            If x1 < .Left Then x1 = .Left
            If x2 > .Right Then x2 = .Right
            If y1 < .top Then y1 = .top
            If y2 > .Bottom Then y2 = .Bottom
        End If
    End With
    
    
    If blnIsVisible Then
        hPen = CreatePen(PS_SOLID, 1, Color)
        hSavePen = SelectObject(hdc, hPen)
        hBrush = CreateSolidBrush(Color)
        hSaveBrush = SelectObject(hdc, hBrush)
        Rectangle hdc, x1, y1, x2, y2
        SelectObject hdc, hSavePen
        SelectObject hdc, hSaveBrush
        DeleteObject hPen
        DeleteObject hBrush
    End If
End Sub



Private Sub mclsSubClassEdit_OnMessage(ByVal hwnd As Long, ByVal umsg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    If Not mEditObject Is Nothing Then
        Select Case umsg
        Case WM_KEYDOWN
            If wParam = vbKeyTab Then
                bCancel = True
                EditKeyCode mEditObject, vbKeyReturn, 0
            ElseIf (wParam = vbKeyDown Or wParam = vbKeyUp) Then
                If Not (TypeOf mEditObject Is ListText) And Not (TypeOf mEditObject Is GACALENDARLibCtl.calendar) Then
                    bCancel = True
                    EditKeyCode mEditObject, vbKeyReturn, 0
                End If
            End If
        End Select
    End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  SubClass程序
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub mclsSubClassFlex_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim lngX As Long, lngY As Long
    Dim blnCancel As Boolean, blnChangeCancel As Boolean
    Dim lngCnt As Long, lngCols As Long
    Dim intDX, intDY
    Dim blnIsOnCol As Boolean
    
    If Not mFlex.Visible Then
        Result = 0
        Exit Sub
    End If
    
    Select Case Msg
    Case WM_PAINT
        '取Paint事件矩形区域
        GetUpdateRect mFlex.hwnd, mClipRect, False
        
        Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
        
        DrawGridLine
        If mblnTotal Then DrawTotalBox
    Case WM_LBUTTONDOWN
        intDX = Screen.TwipsPerPixelX
        intDY = Screen.TwipsPerPixelY
        lngX = LoWord(lParam) * intDX
        lngY = HiWord(lParam) * intDY
        blnCancel = False
        If Not blnCancel Then
            With mFlex
                If lngX < .ColPos(0) Or lngX > (.ColPos(.Cols - 1) + .ColWidth(.Cols - 1)) Or _
                   lngY < .RowPos(0) Or lngY > (.RowPos(.Rows - 1) + .RowHeight(.Rows - 1)) Then
                    blnCancel = True
                    '选中无效区域，光标消失
                    If Not ((wParam And MK_CONTROL) = MK_CONTROL Or (wParam And MK_SHIFT) = MK_SHIFT) Then
                        If .SelectionMode = flexSelectionByRow Then
                            .col = 0
                            .ColSel = 0
                            mblnRowSel = False
                        ElseIf Not (mEditObject Is Nothing) Then
                            If mEditObject.Visible Then
                                .col = 0
                                .ColSel = 0
                                mblnRowSel = False
                            End If
                        End If
                    End If
                    
                ElseIf .MouseRow = 0 Then
                    '选中标题区域：如果光标位于列分割线上，不处理；如果光标没有位于列分割线上并且当前列是可排序列，按列排序；
                    '如果光标没有位于列分割线上并且当前列是不可排序列，取消该消息。
                    mblnMouseDownOnFixedRow = True
                    blnIsOnCol = False
                    
                    lngCols = .FixedCols
                    For lngCnt = 1 To lngCols
                        If lngX > .ColPos(lngCnt) + intDX And lngX < .ColPos(lngCnt) + .ColWidth(lngCnt) - intDX Then
                            blnIsOnCol = True
                            Exit For
                        End If
                    Next lngCnt
                    
                    If Not blnIsOnCol Then
                        lngCols = .Cols - 1
                        For lngCnt = .LeftCol To lngCols
                            If lngX > .ColPos(lngCnt) + intDX And lngX < .ColPos(lngCnt) + .ColWidth(lngCnt) - intDX Then
                                blnIsOnCol = True
                                Exit For
                            End If
                        Next lngCnt
                    End If
                    
                    If blnIsOnCol Then
                        mlngMouseDownCol = lngCnt
                        
                        '光标没有位于列分割线上，取消该消息
                        blnCancel = True
                    Else
                        mlngMouseDownCol = 0
                        For lngCnt = 1 To .Cols - 1
                            If lngX >= .ColPos(lngCnt) + .ColWidth(lngCnt) - intDX And lngX <= .ColPos(lngCnt) + .ColWidth(lngCnt) Then
                                mlngMouseDownCol = lngCnt
                                mblnColResize = True
                                Exit For
                            End If
                        Next lngCnt
                    End If
                Else
                    If .SelectionMode = flexSelectionByRow Then
                        If .Row <> .MouseRow And .Rows > .FixedRows Then
                            .Row = .MouseRow
                            blnCancel = True
                        End If
                        If .Row >= .FixedRows Then
                            mblnCancelRowColChange = True
                            If .col <> 0 Then .col = 0
                            If .ColSel = 0 Then .ColSel = .Cols - 1
                            mblnCancelRowColChange = False
                            mblnRowSel = True
                        End If
                    End If
                End If
            End With
            If Not blnCancel Then Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
        End If
        mFlex.SetFocus
    Case WM_MOUSEMOVE
        ' 确保隐藏的第0列不被拖除
        If mFlex.MouseRow <> 0 Or mFlex.MouseCol <> 0 Then
            blnCancel = False
            If wParam = MK_LBUTTON Then
                If mFlex.MouseRow = 0 And mblnMouseDownOnFixedRow And mlngMouseDownCol > 0 Then
                    mblnMouseDownOnFixedRow = False
                    
                    '隐藏编辑
                    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
                    
                    '如果ListSet对象存在，不可拖动非ListSet列
                    If Not mblnColResize And mblnColExchange And ListSet.ViewId > 0 And mlngMouseDownCol >= mlngColOfs Then
                        '启动拖动
        
                        RaiseEvent BeforeColChange(blnChangeCancel)
                        If Not blnChangeCancel Then
                            mlngDragOverCol = -1
                            mFlex.Drag vbBeginDrag
                        End If
                    End If
                End If
            End If
            
            If Not blnCancel Then Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
        End If
    Case WM_LBUTTONUP
        If mblnMouseDownOnFixedRow Then
            mblnMouseDownOnFixedRow = False
            If Not mblnColResize And ColSort(mlngMouseDownCol) Then
                With mFlex
                    '排序
                    If mlngMouseDownCol = mlngSortedCol And mlngSortedType = GridAscOrder Then
                        Sort mlngMouseDownCol, GridDescOrder
                    Else
                        Sort mlngMouseDownCol, GridAscOrder
                    End If
                    RaiseEvent AfterSort(mlngMouseDownCol)
                End With
            End If
        End If

        Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
        
        If mblnColResize Then
            mblnColResize = False
            mblnSaveList = True
            If mblnTotal Then
                TotalRowAdjust
                DrawTotalBox
            End If
            RaiseEvent AfterColResize(mlngMouseDownCol)
        End If
    Case WM_KEYDOWN
        Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
    Case Else
        Result = mclsSubClassFlex.CallWndProc(Msg, wParam, lParam)
    End Select
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  SubClass程序
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub mclsSubClassEdit_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim lngX As Long, lngY As Long
    Dim blnCancel As Boolean, blnChangeCancel As Boolean
    Dim lngCnt As Long, lngCols As Long
    Dim intDX, intDY
    Dim blnIsOnCol As Boolean
    
    If mEditObject Is Nothing Then
        Result = 0
        Exit Sub
    End If
    
    Select Case Msg
    Case WM_KEYDOWN
        Result = mclsSubClassEdit.CallWndProc(Msg, wParam, lParam)
    Case Else
        Result = mclsSubClassEdit.CallWndProc(Msg, wParam, lParam)
    End Select
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  mFlex的事件处理程序
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 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 + 1
        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 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 >= 0 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