Printable View
Is it possible to disable or suppress the (Ugly!) scroll bar in a listbox?
I would like to have something like a plain window in which an unchanging list of items can be scrolled either from code or from a remote button.
Any help is Appreciated!
Wendy
I don't think it can happen
You can scroll in picture box but once your text reaches
the top of the box, that is it. You will not see anything
that does not fit in the box.
IE.example is scrolling text from bottom up.
Code:'scrolling text...
'scrolls once from the bottom of the picture box
'to the top of the box
' requires a picture box and a timer control
'(timer ctrl propery enabled set to false)
'
Option Explicit
'
'Text string to be scrolled
Public strString As String
'Last position of text
Public IntLPosition As Integer
Private Sub Form_Load()
'
'strString = the text you want scrolled
'
strString = "This is a scrolling text example." & vbCrLf
strString = strString & "The life and times of me!" & vbCrLf
strString = strString & "As if there was a tale." & vbCrLf
strString = strString & "Who, but you, would you tell it to?"
'
IntLPosition = Picture1.Height 'Start at bottom
Timer1.Interval = 50 'time between scrolling (lower number faster speed)
Timer1.Enabled = True 'Start timer
'
End Sub
Private Sub Timer1_Timer()
Picture1.Cls 'Clear picture box
Picture1.CurrentY = IntLPosition 'Set position
Picture1.Print strString 'Show
IntLPosition = IntLPosition - Screen.TwipsPerPixelY 'Move up one pixel
If IntLPosition < 0 Then Timer1.Enabled = False 'Stop when at top
End Sub
Thanks, HeSaidJoe!
I was affraid I would't be able to do that.
I appreciate your answer.
Do you happen to know how I can make the scroll bar the same color as the listbox's background? I saw a code example about this somewhere on the net just last week, but I am unable to find it now.
Thanks again!
Wendy
haven't seen it but will have a look.
It may be easier to make the listbox backcolor grey
like the scrollbar
Notice that if you change the backcolor of the listbox to plain grey, then it won't fit to any user, instead of "&HC0C0C0", try 'vbScrollBars' ("&H80000000"). This will set the backcolor to the system scroll bar color.
As far as I can tell, the scroll bar can only be "disabled" at creation time of the list box.
Unfortunately we (the VB user) do not have any control over that process.
You might have to emulate the behaviour you are looking for by only letting a certain number of items into the listbox. Your code would have to control the adding and removing of items form the start and end of the listbox in order to give the appearance you are after.
If you could find a way to change the colour of the scroll bar then the listbox will look weird. My suggested kludge on the other hand is a hassle for you to write, but will look good.
Regards
Paul Lewis
HeSaidJoe,
ScOrp,
PaulLewis,
Thanks guys!
I'm working on this thing and have just about got the look I want. I appreciate all your help.
Wendy
I had a few minutes and I thought I could probably use this myself so I wrote a small class wrapper for the list box. This could be made more elaborate and used in a UserControl if you wish.
Code:' code for Form
' One ListBox and Two Buttons called cmdUp and cmdDown
Option Explicit
Dim myListBox As New SpecialListBox
Private Sub cmdDown_Click()
myListBox.ScrollDown
End Sub
Private Sub cmdUp_Click()
myListBox.ScrollUp
End Sub
Private Sub Form_Load()
myListBox.LinkedControl = List1
myListBox.VisibleRows = 6
Dim c As Integer
For c = 0 To 10
myListBox.AddItem Str(c)
Next
End Sub
I know you will have found your own solution as well so hopefully my post will help someone else if they ever come across your post while searching in the future.Code:' this is the class module I called "SpecialListBox"
Option Explicit
Dim mItems() As String
Dim mItemCount As Integer
Dim mLinkedControl As ListBox
Dim mCurrentPos As Integer
Dim mVisibleRows As Integer
Public Property Get List(Index As Integer)
List = mItems(Index)
End Property
Public Property Get VisibleRows() As Integer
VisibleRows = mVisibleRows
End Property
Public Property Let VisibleRows(RowCount As Integer)
mVisibleRows = RowCount
End Property
Public Property Let LinkedControl(TheControl As ListBox)
Set mLinkedControl = TheControl
End Property
Public Property Get LinkedControl() As ListBox
Set LinkedControl = mLinkedControl
End Property
Public Sub AddItem(Item As String, Optional Index As Integer = -1)
mItemCount = mItemCount + 1
ReDim Preserve mItems(mItemCount)
If Index = -1 Then
' add to the end as the default
mItems(mItemCount - 1) = Item
Else
' add to the correct position
Dim c As Integer
' shift all the current items
For c = mItemCount To Index + 1 Step -1
mItems(c) = mItems(c - 1)
Next
mItems(Index) = Item
End If
Refresh
End Sub
Public Sub RemoveItem(Index As Integer)
Dim c As Integer
For c = Index To mItemCount - 1
mItems(c) = mItems(c + 1)
Next
mItemCount = mItemCount - 1
ReDim Preserve mItems(mItemCount)
Refresh
End Sub
Public Sub Refresh()
Dim c As Integer
mLinkedControl.Clear
For c = 0 To mVisibleRows - 1
If c + mCurrentPos >= mItemCount Then Exit For
mLinkedControl.AddItem mItems(c + mCurrentPos)
Next
End Sub
Public Sub Clear()
mItemCount = 0
mCurrentPos = 0
ReDim Preserve mItems(0)
mLinkedControl.Clear
End Sub
Public Property Get ListCount() As Integer
ListCount = mItemCount
End Property
Public Property Let CurrentPosition(NewPos As Integer)
If NewPos < mItemCount And NewPos >= 0 Then
mCurrentPos = NewPos
Refresh
End If
End Property
Public Property Get CurrentPosition() As Integer
CurrentPosition = mCurrentPos
End Property
Public Function ScrollDown() As Boolean
' convenience method to allow scroll down the list
Dim tmp As Integer
tmp = CurrentPosition
CurrentPosition = tmp + 1
ScrollDown = Not (tmp = CurrentPosition)
End Function
Public Function ScrollUp() As Boolean
' convenience method to allow scroll up the list
Dim tmp As Integer
tmp = CurrentPosition
CurrentPosition = tmp - 1
ScrollUp = Not (tmp = CurrentPosition)
End Function
Regards
Paul Lewis
You can get control over the creation process by Subclassing/Hooking the Application Thread and altering the Listbox Style before it's created, i.e.:
In a Module:In a Form with a Listbox: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 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))
tCreate.style = tCreate.style Xor WS_VSCROLL
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
Code:Private Sub Form_Initialize()
'Hoop the Application Thread before the Controls get a chance to be created
HookThread
End Sub
Private Sub Form_Load()
Dim lIndex As Long
For lIndex = 1 To 100
List1.AddItem "Item " & lIndex
Next
End Sub
Private Sub Form_Terminate()
'Remove the Hook
UnHookThread
End Sub
Aaron:
Wow! Too good. It works like a charm.
One little drawback..at least on my system, the
hook crashed VB.
Er yes - I will be copying your code and trying it our Aaron Young as it looks like quite a useful thing.
Cheers
Paul Lewis
Never mind, I just realized it's cause I quit using the
VB button and not the terminate on the form.
False Alarm...
Aaron Young:
How did you use this API without a DLL???
Oops, my mistake. I just realized you're hooking your own thread. :D
WOW!!!!
Goodness!
Thank you Paul Lewis and Aaron Young!
I just checked here between class and work and couldn't believe it. I won't be able to do my work today for thinking about this. You guys have done some stuff!
(Thanks to ScOrp and HeSaidJoe too.)
I'll be learning and working with this for days (or weeks)to come.
You guys are troopers. Thanks again.
Wendy
OK, Guys!
It can be done!
I've not tried it, but I think this may be what I was looking for. (I wanted to post the link here before I forgot.)
There is a very good post at the following site about
disabling the scroll bar in a list box. Please take a look at it. It's very interesting and educational.
http://www.geocities.com/vb4developer/
This guy has done some good work.
Thanks!
Wendy