Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Sub Form_Load()
    ' Command1.Style = 1 ' Graphical
    SendMessage Command1.hWnd, &HF4&, &H0&,  0 &
End Sub

'Public Module
Option Explicit

Private Const GWL_WNDPROC = - 4 
Private Const WM_SIZE = &H5
Private Const WM_MOVE = &H3
Private Const WM_PAINT = &HF


Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWND As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private 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 gWH As Long
Private OldWndProc As Long
Private ctl As TextBox

Public Function WindowProc(ByVal HWND As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim X As Long
    
    X = CallWindowProc(OldWndProc, HWND, Msg, wParam, lParam)
    
    Select Case Msg
        Case WM_PAINT
            ctl.BackColor = vbRed
    End Select
    
    WindowProc = X
End Function

Public Sub Subclass(ByRef mCtl As TextBox)
    Set ctl = mCtl
    gWH = ctl.HWND
    OldWndProc = SetWindowLong(gWH, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnSubclass()
    Set ctl = Nothing
    SetWindowLong gWH, GWL_WNDPROC, OldWndProc
End Sub


'Form1
'Text1 - textbox
Option Explicit

Private Sub Form_Load()
    Me.Text1.BackColor = vbWhite
    Me.Text1.Locked = True
    Subclass Me.Text1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclass
End Sub

Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Public Declare Sub InitCommonControls Lib "Comctl32.dll" ()
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
(iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200

Public Function InitCommonControlsVB() As Boolean
On Error Resume Next
Dim iccex As tagInitCommonControlsEx
' Ensure CC available:
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControls
InitCommonControlsEx iccex

InitCommonControlsVB = (Err.Number =  0 )
  
End Function