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
| Name | Description |