Bah après une galère pour détecter le message WM_CTLCOLORSTATIC (avec
une méthode conne mais ça marche :) ). Maintenant je me trouve
devant une autre problème : quand j'utilise SetBkColor pour donner une
couleur à mon control, elle color juste l'arriere plan du text (la zone
qui contient le text "OptionX" dans notre cas)! j'aimerais la couleur
s'applique sur toute la zone du control.
Je ne comprends pas pourquoi il applique juste sur la zone du text!
bah je pense que le Radio contient un autre static (label) et je suis
en train d'utiliser le handle de ce static! alors peut etre qu'il faut
recuperer une autre hwnd (du tt le control)!
SVP AIDEZ moi meme avec quelques idées
Voici ci-desous le code pour être + clair
Merci d'avance
'creer un nouveau projet
'avec module
'in form
Private Declare Function CreateWindowEx Lib "user32" Alias
"CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As
String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As
Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long,
lpParam As Any) As Long
Private Const WS_VISIBLE = &H10000000
Private Const BS_AUTOCHECKBOX = &H3&
Private Const BS_CHECKBOX = &H2&
Private Const BS_RADIOBUTTON = &H4&
Private Const WM_CTLCOLORBTN = &H135
Private Const WM_CTLCOLORSTATIC = &H138
Private Const WS_CHILD = &H40000000
Private Const BS_AUTORADIOBUTTON = &H9&
Private Const WS_EX_TRANSPARENT = &H20&
Private Const WS_TABSTOP = &H10000
Private Const WS_GROUP = &H20000
Private Sub Form_Load()
hwndRadio = CreateWindowEx(WS_EX_TRANSPARENT, "BUTTON", "OptionX", WS_CHILD Or WS_VISIBLE Or _
BS_AUTORADIOBUTTON Or WS_TABSTOP Or WS_GROUP, 70, 70, 150, 20, Me.hwnd,
ByVal 0&, App.hInstance, 0&)
hookButton hwndRadio, vbBlue
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookButton hwndRadio
End Sub
'in module
Option Explicit
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal
hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) 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 Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex 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 GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Public Const TRANSPARENT As Long = 1
Private Const GWL_WNDPROC As Long = -4
Private Const WM_DESTROY As Long = &H2
Private Const WM_DRAWITEM As Long = &H2B
Public Const WM_CTLCOLORBTN = &H135
Public Const WM_CTLCOLORSTATIC = &H138
Public Const NULL_BRUSH = 5
Public Const NULL_PEN = 8
Public Const PS_SOLID = 0
Public Const GCL_HBRBACKGROUND = (-10)
Public Const WM_PAINT = &HF
'property names
Private Const PropForeColor = "UMGForeColor"
Private Const PropBackColor = "UMGBackColor"
Private Const PropSubclass = "UMGDrawProc"
Public hwndRadio As Long
Public Sub hookButton(hwnd As Long, ByVal ForeColor As OLE_COLOR)
Dim hWndPnt As Long
hWndPnt = GetParent(hwnd)
If GetProp(hWndPnt, PropSubclass) = 0 Then 'not yet subclassed
SetProp hWndPnt, PropSubclass, GetWindowLong(hWndPnt, GWL_WNDPROC)
SetWindowLong hWndPnt, GWL_WNDPROC, AddressOf DrawButtonProc
End If
SetProp hwnd, PropForeColor, ForeColor
SetProp hwnd, PropBackColor, ForeColor
End Sub
Public Sub UnhookButton(hwnd As Long)
RemoveProp hwnd, PropForeColor
RemoveProp hwnd, PropBackColor
End Sub
Private Function DrawButtonProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lOldProc As Long
Dim brush As Long
Dim hpen, hsel_pen As Long
Dim Brush_nul As Long
lOldProc = GetProp(hwnd, PropSubclass)
DrawButtonProc = CallWindowProc(lOldProc, hwnd, wMsg, wParam, lParam)
Select Case wMsg
Case WM_CTLCOLORSTATIC
SetTextColor CLng(wParam), vbBlue
'SetBkMode CLng(wParam), TRANSPARENT
SetBkColor CLng(wParam), vbGreen
'Brush_nul = SelectObject(CLng(wParam), GetStockObject(NULL_BRUSH))
Case WM_DESTROY
If lOldProc Then 'is subclassed
SetWindowLong hwnd, GWL_WNDPROC, lOldProc
RemoveProp hwnd, PropSubclass
End If
End Select
End Function