ComboRoutin




Option Explicit
'// Windows API calls

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
'// Windows message

Private Const WM_USER = &H400
'// Combo and edit box messages

Private Const CB_SHOWDROPDOWN = WM_USER + 15
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const EC_LEFTMARGIN = &H1
Private Const EC_RIGHTMARGIN = &H2
Private Const EC_USEFONTINFO = &HFFFF&
Private Const EM_SETMARGINS = &HD3&
Private Const EM_GETMARGINS = &HD4&
Public Sub SetDropWidth(cbo As ComboBox, lngWidth As Long)
SendMessageLong cbo.hwnd, CB_SETDROPPEDWIDTH, lngWidth, 0
End Sub

Public Sub SetDropHeight(cbo As ComboBox, lngHeight As Long)
Dim intScaleMode As Integer
'// Store the current scalemode

intScaleMode = cbo.Parent.ScaleMode
'// Set it to pixels

cbo.Parent.ScaleMode = vbPixels
'// Move the check box

MoveWindow cbo.hwnd, cbo.Left, cbo.Top, cbo.Width, lngHeight, 1
'// Reset the scalemode

cbo.Parent.ScaleMode = intScaleMode
End Sub

Public Sub AddCheckBox(cbo As ComboBox, chk As CheckBox)
Dim lngHwnd As Long
Dim lngMargin As Long
'// Find the edit window

lngHwnd = FindWindowEx(cbo.hwnd, 0, "EDIT", vbNullString)
If lngHwnd = 0 Then
'// Calculate the left margin

lngMargin = chk.Width / Screen.TwipsPerPixelX + 2
'// Set the margin

SendMessageLong lngHwnd, EM_SETMARGINS, EC_LEFTMARGIN, lngMargin
chk.BackColor = cbo.BackColor
'// Move the check box

chk.Move cbo.Left + 3 * Screen.TwipsPerPixelX, cbo.Top + 2 * Screen.TwipsPerPixelY, chk.Width, cbo.Height - 4 * Screen.TwipsPerPixelY
chk.ZOrder
End If
End Sub

Public Sub DropDown(cbo As ComboBox, blnShow As Boolean)
If blnShow Then
SendMessageLong cbo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
Else
SendMessageLong cbo.hwnd, CB_SHOWDROPDOWN, 0, ByVal 0&
End If
End Sub

Comments
This code allows you To:

Add check boxes:
AddCheckBox(cbo As ComboBox, chk As CheckBox)

Drop it down through code:
DropDown(cbo As ComboBox, blnShow As Boolean)

Set the drop down height:
SetDropHeight(cbo As ComboBox, lngHeight As Long)

Set the drop down Width:
SetDropWidth(cbo As ComboBox, lngWidth As Long)










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