ThomasAJ said:My list box has many more columns than can be shown within it's width. Under
certain circumstances I would like to scroll it left/right to show other
columns.
Stephen Lebans said:Here's the code to scroll the ListBox vertically. THe only mod required to
scroll Horiz instead is to change one constant.
Private Const WM_VSCROLL = &H115
TO
Private Const WM_HSCROLL = &H114
' ***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
--
HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
pjgalloway said:I am trying to sort a listbox based on a click on the column header. I
should note that my listbox is based on a query and has enough columns that a
horizontal scroll bar is required but it is well behaved in that every column
has a defined column width.
I was able to modify Stephen Lebans' ComboCurrentRow.mdb using
apiGetScrollInfo to determine which column was clicked. I have put my code
in the mouse down event of the listbox. My problem is that when I reset the
row source of the listbox to change the Order By, the listbox is returned to
the non-scrolled position. If I call the same function elsewhere it scrolls
the listbox just fine. How do I scroll the listbox while in the mouse down
event for the listbox?
Here's the scrolling function, the sorting function, and the mouse down event:
Public Sub ListBoxScrollHorz(anyListbox As Control, intColNumber As Integer)
Dim LngThumb As Long, lngLParam As Long, lRet As Long, hWndList As Long
anyListbox.SetFocus
hWndList = GetFocus()
lngLParam = MakeDWord(0, 0)
LngThumb = MakeDWord(SB_THUMBPOSITION, intColNumber)
lRet = SendMessage(hWndList, WM_HSCROLL, LngThumb, lngLParam)
End Sub
Public Function ListBoxSort(anyListbox As Control, anySortLabel As Label,
frm As Form, Button As Integer, Shift As Integer, X As Single, Y As Single)
As Integer
On Error GoTo HandleErrors
Dim lRet As Long
Dim hWndList As Long
Dim sngRowHeight As Single ' Height of One ListBox Row.
Dim myscrollinfo As SCROLLINFO
Dim strColWidths() As String
Dim strOrderBy As String, strSortCaption As String, strSQL As String
Dim i As Integer, intColCount As Integer, intMinCol As Integer, intMaxCol As
Integer
Dim intColNumber As Integer, intColWidthSum As Integer
Dim intWidths() As Integer
' must have column headers or can't do sort
If Not anyListbox.ColumnHeads Then Exit Function
'only sort listbox based on queries
If anyListbox.RowSourceType <> "table/query" Then Exit Function
'Nothing there, so ignore the click
If Len(anyListbox.RowSource) = 0 Then Exit Function
'If rowsource does not start with SELECT or PARAMETERS then
'assume it is a table not a query
If Not (InStr(1, Trim(anyListbox.RowSource), "Select", vbTextCompare) = 1 _
Or InStr(1, Trim(anyListbox.RowSource), "Parameters", vbTextCompare) =
1) Then Exit Function
'Column count must be correctly set, otherwise this routine could cause
errors.
'Column count set less than actual field count will cause subscript errors.
'Column count set higher than actual field count can cause listbox to
display nothing if "Extra" column is clicked.
If anyListbox.ColumnCount <> DBEngine(0)(0).CreateQueryDef("",
anyListbox.RowSource).Fields.Count Then Exit Function
'Every column must have a width specified
intColCount = anyListbox.ColumnCount
strColWidths = Split(anyListbox.ColumnWidths, ";")
If intColCount <> UBound(strColWidths) + 1 Then Exit Function
For i = 0 To UBound(strColWidths)
If strColWidths(i) = "" Then Exit Function
Next i
' must be on header row
sngRowHeight = StringToTwips(anyListbox, "Tj")
If Y < 0 Or Y > sngRowHeight Or X < 0 Then Exit Function
hWndList = GetFocus()
' This is the List Box because Access has called the SetCapture API.
If hWndList = 0 Then Exit Function
' Now we need to determine the offset of the ScrollBar position if any
myscrollinfo.cbSize = Len(myscrollinfo)
myscrollinfo.fMask = SIF_ALL
myscrollinfo.nTrackPos = 0
myscrollinfo.nPos = 0
lRet = apiGetScrollInfo(hWndList, SB_HORZ, myscrollinfo)
intMinCol = myscrollinfo.nPos
ReDim intWidths(intColCount - 1, 1)
intColWidthSum = 0
intMaxCol = 0
For i = intMinCol To UBound(strColWidths)
'Assign values to array that holds length and running sum of length
intColWidthSum = intColWidthSum + Val(strColWidths(i))
intWidths(i, 0) = strColWidths(i)
If intColWidthSum > anyListbox.Width Then
intWidths(i, 1) = anyListbox.Width
intMaxCol = i
Exit For
Else
intWidths(i, 1) = intColWidthSum
End If
Next i
If intMaxCol = 0 Then intMaxCol = UBound(strColWidths)
'Determine which column was clicked
For i = intMinCol To intMaxCol
If X <= intWidths(i, 1) Then
intColNumber = i
Exit For
End If
Next i
'Rebuild SQL if col number is in range 0 to number of Columns - 1 (since 0
based)
If intColNumber >= 0 And intColNumber <= intColCount - 1 Then
strSQL = Trim(anyListbox.RowSource)
If Right(strSQL, 1) = ";" Then strSQL = Left(strSQL, Len(strSQL) - 1)
i = InStr(1, strSQL, "Order by")
If i > 0 Then
strOrderBy = Trim(Mid(strSQL, i + Len("Order by")))
strSQL = Trim(Left(strSQL, i - 1))
End If
'Build the appropriate ORDER BY clause
If Len(strOrderBy) = 0 Then
'If no prior sort then sort this column ascending
strOrderBy = " Order by " & intColNumber + 1 & " Asc"
strSortCaption = "Ordered by " & anyListbox.Column(intColNumber, 0)
& " (Ascending)"
ElseIf InStr(1, strOrderBy, intColNumber + 1 & " Asc") > 0 Then
'If already sorted asc on this column then sort descending
strOrderBy = " Order By " & intColNumber + 1 & " Desc"
strSortCaption = "Ordered by " & anyListbox.Column(intColNumber, 0)
& " (Descending)"
ElseIf InStr(1, strOrderBy, intColNumber & " Desc") > 0 Then
'If already sorted desc on this column then sort Ascending
strOrderBy = " Order By " & intColNumber + 1 & " Asc"
strSortCaption = "Ordered by " & anyListbox.Column(intColNumber, 0)
& " (Ascending)"
Else
strOrderBy = " Order by " & intColNumber + 1 & " Asc"
strSortCaption = "Ordered by " & anyListbox.Column(intColNumber, 0) &
" (Ascending)"
End If
strSQL = strSQL & strOrderBy
anyListbox.RowSource = strSQL
anySortLabel.Caption = strSortCaption
End If
ExitHere:
ListBoxSort = intMinCol
Exit Function
HandleErrors:
Select Case Err.Number
Case Else
MsgBox "Unexpected error #" & Err.Number & ": " &
Err.Description, vbCritical + vbOKOnly, "Error Sorting Listbox"
End Select
Resume ExitHere
End Function
Private Sub lstAvailable_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
intColNum = ListBoxSort(lstAvailable, lblAvailableOrder, Me, Button, Shift,
X, Y)
ListBoxScrollHorz lstAvailable, intColNum
End Sub
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.