axgrid.ctl

VB开发的USB卸载助手源码VB开发的USB卸载助手源码VB开发的USB卸载助手源码VB开发的USB卸载助手源码

    lCol = lNewValue
    HilightCell
End Property

Public Property Get Text() As String
Attribute Text.VB_Description = "Gets/sets the text for the current row and column"
Attribute Text.VB_MemberFlags = "400"
    Text = Cells.Text(lCol, lRow)
End Property

Public Property Let Text(sNewValue As String)
    Cells.Text(lCol, lRow) = sNewValue
End Property

Public Property Get TextMatrix(ByVal vRow As Long, ByVal vCol As Long) As String
Attribute TextMatrix.VB_Description = "Gets/sets the text for the specified row and column"
    TextMatrix = Cells.Text(vCol, vRow)
End Property

Public Property Let TextMatrix(ByVal vRow As Long, ByVal vCol As Long, sNewValue As String)
    Cells.Text(vCol, vRow) = sNewValue
End Property

Public Property Get Redraw() As Boolean
    Redraw = bRedraw
End Property

Public Property Let Redraw(bNewValue As Boolean)
    bRedraw = bNewValue
    Refresh
End Property

Private Sub DrawRightCols(lThisLeftCol As Long, lUpdateWidth As Long)
    Dim lScaleWidth As Long, lScaleHeight As Long
    Dim lMyColWidth As Long
    
    lScaleWidth = picGrid.ScaleWidth
    lScaleHeight = picGrid.ScaleHeight
    
    If bShowGrid Then
        bytGridLine = 1
    Else
        bytGridLine = 0
    End If
    
    'If scrVertical.Visible Then
    '    lScrollWidth = scrVertical.Width
    'Else
        lScrollWidth = 0
    'End If
    
    If bRowHeader Then
        x& = lColWidth(0) + 1 + bytGridLine
    Else
        x& = 1
    End If
    For l& = lThisLeftCol To lCols
        lMyColWidth = lColWidth(l&)
        If x& < lScaleWidth - lUpdateWidth - lMyColWidth - lScrollWidth Then
            x& = x& + lMyColWidth + bytGridLine
        Else
            For lRemainder& = l& To lCols
                DrawCol lRemainder&, x&, True
                x& = x& + lColWidth(lRemainder&) + bytGridLine
                If l& = lCols& Or x& > lScaleWidth Then
                    Exit For
                End If
            Next
            Exit For
        End If
    Next
    lGridWidth& = x& - 1
    DrawBox lGridWidth + 1, 1, lScaleWidth - 1, lScaleHeight - 1, COLOR_GREY
End Sub

Private Sub RedrawAllCells(bDrawColHeader As Boolean)
    Dim lMyRowHeight As Long
    Dim lScaleHeight As Long, lScaleWidth As Long
    Dim lpRect As RECT
    
    'picGrid.AutoRedraw = True
    
    If bColHeader Then
        If bDrawColHeader Then
            DrawRow 0, 1, True
        End If
        y& = 1 + lRowHeight(0) + bytGridLine
        lGridHeight = 1 + lRowHeight(0)
    Else
        lGridHeight = 0
        y& = 1
    End If
    lScaleHeight = picGrid.ScaleHeight
    lScaleWidth = picGrid.ScaleWidth
    For lThisRow& = lTopRow To lRows
        lMyRowHeight& = lRowHeight(lThisRow&)
        DrawRow lThisRow&, y&, True
        y& = y& + lRowHeight(lThisRow&) + bytGridLine
        If lThisRow& = lRows Or y& > lScaleHeight - 1 Then
            If lLargeVChange = 0 Then
                lLargeVChange = lThisRow& - lTopRow - 1
                If lLargeVChange > 0 Then scrVertical.LargeChange = lLargeVChange
            End If
            lGridHeight = y& - 1
            Exit For
        End If
    Next
    
    If lGridHeight >= lScaleHeight - 1 Then
        bHeightOverflow = True
        lGridHeight = lScaleHeight - 1
        scrVertical.Tag = True
    Else
        If lTopRow > 1 Then
            bHeightOverflow = True
            scrVertical.Tag = True
        Else
            bHeightOverflow = False          'kdq090198          added to make sure scrollbars turn on/off
            scrVertical.Tag = False
        End If
    End If
    
    If lGridWidth >= lScaleWidth - 1 Then
        bWidthOverflow = True
        lGridWidth = lScaleWidth - 1
        scrHorizontal.Tag = True
    Else
        If lLeftCol > 1 Then
            bWidthOverflow = True
            scrHorizontal.Tag = True
        Else
            bWidthOverflow = False          'kdq090198          added to make sure scrollbars turn on/off
            scrHorizontal.Tag = False
        End If
    End If
    
    
    'color in space between grid and horizontal scrollbar
    DrawBox 1, lGridHeight + 1, lScaleWidth - 1, lScaleHeight - 1, lBackColorBkg        'COLOR_GREY
    'color in space between grid and vertical scrollbar
    DrawBox lGridWidth + 1, 1, lScaleWidth - GridWidth, lScaleHeight - 1, lBackColorBkg         'COLOR_GREY
    
    If Rows > 0 Then
    DrawGrid
    
        HilightSelection
        HilightSelection lRow1, lCol1, lRow1, lCol1

        bOver = GetCellCoordinates(lRow, lCol, x&, y&)
        If bOver = False Then
            HilightCell
        End If
    End If
    SetSizers
    ''Draw the grid border
    'lpRect.Left = 0
    'lpRect.Top = 0
    'lpRect.Bottom = UserControl.ScaleHeight
    'lpRect.Right = 0
    'DrawLine lpRect, vbBlack, UserControl.hDC
    '
    'lpRect.Right = UserControl.ScaleWidth - 1
    'lpRect.Bottom = 0
    'DrawLine lpRect, vbBlack, UserControl.hDC
    '
    'lpRect.Left = lpRect.Right
    'lpRect.Bottom = UserControl.ScaleHeight
    'DrawLine lpRect, vbBlack, UserControl.hDC
    
    'If bRedraw Then picGrid.Refresh
    'picGrid.AutoRedraw = False
End Sub

Private Sub DrawBox(x As Long, y As Long, lWidth As Long, lHeight As Long, lColor As Long)
    Dim lpRect As RECT, hBrush As Long
    
    lpRect.Top = y
    lpRect.Left = x
    lpRect.Right = lpRect.Left + lWidth
    lpRect.Bottom = lpRect.Top + lHeight
    hBrush = CreateSolidBrush(lColor)
    FillRect picGrid.hDC, lpRect, hBrush
    DeleteObject hBrush
End Sub

Private Sub DrawRect(x As Long, y As Long, x1 As Long, y1 As Long, lColor As Long)
    Dim lpRect As RECT
    picGrid.ForeColor = lColor
    
    'draw top line
    lpRect.Left = x
    lpRect.Top = y
    lpRect.Right = x1
    lpRect.Bottom = y
    MoveToEx picGrid.hDC, lpRect.Left, lpRect.Top, 0
    LineTo picGrid.hDC, lpRect.Right, lpRect.Bottom
    
    'draw bottom line
    lpRect.Left = x
    lpRect.Top = y1
    lpRect.Right = x1
    lpRect.Bottom = y1
    MoveToEx picGrid.hDC, lpRect.Left, lpRect.Top, 0
    LineTo picGrid.hDC, lpRect.Right, lpRect.Bottom
    
    'draw left line
    lpRect.Left = x
    lpRect.Top = y
    lpRect.Right = x
    lpRect.Bottom = y1
    MoveToEx picGrid.hDC, lpRect.Left, lpRect.Top, 0
    LineTo picGrid.hDC, lpRect.Right, lpRect.Bottom
    
    'draw right line
    lpRect.Left = x1
    lpRect.Top = y
    lpRect.Right = x1
    lpRect.Bottom = y1
    MoveToEx picGrid.hDC, lpRect.Left, lpRect.Top, 0
    LineTo picGrid.hDC, lpRect.Right, lpRect.Bottom
    
End Sub

Private Sub DrawLine(lpRect As RECT, lColor As Long, Optional DC)
    If IsMissing(DC) Then DC = picGrid.hDC
    picGrid.ForeColor = lColor
    MoveToEx DC, lpRect.Left, lpRect.Top, 0
    LineTo DC, lpRect.Right, lpRect.Bottom
End Sub

Public Property Get GridLineColor() As OLE_COLOR
Attribute GridLineColor.VB_Description = "Gets/sets the color used to draw the grid lines"
    GridLineColor = lGridLineColor
End Property

Public Property Let GridLineColor(lNewValue As OLE_COLOR)
    lGridLineColor = lNewValue
    Refresh
    PropertyChanged "GridLineColor"
End Property

Private Sub HilightCell(Optional ThisRow, Optional ThisCol)
    Dim lMyColWidth As Long, lMyRowHeight As Long
    Dim lScaleWidth As Long, lScaleHeight As Long
    Dim lpRect As RECT
    Dim bOver As Boolean
    Dim bytTopWidth As Byte
    
    If lRows < 1 Or lCols < 1 Then Exit Sub     'kdq090298
    If IsMissing(ThisRow) Then ThisRow = lRow
    If IsMissing(ThisCol) Then ThisCol = lCol
    
    lScaleWidth = picGrid.ScaleWidth
    lScaleHeight = picGrid.ScaleHeight
    
    If ThisRow >= lTopRow And ThisCol >= lLeftCol Then
        bOver = GetCellCoordinates(ThisRow, ThisCol, x&, y&)
        If bOver = False Then
            'Now we have the X and Y coordinates of the cell and we know
            '   that the cell is visible on the screen
            lMyColWidth = lColWidth(ThisCol)
            lMyRowHeight = lRowHeight(ThisRow)
            
            'Draw a black box around the cell
            picGrid.DrawMode = vbInvert
            
            'kdq090498      changed to force highlight to be the same on all columns
                lpRect.Left = x&
                lpRect.Top = y&
                lpRect.Right = lpRect.Left + lMyColWidth
                lpRect.Bottom = lpRect.Top + lMyRowHeight
                di = DrawFocusRect(picGrid.hDC, lpRect)
                
            
            picGrid.DrawMode = vbCopyPen
            picGrid.DrawWidth = 1
            
            'Set the position of the edit box
            txtEdit.Move x& + 3, y& + 2, lMyColWidth - 3, lMyRowHeight          'kdq090198      x and y were adjusted due to movement of picGrid
            If bEditMode Then
                txtEdit.Visible = True
            Else
                If txtEdit.Visible Then
                  txtEdit.Visible = False
                  RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
                End If
                txtEdit.ZOrder 1
            End If
        End If
    End If
    
    If bRedraw Then picGrid.Refresh
End Sub

Public Sub MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
Attribute MouseDown.VB_MemberFlags = "40"
    Dim lX As Long, lY As Long, lMyColWidth As Long, lMyRowHeight As Long
    Dim lNewCol As Long, lNewRow As Long
    Dim iMousePointer As Integer
    
    bMouseDown = True
    
    'Find out if we're sizing columns or rows
    iMousePointer% = UserControl.MousePointer
    If iMousePointer = vbSizeWE Then
        'Initiate the column size drag
        picSizer.Width = 2
        picSizer.Height = UserControl.ScaleHeight
        picSizer.Top = 0
        picSizer.Left = x
        picSizer.Visible = True
        bSizingCol = True
    ElseIf iMousePointer = vbSizeNS Then
        'Initiate the row size drag
        picSizer.Height = 2
        picSizer.Width = UserControl.ScaleWidth
        picSizer.Left = 0
        picSizer.Top = y
        picSizer.Visible = True
        bSizingRow = True
    Else
    
    'Un-select the spreadsheet 0,0 selector
    If Cells.Value(0, 0) Then
        Cells.Value(0, 0) = False
        GetCellCoordinates 0, 0, lX, lY
        lMyColWidth = ColWidth(0)
        lMyRowHeight = RowHeight(0)
        DrawCell 0, 0, 1, 1, lMyColWidth, lMyRowHeight
    End If
    
    'Un-select any col selectors
    lMyRowHeight = RowHeight(0)
    For lOldCol& = lCol1 To lCol2
        If Cells.Value(lOldCol&, 0) Then
            Cells.Value(lOldCol&, 0) = False
            bOver = GetCellCoordinates(0, lOldCol&, lX, lY)
            If Not bOver Then
                lMyColWidth = ColWidth(lOldCol)
                DrawCell 0, lOldCol, lX, 1, lMyColWidth, lMyRowHeight
            End If
        End If
    Next
    
    'Un-select any row selectors
    lMyColWidth = ColWidth(0)
    For lOldRow& = lRow1 To lRow2
        If Cells.Value(0, lOldRow&) Then
            Cells.Value(0, lOldRow&) = False
            bOver = GetCellCoordinates(lOldRow&, 0, lX, lY)
            If Not bOver Then
                lMyRowHeight = RowHeight(lOldRow&)
                DrawCell lOldRow, 0, 1, lY, lMyColWidth, lMyRowHeight
            End If
        End If
    Next
    
    'Process the mouse down
    If scrHorizontal.Visible And scrVertical.Visible And x > scrVertical.Left And y > scrHorizontal.Top Then Exit Sub
    
    lNewRow = RowFromPoint(x, y)
    lNewCol = ColFromPoint(x, y)
    
    If (lNewRow = 0 Or lNewCol = 0) And (lNewRow > -1 And lNewCol > -1) Then
        'mouse clicked on a fixed cell
        If (Shift And 1) And (button And 1) Then
            'Extend the existing selection
        Else
            If lRow1 <> lRow2 Or lCol1 <> lCol2 Then
                HilightSelection
                'Un-hilight the previous selected cell
                HilightSelection lRow1, lCol1, lRow1, lCol1
            End If
            
            HilightCell
            
            If bAllowSelection And iSelectionMode > 0 Then Cells.Value(lNewCol, lNewRow) = True
            bOver = GetCellCoordinates(lNewRow, lNewCol, lX, lY)
            lMyColWidth = ColWidth(lNewCol)
            lMyRowHeight = RowHeight(lNewRow)
            If lNewCol = 0 And lNewRow = 0 Then
                If bAllowSelection And iSelectionMode = 0 Then
                DrawCell lNewRow, lNewCol, 1, 1, lMyColWidth, lMyRowHeight
                
                lMyRowHeight = RowHeight(0)