MultiDropDownMnuTbar




Option Explicit
Private Const WM_USER = &H400
Private Const TB_GETITEMRECT = (WM_USER + 29&)
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hwnd1 As Long, _
ByVal hwnd2 As Long, ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 Declare Function ScreenToClient Lib "user32" _
(ByVal hwnd As Long, lpPT As POINTAPI) As Long

Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPT As POINTAPI) As Long
Private Function GetToolbarButtonPt( _
ByVal oTlb As MSComctlLib.Toolbar, _
ByVal oButton As MSComctlLib.Button, _
ByRef x As Long, ByRef y As Long) As Boolean

'This function returns the x and y coordinates of the

'bottom left-hand corner of a toolbar button. These

'coordinates can be used for a popup-menu or any other

'type of popup you want.


Dim hwndTlb As Long 'handle to the real windows
'toolbar control


'The hwnd returned by a toolbar control is actually the

'handle of the VB wrapper for the real windows toolbar,

'so first we need to find the handle to the "real"

'windows toolbar.

hwndTlb = FindWindowEx(oTlb.hwnd, 0&, "msvb_lib_toolbar", vbNullString)

If hwndTlb Then
'We've got the real toolbar's handle.


'Now let's try to get the bounding rectangle for our button. Note

'that VB's toolbar control indexes buttons starting at 1, the

'real windows toolbar starts its index as 0, so we'll need to

'subtract 1 when specifying which button we want.

Dim uRECT As Rect
Dim r As Long

r = SendMessage(hwndTlb, TB_GETITEMRECT, oButton.Index - 1&, uRECT)
If r = 1& Then
'We've got the bounding rect for the button.

Dim uPt As POINTAPI
uPt.x = uRECT.Left
uPt.y = uRECT.Bottom

'Lets convert our point to screen coordinates.

ClientToScreen hwndTlb, uPt

'Pass back the screen coordinates and return True

'so that the caller knows we successfully got the

'location.


'We're passing the coordinates back in screen pixels

'so that the caller can decide what to do with them.

'If for example, they want to use a popup menu, they

'would call, ScreenToClient() and then convert the

'pixel units to whatever is appropriate for the form.

'If they wanted to use a seperate form as a "Popup"

'control of some sort, they could multiply the screen

'pixel coordinates by Screen.TwipsPerPixel? to

'position the form.


x = uPt.x
y = uPt.y
GetToolbarButtonPt = True
End If
End If
End Function

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim uPt As POINTAPI

If GetToolbarButtonPt(Toolbar1, Button, uPt.x, uPt.y) Then
'Convert the client coordinates to our own form's.

ScreenToClient Me.hwnd, uPt

'Convert the pixels to twips.

uPt.x = uPt.x * Screen.TwipsPerPixelX
uPt.y = uPt.y * Screen.TwipsPerPixelY

'Show a popup menu at the specified point

Me.PopupMenu mnuHide, , uPt.x, uPt.y
End If
End Sub












( multidropdownmnutbar.html )- by Paolo Puglisi - Modifica del 17/12/2023