AUTO COMPLETAR USANDO TEXTBOX C/ LISTBOX
usei o exemplo abaixo e funcionou bem só que qdo vou digitando um item no textbox, o programa autocompleta no proprio textbox e seleciona a mesma no listbox. só que qdo o ultimo caracter digitado não é encontrado o textbox é limpo automaticamente e queria saber como faz para que ele não fosse limpo e deixando o ultimo item encontrado no listbox selecionado?
tipo, o meu listbox tem muitos nomes de jogos e conforme digito o nome aparece como descrevi acima, mas se colocar um caracter e o nome digitado não é encontrado no listbox, o textbox se autolimpa e gostaria de evitar essa ação dele.
usei este exemplo no evento CHANGE do textbox, busquei muito aki no site mas nada resolveu minha questão:
Dim POS As Long
ListJogos.ListIndex = SendMessage(ListJogos.hwnd, LB_FINDSTRING, -1, ByVal CStr(TextConsulta.Text))
If ListJogos.ListIndex = -1 Then
POS = TextConsulta.SelStart
TextConsulta.Text = ListJogos
Else
POS = txtJogos.SelStart
TextConsulta.Text = ListJogos
TextConsulta.SelStart = POS
TextConsulta.SelLength = Len(TextConsulta.Text) - POS
End If
tipo, o meu listbox tem muitos nomes de jogos e conforme digito o nome aparece como descrevi acima, mas se colocar um caracter e o nome digitado não é encontrado no listbox, o textbox se autolimpa e gostaria de evitar essa ação dele.
usei este exemplo no evento CHANGE do textbox, busquei muito aki no site mas nada resolveu minha questão:
Dim POS As Long
ListJogos.ListIndex = SendMessage(ListJogos.hwnd, LB_FINDSTRING, -1, ByVal CStr(TextConsulta.Text))
If ListJogos.ListIndex = -1 Then
POS = TextConsulta.SelStart
TextConsulta.Text = ListJogos
Else
POS = txtJogos.SelStart
TextConsulta.Text = ListJogos
TextConsulta.SelStart = POS
TextConsulta.SelLength = Len(TextConsulta.Text) - POS
End If
eu faço assim na txt de consulta eu ponho isso
Private Sub txtprod_Change()
Dim pos As Long
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal CStr(txtprod.Text))
If List1.ListIndex = -1 Then
pos = txtprod.SelStart
Else
pos = txtprod.SelStart
txtprod.Text = List1
txtprod.SelStart = pos
txtprod.SelLength = Len(txtprod.Text) - pos
End If
End Sub
Private Sub txtprod_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 8 Then 'Backspace
If txtprod.SelLength <> 0 Then
txtprod.Text = Mid$(txtprod, 1, _
txtprod.SelStart - 1)
KeyCode = 0
End If
ElseIf KeyCode = 46 Then 'Del
If txtprod.SelLength <> 0 And txtprod.SelStart <> 0 Then
txtprod.Text = ""
KeyCode = 0
End If
End If
End Sub
dentro do list isso
Private Sub List1_Click()
If List1.ListIndex = -1 Then Exit Sub
Set rst = bdaccess.Execute("Select * from Tbl_Pedidos where Ped_Cod=" & List1.ItemData(List1.ListIndex))
If Not rst.EOF Then
txtcod = rst("Ped_Cod")
txtprod = rst("Ped-Produto")
txtquant = rst("Ped_Quantidade")
End If
End Sub
no load acerscento isso
Dim rst As New ADODB.Recordset
Dim sql As String
Set rst.ActiveConnection = bdaccess
sql = "SELECT * FROM Tbl_Pedidos ORDER BY Ped_Cod"
rst.Open sql, bdaccess, adOpenDynamic, adLockReadOnly
rst.MoveFirst
While Not rst.EOF
List1.AddItem rst![Ped-Produto]
List1.ItemData(List1.NewIndex) = rst![Ped_Cod]
rst.MoveNext
Wend
Private Sub txtprod_Change()
Dim pos As Long
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal CStr(txtprod.Text))
If List1.ListIndex = -1 Then
pos = txtprod.SelStart
Else
pos = txtprod.SelStart
txtprod.Text = List1
txtprod.SelStart = pos
txtprod.SelLength = Len(txtprod.Text) - pos
End If
End Sub
Private Sub txtprod_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 8 Then 'Backspace
If txtprod.SelLength <> 0 Then
txtprod.Text = Mid$(txtprod, 1, _
txtprod.SelStart - 1)
KeyCode = 0
End If
ElseIf KeyCode = 46 Then 'Del
If txtprod.SelLength <> 0 And txtprod.SelStart <> 0 Then
txtprod.Text = ""
KeyCode = 0
End If
End If
End Sub
dentro do list isso
Private Sub List1_Click()
If List1.ListIndex = -1 Then Exit Sub
Set rst = bdaccess.Execute("Select * from Tbl_Pedidos where Ped_Cod=" & List1.ItemData(List1.ListIndex))
If Not rst.EOF Then
txtcod = rst("Ped_Cod")
txtprod = rst("Ped-Produto")
txtquant = rst("Ped_Quantidade")
End If
End Sub
no load acerscento isso
Dim rst As New ADODB.Recordset
Dim sql As String
Set rst.ActiveConnection = bdaccess
sql = "SELECT * FROM Tbl_Pedidos ORDER BY Ped_Cod"
rst.Open sql, bdaccess, adOpenDynamic, adLockReadOnly
rst.MoveFirst
While Not rst.EOF
List1.AddItem rst![Ped-Produto]
List1.ItemData(List1.NewIndex) = rst![Ped_Cod]
rst.MoveNext
Wend
este exemplo q vc passou é usando um banco de dados mas no meu caso envolve um LIstBox com TextBox, sendo o listbox com uma lista de jogos e o textbox o da pesquisa e conforme é digitado ele seleciona e mostra o resultado numa Richtextbox (que não vem ao caso pois funciona bem) mas qdo algum caracter não é encontrado ele limpa o textbox como se nada tivesse ter sido digitado e queria evitar isso, para q mesmo o item não fosse encontrado ele deixasse digitar e q no listbox ficasse o ultimo item encontrado selecionado
Já Pensou em usar um Combobox para fazer isto tudo?
Coloque uma combo no projeto e nas propriedades da combo, em Style escolha 1 - Simple Combo. Depois aumente o tamanho dela, vai parecer ser um Textbox com outro embaixo. Este debaixo é o List da Combo. Depois coloque uma API de Autocomplemento (já até postei no site, mas segue abaixo para ajudar)
Num Modulo:
Option Explicit
Global Combo As String
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nsize As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const CB_ERR = -1
Public Const CB_FINDSTRING = &H14C
Sub AutoProcura(cbo As ComboBox, KeyAscii As Integer)
Dim sBuffer As String
Dim lRetVal As Long
sBuffer = Left(cbo.Text, cbo.SelStart) & Chr(KeyAscii)
lRetVal = SendMessage((cbo.hwnd), CB_FINDSTRING, -1, ByVal sBuffer)
If lRetVal <> CB_ERR Then
cbo.ListIndex = lRetVal
cbo.Text = cbo.List(lRetVal)
cbo.SelStart = Len(sBuffer)
cbo.SelLength = Len(cbo.Text)
KeyAscii = 0
End If
End Sub
Para Chamarn no evendo Keypress da Combo coloque
Autoprocura nomedacombo, keyascii
Funciona que é uma beleza.
Coloque uma combo no projeto e nas propriedades da combo, em Style escolha 1 - Simple Combo. Depois aumente o tamanho dela, vai parecer ser um Textbox com outro embaixo. Este debaixo é o List da Combo. Depois coloque uma API de Autocomplemento (já até postei no site, mas segue abaixo para ajudar)
Num Modulo:
Option Explicit
Global Combo As String
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nsize As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const CB_ERR = -1
Public Const CB_FINDSTRING = &H14C
Sub AutoProcura(cbo As ComboBox, KeyAscii As Integer)
Dim sBuffer As String
Dim lRetVal As Long
sBuffer = Left(cbo.Text, cbo.SelStart) & Chr(KeyAscii)
lRetVal = SendMessage((cbo.hwnd), CB_FINDSTRING, -1, ByVal sBuffer)
If lRetVal <> CB_ERR Then
cbo.ListIndex = lRetVal
cbo.Text = cbo.List(lRetVal)
cbo.SelStart = Len(sBuffer)
cbo.SelLength = Len(cbo.Text)
KeyAscii = 0
End If
End Sub
Para Chamarn no evendo Keypress da Combo coloque
Autoprocura nomedacombo, keyascii
Funciona que é uma beleza.
deu certo
era isso mesmo que eu queria
valeu pela ajuda FGSANTOS
era isso mesmo que eu queria
valeu pela ajuda FGSANTOS
Tópico encerrado , respostas não são mais permitidas