subclassing en VB

J'essaie de faire du subclassing en VB pour récupérer et exploiter un message que j'ai moi-même défini WM_OK et WM_FAILED. J'ai trouvé plein d'exemples sur le net. Mais j'ai toujours 2 problèmes:
- un crash après mon appel à CallWindowProc(Module2.hOldProc, hwnd, uMsg, wParam, lParam)
- dans la méthode NewWindowProc, sensée remplacer la méthode d'origine de gestion des messages, je récupère le numéro de mon message dans le paramètre handler de la fenêtre (hwnd) et le paramètre message (uMsg) est égal à 0. Pourquoi? Où est mon erreur?
Est-ce que quelqu'un peut m'aider? Merci

Voilà un bout du code
Dans mon Form

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private Sub Btn1_Click()
 
   Dim retVal As Long
   Dim ret As Long
   Dim retString As String
   Dim cmdLine As String
   Dim hwndThis As Long
 
   hwndThis = CreateWindowEx(0, "STATIC", "Ma fenetre", 0, 0, 0, 0, 0, 0, 0, App.hInstance, ByVal 0&)
 
   If hwndThis <> 0 Then
      ret = Module2.Subclass(hwndThis)
      Call SendMessageLong(hwndThis, Module2.WM_OK, 0, 0)
      Call SendMessageLong(hwndThis, Module2.WM_FAILED, 0, 0)
   End If

Dans Module2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Public Declare Function RegisterWindowMessage Lib "user32" Alias _
  "RegisterWindowMessageA" (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
 
 
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Public hOldProc As Long
 
Public hWindow As Long
 
Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_NCDESTROY As Long = &H82&
 
Public Const MSG_OK = "OK"
Public Const MSG_FAILED = "FAILED"
 
Public Function WM_OK() As Long
Static msgOk As Long
 
If msgOk = 0 Then
   msgOk = RegisterWindowMessage(MSG_OK)
End If
 
WM_OK = msgOk
 
End Function
 
Public Function WM_FAILED() As Long
Static msgFailed As Long
 
If msgFailed = 0 Then
   msgFailed = RegisterWindowMessage(MSG_FAILED)
End If
 
WM_FAILED = msgFailed
End Function
 
Public Function Subclass(ByVal hwnd As Long) As Boolean
 
    If hWindow = 0 Then
        hOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf Module2.NewWindowProc) 
         hWindow = hwnd
        Subclass = True
    Else
        Subclass = False
    End If
End Function
 
 
 
Public Function UnSubclass() As Boolean
Dim retVal As Long
 
    If hWindow <> 0 Then
        retVal = SetWindowLong(hWindow, GWL_WNDPROC, hOldProc)
        hWindow = 0
        UnSubclass = True
    Else
        UnSubclass = False
    End If
 
End Function
 
 
 
 
Public Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
 
    If hwnd = WM_NCDESTROY Then
        Call UnSubclass
    End If
 
    Select Case hwnd
    Case WM_OK
         MsgBox "OK"
        NewWindowProc = 0
    Case WM_FAILED
        MsgBox "FAILED"
        NewWindowProc = 0
    Case Else
         NewWindowProc = CallWindowProc(Module2.hOldProc, hwnd, uMsg, wParam, lParam)
    End Select
 
End Function