codice:
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 Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_GETFONT = &H31
Private Const WM_SETFONT = &H30
Dim btnWindow As Long
Dim Font As Long
btnWindow = CreateWindowEx(0, "BUTTON", "Hello", WS_CHILD Or WS_VISIBLE, 300, 3, 80, 20, _
lToolbar, 0, App.hInstance, 0)
Font = SendMessage(lToolbar, WM_GETFONT, 0, 0)
SendMessage btnWindow, WM_SETFONT, Font, 0
'Il codice seguente permette di intercettare gli eventi di un bottone presente sulla ToolBar
' .........Module1.bas..........
Public Declare Function SetWindowLong Lib "user32.dll" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nindex As Long, _
ByVal dwnewlong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
lParam As Long) As Long
Public Const WM_LBUTTONUP = &H202
Public Const GWL_WNDPROC = (-4)
Public myOldhWndProc As Long
Public Sub SubclassButton(phWnd As Long)
myOldhWndProc = SetWindowLong(phWnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub
Public Function MyWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
If uMsg = WM_LBUTTONUP Then
Beep
End If
MyWindowProc = CallWindowProc(myOldhWndProc, hWnd, uMsg, wParam, lParam)
End Function
'ecco il codice per attivare il subclassing di uno dei bottoni inseriti
SubclassButton btnWindow1
grazie