ListBox Styles

Hi

I'm trying to make a listbox display a vertical scrollbar all the time. I've found the LBS_DISABLENOSCROLL listbox style constant and it sounds like the one I'm looking for, but I can't get it to work when I do the following:


Option Explicit
Private Const LBS_DISABLENOSCROLL = &H1000&
Private Const GWL_STYLE = (-16)

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 Sub Command1_Click

Dim lngStyle As Long

' Get the current List Box window style
lngStyle = GetWindowLong(List1.hWnd, GWL_STYLE)

' Add the Disable No Scroll list box to the
' current list box styles
Call SetWindowLong(List1.hWnd, GWL_STYLE, _
lngStyle Or LBS_DISABLENOSCROLL)

End Sub

How do I make a listbox show a vertical scrollbar all the time?

I may be wrong, but I think you cannot modify the LBS_DISABLENOSCROLL style after the listbox has been created, you actually have to supply this style with either CreateWindow or CreateWindowEx.....

Use the ShowScrollBar API function.

Code:

---

Private Declare Function ShowScrollBar Lib "user32" _
(ByVal hwnd As Long, ByVal wBar As Long, _
ByVal bShow As Long) As Long


Private Sub Command1_Click()
    ShowScrollBar List1.hwnd, 1, True
End Sub

---

That won't work.

It does work, I jus' forgot to mention that the listbox has to have something in it :rolleyes:.

Yes, I know, but it only displays the regular scrollbar, not the disabled one.

You can Hook to form before it has a chance to Create its controls then change the Listbox's creation data making the change permenant, i.e.

In a Module:

Code:

---

Option Explicit

Private Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type

Private Type CREATESTRUCT
        lpCreateParams As Long
        hInstance As Long
        hMenu As Long
        hWndParent As Long
        cy As Long
        cx As Long
        y As Long
        x As Long
        style As Long
        lpszName As Long 'string
        lpszClass As Long 'string
        ExStyle As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

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 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 Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WH_CALLWNDPROC = 4

Private Const GWL_WNDPROC = (-4)
Private Const GWL_STYLE = (-16)

Private Const WM_CREATE = &H1

Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000

Private Const LBS_DISABLENOSCROLL = &H1000&

Private lHook As Long
Private lSubList As Long

Public Sub HookThread()
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookApp, App.hInstance, App.ThreadID)
End Sub

Public Sub UnHookThread()
    Call UnhookWindowsHookEx(lHook)
End Sub

Private Function HookApp(ByVal lHookID As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCWP As CWPSTRUCT
    Dim sClass As String

    'Monitor this application thread for Window Creation Messages
    Call CopyMemory(tCWP, ByVal lParam, Len(tCWP))

    If tCWP.message = WM_CREATE Then
        'Looking for a Listbox class...
        sClass = Space(128)
        Call GetClassName(tCWP.hwnd, ByVal sClass, 128)
        sClass = Left(sClass, InStr(sClass, Chr(0)) - 1)
        If InStr(LCase(sClass), "listbox") Then
            'When found, Subclass this Window before the Listbox is created
            lSubList = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubListCreate)
        End If
    End If
    HookApp = CallNextHookEx(lHook, lHookID, wParam, ByVal lParam)
End Function

Private Function SubListCreate(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCreate As CREATESTRUCT
   
    'Capture the Create Message for the Listbox and Remove the Vertical Scrollbar from it's Style
    If Msg = WM_CREATE Then
        Call CopyMemory(tCreate, ByVal lParam, Len(tCreate))
        'Disable Vertical Scrollbar when not enough items to scroll and remove Horizontal Scrollbar
        tCreate.style = tCreate.style Or LBS_DISABLENOSCROLL Xor WS_HSCROLL
        Call CopyMemory(ByVal lParam, tCreate, Len(tCreate))
        Call SetWindowLong(hwnd, GWL_STYLE, tCreate.style)
        'Remove the SubClassing for the Listbox
        Call SetWindowLong(hwnd, GWL_WNDPROC, lSubList)
    End If
    SubListCreate = CallWindowProc(lSubList, hwnd, Msg, wParam, lParam)
End Function

---

In a form with a Listbox:

Code:

---

Private Sub Command1_Click()
    List1.AddItem "Item" & List1.ListCount + 1
End Sub

Private Sub Form_Initialize()
    'Hoop the Application Thread before the Controls get a chance to be created
    HookThread
End Sub

Private Sub Form_Terminate()
    'Remove the Hook
    UnHookThread
End Sub

---

I've just tried the code and it works great.

Thank you.

:)