vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 17 bzw. 24 Entwickler-Vollversionen zum unschlagbaren Preis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Controls · TextBox & RichTextBox   |   VB-Versionen: VB4, VB5, VB627.05.02
AutoComplete in der TextBox

Ein Tipp, wie sich eine Auto-Vervollständigungs-Funktion für einelne Wörter innerhalb einer TextBox realisieren lässt.

Autor:   Ralf KronenBewertung:     [ Jetzt bewerten ]Views:  21.961 
www.kerstel-solutions.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Jeder kennt es vom Handy oder aus der VB-IDE, man gibt einen buchstaben ein und schon erscheint eine ganze Latte von Wörtern die mit dem jeweiligen Buchstaben anfangen, in VB sind es natürlich nicht nur Wörter . In diesem Tipp wird gezeigt wie man soetwas unter VB realisiert.

Alles was dazu braucht, ist eine Textbox, sowie eine Listbox, die man auf der Form plaziert. Sobald in der Textbox ein a eingegeben wird, erscheint eine Liste mit Wörtern die mit a beginnen. Dies kann natürlich mit jedem Buchstaben, oder auf eine rtf-box erweitert werden.

Here's the code:

' benötigte API-Deklarationen
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As String) As Long
 
Private Declare Function GetCaretPos Lib "user32" ( _
  lpPoint As POINTAPI) As Long
 
Private Declare Function DrawText Lib "user32" _
  Alias "DrawTextA" ( _
  ByVal hdc As Long, _
  ByVal lpStr As String, _
  ByVal nCount As Long, _
  lpRect As RECT, _
  ByVal wFormat As Long) As Long
 
Private Type POINTAPI
  x As Long
  y As Long
End Type
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Const DT_CALCRECT = &H400
Const LB_FINDSTRING = &H18F
Const SP = 3&
' ListBox füllen
Private Sub Form_Load()
  Dim aa As String
 
  List1.AddItem "Aaron"
  List1.AddItem "Abend"
  List1.AddItem "Abendhimmel"
  List1.AddItem "Abacus"
  List1.AddItem "Auto"
  List1.AddItem "jürgen"
 
  Text1.Text = "Geben Sie in diese TextBox Wörter ein, " & _
    "die mit dem Buchstaben A beginnen"
  Text1.SelStart = 0
  Text1.SelLength = Len(Text1.Text)
End Sub
' Doppelklick auf Auto-Liste
Private Sub List1_DblClick()
  Text1_KeyPress 32
End Sub
 
 
' Wenn Auto-Liste Fokus erhält, sofort Fokus
' wieder in die TextBox setzen
Private Sub List1_GotFocus()
  Text1.SetFocus
End Sub
' Auto-Liste anzeigen
Private Sub Text1_Change()
  Dim p As POINTAPI
  Dim hDcT As Long
  Dim R As RECT
  Dim x As Long
  Dim y As Long
  Dim Word As String
  Dim x1 As Long
  Dim x2 As Long
  Dim aa As String
  Dim Lx As Long
  Dim Ly As Long
 
  hDcT = Text1.Parent.hdc
  Call DrawText(hDcT, CStr("x"), -1, R, DT_CALCRECT)
  Call GetCaretPos(p)
 
  ' ListBox-Position bestimmen
  Lx = Text1.Left + (p.x + SP) * Screen.TwipsPerPixelX
  If Lx + List1.Width > Text1.Width Then
    Lx = Text1.Width - List1.Width
  End If
 
  Ly = Text1.Top + (p.y + R.Bottom + SP) * Screen.TwipsPerPixelY
  If Ly + List1.Height > Text1.Height Then
    Ly = Text1.Top + p.y * Screen.TwipsPerPixelY - List1.Height
  End If
 
  ' ListBox positionieren
  List1.Left = Lx
  List1.Top = Ly
 
  ' aktuelles Wort ermitteln
  Word = FindWordPos(Text1, x1, x2)
  If Word <> "" Then
    If LCase(Left$(Word, 1)) = "a" Then
      List1.Visible = True
    Else
      List1.Visible = False
    End If
  Else
    List1.Visible = False
  End If
 
  ' Eintrag in der ListBox markieren (falls gefunden)
  x = SendMessage(List1.hwnd, LB_FINDSTRING, -1, Word)
  If x <> -1 Then List1.TopIndex = x
  List1.ListIndex = x
End Sub
 
 
' Auto-Liste ausblenden
Private Sub Text1_Click()
  List1.Visible = False
End Sub
 
 
Private Sub Text1_KeyDown(KeyCode As Integer, _
  Shift As Integer)
 
  Dim x As Long
 
  ' Falls Auto-Liste angezeigt wird, soll mit den
  ' Pfeil Hoch/Runter-Tasten innerhalb der ListBox
  ' gescrollt werden
  With List1
    If (.Visible) And _
      (KeyCode = vbKeyDown Or KeyCode = vbKeyUp) Then
 
      x = .ListIndex
 
      If x = -1 Then
        .ListIndex = .TopIndex
      Else
        If KeyCode = vbKeyDown Then
          If x + 1 < .ListCount Then .ListIndex = x + 1
        ElseIf KeyCode = vbKeyUp Then
          If x - 1 > -1 Then .ListIndex = x - 1
        End If
        KeyCode = 0
      End If
    End If
  End With
End Sub
 
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
  ' Prüfen, ob aktuelles Wort in Auto-Liste vorhanden
  Dim x As Long
  Dim x1 As Long
  Dim x2 As Long
  Dim aa As String
  Dim Word As String
 
  With List1
    If .Visible Then
      If KeyAscii = 32 Then
        x = .ListIndex
        If x <> -1 Then
          Word = FindWordPos(Text1, x1, x2)
          aa = Left$(Text1.Text, x1 - 1) & .List(x) & _
            Chr$(KeyAscii) & Mid$(Text1.Text, x2 + 1)
          KeyAscii = 0
          Text1.Text = aa
          Text1.SelStart = x1 + Len(.List(x))
          .Visible = False
        End If
      End If
    End If
  End With
End Sub
' aktuelles Wort ermitteln
Private Function FindWordPos(TXT As Control, _
  x1 As Long, x2 As Long) As String
 
  Dim x As Long
  Dim y As Long
  Dim aa As String
  Dim Break As String
 
  Break = vbCr & vbLf & vbTab & Chr$(32) & Chr$(160)
 
  x = Text1.SelStart + 1
  x1 = 1
  For y = x - 1 To 1 Step -1
    aa = Mid$(Text1.Text, y, 1)
    If InStr(1, Break, aa) <> 0 Then
      x1 = y + 1
      Exit For
    End If
  Next y
 
  x2 = Len(Text1.Text)
  For y = x To x2
    aa = Mid$(Text1.Text, y, 1)
    If InStr(1, Break, aa) <> 0 Then
      x2 = y - 1
      Exit For
    End If
  Next y
 
  If x2 - x1 >= 0 Then
    FindWordPos = Mid$(Text1.Text, x1, x2 - x1 + 1)
  End If
End Function

Dieser Tipp wurde bereits 21.961 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel