axgrid.ctl

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

        If bWidthOverflow = False Then          'kdq090898      changed so scrollbars size properly
          scrVertical.Height = lScaleHeight
        Else
          scrVertical.Height = lScaleHeight - scrHorizontal.Height
        End If
        scrVertical.Visible = True
        scrVertical.Tag = True
    Else
        scrVertical.Visible = False
        scrVertical.Tag = False
    End If
    
    'Draw the horizontal scroll bar (if necessary)
    If bWidthOverflow Then
        If bHeightOverflow = False Then         'kdq090898      changed so scrollbars size properly
          scrHorizontal.Width = lScaleWidth
        Else
          scrHorizontal.Width = lScaleWidth - scrVertical.Width
        End If
        scrHorizontal.Visible = True
        scrHorizontal.Tag = True
    Else
        scrHorizontal.Visible = False
        scrHorizontal.Tag = False
    End If

    'Draw the grid border
    'lpRect.Left = 0
    'lpRect.Top = 0
    'lpRect.Bottom = lScaleHeight
    'lpRect.Right = 0
    'DrawLine lpRect, vbBlack
    '
    'lpRect.Right = lScaleWidth
    'lpRect.Bottom = 0
    'DrawLine lpRect, vbBlack
End Sub

Private Sub DrawButton(x As Long, y As Long, lWidth As Long, lHeight As Long, Value As Integer)

    Dim lpRect As RECT
    
    If Value Then
        un2 = DFCS_BUTTONPUSH Or DFCS_PUSHED
    Else
        un2 = DFCS_BUTTONPUSH
    End If

    '**********************  Draw the button  ****************************
    un1 = DFC_BUTTON
    lpRect.Left = x
    lpRect.Top = y
    lpRect.Right = x + lWidth
    lpRect.Bottom = y + lHeight
    
    DrawBox x, y, lWidth, lHeight, COLOR_GREY                 'kdq090198  clear out center of button
    
    Select Case Value
        Case False
            di = DrawEdge(picGrid.hDC, lpRect, BDR_RAISEDINNER, BF_TOPLEFT)
            di = DrawEdge(picGrid.hDC, lpRect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
        Case True
            di = DrawEdge(picGrid.hDC, lpRect, BDR_SUNKENINNER, BF_TOPLEFT)
            di = DrawEdge(picGrid.hDC, lpRect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT)
     End Select
End Sub

Public Property Get ColHeader() As Boolean
Attribute ColHeader.VB_Description = "Determines if column headers are displayed"
    ColHeader = bColHeader
End Property

Public Property Let ColHeader(bNewValue As Boolean)
    bColHeader = bNewValue
    Refresh
    PropertyChanged "ColHeader"
End Property

Public Property Get RowHeader() As Boolean
Attribute RowHeader.VB_Description = "Determines if row headers are displayed"
    RowHeader = bRowHeader
End Property

Public Property Let RowHeader(bNewValue As Boolean)
    bRowHeader = bNewValue
    Refresh
    PropertyChanged "RowHeader"
End Property

Public Property Get CellBackColor(ByVal lThisCol As Long, ByVal lThisRow As Long) As Long
Attribute CellBackColor.VB_Description = "Set/return background color for the specified cell"
Attribute CellBackColor.VB_MemberFlags = "400"
    CellBackColor = Cells.BackColor(lThisCol, lThisRow)
End Property

Public Property Let CellBackColor(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Long)
    Cells.BackColor(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellForeColor(ByVal lThisCol As Long, ByVal lThisRow As Long) As Long
Attribute CellForeColor.VB_Description = "Set/return foreground color for the specified cell"
Attribute CellForeColor.VB_MemberFlags = "400"
    CellForeColor = Cells.ForeColor(lThisCol, lThisRow)
End Property

Public Property Let CellForeColor(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Long)
    Cells.ForeColor(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontName(ByVal lThisCol As Long, ByVal lThisRow As Long) As String
Attribute CellFontName.VB_Description = "Set/return font name for the specified cell"
    CellFontName = Cells.FontName(lThisCol, lThisRow)
End Property

Public Property Let CellFontName(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As String)
    Cells.FontName(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontBold(ByVal lThisCol As Long, ByVal lThisRow As Long) As Boolean
Attribute CellFontBold.VB_Description = "Set/return font bold for the specified cell"
    CellFontBold = Cells.FontBold(lThisCol, lThisRow)
End Property

Public Property Let CellFontBold(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Boolean)
    Cells.FontBold(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontItalic(ByVal lThisCol As Long, ByVal lThisRow As Long) As Boolean
Attribute CellFontItalic.VB_Description = "Set/return font italics for the specified cell"
    CellFontItalic = Cells.FontItalic(lThisCol, lThisRow)
End Property

Public Property Let CellFontItalic(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Boolean)
    Cells.FontItalic(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontUnderline(ByVal lThisCol As Long, ByVal lThisRow As Long) As Boolean
Attribute CellFontUnderline.VB_Description = "Set/return font underline for the specified cell"
    CellFontUnderline = Cells.FontUnderline(lThisCol, lThisRow)
End Property

Public Property Let CellFontUnderline(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Boolean)
    Cells.FontUnderline(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontStrikeThru(ByVal lThisCol As Long, ByVal lThisRow As Long) As Boolean
Attribute CellFontStrikeThru.VB_Description = "Set/return font strikethru for the specified cell"
    CellFontStrikeThru = Cells.FontStrikethru(lThisCol, lThisRow)
End Property

Public Property Let CellFontStrikeThru(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Boolean)
    Cells.FontStrikethru(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get CellFontSize(ByVal lThisCol As Long, ByVal lThisRow As Long) As Integer
Attribute CellFontSize.VB_Description = "Set/return font size for the specified cell"
    CellFontSize = Cells.FontSize(lThisCol, lThisRow)
End Property

Public Property Let CellFontSize(ByVal lThisCol As Long, ByVal lThisRow As Long, lNewValue As Integer)
    Cells.FontSize(lThisCol, lThisRow) = lNewValue
    Refresh
End Property

Public Property Get TopRow() As Long
Attribute TopRow.VB_Description = "Returns or sets the uppermost visible row (other than a fixed row) in the grid. "
Attribute TopRow.VB_MemberFlags = "400"
    TopRow = lTopRow
End Property

Public Property Let TopRow(lNewValue As Long)
    lTopRow = lNewValue
End Property

Public Property Get LeftCol() As Long
Attribute LeftCol.VB_Description = "Returns or sets the left-most visible column (other than a fixed column) in the grid control"
Attribute LeftCol.VB_MemberFlags = "400"
    LeftCol = lLeftCol
End Property

Public Property Let LeftCol(lNewValue As Long)
    lLeftCol = lNewValue
    If bRedraw Then
        RedrawAllCells True
    End If
End Property

Private Sub DrawCell(lThisRow As Long, lThisCol As Long, x As Long, y As Long, lWidth As Long, lHeight As Long, Optional Selected)
    Dim XOffset As Byte, YOffset As Byte
    Dim lpRect As RECT, iFlags As Integer
    Dim cx As Long
    
    If IsMissing(Selected) Then Selected = False
    
    'Draw the cell box
    If Cells.Style(lThisCol, lThisRow) = STYLE_BUTTON Then
        If (lThisCol = 0 Or lThisRow = 0) And iFixedStyle = 0 Then
          DrawBox x, y, lWidth, lHeight, lBackColorFixed
        Else
          DrawButton x, y, lWidth + 1, lHeight + 1, Cells.Value(lThisCol, lThisRow)
        End If
        XOffset = 2
        YOffset = 0
    Else
        XOffset = 2
        'lCellforecolor& = Cells.BackColor(lThisCol, lThisRow)
        lcellbackcolor& = Cells.BackColor(lThisCol, lThisRow)
        If lcellbackcolor& < 0 Then lcellbackcolor& = lBackColor
        DrawBox x, y, lWidth, lHeight, lcellbackcolor&
    End If
    
    'Print the cell text in the cell
    If bDAO Then
        If lThisRow > 0 And lThisCol > 0 Then
            m_Recordset.AbsolutePosition = lThisRow - 1
            sCellText$ = m_Recordset(lThisCol - 1) & ""
        Else
            sCellText$ = Cells.Text(lThisCol, lThisRow)
        End If
    ElseIf bRDO Then
        sCellText$ = Cells.Text(lThisCol, lThisRow)
    Else
        sCellText$ = Cells.Text(lThisCol, lThisRow)
    End If
    
    If lThisCol <> 0 And lThisRow <> 0 And lColMask(lThisCol) = 4 Then      'draw checkmark if checkbox mask
      cx = x + (lWidth / 2) - 7         'calc width of cell, divide by 2, subtract 1/2 width of checkbox
      If Cells.Text(lThisCol, lThisRow) = "1" Then
        DrawFrameControl picGrid.hDC, MakeRect(cx, y + 1, 15, 15), DFC_BUTTON, DFCS_BUTTONCHECK Or DFCS_CHECKED
      Else
        DrawFrameControl picGrid.hDC, MakeRect(cx, y + 1, 15, 15), DFC_BUTTON, DFCS_BUTTONCHECK
      End If
    End If
    
        If lThisCol = 0 Or lThisRow = 0 Then
          picGrid.ForeColor = lForeColorFixed
 '          Set picGrid.Font = fFontFixed
          picGrid.FontName = fFontFixed.Name
          picGrid.FontSize = fFontFixed.Size
          picGrid.FontBold = fFontFixed.Bold
          picGrid.FontItalic = fFontFixed.Italic
          picGrid.FontUnderline = fFontFixed.Underline
          picGrid.FontStrikethru = fFontFixed.Strikethrough
           
        Else
           If Cells.ForeColor(lThisCol, lThisRow) < 0 Then
             picGrid.ForeColor = lForeColor
           Else
             picGrid.ForeColor = Cells.ForeColor(lThisCol, lThisRow)
           End If
'           Set picGrid.Font = fFont
          picGrid.FontName = fFont.Name
          picGrid.FontSize = fFont.Size
          picGrid.FontBold = fFont.Bold
          picGrid.FontItalic = fFont.Italic
          picGrid.FontUnderline = fFont.Underline
          picGrid.FontStrikethru = fFont.Strikethrough
        End If
        
        If Cells.FontName(lThisCol, lThisRow) > "" Then
          picGrid.FontName = Cells.FontName(lThisCol, lThisRow)
          picGrid.FontSize = Cells.FontSize(lThisCol, lThisRow)
          picGrid.FontBold = Cells.FontBold(lThisCol, lThisRow)
          picGrid.FontItalic = Cells.FontItalic(lThisCol, lThisRow)
          picGrid.FontUnderline = Cells.FontUnderline(lThisCol, lThisRow)
          picGrid.FontStrikethru = Cells.FontStrikethru(lThisCol, lThisRow)
        End If
    
    If (Len(sCellText$) And lColMask(lThisCol) <> 4) Or (lThisCol = 0 Or lThisRow = 0) Then
        
        iFlags = DT_SINGLELINE
        
        'Select Case Cells.TextAlign(lThisCol, lThisRow)
        Select Case lColAlign(lThisCol)             'kdq091498
        Case ALIGN_LEFT
            iFlags = iFlags + DT_LEFT
        Case ALIGN_CENTER
            iFlags = iFlags + DT_CENTER
        Case ALIGN_RIGHT
            iFlags = iFlags + DT_RIGHT
        End Select
        
        Select Case Cells.TextAlignVertical(lThisCol, lThisRow)
        Case ALIGNV_TOP
            iFlags = iFlags + DT_TOP
        Case ALIGNV_CENTER
            iFlags = iFlags + DT_VCENTER
        Case ALIGNV_BOTTOM
            iFlags = iFlags + DT_BOTTOM
        End Select
        
        lpRect.Top = y + YOffset
        lpRect.Left = x + XOffset
        lpRect.Right = lpRect.Left + lWidth - (XOffset * 2)
        lpRect.Bottom = lpRect.Top + lHeight - (YOffset * 2)
        DrawText picGrid.hDC, sCellText$, Len(sCellText$), lpRect, iFlags
    End If
End Sub

Public Property Get ShowGrid() As Boolean
Attribute ShowGrid.VB_Description = "Determines if grid lines are to be drawn"
    ShowGrid = bShowGrid
End Property

Public Property Let ShowGrid(bNewValue As Boolean)
    bShowGrid = bNewValue
    Refresh
End Property

Public Property Get GridSolid() As Boolean
Attribute GridSolid.VB_Description = "Determines if the grid is solid or dashed"
   GridSolid = bGridSolid
End Property

Public Property Let GridSolid(bNewValue As Boolean)
    bGridSolid = bNewValue
    Refresh
End Property

Public Sub HChange()
Attribute HChange.VB_MemberFlags = "40"
    Dim iDirection As Integer, lNewLeftCol As Long
    Dim lOldLeftCol As Long
    Dim lpRect As RECT, lpOldRect As RECT
    Dim lMyColWidth As Long
    Dim lMyRowHeight As Long
    Dim x As Long, y As Long
    
    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
        RaiseEvent AfterEdit(CInt(lRow), CInt(lCol), Text)
    End If
    
    lNewLeftCol& = scrHorizontal.Value
    iDirection% = lLeftCol& - lNewLeftCol&
    If Abs(iDirection%) = 1 Then
        'picGrid.AutoRedraw = True
        bOldRedraw = bRedraw
        bRedraw = False
        
        'Un-hilight the old selection
        HilightSelection
        'Un-hilight the previous selected cell
        HilightSelection lRow1, lCol1, lRow1, lCol1
        'Un-hilight the border of the previous selected cell
        'HilightCell
        
        lOldLeftCol = lLeftCol
        lLeftCol = lNewLeftCol&
        
        'Scroll the DC
        lpRect.Top = 1
        If bRowHeader Then
            lpRect.Left = lColWidth(0) + 2
        Else
            lpRect.Left = 1
        End If
        lpRect.Right = picGrid.ScaleWidth - 1
        If iDirection > 0 Then
            lMyColWidth& = lColWidth(lLeftCol&) + 1
        Else
            lMyColWidth& = lColWidth(lOldLeftCol&) + 1
        End If
        lpRect.Bottom = picGrid.ScaleHeight - 1
        lRet = ScrollDC(picGrid.hDC, lMyColWidth& * iDirection, 0, lpRect, lpRect, hRegion, lpOldRect)
        
        If iDirection > 0 Then
            DrawCol lNewLeftCol&, lpRect.Left, True
        Else