Make Editable List Box

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button, 1 List Box and 1 Text Box to your form.
'Insert the following code to your module:

Option Explicit
DefLng A-Z

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type SIZE
cx As Long
cy As Long
End Type

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal _
cbString As Long, lpSize As SIZE) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal _
hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As _
Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long

Public Const WM_SETREDRAW = &HB&
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31
Public Const LB_GETITEMRECT = &H198
Public Const LB_ERR = (-1)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SM_CXEDGE = 45
Public Const SM_CYEDGE = 46
Public Function Max(ByVal param1 As Long, ByVal param2 As Long) As Long
If param1 > param2 Then Max = param1 Else Max = param2
End Function

'Insert the following code to your form:
Option Explicit
DefLng A-Z
Private m_bEditing As Boolean
Private m_lngCurrIndex As Long

Private Sub Command1_Click()
If Not m_bEditing Then Editing = True
End Sub

Private Sub Form_Load()
Me.ScaleMode = 3
Text1.Visible = False
Text1.Appearance = 0
Command1.Caption = "Press F2 to edit"
Dim a%
For a% = 1 To 10
List1.AddItem "Item number " & a%
Next a%
Set Text1.Font = List1.Font
End Sub

Private Sub List1_KeyUp(KeyCode As Integer, Shift As Integer)
If ((KeyCode = vbKeyF2) And (Shift = 0)) Then
If (Not m_bEditing) Then Editing = True
End If
End Sub

Private Sub Text1_LostFocus()
'If the textbox looses focus and we're editing, restore the text
'and cancel the edit
If m_bEditing = True Then
List1.List(m_lngCurrIndex) = Text1.Tag
Editing = False
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim strText As String
If KeyAscii = 10 Or KeyAscii = 13 Then
If Len(Trim$(Text1.Text)) = 0 Then
List1.List(m_lngCurrIndex) = Text1.Tag
Else
strText = Text1.Text
'assign the new text to the item
List1.List(m_lngCurrIndex) = strText
End If
Editing = False 'return to the old state
KeyAscii = 0 'avoid a beep

ElseIf KeyAscii = 27 Then 'pressed Esc to cancel the edit
List1.List(m_lngCurrIndex) = Text1.Tag 'restore the original text
Editing = False
KeyAscii = 0 'avoid a beep
End If
End Sub

Private Sub Text1_GotFocus()
'select all the text
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_Change()
Dim lpSize As SIZE
Dim phDC As Long
'adjust the size of the textbox depending on the calculated
'size of the text it contains (or 50 pixels, whatever is greater)
'note that the extent calculation fails (for some reason) when the
'font is over 14 points, but if you have a listbox with a 14 point
'font then you need some redesign there
phDC = GetDC(Text1.hwnd)
If GetTextExtentPoint32(phDC, Text1.Text, Len(Text1.Text), lpSize) = 1 Then
Text1.Width = Max(50, lpSize.cx)
End If
Call ReleaseDC(Text1.hwnd, phDC)
End Sub

Private Property Let Editing(vData As Boolean)
Dim rcItem As RECT 'RECT of the item being edited
Dim strText As String 'text of the item beign edited
Dim lpSize As SIZE 'uset to calculate the size of the textbox
Dim phDC As Long 'hDC of the listbox
On Error Resume Next
'Get the current index...
m_lngCurrIndex = List1.ListIndex
'...and split if there's no index
If m_lngCurrIndex = -1 Then Beep: Exit Property
'are we starting an edit?
If vData = True Then
strText = List1.List(m_lngCurrIndex)
If Len(strText) = 0 Then Beep: Exit Property
'try to get the RECT of the item within the list
If SendMessage(List1.hwnd, LB_GETITEMRECT, ByVal m_lngCurrIndex, rcItem) _
<> LB_ERR Then
'adjust the RECT to makeup. Note that these are client window coordinates
'That is, the RECT is in relation to the list's parent window.
'We also take into consideration the 3-D border, so remove the call to
'GetSystemMetrics() if the listbox's appearance is "flat"
With rcItem
.Left = .Left + List1.Left + GetSystemMetrics(SM_CXEDGE)
.Top = List1.Top + .Top
'why not a call to GetSysMetrics and the SM_CYEDGE?
'because we want the textbox to pop up centered over
'the list item, not flush with the top.

'Get the DC of the listbox and calculate the height and width of the
'Note that the extent calculation fails (for some reason) when the
'font is over 14 points.
phDC = GetDC(Text1.hwnd)
Call GetTextExtentPoint32(phDC, strText, Len(strText), lpSize)
Call ReleaseDC(Text1.hwnd, phDC)
'position and show the textbox, bring it to the top of the Z order.
Call SetWindowPos(Text1.hwnd, HWND_TOP, .Left, .Top, Max(50, lpSize.cx), _
lpSize.cy + 2, SWP_SHOWWINDOW Or SWP_NOREDRAW)
End With
'setting the List property of the listbox causes too
'much flashing, so turn off redrawing
Call SendMessage(List1.hwnd, WM_SETREDRAW, 0, ByVal 0&)
List1.List(m_lngCurrIndex) = ""
'save the item's text and set the focus to the textbox
With Text1
.Enabled = True
.Tag = strText
.Text = strText
.SetFocus
End With
End If
Else
'set the redraw flag so that the listbox updates itself
Call SendMessage(List1.hwnd, WM_SETREDRAW, 1, ByVal 0&)
'Get rid of the textbox and clear it
With Text1
.Enabled = False
.Visible = False
.Move 800, 800
.Text = ""
.Tag = ""
End With
m_lngCurrIndex = -1 'invalidate this for next time
End If
'save the current state
m_bEditing = vData
End Property