VB - ListView; LabelEdit for SubItems

[TheVader]

The ListView control available from the Windows Common Controls does provide the ability to edit the labels of items. But, when set to Report mode, it only allows editing of the text in the first column. The SubItems in the other columns cannot be directly edited.

This module allows editing of the items in all columns. It uses a textbox to let the user edit listitems.

Please download the attachment for an example of its usage.

• Unlike the previous version, the code is now placed inside a class. That makes it easier to use and doesn't clutter up existing code. Also multiple instances can run at once, so LabelEditing can be applied to several ListViews at the same time.
• The code now works with ListViews with horizontal scrollbars.
• You no longer have to place a textbox on your form for the editing; the class takes care of that by itself.
• This code works with the Windows Common Controls 6 ListView (not with the Common Controls 5 component). With a bit of tweaking it can also be applied to the vbAccelerator ListView (in that case the subclassing code can be removed).
• The ScaleMode of the form has to be 1-Twip for this code to work.

The LabelEdit class:

Option Explicit
 
'===============================================================
'ListView LabelEdit
'© 2004 by Michiel Meulendijk
'
'This code enables label editing for SubItems in ListViews.
'By default, when using the LabelEdit property, only the first
'ListItem of a ListView can be edited. With this code all
'ListSubItems can be edited as well.
'
'This code is contained within a class, so multiple instances
'can run at the same time (e.g. more ListViews on one form can
'all support label editing).
'
'This file is provided "as is" with no expressed or implied
'warranty. The author accepts no liability for any damage caused
'to your system because of using this code.
'===============================================================
 
Private Declare Function GetScrollInfo Lib "user32.dll" ( _
                ByVal hwnd As Long, ByVal n As Long, _
                lpScrollInfo As SCROLLINFO) As Long
 
Private Type SCROLLINFO
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type
 
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SIF_POS = &H4
 
Dim WithEvents txtEdit As TextBox
Dim WithEvents ltvListView As ListView
Dim objItem As Object
 
Public Sub Init(ByRef ctlForm As Form, ByRef ctlListView As ListView)
'Initiates object. Adds textbox control.
Set ltvListView = ctlListView
Set txtEdit = ctlForm.Controls.Add("VB.TextBox", "txtLabelEdit_" & ctlListView.Name)
Set txtEdit.Container = ctlListView.Container
Set txtEdit.Font = ctlListView.Font
txtEdit.Appearance = 0
txtEdit.ForeColor = vbHighlight
'Subclass listview
SubClassWnd ltvListView.hwnd, Me
End Sub
 
Private Function GetHorizontalScroll() As Long
'Returns the position of the horizontal scroll bar
Dim scrInfo As SCROLLINFO
scrInfo.cbSize = LenB(scrInfo)
scrInfo.fMask = SIF_POS
GetScrollInfo ltvListView.hwnd, SB_HORZ, scrInfo
GetHorizontalScroll = scrInfo.nPos
End Function
 
Private Sub EditText(ByVal x As Integer, ByVal y As Integer)
'Handles label editing
On Error GoTo endSub
Dim i As Integer, objCol As ColumnHeader, lngScroll As Long
 
lngScroll = GetHorizontalScroll * Screen.TwipsPerPixelX
x = x + lngScroll
 
For i = 1 To ltvListView.ColumnHeaders.Count
    If x < ltvListView.ColumnHeaders.Item(1).Width Or ltvListView.ColumnHeaders.Count = 1 Then
        Set objCol = ltvListView.ColumnHeaders.Item(1)
        Set objItem = ltvListView.SelectedItem
        Exit For
    ElseIf x < ltvListView.ColumnHeaders.Item(i).Left Then
        Set objCol = ltvListView.ColumnHeaders.Item(i - 1)
        Set objItem = ltvListView.SelectedItem.ListSubItems.Item(i - 2)
        Exit For
    ElseIf i = ltvListView.ColumnHeaders.Count Then
        Set objCol = ltvListView.ColumnHeaders(i)
        Set objItem = ltvListView.SelectedItem.ListSubItems.Item(i - 1)
        Exit For
    End If
Next i
 
txtEdit.BorderStyle = 0
txtEdit.Left = ltvListView.Left + objCol.Left - lngScroll
txtEdit.Top = ltvListView.Top + ltvListView.SelectedItem.Top
txtEdit.Width = objCol.Width
txtEdit.Height = ltvListView.SelectedItem.Height
txtEdit.BorderStyle = 1
 
txtEdit.Text = objItem.Text
txtEdit.SelStart = 0
txtEdit.SelLength = Len(txtEdit)
txtEdit.Visible = True
txtEdit.SetFocus
 
endSub:
End Sub
 
Public Sub SetText()
On Error Resume Next
objItem.Text = txtEdit.Text
txtEdit.Visible = False
End Sub
 
Private Sub Class_Terminate()
UnSubClassWnd ltvListView.hwnd
Set txtEdit = Nothing
Set ltvListView = Nothing
End Sub
 
Private Sub ltvListView_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
EditText x, y
End Sub
 
Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then SetText
End Sub
 
Private Sub txtEdit_LostFocus()
SetText
End Sub

The SubClassing Module:

Option Explicit
 
'===============================================================
'ListView LabelEdit
'© 2004 by Michiel Meulendijk
'
'This module handles the subclassing and belongs to the
'LabelEdit class module.
'===============================================================
 
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)
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 Const GWL_WNDPROC = (-4)
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
 
Dim WndProcOld As Long
Dim colWnd As Collection
Dim colClass As Collection
 
'SubClass Code
Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, _
       ByVal wParam As Long, ByVal lParam As Long) As Long
If wMsg = WM_VSCROLL Or wMsg = WM_HSCROLL Then colClass.Item("H" & hwnd).SetText
WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&)
End Function
 
Public Sub InitSubClass()
Set colClass = New Collection
End Sub
 
Public Sub CloseSubClass()
Set colClass = Nothing
End Sub
 
Public Sub SubClassWnd(hwnd As Long, Class As Object)
colClass.Add Class, "H" & hwnd
WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub
 
Public Sub UnSubClassWnd(hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
WndProcOld& = 0
End Sub

[Danial]

Brilliant code

Just one problem, if your listview has horizontal scroll bar then it gets all wired, if you could fix that, it would be perfect.

Thanks.

[$hep]

This is what I've been trying to do...
The code above posted by vader works nicely when theres 4 or more columns.
I was trying to figure out why when theres only 2 columns its only editing column 1. Even if I use the demo, set the LV for only 2 columns and click column2 samething.
I'm stumped... I tried changing somethings around, can't figure it out.
Anyone got any idea's ?

Any help/input much appreciated..
$hep

[TheVader]

I've tried editing with two columns and it works fine for me... With only one column it gives an error, though.

This code could surely use an update. A bit more reliability wouldn't hurt, and the horizontal scrollbar problem pointed out by Danial should be fixed too.

Anyway, I attached an example with two columns, which works fine for me. Does that work?

[TheVader]

I've completely revised the code today; the scrollbar bug has been fixed and the code is now much easier to implement. Check out the first post in the thread.

[$hep]

I started to think I had messed it up when I seen your reply post, cause you said it worked fine for you.. I've posted a picture just so you don't think I'm crazy.
Basically all I did to your demo just to check, was delete 2 columns..
But this pic is from the demo you said works for you. Samething.(Looks like your editing in col 2 but edits col 1)
But the revised code(class) seems to correct it. Being as you've made it into a class its much better and it works very nicely.. Thanks for your help and sharing...

Oh also why the subclassing ?
When I commented out the Call SubClassWnd(ltv.hwnd) to step through, it seemed to funtion the same.
To control painting?

Thanks again,
$hep

[TheVader]

You're welcome.

Oh also why the subclassing ?
When I commented out the Call SubClassWnd(ltv.hwnd) to step through, it seemed to funtion the same.
To control painting?

To capture the Scroll messages. If you're editing an item and scroll the listview, the textbox doesn't lose focus, and so it stays visible.

[$hep]

Oh... That makes since...

This helps me alot.
Thanks
$hep

[$hep]

Hi again,
Another question.. How would I go about capturing the tab key when in edit .
Like say you were editing in column 1 and you hit [tab].
I've tried different events of the txtEdit and the Listview.

KeyUp - Doesn't catch tab.
KeyDown - In a normal txtbox if I set tabstop=False this catches [tab] can't get it to work in the class.
KeyPress - Doesn't catch tab.
LostFocus - Reacts to tab but can't get keycode.

I'm tring to add like a tab order to the columns.
If your editing in col 1 hit tab and begin editing in col 2.

Thanks for any help\input
$hep

[RESOLVED]-The only way I could resolve this was to set every control's tabstop=false. But it works, its just dirty.

[dee-u]

I've got this problem, (attached is the screenshot), why is it not fitted exactly? Here is the minor modifications I did so the editing will be triggered after double-click...

Dim xPos As Single, yPos As Single
 
Private Sub ltvListView_DblClick()
    EditText xPos, yPos
End Sub
 
Private Sub ltvListView_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    xPos = x
    yPos = y
End Sub

[manavo11]

I've got this problem, (attached is the screenshot), why is it not fitted exactly? Here is the minor modifications I did so the editing will be triggered after double-click...

Dim xPos As Single, yPos As Single
 
Private Sub ltvListView_DblClick()
    EditText xPos, yPos
End Sub
 
Private Sub ltvListView_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    xPos = x
    yPos = y
End Sub

You need to make the style of the listview the same as the original, Appearence and BorderStyle set to 0. Or calculate those and reposition the textbox by adding those to your calculations.

[dee-u]

I've given up on this, the subclassing is crashing my IDE and I have found a similar technique but without resorting to subclassing...

[VB Client/Server]

hello,

If I edit 1st column, how can I directly change subitem colum 3 and 4 from database ( for example )

If I add number 50 to frist coulumn I want to change subitem 3 and 4 in that column with data from mysql database.

I just need some example how can be subitem changed when 1st column is edited.