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