回复：自绘制控件集合

Public Sub AddMenu(mnuItem As MENUITEMINFO, ByVal Top As Boolean, ByVal mnuString As String, ByVal hwnd As Long)
 Dim PTab As Long
 mnuItem.fType = mnuItem.fType Or MF_OWNERDRAW
 ReDim Preserve OwnerMenus(UBound(OwnerMenus) + 1)
 PTab = InStr(mnuString, vbTab)
 OwnerMenus(UBound(OwnerMenus)).Parent = hwnd
 OwnerMenus(UBound(OwnerMenus)).TopMenu = Top
 OwnerMenus(UBound(OwnerMenus)).Separator = (mnuItem.fType And MF_SEPARATOR)
 If PTab = 0 Then
 OwnerMenus(UBound(OwnerMenus)).MenuCaption = mnuString
 OwnerMenus(UBound(OwnerMenus)).MenuHotKey = ""
 Else
 OwnerMenus(UBound(OwnerMenus)).MenuCaption = Left$(mnuString, PTab - 1)
 OwnerMenus(UBound(OwnerMenus)).MenuHotKey = Right$(mnuString, Len(mnuString) - PTab)
 End If
 OwnerMenus(UBound(OwnerMenus)).IconIndex = 0
 OwnerMenus(UBound(OwnerMenus)).hHotIcon = 0
 OwnerMenus(UBound(OwnerMenus)).hDisableIcon = 0
 OwnerMenus(UBound(OwnerMenus)).hImageList = 0
 MenuLink.Add UBound(OwnerMenus), CStr(mnuItem.wID)
End Sub

Public Sub DrawCheckMark(ByVal pDC As Long, ByVal X As Long, ByVal Y As Long, ByVal Color As Long)
 Call SetPixel(pDC, X, Y + 2, Color)
 Call SetPixel(pDC, X, Y + 3, Color)
 Call SetPixel(pDC, X, Y + 4, Color)
 Call SetPixel(pDC, X + 1, Y + 3, Color)
 Call SetPixel(pDC, X + 1, Y + 4, Color)
 Call SetPixel(pDC, X + 1, Y + 5, Color)
 Call SetPixel(pDC, X + 2, Y + 4, Color)
 Call SetPixel(pDC, X + 2, Y + 5, Color)
 Call SetPixel(pDC, X + 2, Y + 6, Color)
 Call SetPixel(pDC, X + 3, Y + 3, Color)
 Call SetPixel(pDC, X + 3, Y + 4, Color)
 Call SetPixel(pDC, X + 3, Y + 5, Color)
 Call SetPixel(pDC, X + 4, Y + 2, Color)
 Call SetPixel(pDC, X + 4, Y + 3, Color)
 Call SetPixel(pDC, X + 4, Y + 4, Color)
 Call SetPixel(pDC, X + 5, Y + 1, Color)
 Call SetPixel(pDC, X + 5, Y + 2, Color)
 Call SetPixel(pDC, X + 5, Y + 3, Color)
 Call SetPixel(pDC, X + 6, Y, Color)
 Call SetPixel(pDC, X + 6, Y + 1, Color)
 Call SetPixel(pDC, X + 6, Y + 2, Color)
End Sub

Public Sub DrawRadioDot(ByVal pDC As Long, ByVal X As Long, ByVal Y As Long, ByVal Color As Long)
 Dim rcDot As RECT, Brush As Long, Pen As Long
 rcDot.Left = X: rcDot.Top = Y: rcDot.Right = X + MENUCHECKMARKSIZE: rcDot.Bottom = Y + MENUCHECKMARKSIZE
 Brush = CreateSolidBrush(Color)
 Pen = CreatePen(PS_SOLID, 0, Color)
 Dim pOldBrush As Long
 pOldBrush = SelectObject(pDC, Brush)
 Dim pOldPen As Long
 pOldPen = SelectObject(pDC, Pen)
 Call Ellipse(pDC, rcDot.Left, rcDot.Top, rcDot.Right, rcDot.Bottom)
 Call SelectObject(pDC, pOldBrush)
 Call SelectObject(pDC, pOldPen)
 Call DeleteObject(Pen)
 Call DeleteObject(Brush)
End Sub

Public Function GetImageListIcon(ByVal hImageList As Long, ByVal ImageIndex As Long) As Long
 GetImageListIcon = ImageList_GetIcon(hImageList, ImageIndex - 1, 0)
End Function

Public Sub DrawMenuIcon(pDC As Long, DrawItem As DRAWITEMSTRUCT, MenuItem As MenuInformation)
 If DrawItem.itemState And ODS_SELECTED Then
 If DrawItem.itemState And ODS_GRAYED Then
 Dim Br As Long
 Br = CreateSolidBrush(GetSysColor(COLOR_GRAYTEXT))
 Call DrawState(pDC, Br, 0, GetImageListIcon(MenuItem.hImageList, MenuItem.IconIndex), 0, DrawItem.rcItem.Left + 2, DrawItem.rcItem.Top + 2, 16, 16, DST_ICON Or DSS_MONO)
 Else
 If MenuItem.hHotIcon = -1 Then
 Call ImageList_Draw(MenuItem.hImageList, MenuItem.IconIndex - 1, pDC, DrawItem.rcItem.Left + 2, DrawItem.rcItem.Top + 2, ILD_TRANSPARENT Or ILD_SELECTED)
 Else
 Call DrawState(pDC, 0, 0, GetImageListIcon(MenuItem.hImageList, MenuItem.IconIndex), 0, DrawItem.rcItem.Left + 2, DrawItem.rcItem.Top + 2, 16, 16, DST_ICON Or DSS_NORMAL)
 End If
 End If
 Else
 If DrawItem.itemState And ODS_GRAYED Then
 Call DrawState(pDC, 0, 0, GetImageListIcon(MenuItem.hImageList, MenuItem.IconIndex), 0, DrawItem.rcItem.Left + 2, DrawItem.rcItem.Top + 2, 16, 16, DST_ICON Or DSS_DISABLED)
 Else
 Call DrawState(pDC, 0, 0, GetImageListIcon(MenuItem.hImageList, MenuItem.IconIndex), 0, DrawItem.rcItem.Left + 2, DrawItem.rcItem.Top + 2, 16, 16, DST_ICON Or DSS_NORMAL)
 End If
 End If
End Sub

效果图:
http://olv.photo.qq.com/?file=FE4D731FE95D620B4F5A9AD5CEE13709DF082EE0F08DA1CB5449C663134A7A20

要用ImageList5.0.

二、自绘制按钮
VB按钮Style=Graphic属性的内部实现方法就是这样；
新建窗体“Form1”，标准模块“APIFunctions”、“MainSubs�

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateEllipticRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Public Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lpString As String, ByVal cbStringLen As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal fuFlags As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'MainSubs
Public Const PI = 3.14159265358979

Public OldWindowProc As Long
Public m_nRadius As Long
Public m_ptCentre As POINTAPI
Public m_Rgn As Long

Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long
 Dim dM As DRAWITEMSTRUCT
 Select Case Msg
 Case WM_DRAWITEM
 MemCopy dM, lParam, Len(dM)
 If (dM.CtlType = ODT_BUTTON) Then
 Call OnDrawItem(dM)
 NewWindowProc = 1
 'Exit Function
 End If
 End Select
 NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, VarPtr(lParam))
End Function

Public Sub OnDrawItem(LpDis As DRAWITEMSTRUCT)
 '重载DrawItem函数
 Dim pDC As Long, State As Long, Brush As Long, nRadius As Long, strText As String, Rgn As Long, nSavedDC As Long, pBrush As Long
 Dim CRect As RECT, Extent As Size, Pt As POINTAPI, lgBrush As LOGBRUSH
 pDC = LpDis.hdc
 CRect = LpDis.rcItem
 State = LpDis.itemState
 nRadius = m_nRadius
 nSavedDC = SaveDC(pDC)
 lgBrush.lbStyle = BS_SOLID
 lgBrush.lbColor = GetSysColor(COLOR_BTNFACE)
 lgBrush.lbHatch = 0
 pBrush = CreateBrushIndirect(lgBrush)
 Call SelectObject(pDC, pBrush)
 Call FillRect(pDC, CRect, pBrush)
 Call DeleteObject(pBrush)
 If (State And ODS_FOCUS) = ODS_FOCUS Then
 nRadius = nRadius - 1
 Call DrawDashCircle(pDC, m_ptCentre, nRadius, vbBlack)
 End If
 If (State And ODS_SELECTED) = ODS_SELECTED Then
 nRadius = nRadius - 1
 Call DrawCircle(pDC, m_ptCentre, nRadius, GetSysColor(COLOR_3DDKSHADOW), GetSysColor(COLOR_3DHIGHLIGHT))
 nRadius = nRadius - 1
 Call DrawCircle(pDC, m_ptCentre, nRadius, GetSysColor(COLOR_3DSHADOW), GetSysColor(COLOR_3DLIGHT))
 Else
 nRadius = nRadius - 1
 Call DrawCircle(pDC, m_ptCentre, nRadius, GetSysColor(COLOR_3DHIGHLIGHT), GetSysColor(COLOR_3DDKSHADOW))
 nRadius = nRadius - 1
 Call DrawCircle(pDC, m_ptCentre, nRadius, GetSysColor(COLOR_3DLIGHT), GetSysColor(COLOR_3DSHADOW))
 End If
 If (State And ODS_FOCUS) Then
 Call DrawDashCircle(pDC, m_ptCentre, nRadius - 2, RGB(0, 0, 0), True)
 End If
 strText = String$(255, 0)
 Call GetWindowText(LpDis.hwndItem, strText, Len(strText))
 strText = Left$(strText, InStr(strText, Chr$(0)) - 1)
 If strText <> "" Then
 Rgn = CreateEllipticRgn(m_ptCentre.x - nRadius, m_ptCentre.y - nRadius, m_ptCentre.x + nRadius, m_ptCentre.y + nRadius)
 Call SelectClipRgn(pDC, Rgn)
 Call GetTextExtentPoint32(pDC, strText, Len(strText), Extent)
 Pt.x = m_ptCentre.x - Extent.cX \ 2
 Pt.y = m_ptCentre.y - Extent.cY \ 2
 If (State And ODS_SELECTED) = ODS_SELECTED Then
 Pt.x = Pt.x + 1: Pt.y = Pt.y + 1
 End If
 Call SetBkMode(pDC, TRANSPARENT)
 If (State And ODS_DISABLED) Then
 Call DrawState(pDC, 0, 0, strText, Len(strText), Pt.x, Pt.y, Extent.cX, Extent.cY, DST_TEXT + DSS_DISABLED)
 Else
 Call TextOut(pDC, Pt.x, Pt.y, strText, Len(strText))
 End If
 Call SelectClipRgn(pDC, NULLREGION)
 Call DeleteObject(Rgn)
 End If
 Call RestoreDC(pDC, nSavedDC)
End Sub

Public Function Min(ByVal n1 As Long, ByVal n2 As Long) As Long
 If n1 > n2 Then Min = n2 Else Min = n1
End Function

Public Function Atan2(ByVal y As Double, ByVal x As Double) As Double
 If x = 0 And y = 0 Then
 Atan2 = 0
 Else
 Atan2 = Atn(y / x) - PI * (x < 0)
 End If
End Function

Function GetRValue(ByVal nColor As Long) As Long
 GetRValue = nColor And &HFF&
End Function

Function GetGValue(ByVal nColor As Long) As Long
 GetGValue = (nColor \ &H100&) And &HFF&
End Function

Function GetBValue(ByVal nColor As Long) As Long
 GetBValue = (nColor \ &H10000) And &HFF&
End Function

Public Function GetColour(dAngle As Double, crBright As Long, crDark As Long) As Long
 Dim dAngleDifference As Double
 Dim Weight As Double
 Dim Red As Long, Green As Long, Blue As Long
 Const Rad2Deg = 180# / 3.1415
 Const LIGHT_SOURCE_ANGLE = -2.356
 dAngleDifference = LIGHT_SOURCE_ANGLE - dAngle

 If dAngleDifference < -3.1415 Then
 dAngleDifference = 6.293 + dAngleDifference
 ElseIf dAngleDifference > 3.1415 Then
 dAngleDifference = 6.293 - dAngleDifference
 End If

 Weight = 0.5 * (Cos(dAngleDifference) + 1#)

 Red = CLng((Weight * GetRValue(crBright) + (1 - Weight) * GetRValue(crDark)))
 Green = CLng((Weight * GetGValue(crBright) + (1 - Weight) * GetGValue(crDark)))
 Blue = CLng((Weight * GetBValue(crBright) + (1 - Weight) * GetBValue(crDark)))

 GetColour = RGB(Red, Green, Blue)
End Function

Public Sub DrawDashCircle(pDC As Long, p As POINTAPI, lRadius As Long, crColour As Long, Optional bDashed As Boolean)
 Dim nDashLength As Long
 Dim lError As Long, lXoffset As Long, lYoffset As Long, nDash As Long
 Dim bDashOn As Boolean
 nDash = 0: nDashLength = 1
 bDashOn = True
 'Set starting values
 lXoffset = lRadius: lYoffset = 0: lError = -lRadius
 If IsMissing(bDashed) Then bDashed = False
 
 Do
 If (bDashOn) Then
 Call SetPixelV(pDC, p.x + lXoffset, p.y + lYoffset, crColour)
 Call SetPixelV(pDC, p.x + lXoffset, p.y - lYoffset, crColour)
 Call SetPixelV(pDC, p.x + lYoffset, p.y + lXoffset, crColour)
 Call SetPixelV(pDC, p.x + lYoffset, p.y - lXoffset, crColour)
 Call SetPixelV(pDC, p.x - lYoffset, p.y + lXoffset, crColour)
 Call SetPixelV(pDC, p.x - lYoffset, p.y - lXoffset, crColour)
 Call SetPixelV(pDC, p.x - lXoffset, p.y + lYoffset, crColour)
 Call SetPixelV(pDC, p.x - lXoffset, p.y - lYoffset, crColour)
 End If

 'Advance the error term and the constant X axis step
 lError = lError + lYoffset
 lYoffset = lYoffset + 1

 'Check to see if error term has overflowed
 lError = lError + lYoffset
 If (lError >= 0) Then
 lXoffset = lXoffset - 1
 lError = lError - lXoffset * 2
 End If

 nDash = nDash + 1
 If (bDashed And (nDash = nDashLength)) Then
 nDash = 0
 bDashOn = Not bDashOn
 End If

 Loop While (lYoffset <= lXoffset) 'Continue until halfway point
End Sub

Public Sub PreSubclassWindow(ByVal BtnHdl As Long)
 '重载PreSubClassWindow函数，将控件风格改为自绘制
 Dim OldStyle As Long, lpPoint As POINTAPI, pParent As Long
 Dim CRect As RECT
 OldStyle = GetWindowLong(BtnHdl, GWL_STYLE)
 Call SetWindowLong(BtnHdl, GWL_STYLE, OldStyle + BS_PUSHLIKE + BS_OWNERDRAW)
 Call GetClientRect(BtnHdl, CRect)
 CRect.Right = Min(CRect.Bottom, CRect.Right)
 CRect.Bottom = CRect.Right
 m_ptCentre.x = (CRect.Bottom - CRect.Top) \ 2
 m_ptCentre.y = (CRect.Right - CRect.Left) \ 2
 m_nRadius = CRect.Bottom \ 2 - 1
 Call DeleteObject(m_Rgn)
 Call SetWindowRgn(BtnHdl, NULLREGION, False)
 m_Rgn = CreateEllipticRgnIndirect(CRect)
 Call SetWindowRgn(BtnHdl, m_Rgn, True)
 lpPoint.x = CRect.Left: lpPoint.y = CRect.Top
 Call ClientToScreen(BtnHdl, lpPoint)
 CRect.Left = lpPoint.x: CRect.Top = lpPoint.y
 lpPoint.x = CRect.Right: lpPoint.y = CRect.Bottom
 Call ClientToScreen(BtnHdl, lpPoint)
 CRect.Right = lpPoint.x: CRect.Bottom = lpPoint.y
 pParent = GetParent(BtnHdl)
 If pParent Then
 lpPoint.x = CRect.Left: lpPoint.y = CRect.Top
 Call ScreenToClient(pParent, lpPoint)
 CRect.Left = lpPoint.x: CRect.Top = lpPoint.y
 lpPoint.x = CRect.Right: lpPoint.y = CRect.Bottom
 Call ScreenToClient(pParent, lpPoint)
 CRect.Right = lpPoint.x: CRect.Bottom = lpPoint.y
 End If
 Call MoveWindow(BtnHdl, CRect.Left, CRect.Top, CLng(CRect.Right - CRect.Left), CLng(CRect.Bottom - CRect.Top), True)
End Sub