Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0296: Erstellung einer Intellisense-Box

 von 

Beschreibung 

Die berüchtigte IntelliSenseBox aus der VB-IDE im Eigenbau: Wird ein neues Wort in einem TextFeld begonnen, öffnet sich an der jeweiligen Cursor-Position eine ListBox, die dann im Zuge des Weiterschreibens mögliche Wortvorschläge unterbreitet. Diese können wie gewohnt durch Betätigen der Leertaste bzw. durch einen Doppelklick übernommen werden.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

DrawTextA (DrawText), GetCaretPos, SendMessageA (SendMessage)

Download:

Download des Beispielprojektes [12,26 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Textfeld "Text1"

Option Explicit

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&

Private Sub Form_Load()
  Dim aa$, FN%
    
    FN = FreeFile
    Open App.Path & "\AData.txt" For Input As #FN
      Do While Not EOF(FN)
        Input #FN, aa
        List1.AddItem aa
      Loop
    Close FN
    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

Private Sub List1_DblClick()
  Call Text1_KeyPress(32)
End Sub

Private Sub List1_GotFocus()
  Text1.SetFocus
End Sub

Private Sub Text1_Change()
  Dim p As POINTAPI
  Dim hDcT&, R As RECT
  Dim x&, y&, Word$, x1&, x2&, aa$, Lx&, Ly&
  
    hDcT = Text1.Parent.hdc
    Call DrawText(hDcT, CStr("x"), -1, R, DT_CALCRECT)
    Call GetCaretPos(p)
    
    Lx = Text1.Left + (p.x + SP) * Screen.TwipsPerPixelX
    
    If Check1.Value = vbUnchecked Then
      If Lx + List1.Width > Text1.Width Then
        Lx = Text1.Width - List1.Width
      End If
    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
    
    List1.Left = Lx
    List1.Top = Ly
    
    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
    
    x = SendMessage(List1.hwnd, LB_FINDSTRING, -1, Word)
    If x <> -1 Then List1.TopIndex = x
    List1.ListIndex = x
End Sub

Private Sub Text1_Click()
  List1.Visible = False
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim x&

    If List1.Visible And (KeyCode = vbKeyDown Or _
                          KeyCode = vbKeyUp) Then
      x = List1.ListIndex

      If x = -1 Then
        List1.ListIndex = List1.TopIndex
      Else
        If KeyCode = vbKeyDown Then
          If x + 1 < List1.ListCount Then
            List1.ListIndex = x + 1
          End If
        ElseIf KeyCode = vbKeyUp Then
          If x - 1 > -1 Then List1.ListIndex = x - 1
        End If
      End If
      KeyCode = 0
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Dim x&, x1&, x2&, aa$, Word$
  
  If List1.Visible Then
    If KeyAscii = 32 Then
       x = List1.ListIndex
       If x <> -1 Then
          Word = FindWordPos(Text1, x1, x2)
          aa = Left$(Text1.Text, x1 - 1) & List1.List(x) & _
               Chr$(KeyAscii) & Mid$(Text1.Text, x2 + 1)
          KeyAscii = 0
          Text1.Text = aa
          Text1.SelStart = x1 + Len(List1.List(x))
          List1.Visible = False
       End If
    End If
  End If
End Sub

Private Function FindWordPos(TXT As Control, x1&, x2&) As String
  Dim x&, y&, aa$
  Dim Break$
  
    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
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von FanatiX am 07.03.2003 um 19:15

P.S:damit das ganze mit allen wörtern funzt muss man jediglich die abfrage entfernen die nach dem buchstaben 'a' sucht...die liste der wörter muss jetzt nurnoch ergänzt werden...

Kommentar von FanatiX am 23.02.2003 um 10:17

hihi...echt genial....passt zu meinem jetzigen project: mirc scripting editor...ne IDE für Mirc Scripting :o)

Kommentar von hellcoder am 27.07.2001 um 16:30

eine Frage noch: bei mir is des so das er das ganze nur bei dem buchstaben "a" macht, ich will aber das er das bei allen, macht,was muss ich ändern?

Kommentar von hellcoder am 27.07.2001 um 16:10

jaaaaaaa!!!! ich such sowas seit 3 Wochen! DANKE!!

Kommentar von deepblue am 13.04.2001 um 20:36

Das ist genial!!!!
einfach genial!

Kommentar von Götz Reinecke am 06.01.2001 um 02:35

Danke für den Hinweis, ich habe es bereits geändert

Kommentar von Josef Lindinger am 26.12.2000 um 00:40

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim x&
If List1.Visible And KeyCode = 32 Then
If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Then
x = List1.ListIndex
---
Die Keycodeabfrage kann so nie ausgeführt werden...