Sync Scrolling of Two Listboxes

[Dennis]

I'm trying to have two listboxes scroll each other with
the following code:

Private Sub List1_Scroll()
List2.TopIndex = List1.TopIndex
End Sub

Private Sub List2_Scroll()
List1.TopIndex = List2.TopIndex
End Sub

This is great for VB, but VBA doesn't offer a Scroll Event
for a listbox. The scrollbars that automatically appear
on Access listboxes don't seem to fire any events
(BeforeUpdate, AfterUpdate, etc.).

I'm trying to NOT use a bulky ActiveX control to sync two
listboxes (if possible) and am not sure if creating some
kind of class using the WithEvents keyword is the way to
go. Is there a way to access a native Access control
event for this purpose?

FYI - The top listbox will just show the Column Heads and
the botton listbox will show the records WITHOUT the
Column Heads. I'm doing this because the bottom listbox's
RowSource is set to an SQL string and if the ColumnHeads
property is not set to False when setting the
RowSource, the field headings become the first row in the
listbox causing .Column(0, 0) to become "Column_Name"
instead of the actual Column value. This throws off the
index by 1, creating a subtle error

I appreciate any and all help - Thanks !!!

 

[Dennis]

Of course, if there is a standard ActiveX control that is
not too bulky and offers a RowSource property that can be
set to an SQL string AND has a Scroll property to sync it
with a duplicate ActiveX control, then I'm open to
suggestion there as well. I just think that I would get
better performance trying to do this natively.

 

[Follow-Up]

I decided to post my question on another forum in addition
to this one and received a response that made use of the
Win32API to accomplish the task. Unfortunately, it didn't
work as planned, but I think it is a good way to go. In
case someone can spot something obviously wrong with the
code and to help others out if it can be made to work, I
am posting the suggestion and my response:

++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Suggestion:

To accomplish what you want, we need to access two
functions from the Comctl32.DLL and one function from the
User32.DLL. The FlatSB_GetScrollPos and
FlatSB_SetScrollPos are pretty much self explanitory. The
GetFocus function is required in order to get the handle
(hWnd) of your List Box controls (or any control for that
matter). MSAccess does not give this feature as it does
for Forms (Me.hWnd) so we need to use API calls to
accomplish this.

Copy and Paste this code into a database module.


code:------------------------------------------------------
--------------------------
Declare Function FlatSB_SetScrollPos Lib "comctl32" (ByVal
hWnd As Long, ByVal code As Long, _
ByVal nPos As Long, ByVal fRedraw As Boolean) As Long
Declare Function FlatSB_GetScrollPos Lib "comctl32" (ByVal
hWnd As Long, _
ByVal code As Long) As Long
'-----------------------------------------
Public Declare Function apiGetFocus Lib "user32"
Alias "GetFocus" () As Long
'Used to get the Handle of a Control.
'------------------------------------------

Public Const SB_HORZ = 0
Public Const SB_VERT = 1
Public Const SB_BOTH = 3


Public Function fhWnd(ctl As Control) As Long
On Error Resume Next
ctl.SetFocus
If Err Then
fhWnd = 0
Else
fhWnd = apiGetFocus
End If
On Error GoTo 0
End Function
-----------------------------------------------------------
---------------------


In the Declarations section of your Form which contains
the List Boxes, place the following dimension:


code:------------------------------------------------------
--------------------------
Dim hWnd_A as Long
Dim hWnd_B as Long
-----------------------------------------------------------
---------------------

In the GotFocus event of List1, copy and paste this code:

code:------------------------------------------------------
--------------------------
hWnd_A = fhWnd(Me.List1)
hWnd_B = fhWnd(Me.List2)
Me.TimerInterval = 1
-----------------------------------------------------------
---------------------

In the GotFocus event of List2, copy and paste this code:


code:------------------------------------------------------
--------------------------
hWnd_A = fhWnd(Me.List2)
hWnd_B = fhWnd(Me.List1)
Me.TimerInterval = 1
-----------------------------------------------------------
---------------------

In the LostFocus event of both List1 and List2, copy and
paste this code:


code:------------------------------------------------------
--------------------------
Me.TimerInterval = 0
-----------------------------------------------------------
---------------------

Now....In the OnTimer event for the Form which contains
your List Boxes, copy and paste this code:


code:------------------------------------------------------
--------------------------
FlatSB_SetScrollPos hWnd_B, SB_VERT, FlatSB_GetScrollPos
(hWnd_A, SB_VERT), False
-----------------------------------------------------------
---------------------


This should work...

To get property info on and to manipulate scroll bars,
check out these API functions:


FlatSB_EnableScrollBar
FlatSB_GetScrollPos
FlatSB_GetScrollInfo
FlatSB_GetScrollProp
FlatSB_GetScrollRange
FlatSB_SetScrollInfo
FlatSB_SetScrollPos
FlatSB_SetScrollProp
FlatSB_SetScrollRange
FlatSB_ShowScrollBar

Hope it helps '-----------------------------------------
++++++++++++++++++++++++++++++++++++++++++++++++++++++++


++++++++++++++++++++++++++++++++++++++++++++++++++++++++
My Response:
Well, things didn't go as planned. Everything compiles,
but I get a 43 second delay when I hit the tab where these
two listboxes exist, there is a delay anytime I click on
the scroll bar of either listbox and moving the scroll bar
of either listbox does NOT move the scroll bar of the
alternate listbox. It may be a problem with how Access
creates these pseudo-window controls at runtime.

The main difference between my code and what you had
listed was that I changed SB_VERT
to SB_HORZ in the Timer event because the scroll bars of
interest are Horizontal Scroll
Bars. I changed it back to SB_VERT and tried it out just
to test things and I had the
same 43 second delay and a delay when I moved from the
scroll bar of one listbox to the
scroll bar of the other scroll bar. Better testing showed
that after you move the scroll
bar of one listbar, moving that same listbox doesn't cause
a delay.

Here is what I did:

First, I created a new Module, named
it "basScrollPosition" and added the following code:
===========================================================
=======================
Option Explicit ' Force explicit variable declaration
Option Compare Database

'----------------------------------------------------------
-----------------
' Scroll functions found in the Comctl32.DLL
'
' Syntax: int FlatSB_SetScrollPos(HWND hwnd, int code, int
nPos, BOOL fRedraw);
' Parameters:
' hWnd - Handle to the window that contains the flat
scroll bar.
' code - Parameter that specifies the scroll bar type. It
can be 1 of the following values:
' SB_HORZ - Sets the thumb position of the horizontal
scroll bar.
' SB_VERT - Sets the thumb position of the vertical
scroll bar.
' nPos - Parameter that specifies the new thumb position.
' fRedraw - Parameter that specifies whether the scroll
bar should be redrawn immediately
' to reflect the change. If this parameter is TRUE, the
scroll bar is redrawn; if it is
' FALSE, the scroll bar is not redrawn.
Declare Function FlatSB_SetScrollPos Lib "comctl32" (ByVal
hWnd As Long, _
ByVal code As Long, ByVal nPos As Long, ByVal fRedraw As
Boolean) As Long

' Syntax: int FlatSB_GetScrollPos(HWND hwnd, int code);
' Parameters:
' hWnd - Handle to the window that contains the flat
scroll bar.
' code - Parameter that specifies the scroll bar type. It
can be 1 of the following values:
' SB_HORZ - Sets the thumb position of the horizontal
scroll bar.
' SB_VERT - Sets the thumb position of the vertical
scroll bar.
Declare Function FlatSB_GetScrollPos Lib "comctl32" (ByVal
hWnd As Long, _
ByVal code As Long) As Long
'----------------------------------------------------------
-----------------


'----------------------------------------------------------
-----------------
' Scroll function found in the User32.DLL
'
' Function below is used to Get the Handle of a Control
Public Declare Function apiGetFocus Lib "user32"
Alias "GetFocus" () As Long
'
' Access controls are not standard VB controls. They're
drawn on the screen at runtime.
' As such, unlike VB controls, they do not have a unique
hWnd.

' When an Access control on a form receives the focus, it
becomes a true window and it's
' possible to retrieve it's handle by using the GetFocus
API. Note that because Access
' controls do not behave like VB controls, there's not a
whole lot that we can do with
' the hWnd.
'----------------------------------------------------------
-----------------

Public Const SB_HORZ = 0
Public Const SB_VERT = 1
Public Const SB_BOTH = 3

Public Function fhWnd(ctl As Control) As Long
On Error Resume Next
ctl.SetFocus
If Err Then
fhWnd = 0
Else
fhWnd = apiGetFocus
End If
On Error GoTo 0
End Function
===========================================================
=======================


Second, In the frmInPatientIncidentsDataEntry form (The
form with the 2 listboxes)
I added the following code:


In the Declarations section, I added:
===========================================================
=======================
Option Explicit ' Force explicit variable declaration.

Dim hWnd_A As Long
Dim hWnd_B As Long

Option Compare Database
===========================================================
=======================


In the ListBox1's GotFocus Event I added the following
code:
===========================================================
=======================
Private Sub lstSearchResults2Header_GotFocus()

' Add this code to the GotFocus Event of Listbox1
'hWnd_A = fhWnd(Me.Listbox1)
'hWnd_B = fhWnd(Me.Listbox2)
'Me.TimerInterval = 1

' Retrieve the handle of the Listbox1 Control with the
fhWnd function
' in the basScrollPosition Module and assign that value to
hWnd_A
hWnd_A = fhWnd(Me.lstSearchResults2Header)
' Retrieve the handle of the Listbox2 Control with the
fhWnd function
' in the basScrollPosition Module and assign that value to
hWnd_B
hWnd_B = fhWnd(Me.lstSearchResults2)
' The TimerInterval property specifies the interval, in
milliseconds, between Timer events
' on a form. Code in the form's Timer event procedure
(OnTimer) repeats at this interval
Me.TimerInterval = 1000

End Sub
===========================================================
=======================


In the ListBox1's LostFocus Event I added the following
code:
===========================================================
=======================
Private Sub lstSearchResults2Header_LostFocus()

' Put this code into the LostFocus event of both Listbox1
and Listbox2
' Setting the TimerInterval property to 0 prevents the
Timer event from occurring
Me.TimerInterval = 0

End Sub
===========================================================
=======================


In the ListBox2's GotFocus Event I added the following
code:
===========================================================
=======================
Private Sub lstSearchResults2_GotFocus()

' Add this code to the GotFocus Event of Listbox2
'hWnd_A = fhWnd(Me.Listbox2)
'hWnd_B = fhWnd(Me.Listbox1)
'Me.TimerInterval = 1

' Retrieve the handle of the Listbox2 Control with the
fhWnd function
' in the basScrollPosition Module and assign that value to
hWnd_A
hWnd_A = fhWnd(Me.lstSearchResults2)
' Retrieve the handle of the Listbox1 Control with the
fhWnd function
' in the basScrollPosition Module and assign that value to
hWnd_B
hWnd_B = fhWnd(Me.lstSearchResults2Header)
' The TimerInterval property specifies the interval, in
milliseconds, between Timer events
' on a form. Code in the form's Timer event procedure
(OnTimer) repeats at this interval
Me.TimerInterval = 1000

End Sub
===========================================================
=======================


In the ListBox2's LostFocus Event I added the following
code:
===========================================================
=======================
Private Sub lstSearchResults2_LostFocus()

' Put this code into the LostFocus event of both Listbox1
and Listbox2
' Setting the TimerInterval property to 0 prevents the
Timer event from occurring
Me.TimerInterval = 0

End Sub
===========================================================
=======================


In the frmInPatientIncidentsDataEntry form's Time Event I
added the following code:
===========================================================
=======================
Private Sub Form_Timer()

' Pass the following parameters to the FlatSB_SetScrollPos
function in the
' basScrollPosition Module:
' Parameters:
' integer handle stored in hWnd_B
' SB_HORZ (For "Scroll Bar-Horizontal" Thumb
Position). Alternately, use
' SB_VERT for "Scroll Bar-Vertical" Thumb
Position
' FlatSB_GetScrollPos(hWnd_A, SB_HORZ) passed to
specify the new thumb position

' In other words, Get the Horizontal Scroll Bar's Thumb
position for the control specified
' by the hWnd_A window handle using the
FlatSB_GetScrollPos function, and then set the
' Horizontal Scroll Bar's Thumb position of the control
specified by hWnd_B to the same
' thumb position as that retrieved from hWnd_A

FlatSB_SetScrollPos hWnd_B, SB_HORZ, FlatSB_GetScrollPos
(hWnd_A, SB_HORZ), False

End Sub
===========================================================
=======================

I'm using Access 2000 as a front-end application to tables
stored in an Access97 database.
Since all of my code here is in Access 2000 and doesn't
hit any tables at this point, I don't think that should
have any impact, but I thought that I should mention it.
I'll take a look at the other API's that you mentioned and
see if they can be used. If you see something that you
think is wrong in my code, please let me know and I'll
gladly make the change and give it a try.

Thanks again for all of the excellent code and outstanding
help !!! Although it didn't work for me, I'm still very
grateful for everyone's time and energy on this.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 

[Kelvin]

How about setting up your list box in an independent form to be used as a
subform. Make the form wide enough to see all the fields. Set the scroll
bar property of this form to none. Then when you insert this into the main
form, make it the szie you want to see on the main form and set the scrol
lbar property of the subform to horizontal. Then when you scroll, both list
bozes will appear to be scrolling together. Link the data for the listbox
to invisible controls on the main form.

Kelvin

 

[Stephen Lebans]

I just quickly read through your lengthy post and a couple of issues
come to mind:

1) Access ListBox control's are not lightweight and do have a permanent
hWnd for the current session. You can determine this hWnd in the Form's
Load event but not by setting focus to the control. There's code in the
TOOLTIPS class on my site showing how to do this from the Fomr's Load
event.

2) There is ready made code on my site showing how to get and set
ScrollBar positions. It is currently set for the Form's ScrollBar
control but it is only a minor change to have it work for a Wndow's
instrinsic ScrollBar.
http://www.lebans.com/setgetsb.htm

3) Here is some code to set THumb position for a ListBox control's
ScrollBar
whatever you want. Really should be a Class Wrapper for a ListBox to
expose a TopIndex property like VB ListBoxes.

' ***CODE START
'Place this code in the General Declarations of your Form
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 GetFocus Lib "user32" () As Long

' Windows Message Constant
Private Const WM_VSCROLL = &H115
' Scroll Bar Commands
Private Const SB_THUMBPOSITION = 4
' Code end for General Declarations


' Code for Control's Click Event
Private Sub Customer_Click()

Dim hWndSB As Long
Dim lngRet As Long
Dim lngIndex As Long
Dim LngThumb As Long

' You will get lngIndex value from the user or whatever.
' For now I'm just setting it to arbitrary Number
lngIndex = 45

' SetFocus to our listBox so that we can
' get its hWnd
Me.List2.SetFocus
hWndSB = GetFocus

' Set the window's ScrollBar position
LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(LngIndex))
lngRet = SendMessage(hWndSB, WM_VSCROLL, LngThumb, 0&)

End Sub

' Here's the MakeDWord function from the MS KB
Function MakeDWord(loword As Integer, hiword As Integer) As Long
MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&) End Function
'***END CODE


--


HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.