OwnerDrawHandler object

The OwnerDrawHandler interface provides an elegant way to let user paints the cell. The CellOwnerDraw property requires an object that implements the OwnerDrawHandler interface. Use the Def(exCellOwneDraw) property to assign an owner draw object for the entire column. The control calls DrawCell method when an owner draw cell requires painting. The inteface definition is like follows:

[
 uuid(BA219E1D-D1CD-4682-81AA-7E1D9D37B187),
 pointer_default(unique) 
]
interface IOwnerDrawHandler : IUnknown
{
 [id(1), helpstring("The source paints the cell.")] HRESULT DrawCell( long hDC, long left, long top, long right, long bottom, long Item, long Column, IDispatch* Source );
 [id(2), helpstring("The source erases the cell's background.")] HRESULT DrawCellBk( long hDC, VARIANT* Options, long left, long top, long right, long bottom, long Item, long Column, IDispatch* Source );
}

Use the DrawCellBk method to erase the cell's background. The DrawCell method is called before painting the cell's caption.

The following sample shows how to paint a gradient color into the cells:

Option Explicit
Implements IOwnerDrawHandler

Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Const ETO_OPAQUE = 2
Private Declare Sub InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal Y As Long)
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As RECT, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32" (ByVal c As Long, ByVal p As Long, c As Long) As Long
Private Const DT_VCENTER = &H4
Private Const DT_CENTER = &H1
Private Const DT_WORDWRAP = &H10

Private Sub DrawGradient(ByVal hdc As Long, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal c1 As Long, ByVal c2 As Long)
    On Error Resume Next
    Dim x As Long, rg, gg, bg, r1, r2, g1, g2, b1, b2
    Dim rc As RECT
    With rc
        .left = left
        .right = right
        .top = top
        .bottom = bottom
    End With
    OleTranslateColor c1, 0, c1
    OleTranslateColor c2, 0, c2
    r1 = c1 Mod 256
    r2 = c2 Mod 256
    b1 = Int(c1 / 65536)
    b2 = Int(c2 / 65536)
    g1 = Int(c1 / 256) Mod 256
    g2 = Int(c2 / 256) Mod 256
    For x = left To right Step 2
        rc.left = x
        SetBkColor hdc, RGB(r1 + (x - left) * (r2 - r1) / (right - left), g1 + (x - left) * (g2 - g1) / (right - left), b1 + (x - left) * (b2 - b1) / (right - left))
        ExtTextOut hdc, rc.left, rc.top, ETO_OPAQUE, rc, " ", 1, x
    Next
    End Sub

Private Sub Form_Load()
    With Grid1
        .BeginUpdate
        .LinesAtRoot = False
        .SortOnClick = False
        .MarkTooltipCells = True
        .ShowFocusRect = False
        .MarkSearchColumn = False
        .ShowFocusRect = True
        .ColumnAutoResize = True
        .BackColor = vbWhite
        .SelBackColor = vbWhite
        .SelForeColor = vbBlue
        Set .Picture = LoadPicture(App.Path + "\exontrol.gif")
        .PictureDisplay = LowerRight
        .SelBackMode = exTransparent
        .SelBackColor = vbWhite

        ' Adds few columns
        With .Columns
            .Add("Name").Width = 242
            With .Add("Description")
                .Width = 356
                .HeaderImage = 2
                .Editor.EditType = MemoType
                .Editor.Appearance = RaisedApp
            End With
        End With

        ' Adds few items
        With .Items
            Dim h As HITEM, h2 As HITEM, h3 As HITEM
            h = .AddItem("My Desktop")
            .CellBold(h, 0) = True
            ' Defines the cell that becomes the title for the divider
            .ItemHeight(h) = .ItemHeight(h) + 4
            .ItemDivider(h) = 0
            .CellBackColor(h) = &HFF6531
            .ItemForeColor(h) = vbWhite
            .ItemDividerLine(h) = EmptyLine
            Set .CellOwnerDraw(h, 0) = Me

            h2 = .InsertItem(h, , "Hard Disk Drives")
            .CellBold(h2, 0) = True
            .ItemDivider(h2) = 0
            .ItemDividerLine(h2) = DotLine
            .CellBackColor(h2) = vbBlue
            .ItemHeight(h2) = .ItemHeight(h2) + 4
            .CellForeColor(h2, 0) = &HFF6531
            .CellForeColor(h2, 0) = vbWhite
            Set .CellOwnerDraw(h2, 0) = Me

            h3 = .InsertItem(h2, , "Scratch (C:)" & vbCrLf & "1.95 GB" & vbCrLf)
            .CellPicture(h3, 0) = LoadPicture(App.Path + "\hard.gif")
            .CellSingleLine(h3, 0) = False
            .CellValue(h3, 1) = "You can add hardware devices to your Windows CE–based target platform that are not directly supported by Windows CE. However, if you do, you must supply device drivers for the additional devices."
            .CellSingleLine(h3, 1) = False
            .CellToolTip(h3, 0) = "This is a bit of text that shoud appear when the cursor is over a cell."

            h3 = .InsertItem(h2, , "Main (E:)" & vbCrLf & "15 GB" & vbCrLf)
            .CellPicture(h3, 0) = LoadPicture(App.Path + "\hard.gif")
            .CellForeColor(h3, 0) = RGB(128, 128, 128)
            .CellSingleLine(h3, 0) = False
            .CellValue(h3, 1) = "Windows CE versions 1.01 and later provide kernel support to enable stream interface drivers to access additional built-in hardware devices."
            .CellSingleLine(h3, 1) = False
            .CellBackColor(h3, 1) = RGB(196, 196, 196)
            .CellForeColor(h3, 1) = vbBlack
            Set .CellOwnerDraw(h3, 1) = Me

            .ExpandItem(h2) = True

            h2 = .InsertItem(h, , "Devices with Removable Storage")
            .CellBold(h2, 0) = True
            .ItemDivider(h2) = 0
            .ItemDividerLine(h2) = DotLine
            .CellBackColor(h2) = vbBlue
            .ItemHeight(h2) = .ItemHeight(h2) + 4
            .CellForeColor(h2, 0) = vbWhite
            Set .CellOwnerDraw(h2, 0) = Me

            h3 = .InsertItem(h2, , vbCrLf & "3½ Floppy (A:)" & vbCrLf)
            .CellPicture(h3, 0) = LoadPicture(App.Path + "\floppy.gif")
            .CellSingleLine(h3, 0) = False
            With .CellEditor(h3, 1)
                .EditType = ColorType
            End With
            .CellValue(h3, 1) = .CellBackColor(.ItemParent(h3), 0)
            .CellData(h3, 1) = True

            h3 = .InsertItem(h2, , vbCrLf & "CD Reader" & vbCrLf)
            .CellPicture(h3, 0) = LoadPicture(App.Path + "\floppy.gif")
            .CellSingleLine(h3, 0) = False
            With .CellEditor(h3, 1)
                .EditType = ColorType
            End With
            .CellValue(h3, 1) = .CellBackColor(.ItemParent(h3), 0)
            .CellData(h3, 1) = True

            .ExpandItem(h2) = True

            .ExpandItem(h) = True

            h = .AddItem("Folder Options")
            .CellBold(h, 0) = True
            .ItemDivider(h) = 0
            .CellBackColor(h) = &HFF6531
            .ItemForeColor(h) = vbWhite
            .ItemHeight(h) = .ItemHeight(h) + 4
            Set .CellOwnerDraw(h, 0) = Me

            h2 = .InsertItem(h, , "Web View")
            .CellImage(h2, 0) = 2
            .CellBold(h2, 0) = True
            .ItemDivider(h2) = 0
            .ItemDividerLine(h2) = DotLine
            .ItemHeight(h2) = .ItemHeight(h2) + 4
            .CellForeColor(h2, 0) = vbWhite
            .CellBackColor(h2) = vbBlue
            Set .CellOwnerDraw(h2, 0) = Me

            h3 = .InsertItem(h2, , "Enable Web content in folders")
            .CellHasRadioButton(h3, 0) = True
            .CellImage(h3, 0) = 1
            .CellRadioGroup(h3, 0) = 1234
            .CellState(h3, 0) = 1
            .CellEditorVisible(h3, 1) = False

            h3 = .InsertItem(h2, , "Use Windows Classic folders")
            .CellHasRadioButton(h3, 0) = True
            .CellRadioGroup(h3, 0) = 1234
            .CellImage(h3, 0) = 2
            .CellEditorVisible(h3, 1) = False

            .ExpandItem(h2) = True

            .ExpandItem(h) = True

        End With
        .EndUpdate
    End With
End Sub

Private Sub Grid1_Change(ByVal Item As EXGRIDLibCtl.HITEM, ByVal ColIndex As Long, NewValue As Variant)
    With Grid1.Items
        If .CellData(Item, ColIndex) Then
            .CellBackColor(.ItemParent(Item), 0) = NewValue
        End If
    End With
End Sub

Private Sub IOwnerDrawHandler_DrawCellBk(ByVal hDC As Long, Options As Variant, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal Item As Long, ByVal Column As Long, ByVal Source As Object)
End Sub

Private Sub IOwnerDrawHandler_DrawCell(ByVal hdc As Long, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal Item As Long, ByVal Column As Long, ByVal Source As Object)
    With Source.Items
        ' Draws the background cell by gradient
        DrawGradient hdc, left, top, right / 2, bottom, vbWhite, .CellBackColor(Item, Column)
        DrawGradient hdc, right / 2, top, right, bottom, .CellBackColor(Item, Column), vbWhite

        ' Gets the caption cell
        Dim str As String
        str = .CellValue(Item, Column)

        ' Draws the caption cell
        Dim rc As RECT
        With rc
            .left = left
            .right = right
            .top = top
            .bottom = bottom
        End With

        SetTextColor hdc, .CellForeColor(Item, Column)
        rc.top = rc.top + 2
        DrawText hdc, str, Len(str), rc, DT_CENTER Or DT_WORDWRAP
    End With
End Sub

The following sample erase the cell's background, but let the control paints the cell's content:

Implements IOwnerDrawHandler

Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Const ETO_OPAQUE = 2
Private Declare Sub InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal Y As Long)
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As RECT, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32" (ByVal c As Long, ByVal p As Long, c As Long) As Long
Private Const DT_VCENTER = &H4
Private Const DT_CENTER = &H1
Private Const DT_WORDWRAP = &H10
Private Const DT_SINGLELINE = &H20

Private Type POINTAPI
        x As Long
        Y As Long
End Type

Private Sub DrawGradient(ByVal hDC As Long, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal c1 As Long, ByVal c2 As Long)
    On Error Resume Next
    Dim x As Long, rg, gg, bg, r1, r2, g1, g2, b1, b2
    Dim rc As RECT
    With rc
        .left = left
        .right = right
        .top = top
        .bottom = bottom
    End With
    OleTranslateColor c1, 0, c1
    OleTranslateColor c2, 0, c2
    r1 = c1 Mod 256
    r2 = c2 Mod 256
    b1 = Int(c1 / 65536)
    b2 = Int(c2 / 65536)
    g1 = Int(c1 / 256) Mod 256
    g2 = Int(c2 / 256) Mod 256
    For x = left To right Step 2
        rc.left = x
        SetBkColor hDC, RGB(r1 + (x - left) * (r2 - r1) / (right - left), g1 + (x - left) * (g2 - g1) / (right - left), b1 + (x - left) * (b2 - b1) / (right - left))
        ExtTextOut hDC, rc.left, rc.top, ETO_OPAQUE, rc, " ", 1, x
    Next
End Sub


Private Sub Form_Load()
    With Grid1.Items
        Set .CellOwnerDraw(.FindItem("Root 2"), 0) = Me
    End With
End Sub

Private Sub IOwnerDrawHandler_DrawCell(ByVal hDC As Long, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal Item As Long, ByVal Column As Long, ByVal Source As Object)
 End Sub

Private Sub IOwnerDrawHandler_DrawCellBk(ByVal hDC As Long, Options As Variant, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal Item As Long, ByVal Column As Long, ByVal Source As Object)
    Dim c1 As Long, c2 As Long, c As Long
    c1 = Source.BackColor
    c2 = Source.SelBackColor
    DrawGradient hDC, left, top, (right + left) / 2, bottom, c1, c2
    DrawGradient hDC, (right + left) / 2, top, right, bottom, c2, c1
End Sub

 NameDescription