Here's the revised code ... the demo uses a listview, label and three
command buttons....
Option Explicit
Private Const LVM_FIRST = &H1000
Private Const LVM_GETTOPINDEX = (LVM_FIRST + 39)
Private Const LVM_GETCOUNTPERPAGE As Long = (LVM_FIRST + 40)
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 Function ListView_SetTopIndex(lv As ListView, ByVal itemToTop As
Long) As Long
Dim lvItemsPerPage As Long
Dim lvNeededItems As Long
Dim lvCurrentTopIndex As Long
'determine if desired index + number
'of items in view will exceed total
'items in the control
lvCurrentTopIndex = ListView_GetTopIndex(lv.hwnd) + 1 '0-based!
lvItemsPerPage = ListView_GetVisibleCount(lv.hwnd)
lvNeededItems = (itemToTop - lvItemsPerPage)
'is current index above or below
'desired index?
If lvCurrentTopIndex > itemToTop Then
'it is above the desired index, so
'scroll up. The item will automatically
'be positioned at the top
lv.ListItems((itemToTop)).EnsureVisible
Else
'it's below, so based on whether there
'are sufficient items to set to the topindex ...
If (itemToTop + lvItemsPerPage) > lv.ListItems.Count Then
'it is below but it can't be set to
'the top as the control has insufficient
'items, so just scroll to the end of listview
lv.ListItems(lv.ListItems.Count).EnsureVisible
Else
'it is below, and since a listview
'always moves the item just into view,
'have it instead move to the top by
'faking item we want to 'EnsureVisible'
'the item lvItemsPerPage -1 below the actual
'index of interest.
lv.ListItems((itemToTop + lvItemsPerPage) - 1).EnsureVisible
End If
End If
'return a 1-based top index
'as sign of success.
ListView_SetTopIndex = ListView_GetTopIndex(lv.hwnd) + 1
End Function
Private Function ListView_GetTopIndex(hwndlv As Long) As Long
ListView_GetTopIndex = SendMessage(hwndlv, _
LVM_GETTOPINDEX, _
0&, _
ByVal 0&)
End Function
Private Function ListView_GetVisibleCount(ByVal hwndlv As Long) As Long
ListView_GetVisibleCount = SendMessage(hwndlv, _
LVM_GETCOUNTPERPAGE, _
0&, _
ByVal 0&)
End Function
Private Sub Command1_Click()
Static lastIndex As Long
Dim nIndex As Long
Dim itmx As ListItem
Dim topIndex As Long
Set itmx = ListView1.FindItem("main item100", lvwText, 1, lvwPartial)
If Not itmx Is Nothing Then
topIndex = ListView_SetTopIndex(ListView1, itmx.Index)
itmx.Selected = True
lastIndex = itmx.Index
End If
Label1.Caption = topIndex
End Sub
Private Sub Command2_Click()
Static lastIndex As Long
Dim nIndex As Long
Dim itmx As ListItem
Dim topIndex As Long
Set itmx = ListView1.FindItem("main item197", lvwText, 1, lvwPartial)
If Not itmx Is Nothing Then
topIndex = ListView_SetTopIndex(ListView1, itmx.Index)
itmx.Selected = True
lastIndex = itmx.Index
End If
Label1.Caption = topIndex
End Sub
Private Sub Command3_Click()
Static lastIndex As Long
Dim nIndex As Long
Dim itmx As ListItem
Dim topIndex As Long
Set itmx = ListView1.FindItem("main item2", lvwText, 1, lvwPartial)
If Not itmx Is Nothing Then
topIndex = ListView_SetTopIndex(ListView1, itmx.Index)
itmx.Selected = True
lastIndex = itmx.Index
End If
Label1.Caption = topIndex
End Sub
Private Sub Form_Load()
Dim itmx As ListItem
Dim cnt As Long
With ListView1
.ColumnHeaders.Add , , "main"
.ColumnHeaders.Add , , "sub 1"
.ColumnHeaders.Add , , "sub 2"
.ColumnHeaders.Add , , "sub 3"
For cnt = 1 To 200
Set itmx = .ListItems.Add(, , "main item" & CStr(cnt))
itmx.SubItems(1) = "subitem 1," & CStr(cnt)
itmx.SubItems(2) = "subitem 3," & CStr(cnt)
itmx.SubItems(3) = "subitem 4," & CStr(cnt)
Next
.SortKey = 0
.Sorted = False
.View = lvwReport
.FullRowSelect = True
.LabelEdit = lvwManual
End With
Command1.Caption = "mid-way"
Command2.Caption = "item 197"
Command3.Caption = "item 2"
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
'sort the items
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
ListView1.Sorted = True
End Sub
--
Randy Birch
MVP Visual Basic
http://vbnet.mvps.org/
Please respond only to the newsgroups so all can benefit.
There's no place like 127.0.0.1
"Jon Ripley" <ne**@stryker.freeserve.co.uk> wrote in message
news:sr**********************@news-text.cableinet.net...
: Many thanks, got it working now :)
:
: Jon R.
:
:
