here is the code for a combobox with a horizontal scrollbar!!!

[pgarn]

After numerous posts on several different boards a final solution for the combobox has been found. Here is the code to add the functional scrollbar ENJOY!!!!

'========Bas module code=========
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 SetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpcScrollInfo
As SCROLLINFO, ByVal bool As Boolean) As Long
Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpScrollInfo
As SCROLLINFO) As Long
Private Declare Function GetComboBoxInfo Lib "user32.dll" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO)
As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As
Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) 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

Private Const CB_GETLBTEXT = &H148
Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_SETHORIZONTALEXTENT = &H15E
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const SB_HORZ = 0
Private Const SB_LINEDOWN = 1
Private Const SB_LINEUP = 0
Private Const SB_PAGEDOWN = 3
Private Const SB_PAGEUP = 2
Private Const SB_THUMBTRACK = 5
Private Const SB_ENDSCROLL = 8
Private Const WM_DESTROY = &H2
Private Const WM_HSCROLL = &H114


' SCROLLINFO fMask constants:
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)

Private Type SCROLLINFO
cbSize As Long ' Size of structure
fMask As Long ' Which value(s) you are changing
nMin As Long ' Minimum value of the scroll bar
nMax As Long ' Maximum value of the scroll bar
nPage As Long ' Large-change amount
nPos As Long ' Current value
nTrackPos As Long ' Current scroll position
End Type

Private Const GWL_WNDPROC = (-4)
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal
nIndex As Long, ByVal dwNewLong As Long) As Long

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 Type SIZE
cx As Long
cy As Long
End Type
Dim oldproc As Long

Public Sub SetHorzScrollBar(cb As ComboBox)
Dim lResult As Long
Dim lmax As Long
Dim sMax As String
Dim lCount As Long
Dim uComboInfo As COMBOBOXINFO
Dim uScrollInfo As SCROLLINFO

For lCount = 0 To cb.ListCount - 1
lResult = SendMessage(cb.hWnd, CB_GETLBTEXTLEN, lCount, ByVal 0)
If (lResult > lmax) Then
lmax = lResult
sMax = Space(lmax)
lResult = SendMessage(cb.hWnd, CB_GETLBTEXT, lCount, ByVal sMax)
sMax = Left(sMax, lResult)
End If
Next
lResult = SendMessage(cb.hWnd, CB_GETDROPPEDWIDTH, 0, ByVal 0)
lmax = GetActualWidth(cb, sMax)


If (lmax > lResult) Then
uComboInfo = GetComboInfo(cb)
SendMessage cb.hWnd, CB_SETHORIZONTALEXTENT, lmax, ByVal 0
uScrollInfo = GetScrollBarInfo(uComboInfo.hwndList)
uScrollInfo.nMax = lmax
'***ajust max scroll value as you need***
uScrollInfo.nPage = cb.Width \ Screen.TwipsPerPixelX
SetScrollInfo uComboInfo.hwndList, SB_HORZ, uScrollInfo, True
oldproc = SetWindowLong(uComboInfo.hwndList, GWL_WNDPROC, AddressOf WndProc)
End If
End Sub

Private Function GetComboInfo(cboCombo As ComboBox) As COMBOBOXINFO
Dim CBI As COMBOBOXINFO
CBI.cbSize = Len(CBI)
GetComboBoxInfo cboCombo.hWnd, CBI
GetComboInfo = CBI
End Function

Private Function GetScrollBarInfo(hWnd As Long) As SCROLLINFO
Dim SBI As SCROLLINFO
SBI.cbSize = Len(SBI)
SBI.fMask = SIF_ALL
GetScrollInfo hWnd, SB_HORZ, SBI
GetScrollBarInfo = SBI
End Function

Private Function GetActualWidth(cboCombo As ComboBox, sString As String) As Long
Dim hDC As Long
Dim uSize As SIZE
Dim sSavedFont As String
Dim iSavedSize As Integer
Dim bSavedBold As Boolean
Dim bSavedItalic As Boolean
Dim bSavedUnderline As Boolean
Dim bIsFontSaved As Boolean
Dim lResult As Long

On Error GoTo GetActualWidthError

With cboCombo.Parent
sSavedFont = .FontName
iSavedSize = .FontSize
bSavedBold = .FontBold
bSavedItalic = .FontItalic
bSavedUnderline = .FontUnderline
.FontName = cboCombo.FontName
.FontSize = cboCombo.FontSize
.FontBold = cboCombo.FontBold
.FontItalic = cboCombo.FontItalic
.FontUnderline = cboCombo.FontUnderline
End With

bIsFontSaved = True

hDC = GetDC(cboCombo.hWnd)
lResult = GetTextExtentPoint32(hDC, sString, Len(sString), uSize)
ReleaseDC cboCombo.hWnd, hDC

GetActualWidth = uSize.cx - 50

GetActualWidthError:

On Error Resume Next

If bIsFontSaved Then
With cboCombo.Parent
.FontName = sSavedFont
.FontSize = iSavedSize
.FontUnderline = bSavedUnderline
.FontBold = bSavedBold
.FontItalic = bSavedItalic
End With
End If
End Function

Public Function WndProc(ByVal hOwner As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Long) As Long
Dim nOldPos As Long, n As Long
Dim s As SCROLLINFO
Select Case wMsg
Case WM_HSCROLL
s.cbSize = Len(s)
s = GetScrollBarInfo(hOwner)
nOldPos = s.nPos
Select Case GetLoWord(wParam)
Case SB_LINEDOWN
'***ajust min scroll value as you need***
s.nPos = s.nPos + s.nPage \ 25
Case SB_LINEUP
s.nPos = s.nPos - s.nPage \ 25
Case SB_PAGEDOWN
s.nPos = s.nPos + s.nPage
Case SB_PAGEUP
s.nPos = s.nPos - s.nPage
Case SB_THUMBTRACK
s.nPos = GetHiWord(wParam)
Case SB_ENDSCROLL
End Select
SetScrollInfo hOwner, SB_HORZ, s, True
Case WM_DESTROY
Call SetWindowLong(hOwner, GWL_WNDPROC, oldproc)
Case Else
End Select
WndProc = CallWindowProc(oldproc, hOwner, wMsg, wParam, lParam)
End Function

Private Function GetHiWord(dw As Long) As Long
If dw And &H80000000 Then
GetHiWord = (dw \ 65535) - 1
Else
GetHiWord = dw \ 65535
End If
End Function

Private Function GetLoWord(dw As Long) As Long
If dw And &H8000& Then
GetLoWord = &H8000 Or (dw And &H7FFF&)
Else
GetLoWord = dw And &HFFFF&
End If
End Function


'==========Form code========

Private Sub Form_Load()

Combo1.AddItem "Ottawa, Ontario"
Combo1.AddItem "St. John's, Newfoundland and Labrador"
Combo1.AddItem "Halifax, Nova Scotia"
Combo1.AddItem "Charlottetown, Prince Edward Island"
Combo1.AddItem "Fredericton, New Brunswick"
Combo1.AddItem "Qu?bec, Qu?bec"
Combo1.AddItem "Toronto, Ontario"
Combo1.AddItem "Winnipeg, Manitoba"
Combo1.AddItem "Regina, Saskatchewan"
Combo1.AddItem "Edmonton, Alberta"
Combo1.AddItem "Victoria, British Colombia"
Combo1.AddItem "Whitehorse, Yukon"
Combo1.AddItem "Yellowknife, Northwest Territories"
Combo1.AddItem "Iqaluit, Nunavut"
SetHorzScrollBar Combo1

End Sub

[alex_read]

Nice

[vishalmarya]

After numerous posts on several different boards a final solution for the combobox has been found. Here is the code to add the functional scrollbar ENJOY!!!!

I am trying to change the postion of the dropdown window of the combobox.

function GetComboBoxInfo gives me the handler to this dropdown window

then i am using SetWindowPos to set the new postion of the window , but immediately it returns to its orignal position as the system takes over .

Do I have to do subclassing ?

Any Suggestions..

Thanks


Dim CInfo As PCOMBOBOXINFO

CInfo.cbSize = Len(CInfo)

GetComboBoxInfo Combo1.hwnd, CInfo

Dim list_hwnd As Long

list_hwnd = CInfo.hwndList

Dim cntrl_rect As RECT
GetWindowRect Combo1.hwnd, cntrl_rect

Dim result As Long

result = SetWindowPos(list_hwnd, -1, cntrl_rect.Left-10, cntrl_rect.Top, (cntrl_rect.Right - cntrl_rect.Left) , _
cntrl_rect.Bottom - cntrl_rect.Top, SWP_SHOWWINDOW)