| '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 |
Make Editable List Box |
Express News India | Freelance ecommerce web development India