Hola, mira hice un modulo bas, para subclasificar el botón y pintarlo por ensima de este:
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Enum EnuCaptionAlign
DT_TOP = &H0
DT_LEFT = &H0
DT_CENTER = &H1
DT_RIGHT = &H2
DT_BOTTOM = &H8
DT_VCENTER = &H4
End Enum
Private Const DT_SINGLELINE As Long = &H20
Private Const GWL_WNDPROC = (-4)
Private Const WM_PAINT As Long = &HF&
Private Const BM_SETSTATE As Long = &HF3&
Private Const TRANSPARENT As Long = &H1
Private Const OUT_DEFAULT_PRECIS As Long = 0
Private Const CLIP_DEFAULT_PRECIS As Long = 0
Private Const PROOF_QUALITY As Long = 2
Private Const DEFAULT_PITCH As Long = 0
Private Const DEFAULT_CHARSET As Long = 1
Private Const FW_NORMAL As Long = 400
Dim PrevProc As Long
Dim cCaptions As Collection
Public Function AddButtonLabel(ByVal hwnd As Long, ByVal Caption As String, ByVal ForeColor As Long, Optional Align As EnuCaptionAlign = DT_TOP Or DT_RIGHT)
On Error GoTo ErrHandler
Dim lngCaption As Long
If cCaptions Is Nothing Then Set cCaptions = New Collection
cCaptions.Add Caption, Str(hwnd)
SetProp hwnd, "ForeColor", ForeColor
SetProp hwnd, "Align", Align
PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
AddButtonLabel = PrevProc <> 0
ErrHandler:
End Function
Public Function RemoveButtonLabel(ByVal hwnd As Long) As Boolean
SetWindowLong hwnd, GWL_WNDPROC, PrevProc
cCaptions.Remove Str(hwnd)
RemoveProp hwnd, "ForeColor"
RemoveProp hwnd, "Align"
RemoveButtonLabel = CBool(Err.Number = 0)
End Function
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim hdc As Long
Dim tRECT As RECT
Dim hFont As Long
Dim OldFont As Long
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_PAINT Or uMsg = BM_SETSTATE Then
hdc = GetDC(hwnd)
GetClientRect hwnd, tRECT
InflateRect tRECT, -5, -5
SetBkMode hdc, TRANSPARENT
SetTextColor hdc, GetProp(hwnd, "ForeColor")
hFont = CreateFont(-9, 0, 0, 0, FW_NORMAL, False, True, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
OldFont = SelectObject(hdc, hFont)
DrawText hdc, cCaptions(Str(hwnd)), -1, tRECT, DT_SINGLELINE Or GetProp(hwnd, "Align")
DeleteObject SelectObject(hdc, OldFont)
ReleaseDC hwnd, hdc
End If
End Function
y la forma de llamarlo seria asi
Option Explicit
Private Sub Form_Load()
AddButtonLabel Command1.hwnd, "F1", vbBlue
AddButtonLabel Command2.hwnd, "F2", vbRed, DT_RIGHT Or DT_BOTTOM
End Sub
Private Sub Form_Unload(Cancel As Integer)
RemoveButtonLabel Command1.hwnd
RemoveButtonLabel Command2.hwnd
End Sub
fijate que la funcion AddButtonLabel tiene cuatro parametros el 1ero el hwnd del boton, el 2do el texto, el 3ero el color y el 4to es la alineacion tanto horizontal como vertical, solo tenes que combinar las constante de enumeración (mira en el command2 tenes un ejemplo).
