axgrid.ctl

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

                For lMyCol& = 1 To lCols
                    Cells.Value(lMyCol&, 0) = True
                    
                    bOver = GetCellCoordinates(0, lMyCol, lX, lY)
                    If Not bOver Then
                        lMyColWidth = ColWidth(lMyCol)
                        DrawCell 0, lMyCol, lX, 1, lMyColWidth, lMyRowHeight
                    End If
                Next
                
                lMyColWidth = ColWidth(0)
                For lMyRow& = 1 To lRows
                    Cells.Value(0, lMyRow&) = True
                
                    bOver = GetCellCoordinates(lMyRow, 0, lX, lY)
                    If Not bOver Then
                        lMyRowHeight = RowHeight(lMyRow)
                        DrawCell lMyRow, 0, 1, lY, lMyColWidth, lMyRowHeight
                    End If
                Next
                
                lCol1 = 1
                lCol2 = lCols
                lRow1 = 1
                lRow2 = lRows
                
                bSelectingRows = True
                bSelectingCols = True
                End If
            Else
                If lNewCol = 0 Then
                    'clicked on row header
                    If iSelectionMode = 1 And bAllowSelection Then
                        DrawCell lNewRow, lNewCol, 1, lY, lMyColWidth, lMyRowHeight
                        lCol1 = 1
                        lCol2 = lCols
                        lRow1 = lNewRow
                        lRow2 = lNewRow
                        
                        bSelectingRows = True
                    End If
                Else
                    'clicked on column header
                    If iSelectionMode = 2 And bAllowSelection Then
                        DrawCell lNewRow, lNewCol, lX, 1, lMyColWidth, lMyRowHeight
                        lCol1 = lNewCol
                        lCol2 = lNewCol
                        lRow1 = 1
                        lRow2 = lRows
                    
                        bSelectingCols = True
                    End If
                End If
            End If
        End If
            
        'Hilight the new selection
        HilightSelection
        
        'Un-hilight the previous selected cell
        HilightSelection lRow1, lCol1, lRow1, lCol1
        
        lCol = lCol1
        lRow = lRow1

        HilightCell
        
        'If bRedraw Then picGrid.Refresh
    ElseIf lNewRow > -1 And lNewCol > -1 Then
            
        'mouse clicked on unfixed cell
        
        'kdq090998
        'added so if last col does not fit in grid and is clicked on, auto move grid
        bOver = GetCellCoordinates(lNewRow, lNewCol, lX, lY)
        If lX + lColWidth(lNewCol) > scrVertical.Left Then scrHorizontal.Value = scrHorizontal.Value + 1
        If lY + lRowHeight(lNewRow) > scrHorizontal.Top Then scrVertical.Value = scrVertical.Value + 1
        
        If (Shift And 1) And (button And 1) Then
            'Shift was pressed
            'Un-hilight the old selection
            HilightSelection lRow1, lCol1, lRow2, lCol2
            'Hilight the new selection
            lRow2 = lNewRow
            lCol2 = lNewCol
            HilightSelection
        Else
            If lCol2 <> lCol1 Or lRow2 <> lRow1 Then
                HilightSelection
                'Un-hilight the previous selected cell
                HilightSelection lRow1, lCol1, lRow1, lCol1
            End If
            
            lRow1 = lNewRow
            lCol1 = lNewCol
            lRow2 = lRow1
            lCol2 = lCol1
            If lNewRow <> lRow Or lNewCol <> lCol Then
                'Re-set the edit box
                If bEditMode Then
                    HideEdit
                    'picGrid.AutoRedraw = False
                Else
                    HilightCell lRow, lCol
                End If
                
                bRedraw = False
                If lNewRow > -1 Then lRow = lNewRow
                If lNewCol > -1 Then lCol = lNewCol
                If lNewRow > -1 Or lNewCol > -1 Then
                    'Fire the event
                    'FireEvent 1
                End If
                bRedraw = True
                HilightCell
            End If
        End If
    End If
    End If
    'UserControl.Refresh
    If txtEdit.Visible Then
      txtEdit.Visible = False
      RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
    End If
    List1.Visible = False
    cmdLookup.Visible = False
    ShowLookup
  
    If lRow >= 0 And lCol >= 0 Then
    If lColMask(lCol) = 4 Then          'checkmark
      If Cells.Text(lCol, lRow) = "1" Then
        Cells.Text(lCol, lRow) = "0"
      Else
        Cells.Text(lCol, lRow) = "1"
      End If
      GetCellCoordinates lRow, lCol, xc&, yc&
      lMyColWidth = lColWidth(lCol)
      lMyRowHeight = lRowHeight(lRow)
      DrawCell lRow, lCol, xc&, yc&, lMyColWidth, lMyRowHeight
      DrawGridBorder
      HilightCell lRow, lCol
    End If
    End If
    
End Sub

Private Function RowFromPoint(x As Single, y As Single) As Long
    Dim lY As Long, lMyRowHeight As Long
    
    If bShowGrid Then
        bytGridLine = 1
    Else
        bytGridLine = 0
    End If
    
    If bColHeader Then
        lY& = lRowHeight(0) + bytGridLine + 1
    Else
        lY& = 1
    End If
    
    If y! > 0 And y! <= lY& Then
        RowFromPoint = 0
        Exit Function
    End If
    
    RowFromPoint = -1
    For lThisRow& = lTopRow To lRows
        lMyRowHeight = lRowHeight(lThisRow&)
        If y >= lY& And y <= lY& + lMyRowHeight Then
            RowFromPoint = lThisRow&
            Exit For
        End If
        lY& = lY& + lMyRowHeight& + bytGridLine
    Next
End Function

Private Function ColFromPoint(x As Single, y As Single)
    Dim lX As Long, lMyColWidth As Long
    
    If bShowGrid Then
        bytGridLine = 1
    Else
        bytGridLine = 0
    End If
    
    If bRowHeader Then
        lX& = lColWidth(0) + bytGridLine + 1
    Else
        lX& = 1
    End If
    
    If x! > 0 And x! <= lX& Then
        ColFromPoint = 0
        Exit Function
    End If
    
    ColFromPoint = -1
    For lThisCol& = lLeftCol To lCols
        lMyColWidth = lColWidth(lThisCol&)
        If x >= lX& And x <= lX& + lMyColWidth Then
            ColFromPoint = lThisCol&
            Exit For
        End If
        lX& = lX& + lMyColWidth& + bytGridLine
    Next
End Function

Public Sub EditKeyDown(KeyCode As Integer, Shift As Integer)
Attribute EditKeyDown.VB_MemberFlags = "40"
    Dim lX As Long, lY As Long, bOver As Boolean
    Dim lMyColWidth As Long, lMyRowHeight As Long
    
    Select Case KeyCode
    Case 13     'enter key
        If bEditMode Then
            Cells.Text(lCol, lRow) = txtEdit.Text
            bEditMode = False
            'RedrawAllCells False
            GetCellCoordinates lRow, lCol, x&, y&
            lMyColWidth = lColWidth(lCol)
            lMyRowHeight = lRowHeight(lRow)
            txtEdit.Visible = False
            txtEdit.ZOrder 1
            DrawCell lRow, lCol, x&, y&, lMyColWidth, lMyRowHeight
            DrawGridBorder
            HilightCell lRow, lCol
            RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
        End If
    
    Case 27     'escape key
        If bEditMode Then
            bEditMode = False
            'RedrawAllCells False
            GetCellCoordinates lRow, lCol, x&, y&
            lMyColWidth = lColWidth(lCol)
            lMyRowHeight = lRowHeight(lRow)
            txtEdit.Visible = False
            txtEdit.ZOrder 1
            DrawCell lRow, lCol, x&, y&, lMyColWidth, lMyRowHeight
            DrawGridBorder
            HilightCell lRow, lCol
        End If
    
    Case 38     'up arrow
        If bEditMode Then
            Cells.Text(lCol, lRow) = txtEdit.Text
            bEditMode = False
            'RedrawAllCells False
            GetCellCoordinates lRow, lCol, x&, y&
            lMyColWidth = lColWidth(lCol)
            lMyRowHeight = lRowHeight(lRow)
            txtEdit.Visible = False
            txtEdit.ZOrder 1
            DrawCell lRow, lCol, x&, y&, lMyColWidth, lMyRowHeight
            DrawGridBorder
            HilightCell lRow, lCol
            SendKeys "{UP}"
            RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
        End If
    
    Case 40     'down arrow
        If bEditMode Then
            Cells.Text(lCol, lRow) = txtEdit.Text
            bEditMode = False
            GetCellCoordinates lRow, lCol, x&, y&
            lMyColWidth = lColWidth(lCol)
            lMyRowHeight = lRowHeight(lRow)
            txtEdit.Visible = False
            txtEdit.ZOrder 1
            DrawCell lRow, lCol, x&, y&, lMyColWidth, lMyRowHeight
            DrawGridBorder
            HilightCell lRow, lCol
            SendKeys "{DOWN}"
            RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
        End If
    
    End Select
End Sub

Public Sub EditKeyPress(KeyAscii As Integer)
Attribute EditKeyPress.VB_MemberFlags = "40"
    If KeyAscii = 13 Then
        KeyAscii = 0
    End If
End Sub

Public Sub DblClick()
  Dim lMyColWidth As Long, lMyRowHeight As Long
  If lRow >= 0 And lCol >= 0 Then
    If lColMask(lCol) <> 4 Then          'checkmark
      GridEdit Asc(" ")
    End If
  End If
End Sub

Public Sub MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
Attribute MouseUp.VB_MemberFlags = "40"
    bMouseDown = False
    bSelectingRows = False
    bSelectingCols = False
    picSizer.Visible = False
    
    If bSizingCol Then
        If lCurrentColSizer& > 1 Then
            lNewWidth = picSizer.Left - hSizers(lCurrentColSizer& - 1)
        Else
            lNewWidth = picSizer.Left
        End If
        If lNewWidth < 0 Then lNewWidth = 10            'changed default to 10 from 0
        If bRowHeader Then
            ColWidth(lLeftCol + lCurrentColSizer& - 2) = lNewWidth
        Else
            ColWidth(lLeftCol + lCurrentColSizer& - 1) = lNewWidth
        End If
        ShowLookup
    End If
    bSizingCol = False
    
'    If bSizingRow Then
'        If lCurrentRowSizer& > 1 Then
'            lNewHeight = picSizer.Top - vSizers(lCurrentRowSizer& - 1)
'        Else
'            lNewHeight = picSizer.Top
'        End If
'        If lNewHeight < 0 Then lNewHeight = 0
'        RowHeight(lTopRow + lCurrentRowSizer - 2) = lNewHeight
'    End If
    bSizingRow = False
End Sub

Public Sub MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
Attribute MouseMove.VB_MemberFlags = "40"
    Dim lpRect As RECT, bytPointer As Byte
    Dim lScaleWidth As Integer, lScaleHeight As Integer
    Dim bShouldRedraw As Boolean, lNewCol2 As Long, lNewRow2 As Long
    Dim lPt As POINTAPI
    
    lScaleWidth = picGrid.ScaleWidth
    lScaleHeight = picGrid.ScaleHeight
    
    lNewRow2 = RowFromPoint(x, y)
    lNewCol2 = ColFromPoint(x, y)
    
    If bSizingCol Then
        If scrVertical.Visible Then
            lRightEdge = scrVertical.Left - 1
        Else
            lRightEdge = lScaleWidth
        End If
        
        If x <= lRightEdge Then picSizer.Left = x
    
    ElseIf bSizingRow Then
        If scrHorizontal.Visible Then
            lBottomEdge = scrHorizontal.Top - 1
        Else
            lBottomEdge = lScaleHeight
        End If
        
        If y <= lBottomEdge Then picSizer.Top = y
    
    ElseIf bMouseDown And bAllowSelection And iSelectionMode = 0 Then
        If bSelectingRows = True Or bSelectingCols = True Then
            'Select more rows
        Else
            'See if they're selecting multiple cells
            'picGrid.AutoRedraw = True
            bRedraw = False
            bShouldRedraw = False
            bMouseHit = False
            
            'See if we need to auto scroll up
            If y < 0 Or lNewRow2 = 0 Then
                If scrVertical.Value > 1 Then scrVertical = scrVertical - 1
                lNewRow2 = lTopRow
                bShouldRedraw = True
                bMouseHit = True
            End If
            
            'See if we need to auto scroll left
            If x < 0 Or lNewCol2 = 0 Then
                If scrHorizontal.Value > 1 Then scrHorizontal = scrHorizontal - 1
                lNewCol2 = lLeftCol