CodeItBetter Programming Another VB Programming Blog

'Controls - How to make editable List Box

Option Explicit
 
'Add a Command Button, a List Box and a Text Box to your form.

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
 
'Add 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
    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
    m_lngCurrIndex = List1.ListIndex
    If m_lngCurrIndex = -1 Then Beep: Exit Property
    If vData = True Then
        strText = List1.List(m_lngCurrIndex)
        If Len(strText) = 0 Then Beep: Exit Property
        If SendMessage(List1.hwnd, LB_GETITEMRECT, ByVal m_lngCurrIndex, rcItem) <> LB_ERR Then
            With rcItem
                .Left = .Left + List1.Left + GetSystemMetrics(SM_CXEDGE)
                .Top = List1.Top + .Top
                phDC = GetDC(Text1.hwnd)
                Call GetTextExtentPoint32(phDC, strText, Len(strText), lpSize)
                Call ReleaseDC(Text1.hwnd, phDC)
                Call SetWindowPos(Text1.hwnd, HWND_TOP, .Left, .Top, Max(50, lpSize.cx), lpSize.cy + 2, SWP_SHOWWINDOW Or SWP_NOREDRAW)
            End With
            Call SendMessage(List1.hwnd, WM_SETREDRAW, 0, ByVal 0&)
            List1.List(m_lngCurrIndex) = ""
            With Text1
                .Enabled = True
                .Tag = strText
                .Text = strText
                .SetFocus
            End With
        End If
    Else
        Call SendMessage(List1.hwnd, WM_SETREDRAW, 1, ByVal 0&)
        With Text1
            .Enabled = False
            .Visible = False
            .Move 800, 800
            .Text = ""
            .Tag = ""
        End With
        m_lngCurrIndex = -1
    End If
    m_bEditing = vData
End Property