I took a look at the example posted at DevX suggested by Flyguy and found that it basically does the same thing as subclassing to create an ownerdrawn combo, it overrides Windows attempts at drawing the control. In this case by continuously covering up what Windows has drawn which is easier than intercepting the messages and drawing the entire control yourself. That example incorporates the combo into a usercontrol, but there is another approach you could take using a class module for the drawing. One advantage is that instead of mapping them to the usercontrol you retain direct access to the combo's properties and methods. A big disadvantage is that this approach is more difficult to adapt to multiple combo boxes. I'm not saying that it is necessarily a better approach, but I thought I'd offer it as an alternative. The example below doesn't involve subclassing, it does however use a callback.
Code:
'---------------------------------------------------------------------------------------
' Project : Project1 Module : cFlatCombo
' Author : Lar_19 Date/Time : Jun 22, 2004 12:24
'---------------------------------------------------------------------------------------
Option Explicit
Public Enum fcboBorderStyle
Flat
Thin
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type COMBOBOXINFO
cbSize As Long ' Size, in bytes, of the structure.
rcItem As RECT ' Coords of the edit box.
rcButton As RECT ' Coords of the button that contains the drop-down arrow.
stateButton As Long ' See constants.
hwndCombo As Long ' Handle to the combo.
hwndItem As Long ' " " " edit box (N/A on 2-Dropdown List style)
hwndList As Long ' " " " dropdown list.
End Type
' COMBOBOXINFO stateButton constants. '0 = Btn exists but not pressed.
Private Const STATE_SYSTEM_INVISIBLE = &H8000& ' = There is no button.
Private Const STATE_SYSTEM_PRESSED = &H8 ' = The button is pressed.
' Used by the DrawEdge function.
Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Private Const BDR_SUNKENINNER = &H8
Private Const NULL_BRUSH = 5
Private Const SM_CXDLGFRAME = 7
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetComboBoxInfo Lib "user32.dll" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InflateRect Lib "USER32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DrawEdge Lib "USER32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private CB As ComboBox
Private m_eBdrStyle As fcboBorderStyle
Private m_iTimerID As Long
Private Sub Class_Terminate()
' Be sure to kill the timer.
Call StopTimer
End Sub
Private Function StartTimer() As Long
' Returns the timer identifier, or zero if it fails to create the timer. The
' TmrSet() funcioon requires as interval in ms, and a reference to the class.
StartTimer = TmrSet(300, Me)
End Function
Private Function StopTimer() As Boolean
StopTimer = CBool(TmrKill(m_iTimerID))
End Function
Public Sub RedrawCombo()
Call DrawCombo
End Sub
Private Sub DrawCombo()
' Drawing a mask over the combobox to cover any
' drawing done by Windows creates the 'Flat' look.
Dim iBdrWid As Long, tmpDC As Long, rc As RECT, CBI As COMBOBOXINFO
' Get the combobox dimensions and border width.
Call GetClientRect(CB.hWnd, rc)
tmpDC = GetDC(CB.hWnd)
iBdrWid = GetSystemMetrics(SM_CXDLGFRAME)
' Cover the existing outer border.
Call DrawBorder(tmpDC, rc, iBdrWid, vbWindowBackground)
' Get the combo style info and redraw the borders.
CBI.cbSize = Len(CBI)
Call GetComboBoxInfo(CB.hWnd, CBI)
If CBI.stateButton = STATE_SYSTEM_INVISIBLE Then
' The simple combo style doesn't have a button, but it does have a heavy
' border between the edit box and list sections that needs to be thinned.
rc.Bottom = CBI.rcItem.Bottom + iBdrWid
Call DrawBorder(tmpDC, rc, iBdrWid, vbWindowBackground)
Else
' Cover the border around the button.
Call DrawBorder(tmpDC, CBI.rcButton, iBdrWid, vbWindowBackground)
Call InflateRect(CBI.rcButton, -1, -1)
Call DrawBorder(tmpDC, CBI.rcButton, iBdrWid, vbButtonFace)
End If
If m_eBdrStyle = Thin Then
' Reset the rect to the full size and draw a thin border.
Call GetClientRect(CB.hWnd, rc)
Call DrawEdge(tmpDC, rc, BDR_SUNKENINNER, BF_RECT)
End If
' Release the memory
Call DeleteDC(tmpDC)
End Sub
Private Sub DrawBorder(ByVal hdc As Long, rc As RECT, ByVal iPenWidth As Long, ByVal clr As OLE_COLOR)
Dim hPen As Long, hOldPen As Long, hBrush As Long
hPen = CreatePen(vbSolid, iPenWidth, TranslateColor(clr))
hBrush = GetStockObject(NULL_BRUSH)
hOldPen = SelectObject(hdc, hPen)
DeleteObject SelectObject(hdc, hBrush)
Call Rectangle(hdc, rc.Left, rc.Top, rc.Right, rc.Bottom)
DeleteObject SelectObject(hdc, hOldPen)
Call DeleteObject(hOldPen)
End Sub
Private Function TranslateColor(ByVal clr As OLE_COLOR) As Long
Dim iNewClr As Long
Call OleTranslateColor(clr, 0, iNewClr)
TranslateColor = iNewClr
End Function
Public Property Let Border(eValue As fcboBorderStyle)
m_eBdrStyle = eValue
End Property
Public Property Get Border() As fcboBorderStyle
Border = m_eBdrStyle
End Property
Public Property Set FlatComboBox(CBox As ComboBox)
Set CB = CBox
m_iTimerID = StartTimer
End Property
Code:
'---------------------------------------------------------------------------------------
' Project : Project1 Module : mFlatCombo
' Author : Lar_19 Date/Time : Jun 22, 2004 12:25
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function SetTimer Lib "USER32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "USER32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private cbObj As Object ' Holds an instance of the class requiring the timer.
Function TmrSet(iTime As Long, CB As Object) As Long
' Returns the ID of the new timer if it succeeds, and zero if it fails.
TmrSet = SetTimer(0&, 0&, iTime, AddressOf TmrProc)
If TmrSet <> 0 Then Set cbObj = CB
End Function
Function TmrKill(iTimerID As Long) As Long
' Returns a nonzero value if it succeeds.
TmrKill = KillTimer(0&, iTimerID)
Set cbObj = Nothing
End Function
Private Sub TmrProc(ByVal iHwnd As Long, ByVal iMsg As Long, ByVal iTimerID As Long, ByVal iTime As Long)
' Timer callback procedure ussed to pass the event to the class for processing.
Call cbObj.RedrawCombo
End Sub
activeX for flat combo box on vb-6.0
Linear Mode
