- 'API Declarations
- 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 GetWindowLong Lib "user32" _
- Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
-
- 'Constantes
- Private Const GWL_WNDPROC = (-4)
- Private Const WM_SETFOCUS = &H7
-
- 'Variables
- Public StandardButtonProc As Long
-
- Public Sub NoFocusRect(Button As Object, vValue As Boolean)
- If vValue = True Then 'le carré est visible
- 'sauvegarde l'adresse de la procedure du bouton
- StandardButtonProc = GetWindowLong(Button.hWnd, GWL_WNDPROC)
- 'Subclass le bouton pour controler ces messages windows
- SetWindowLong Button.hWnd, GWL_WNDPROC, AddressOf ButtonProc
- Else 'le carré est pas visible
- 'enleve le subclass du bouton
- SetWindowLong Button.hWnd, GWL_WNDPROC, StandardButtonProc
- End If
- End Sub
-
- Public Function ButtonProc(ByVal hWnd As Long, _
- ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- 'la procédure qui reçoit tous les messages de windows
- 'pour le subclassing du bouton
- On Error Resume Next
- Select Case uMsg&
- 'Le bouton va recevoir le focus
- Case WM_SETFOCUS
- 'sort de la procédure -> le message n'atteind pas le bouton
- Exit Function
- End Select
- 'appel la procédure standard du bouton
- ButtonProc = CallWindowProc(StandardButtonProc, hWnd&, uMsg&, wParam&, lParam&)
- End Function
'API Declarations
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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
'Constantes
Private Const GWL_WNDPROC = (-4)
Private Const WM_SETFOCUS = &H7
'Variables
Public StandardButtonProc As Long
Public Sub NoFocusRect(Button As Object, vValue As Boolean)
If vValue = True Then 'le carré est visible
'sauvegarde l'adresse de la procedure du bouton
StandardButtonProc = GetWindowLong(Button.hWnd, GWL_WNDPROC)
'Subclass le bouton pour controler ces messages windows
SetWindowLong Button.hWnd, GWL_WNDPROC, AddressOf ButtonProc
Else 'le carré est pas visible
'enleve le subclass du bouton
SetWindowLong Button.hWnd, GWL_WNDPROC, StandardButtonProc
End If
End Sub
Public Function ButtonProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'la procédure qui reçoit tous les messages de windows
'pour le subclassing du bouton
On Error Resume Next
Select Case uMsg&
'Le bouton va recevoir le focus
Case WM_SETFOCUS
'sort de la procédure -> le message n'atteind pas le bouton
Exit Function
End Select
'appel la procédure standard du bouton
ButtonProc = CallWindowProc(StandardButtonProc, hWnd&, uMsg&, wParam&, lParam&)
End Function