vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Controls · TextBox & RichTextBox   |   VB-Versionen: VB5, VB608.02.05
Suchtexte im RTF hervorheben

Durchsuchen einer RTF-Box nach Wörtern oder -fragmenten und diese hervorheben

Autor:   Thomas GollmerBewertung:     [ Jetzt bewerten ]Views:  14.065 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Suchfunktionen nach dem Schema: "Erste Fundstelle markieren, MSGBox "Suche nächsten" anzeigen, zweite Fundstelle markieren ..." sind für den Anwender u.U. etwas zeitraubend und nervig. Warum also die gefundenen Wörter nicht alle markieren?

Einfach diesen Code ins Projekt übernehmen und das "Texthighlighting" kann beginnen.

Option Explicit
 
' benötigte API-Deklarationen
Private Declare Function LockWindowUpdate Lib "user32.dll" ( _
  ByVal hWnd As Long) As Long
Private Function HighlightText( _
  rtfBox As RichTextBox, _
  Search As String, _
  WholeWord As Boolean, _
  MatchCase As Boolean, _
  Color As Long, _
  Bold As Boolean, _
  GoStart As Boolean) As Long
 
  ' Übergabeparameter
  ' 1. Richtextbox die durchsucht werden soll
  ' 2. Suchtext
  ' 3. True wenn nur ganze Wortübereinstimmungen gesucht werden sollen
  '    False bei Wortfragmenten
  ' 4. True wenn auf Groß- Kleinschreibung geachtet werden soll
  '    False wenn nicht
  ' 5. Farbe mit der die Fundstellen markiert werden sollen
  '    Bei negativem Wert werden die Fundstellen nicht farblich gekennzeichnet
  ' 6. True wenn die Fundstellen Fett markiert werden sollen
  ' 7. True wenn die Einfügemarke nach der Bearbeitung auf die Strartposition
  '    gesetzt werden soll. Mit False wird sie an's Textende gesetzt
  ' 
  ' Die Funktion gibt die Anzahl der Fundstellen zurück
 
  Dim Start As Long
  Dim Ops As Long
  Dim Op1 As Long
  Dim Op2 As Long
  Dim APIRet As Long
  Dim Counter As Long
 
  ' Suchkriterien festlegen
  If WholeWord = True Then Op1 = 2 Else Op1 = 0
  If MatchCase = True Then Op2 = 4 Else Op2 = 0
  Ops = Op1 Or Op2
 
  With rtfBox
    ' Aktualisierung des Textfeldes sperren
    APIRet = LockWindowUpdate(.hWnd)
 
    ' Einfügemarke auf Textstart setzten
    .SelStart = 0
 
    ' Fundstellen hervorheben
    Do
      If .Find(Search, Start, , Ops) = -1 Then Exit Do
      .SelBold = Bold
      If Color >= 0 Then .SelColor = Color
      Start = .SelStart + .SelLength
      Counter = Counter + 1
    Loop
 
    ' Einfügemarke auf Position setzen
    If GoStart = True Then
      .SelStart = 0
    Else
      .SelStart = Len(.Text)
    End If
  End With
 
  ' TextBox Freigeben & Anzahl Fundstellen zurückgeben
  APIRet = LockWindowUpdate(0&)
 
  HighlightText = Counter
End Function

Ein kleines Beispiel:
Fügen Sie einem neuen Projekt eine Richtextbox und einen Commandbutton hinzu und fügen folgenden Code ein.

Private Sub Form_Load()
  ' Richtextbox füllen
    RichTextBox1.Text = "Sie können mehrere Optionen mit Hilfe des " & _
    "Or-Operators kombinieren. Wenn der gesuchte Text gefunden worden " & _
    "ist, dann hebt die Find-Methode den betreffenden Text hervor und " & _
    "gibt den Index des ersten hervorgehobenen Zeichens zurück. " & _
    "Wurde der angegebene Text nicht gefunden, dann gibt die " & _
    "Find-Methode den Wert -1 zurück. Wenn Sie die Find-Methode ohne " & _
    "die Option rtfNoHighlight verwenden, während die " & _
    "HideSelection-Eigenschaft auf True gesetzt ist und das " & _
    "RTF-Steuerelement den Fokus besitzt, dann hebt das Steuerelement " & _
    "den gefundenen Text weiterhin hervor. Das Suchverhalten der " & _
    "Find-Methode ändert sich je nach Kombination der Werte, die für " & _
    "die Argumente Beginn und Ende angegeben sind. Die folgende Tabelle " & _
    "beschreibt das mögliche Suchverhalten."
End Sub
Private Sub Command1_Click()
  ' Alle "d" und "D" in allen Wörtern rot färben
  HighlightText RichTextBox1, "d", False, False, vbRed, False, True
 
  ' Alle "der" und "Der" blau markieren & fett darstellen
  HighlightText RichTextBox1, "der", True, False, vbBlue, True, True
 
  ' Alle "Sie" fett darstellen
  HighlightText RichTextBox1, "Sie", True, True, -1, True, True
End Sub