Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 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 ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Const CB_GETITEMHEIGHT As Long = &H154
Code:
Public Sub SetDropDownHeight(pobjForm As Form, _
pobjCombo As ComboBox, _
plngNumItemsToDisplay As Long)
Dim pt As POINTAPI
Dim rc As RECT
Dim lngSavedWidth As Long
Dim lngNewHeight As Long
Dim lngOldScaleMode As Long
Dim lngItemHeight As Long
lngSavedWidth = pobjCombo.Width
lngOldScaleMode = pobjForm.ScaleMode
pobjForm.ScaleMode = vbPixels
lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hwnd, rc)
pt.X = rc.Left
pt.Y = rc.Top
Call ScreenToClient(pobjForm.hwnd, pt)
Call MoveWindow(pobjCombo.hwnd, pt.X, pt.Y, pobjCombo.Height, lngNewHeight, True)
pobjForm.ScaleMode = lngOldScaleMode
pobjCombo.Width = lngSavedWidth
End Sub
If I put a combobox on a form, and use that procedure like this:
Code:
SetDropDownHeight Me, Combo1, 20
It will work perfectly.
But, the problem is that my combobox is not DIRECTLY on a form.
It is on a picturebox.
And that is why the above procedure doesn't work.
I need to tweak the above procedure, such that it would work for a combobox whether located on the form or on a picturebox.
But, I don't know how to do that.
Can you please help?
Problem 2:
I have a number of comboboxes that are located at the far right of a form.
The width of the contents of the dropdown boxes are larger than the width of the comboboxes themselves.
So, when at runtime, I drop the combobox, the contents of the combobox (that are wider than the un-dropped combo box) extend beyond the right side of the application.
And if the application is positioned at the far right of the screen (monitor), then the contents of the dropdown box are cut off at that point.
I need to force the combobox to show its contents as "right-aligned with the combo box itself.
They are currently left-aligned, and that is why they exceed (and sometimes are cut off at) the right border.
remove 'pobjForm As Form,' from the parameters
declare pobjForm As Object in the declarations of the procedure
add a line Set pobjForm = pobjCombo.Container at the start of the procedure.
For the second problem, I could change the position of the list but after is is shown (and the animation finished).
Not sure if with subclassing it could be done better.
To test, add a timer with 1 millisecond interval and Enabled to False.
It assumes a ComboBox named Combo1:
Code:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type COMBOBOXINFO
cbSize As Long
rcItem As RECT
rcButton As RECT
stateButton As Long
hwndCombo As Long
hwndEdit As Long
hWndList As Long
End Type
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Combo1_DropDown()
Timer1.Enabled = True
End Sub
Private Function GetComboListHwnd(nCombo As Object) As Long
Dim iCboInf As COMBOBOXINFO
iCboInf.cbSize = Len(iCboInf)
GetComboBoxInfo nCombo.hWnd, iCboInf
GetComboListHwnd = iCboInf.hWndList
End Function
Private Sub Timer1_Timer()
Dim iRCList As RECT
Dim iRCCombo As RECT
Dim hWndList As Long
Dim iWidth As Long
Timer1.Enabled = False
hWndList = GetComboListHwnd(Combo1)
GetWindowRect hWndList, iRCList
iWidth = iRCList.Right - iRCList.Left
GetWindowRect Combo1.hWnd, iRCCombo
iRCList.Right = iRCCombo.Right
iRCList.Left = iRCList.Right - iWidth
SetWindowPos hWndList, 0, iRCList.Left, iRCList.Top, iWidth, iRCList.Bottom - iRCList.Top, 0
End Sub
PS: the code will put the list always right aligned, it will need some additions to do it only when necessary.
Last edited by Eduardo-; May 2nd, 2021 at 06:49 AM.
remove 'pobjForm As Form,' from the parameters
declare pobjForm As Object in the declarations of the procedure
add a line Set pobjForm = pobjCombo.Container at the start of the procedure.
For the second problem, I could change the position of the list but after is is shown (and the animation finished).
Not sure if with subclassing it could be done better.
To test, add a timer with 1 millisecond interval and Enabled to False.
It assumes a ComboBox named Combo1:
Code:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type COMBOBOXINFO
cbSize As Long
rcItem As RECT
rcButton As RECT
stateButton As Long
hwndCombo As Long
hwndEdit As Long
hWndList As Long
End Type
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Combo1_DropDown()
Timer1.Enabled = True
End Sub
Private Function GetComboListHwnd(nCombo As Object) As Long
Dim iCboInf As COMBOBOXINFO
iCboInf.cbSize = Len(iCboInf)
GetComboBoxInfo nCombo.hWnd, iCboInf
GetComboListHwnd = iCboInf.hWndList
End Function
Private Sub Timer1_Timer()
Dim iRCList As RECT
Dim iRCCombo As RECT
Dim hWndList As Long
Dim iWidth As Long
Timer1.Enabled = False
hWndList = GetComboListHwnd(Combo1)
GetWindowRect hWndList, iRCList
iWidth = iRCList.Right - iRCList.Left
GetWindowRect Combo1.hWnd, iRCCombo
iRCList.Right = iRCCombo.Right
iRCList.Left = iRCList.Right - iWidth
SetWindowPos hWndList, 0, iRCList.Left, iRCList.Top, iWidth, iRCList.Bottom - iRCList.Top, 0
End Sub
PS: the code will put the list always right aligned, it will need some additions to do it only when necessary.
Hi.
The solution that you providede for problem 1, works perfectly.
The solution for problem 2 does not work.
Does it work on your computer?
Can you please help?
Does it work on your computer?
Can you please help?
Thanks.
Yes, attached is the sample.
I added code to do it only when it exceeds the screen width, but for doing it with secondary monitors it would require some adaptation.
... but for doing it with secondary monitors it would require some adaptation
Not sure what you exactly mean by that.
My computer is attached to only one monitor. So, I cannot test your code with two monitors.
But, it is possible that somebody else using my application may have two monitors attached to his/her computer.
I really don't need the contents of the combo box to extend to the second monitor (contents being split between two monitors).
That kind of cross-monitor splitting is definitely NOT what I need. That would be an unnecessary luxury.
My point is that if there are two monitors attached to a computer, and the user runs this application on either one of the two monitors, will your code work correctly (right-align the contents of the combo box if that content exceeds the right border of the screen on which the application is running (ignoring the other monitor)). whether it is running on monitor 1 or monitor 2?
If it right-aligns based on looking only at the CURRENT monitor (and ignoring the other monitor) then it would be perfectly sufficient for me.
So, my question is how to interpret this:
... but for doing it with secondary monitors it would require some adaptation
Now it works like this: if the right side of the list exceeds the limit of the primary monitor, it aligns the list to the right of the combo control.
It will work fine in 99% of cases, because who works in a secondary monitor anyway?
But, if someone is working in a secondary monitor that is located at the right of the primary (the most common situation), the list will be aligned always to the right (because it always will exceed the right side of the primary monitor).
That can be fixed quite easily (tested).
Changing the line:
Code:
If iRCList.Right > (Screen.Width \ Screen.TwipsPerPixelX) Then ' only if it goes beyond the screen width
to:
Code:
If (iRCList.Right > (Screen.Width \ Screen.TwipsPerPixelX)) And Not (iRCList.Left > (Screen.Width \ Screen.TwipsPerPixelX)) Then ' only if it goes beyond the screen width but is still on the primary monitor
Another consequence is that if the combo is near to the right side of the secondary monitor, it will not change the list alignment as it does with the primary.
Fixing that would require some more complex code (using multi monitors APIs), but it is anyway a situation that probably won't happen or won't happen frequently in practice. And anyway, in such situation the user can still move the window a bit to the left manually.
I just mentioned it for completeness.
If you want it can be done with multi monitor APIs, but i don't think it's worth it.
The main two problems mentioned in post #1 have been solved, thanks to Eduardo.
However, as I am working on this project and the same combo boxes, another problem has happened:
Problem #3:
I need to (if possible) group combo box items.
Please compare it to how menu items are grouped. If in the menu editor, you insert a menu item that is just a dash (this sign: "-"), then the menu that is created at runtime shows a full line that separates the menu items below it from the menu items above it.
This separator comes in really handy. You can group related items together.
I am trying to do the same thing with a combo box.
The following:
populates the combobox with all those items (including the two items that show the dash sign).
Those two items take up as much vertical space as any other item (which is a waste of space and also ugly)
Also those two items are selectable items, while they shouldn't be.
I don't want them to be selectable.
Those two items take up as much vertical space as any other item (which is a waste of space and also ugly)
The ComboBox items are all drawn using the same font.
So all items (rows) have the same height.
Do you want some other font for the "dash" line and also draw it disabled?
About not allowing to select those items, you can roll back the user action:
Code:
Private Sub Combo1_Click()
If Combo1.Text = "-" Then
Combo1.ListIndex = Val(Combo1.Tag)
End If
End Sub
Private Sub Combo1_DropDown()
Combo1.Tag = Combo1.ListIndex
End Sub
Private Sub Form_Load()
Dim c As Long
For c = 1 To 5
Combo1.AddItem "First section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Second section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Third section Item " & c
Next
End Sub
About not allowing to select those items, you can roll back the user action:
Code:
Private Sub Combo1_Click()
If Combo1.Text = "-" Then
Combo1.ListIndex = Val(Combo1.Tag)
End If
End Sub
Private Sub Combo1_DropDown()
Combo1.Tag = Combo1.ListIndex
End Sub
Private Sub Form_Load()
Dim c As Long
For c = 1 To 5
Combo1.AddItem "First section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Second section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Third section Item " & c
Next
End Sub
The above code works fine if the user uses mouse to select items.
But, if the user uses keyboard (Down Arrow and Up Arrow) to select items, it doesn't work fine.
It actually does do the job of disallowing the selection of the "-" item, but then the user cannot continue going further down the dropdown list by pressing the Down Arrow again.
It falls into a trap.
Is there a way we could make it work smoothly in all those situations (Up Arrow, Down Arrow and mouse click)?
Yes, I see. Please check if this one code works better:
Code:
Private Sub Combo1_Click()
If Combo1.Text = "-" Then
Select Case Val(Combo1.Tag)
Case Combo1.ListIndex - 1
Combo1.ListIndex = Combo1.ListIndex + 1
Case Combo1.ListIndex + 1
Combo1.ListIndex = Combo1.ListIndex - 1
Case Else
Combo1.ListIndex = Val(Combo1.Tag)
End Select
Else
Combo1.Tag = Combo1.ListIndex
End If
End Sub
Private Sub Form_Load()
Dim c As Long
For c = 1 To 5
Combo1.AddItem "First section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Second section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Third section Item " & c
Next
End Sub
Yes, I see. Please check if this one code works better:
Code:
Private Sub Combo1_Click()
If Combo1.Text = "-" Then
Select Case Val(Combo1.Tag)
Case Combo1.ListIndex - 1
Combo1.ListIndex = Combo1.ListIndex + 1
Case Combo1.ListIndex + 1
Combo1.ListIndex = Combo1.ListIndex - 1
Case Else
Combo1.ListIndex = Val(Combo1.Tag)
End Select
Else
Combo1.Tag = Combo1.ListIndex
End If
End Sub
Private Sub Form_Load()
Dim c As Long
For c = 1 To 5
Combo1.AddItem "First section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Second section Item " & c
Next
Combo1.AddItem "-"
For c = 1 To 5
Combo1.AddItem "Third section Item " & c
Next
End Sub
Those two items take up as much vertical space as any other item (which is a waste of space and also ugly)
The ComboBox items are all drawn using the same font.
So all items (rows) have the same height.
Do you want some other font for the "dash" line and also draw it disabled?
Why not use a popup menu under a command button?
Sorry I didn't respond to you in time.
Just I was too busy to do so.
Now, all the problems have been solved, but I will respond to your questions:
Those two items take up as much vertical space as any other item (which is a waste of space and also ugly)
What I meant by that was that I compared it to menus (and popup menus) and that how nicely, a single "-" is turned into a narrow line by the menu editor, and that in a combo box, it was not like that.
Do you want some other font for the "dash" line and also draw it disabled?
Yes, it would be nice to have a different font for a combo box item and also draw one combo box item disabled.
Eduardo's code in post #12 does something almost like disabling the item.
Not sure if any way of REALLY disabling an item in a combo box exists or not.
As for a different font for a menu item, I am curious to know if that is possible (even though, now that my problems have been solved, that curiosity is just a curiosity)
Why not use a popup menu under a command button
Well, These combo boxes that I am using in my project contain different stuff that the user should select and then click "Process".
A popup menu doesn't look good for that purpose, and even if I were to use a popup menu, I would have had to use a popup menu under a textbox (and not a commandbutton) because the selected menu item should then be displayed in that text box, so the user knows what he has selected.
That whole thing would take some extra coding (not a lot though) and also would not look nice and normal.
Now it works like this: if the right side of the list exceeds the limit of the primary monitor, it aligns the list to the right of the combo control.
It will work fine in 99% of cases, because who works in a secondary monitor anyway?
But, if someone is working in a secondary monitor that is located at the right of the primary (the most common situation), the list will be aligned always to the right (because it always will exceed the right side of the primary monitor).
That can be fixed quite easily (tested).
Changing the line:
Code:
If iRCList.Right > (Screen.Width \ Screen.TwipsPerPixelX) Then ' only if it goes beyond the screen width
to:
Code:
If (iRCList.Right > (Screen.Width \ Screen.TwipsPerPixelX)) And Not (iRCList.Left > (Screen.Width \ Screen.TwipsPerPixelX)) Then ' only if it goes beyond the screen width but is still on the primary monitor
Another consequence is that if the combo is near to the right side of the secondary monitor, it will not change the list alignment as it does with the primary.
Fixing that would require some more complex code (using multi monitors APIs), but it is anyway a situation that probably won't happen or won't happen frequently in practice. And anyway, in such situation the user can still move the window a bit to the left manually.
I just mentioned it for completeness.
If you want it can be done with multi monitor APIs, but i don't think it's worth it.
Strangely enough, your solution doesn't work in my own project.
It DOES work in the vbp project that you attached.
But doesn't work in my project.
I have stepped through the code and I see that in my own project, this line (the red line):
Code:
hWndList = GetComboListHwnd(Combo1)
GetWindowRect hWndList, iRCList
If iRCList.Right > (Screen.Width \ Screen.TwipsPerPixelX) Then ' only if it goes beyond the screen width
iWidth = iRCList.Right - iRCList.Left
GetWindowRect Combo1.hWnd, iRCCombo
iRCList.Right = iRCCombo.Right
iRCList.Left = iRCList.Right - iWidth
SetWindowPos hWndList, 0, iRCList.Left, iRCList.Top, iWidth, iRCList.Bottom - iRCList.Top, 0
End If
doesn't do anything, because before that line runs, the value of iRCList.Right and iRCCombo.Right are the same!!!
I have checked that hWndList and Combo1.hWnd hold different values
Therefore, I really don't understand why the Right properties of their RECTs are the same.
The right side of the combo window and the right side of the combo list window is a normal case. I attach images to illustrate.
Why your code does not work, I don't know.
If you can narrow it down to a small sample project to see what's going on, please post it.
I just realized that a combo box does not have a MouseUp event !!!
I always thought all the basic VB6 controls had MouseUp events.
But, surprisingly, comboboxes don't.
I need to program the right mouse button to pop up a popup menu.
In other words, I want to enable the user to right-click on a combobox to bring on a popup menu, so that he could then select one of the items of that popup menu.
There should be some way of doing this.
Probably some kind of workaround or some way of doing this.
You have a dropdown list for a combobox, why also show the same list in a pop-up menu when you right click the text field of the combo box?
That’s an unusual UI