Data Presentation Techniques > Owner-drawn Cells |
For cases where you need to perform complex per-cell customizations using Windows API calls, you can draw directly to the list's device context by writing a handler for the OwnerDrawCell event. This event is fired as needed to display the contents of cells that have their OwnerDraw property set to True.
To implement the example depicted here, add the following type and constant declarations to a code module:
Example Title |
Copy Code
|
---|---|
Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' DrawText constants Public Const DT_CENTER = &H1 Public Const DT_VCENTER = &H4 Public Const DT_SINGLELINE = &H20 ' SetBkMode constants Public Const OPAQUE = 2 Public Const TRANSPARENT = 1 |
Next, add the following Windows API declarations to the code module:
Example Title |
Copy Code
|
---|---|
Declare Function CreateRectRgn Lib "gdi32" _ (ByVal X1 As Long, ByVal Y1 As Long, _ ByVal X2 As Long, ByVal Y2 As Long) As Long Declare Function CreateEllipticRgn Lib "gdi32" _ (ByVal X1 As Long, ByVal Y1 As Long, _ ByVal X2 As Long, ByVal Y2 As Long) As Long Declare Function FillRgn Lib "gdi32" _ (ByVal hdc As Long, ByVal hRgn As Long, ByVal hbrush As Long) As Long Declare Function CreateSolidBrush Lib "gdi32" _ (ByVal crColor As Long) As Long Declare Function SelectObject Lib "gdi32" _ (ByVal hdc As Long, ByVal hObject As Long) As Long 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 Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _ (ByVal lHeight As Long, ByVal lWidth As Long, _ ByVal lEscapement As Long, ByVal lOrientation As Long, _ ByVal lWeight As Long, ByVal lItalic As Long, _ ByVal lUnderline As Long, ByVal lStrikeOut As Long, _ ByVal lCharSet As Long, ByVal lOutPrecision As Long, _ ByVal lClipPrecision As Long, ByVal lQuality As Long, _ ByVal lPitch As Long, ByVal FaceName As String) As Long Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, ByVal crColor As Long) As Long Declare Function SetBkColor Lib "gdi32" _ (ByVal hdc As Long, ByVal crColor As Long) As Long Declare Function SetBkMode Lib "gdi32" _ (ByVal hdc As Long, ByVal nBkMode As Long) As Long |
Add the following to the general declarations section of the form containing the list:
Example Title |
Copy Code
|
---|---|
Option Explicit Dim BackBrush As Long Dim EllBrush As Long Dim NewFont As Long |
Add the following handlers for the Form_Load and Form_Unload events:
Example Title |
Copy Code
|
---|---|
Private Sub Form_Load()
BackBrush = CreateSolidBrush(vbWhite)
EllBrush = CreateSolidBrush(vbRed)
NewFont = CreateFont(10, 0, 0, 0, 700, 0, 0, 0, 0, _
0, 0, 0, 0, "MS Sans Serif")
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject BackBrush
DeleteObject EllBrush
DeleteObject NewFont
End Sub
|
The Form_Load event creates two brushes and a font and saves their handles for use in the OwnerDrawCell event. The Form_Unload event cleans up by deleting the brush and font handles.
Finally, implement the OwnerDrawCell event as follows:
Example Title |
Copy Code
|
---|---|
Private Sub TDBList1_OwnerDrawCell(ByVal hdc As Long, _ ByVal Bookmark As Variant, _ ByVal Split As Integer, ByVal Col As Integer, _ ByVal Left As Integer, ByVal Top As Integer, _ ByVal Right As Integer, ByVal Bottom As Integer, _ Done As Integer) Dim BackRegion As Long, EllRegion As Long Dim OldFgColor As Long, OldBkMode As Long, OldFont As Long ' Fill the interior of the cell using the white ' background brush created in the Form_Load event. BackRegion = CreateRectRgn(Left, Top, Right, Bottom) FillRgn hdc, BackRegion, BackBrush DeleteObject BackRegion ' Draw a solid red ellipse within the cell. EllRegion = CreateEllipticRgn(Left + 2, Top + 2, _ Right - 2, Bottom - 2) FillRgn hdc, EllRegion, EllBrush DeleteObject EllRegion ' Set the draw mode, text color, and font, saving ' the old values for later. The font handle NewFont ' was created in the Form_Load event. OldBkMode = SetBkMode(hdc, TRANSPARENT) OldFgColor = SetTextColor(hdc, vbWhite) OldFont = SelectObject(hdc, NewFont) Dim R As RECT R.Bottom = Bottom R.Left = Left R.Right = Right R.Top = Top ' Draw the cell text in white, and center it both ' horizontally and vertically within the cell. Dim S As String S = TDBList1.Columns(Col - 1).CellValue(Bookmark) DrawText hdc, S, Len(S), R, _ DT_CENTER + DT_VCENTER + DT_SINGLELINE ' Restore device context defaults changed earlier. SelectObject hdc, OldFont SetTextColor hdc, OldFgColor SetBkMode hdc, OldBkMode ' Tell the list that this event was handled. Done = True End Sub |
There are several key points worth noting in this example:
If you set the Done argument to True, the list will not fill in the cell's background, nor will it display cell text or graphics. Therefore, you are responsible for filling in the entire cell, even if there is no data to display.
The background and foreground colors of the device context passed in as the hdc argument are not initialized. In other words, you must explicitly call the SetBkColor (Windows API) and SetTextColor (Windows API) functions or create an appropriate background brush to use with a function such as FillRgn (Windows API).
The font of the device context passed in as the hdc argument is not initialized. In other words, you must explicitly create a font using the CreateFont (Windows API) function (or otherwise obtain a valid HFONT handle from a control), then select it into the device context using the SelectObject (Windows API) function.
Any change made to the device context, such as selecting a different font, should be restored before exiting the event.
Even a relatively simple example such as the one illustrated here requires a fair amount of coding, so you should consider using background bitmaps instead of owner-drawn cells if possible.