回复：自绘制控件集合

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

'Form1，添加Command1(Name=Command1,Style=Standard(如果设置成Graphics，你就会知道VB的Graphics属性是怎么回事))
Private Sub Form_Load()
 Call PreSubclassWindow(Command1.hwnd)
 OldWindowProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

如果此时在窗体上再放置几个Graphics按钮，发现他们都变为你所绘制的形状了……
本按钮实际上有一个小小的Bug，主要是由于同VB的内部源码不兼容�