VB 5/6-Tipp 0296: Erstellung einer Intellisense-Box
von ActiveVB
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: | Verwendete API-Aufrufe: DrawTextA (DrawText), GetCaretPos, SendMessageA (SendMessage) | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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...