Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0594: RTF-Syntaxhighlighting

 von 

Beschreibung 

Es gibt viele Wege, Syntaxhighlighting in Richtext anzuwenden. Die wohl edelste und schnellste zugleich ist das Editieren des Richtextes selbst. Dieser Tipp zeigt, wie's geht!

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [4,01 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 -------------
' Die Komponente 'Microsoft Windows Common Controls 5.0 (SP2) (COMCTL32.OCX)' wird benötigt.
' Die Komponente 'Microsoft Rich Textbox Control 6.0 (RICHTX32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: RichTextBox "RichTextBox1"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Sub Command1_Click()
    Call Highlight.highlightRTBox(RichTextBox1, "Courier New", 10, vbBinaryCompare)
    
    'Langsamer aber Case Sensitiv
    'Call highlight.highlightRTBox(RichTextBox1, "Courier New", 10, vbTextCompare)
End Sub

Private Sub Form_Load()
    'Initialisirung der Keywörter und Farben
    Call Highlight.InitKeywords
    
    'Ein wenig Code zu testen...
    RichTextBox1.Text = _
    "'Schreiben Sie hier selbst etwas!" & vbCrLf & vbCrLf & vbCrLf & _
    "Public Sub Main()" & vbCrLf & _
    "    Dim a As Boolean" & vbCrLf & _
    "    " & vbCrLf & _
    "    a = (Len(Command$) > 0)" & vbCrLf & _
    "    " & vbCrLf & _
    "    If a Then" & vbCrLf & _
    "        MsgBox " & Chr(34) & "Command$ enthält: " & Chr(34) & " & Command$" & vbCrLf & _
    "    Else" & vbCrLf & _
    "        MsgBox " & Chr(34) & "Command$ ist leer!" & Chr(34) & vbCrLf & _
    "    End If" & vbCrLf & _
    "End Sub"
    
    'Färben
    Call Command1_Click
End Sub

'Diese Sub färbt bei jeder Änderung alles neu und soll
'zeigen, wie schnell die angewendete Methode ist.
Private Sub RichTextBox1_Change()
    Dim pos As Long
    Dim l As Long
    
    pos = RichTextBox1.SelStart
    l = RichTextBox1.SelLength
    
    Call Command1_Click
    
    RichTextBox1.SelStart = pos
    RichTextBox1.SelLength = l
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------- Anfang Modul "Highlight" alias Module1.bas --------

Option Explicit

Private Type rgbColors
    Red As Long
    Green As Long
    Blue As Long
End Type

Private Type Keywords
    ColorId As Long
    Keyword As String
End Type

Private KeyWordlist() As Keywords
Private rtfColorTable() As rgbColors
Private myRtfColorTable As String


Public Sub InitKeywords()
    Dim i As Long

    ' Farben festlegen in Rot / Grün / Vlau Anteilen (rgb)
    ' (0 ist für die Vordergrundfarbe reserviert)
    ReDim rtfColorTable(2) ' Anzahl der Farben festlegen
    
    'id: 0
    rtfColorTable(0).Red = 0
    rtfColorTable(0).Green = 0
    rtfColorTable(0).Blue = 0
    
    'id: 1 enspricht blau
    rtfColorTable(1).Red = 0
    rtfColorTable(1).Green = 0
    rtfColorTable(1).Blue = 255
    
    'id: 2 entspricht rot
    rtfColorTable(2).Red = 255
    rtfColorTable(2).Green = 0
    rtfColorTable(2).Blue = 0


    
    ' Keyworter die gehighlighted werden sollen definieren
    ReDim KeyWordlist(4) ' Anzahl der Keywörter festlegen
    KeyWordlist(1).Keyword = "If"     ' Wort zuweisen
    KeyWordlist(1).ColorId = 1        ' FarbID -> hier Blau
    KeyWordlist(2).Keyword = "Then"
    KeyWordlist(2).ColorId = 1
    KeyWordlist(3).Keyword = "Else"
    KeyWordlist(3).ColorId = 2        ' FarbID -> hier Rot
    KeyWordlist(4).Keyword = "End"
    KeyWordlist(4).ColorId = 2

    
    Call initRtfColorTable
End Sub



Private Sub initRtfColorTable()
    Dim i As Long
    myRtfColorTable = ""
    For i = 0 To UBound(rtfColorTable)
        With rtfColorTable(i)
        myRtfColorTable = myRtfColorTable & _
                            "\red" & .Red & _
                            "\green" & .Green & _
                            "\blue" & .Blue & ";"
        End With
    Next
End Sub


Public Sub highlightRTBox(ByVal RTB As RichTextBox, _
                            ByVal font As String, _
                            ByVal fontsize As Long, _
                            Optional vbCmp As VbCompareMethod = vbBinaryCompare)
    
    Dim header, colorTable, rtfStart, rtfEnd, rtCrLf As String
    Dim Text, standardFont As String
    Dim i, ii As Long
    
    'RTB.font = font
    RTB.SelFontName = font
    RTB.SelFontSize = fontsize
    fontsize = fontsize * 2
    
    header = "{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
             "{\f1\froman\fcharset2 Symbol;}{\f2\fmodern " & font & ";}}" & vbCrLf
    colorTable = "{\colortbl" & myRtfColorTable & "}" & vbCrLf
    rtfStart = "\deflang1031\pard"
    rtfEnd = "}"
    rtCrLf = "\par "
    standardFont = "\plain\f2\fs" & fontsize & " "
         
    Text = RTB.Text
    
    If Len(Text) <= 0 Then Exit Sub
    
    'Colorize
    For i = LBound(KeyWordlist) To UBound(KeyWordlist)
        With KeyWordlist(i)
            If .Keyword <> "" Then
                Text = Replace(Text, .Keyword, standardFont & "\cf" & _
                                 .ColorId & " " & .Keyword & standardFont _
                                 , , , vbCmp)
            End If
        End With
    Next
    Text = Replace(Text, vbCrLf, rtCrLf, , , vbBinaryCompare)
    
    RTB.TextRTF = header & colorTable & rtfStart & standardFont & Text & rtfEnd
End Sub
'--------- Ende Modul "Highlight" alias Module1.bas ---------
'-------------- 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 19 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 Simone am 12.11.2004 um 18:54

Hi,
was ich schon auf den 1. Blick hier nicht verstehe ist: Warum dimensionierst Du Header, colorTable, rtfStart, rtfEnd, Text und i als Variant und rtCrLf As String und standardFont As String undii As Long? Du machst den gleichen Fehler wie der Autor.

Kommentar von Randy Nürnberger am 12.11.2004 um 17:49

Ich habe eine Lösung für das Problem, dass man am Ende kein Enter einfügen kann, außerdem funktionieren jetzt auch {} und \. Mann muss die Routine highlightRTBox einfach nur so abändern:

Public Sub highlightRTBox(ByVal RTB As RichTextBox, ByVal font As String, ByVal fontsize As Long, Optional vbCmp As VbCompareMethod = vbBinaryCompare)
Dim Header, colorTable, rtfStart, rtfEnd, rtCrLf As String
Dim Text, standardFont As String
Dim I, ii As Long

'RTB.font = font
RTB.SelFontName = font
RTB.SelFontSize = fontsize
fontsize = fontsize * 2

Header = "{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
"{\f1\froman\fcharset2 Symbol;}{\f2\fmodern " & font & ";}}" & vbCrLf
colorTable = "{\colortbl" & myRtfColorTable & "}" & vbCrLf
rtfStart = "\deflang1031\pard"
rtfEnd = "\par }}"
rtCrLf = "\par "
standardFont = "\plain\f2\fs" & fontsize & " "

Text = RTB.Text

Text = Replace(Text, "\", "\\")

If Len(Text) <= 0 Then Exit Sub

'Colorize
For I = LBound(KeyWordlist) To UBound(KeyWordlist)
With KeyWordlist(I)
If .Keyword <> "" Then
Text = Replace(Text, .Keyword, standardFont & "\cf" & .ColorId & " " & .Keyword & standardFont, , , vbCmp)
End If
End With
Next

Text = Replace(Text, vbCrLf, rtCrLf, , , vbBinaryCompare)
Text = Replace(Text, "{", "\{")
Text = Replace(Text, "}", "\}")

RTB.TextRTF = Header & colorTable & rtfStart & standardFont & "{" & Text & rtfEnd
End Sub

Kommentar von Nopies am 19.07.2004 um 21:53

Ich hab gerade den Tipp probiert. Der geht wirklich nicht. Was die anderen hier schreiben, isd doch nur die Ressonanz auf diesen schlechten Tipp. Mal ehrlich! Diese Methode, die der Tipp verwendet kann nicht funktionieren. Er ist auch ein total schlechter Ansatz für die Problemlösung. Denkt mal nach!

Kommentar von Nopies am 19.07.2004 um 21:53

Ich hab gerade den Tipp probiert. Der geht wirklich nicht. Was die anderen hier schreiben, isd doch nur die Ressonanz auf diesen schlechten Tipp. Mal ehrlich! Diese Methode, die der Tipp verwendet kann nicht funktionieren. Er ist auch ein total schlechter Ansatz für die Problemlösung. Denkt mal nach!

Kommentar von Nopies am 19.07.2004 um 21:52

Ich hab gerade den Tipp probiert. Der geht wirklich nicht. Was die anderen hier schreiben, isd doch nur die Ressonanz auf diesen schlechten Tipp. Mal ehrlich! Diese Methode, die der Tipp verwendet kann nicht funktionieren. Er ist auch ein total schlechter Ansatz für die Problemlösung. Denkt mal nach!

Kommentar von Jochen Wierum am 17.07.2004 um 18:02

Hallo,

Wir haben nichts gegen konstruktive Vorschläge einzuwenden, aber es wäre schön, wenn die Autoren das nächste Mal erst die anderen Kommentare lesen würden. Pille, also der Autor selbst, schrieb, dass sich der Tipp nur zum Einfärben der Tags *nach* dem *Laden* von Code eignet. WinMax postete ein Beispiel, wie man neue Zeilen einfügen kann. Außerdem sind diese Tipps nur Code-Schnipsel und keine Programme, also Denkansätze. Diese werden vor dem Veröffentlichen auch getestet.

Wer Verbesserungen hat darf sie gerne und jederzeit an tipps@activevb.de senden oder im TnT-Forum (siehe TnT-Startseite) zur Diskussion stellen!

Gruß,
Jochen Wierum

Admin @ActiveVB

Kommentar von Ronald am 16.07.2004 um 09:37

Dieser Tipp ist es nicht Wert, hier plaziert zu sein. Dieser Tipp ist absolut!! unbrauchbar!! (Da hab ich im Upload was besseres gesehen) Dieser Tipp wurde mit sicherheit nicht getestet!

Kommentar von LotharK am 22.05.2004 um 08:15

Meiner Meinung nach ist der Tipp unbrauchbar. Wenn ich "\" eingeben will, funktioniert es nicht. Ist ja auch logisch, wenn man sich den Code anschaut. Ganz verrückt wird es bei der Eingabe von "{". ein Enter am Ende des Wortes ist mir bis jetzt auch noch nicht gelungen.

Kommentar von WinMax am 06.04.2004 um 19:22

Also nur mal so ein Tipp also das man das nur Nach dem Laden benutzen kann stimmt nicht ganz und zwar muss mann bloß eine kleine Korektur im Script vornehmen und zwar im Modul hier der code
vorher :

RTB.TextRTF = header & colorTable & rtfStart & standardFont & Text & rtfEnd

Nachher :

RTB.TextRTF = header & colorTable & rtfStart & standardFont & Text & rtCrLf & rtfEnd

MFG WinMax

Kommentar von BreakerMaker am 14.12.2003 um 23:29

Ich enttäusche dihc ja soo ungern aber... mit VB kann man einfach cnihts passables coden. Leider ist man immer auf die Runtime-DLLs angewiesen und ich finde es soooo unelegant dem user auch noch ne 6MB DLL mitzugeben, dass ich zu C++ gewecheselt hab... (kann ich nur empfehlen... is nebenbei bemerkt auch einfacher find ich;)

MfG, BreakerMaker

Kommentar von cooljam am 14.10.2003 um 16:20

@BreakerMaker:

tscha, das wäre der code. Ich meinte dass das problem auftritt wenn man den vorgegebenen Code kompiliert, kann als User der EXE am Ende eines "gehighlighteten" Textes kein weiterer Text eingegeben werden.
Das Problem hat sich allerdings mittlerweile für mich erledigt, da ich mir nach längerem Beschäftigen mit der Materie das selber irgendwie zusammenbauen konnte und derzeit einen recht passablen Editor habe.

Kommentar von BreakerMaker am 14.10.2003 um 14:57

@cooljam:

z.b.

text1.text=text1.text+vbnewline

np

Kommentar von Christian Thiele am 28.08.2003 um 00:52

Leider gibt es auch probleme bei der Eingabe von { und }... Schade ;)

Kommentar von Rainer Konz am 14.07.2003 um 15:24

Hallo,

ich benutze eine RTF Feld in einem Access Formular.

Die Daten werden in einem Memo Feld gespeichert, die Darstellung in der Formular ansicht funktionert wunderbar.

Nun möchte ich das RTF Feld in einem Bericht ausgeben.
In der Seitenansicht wird der Inhalt des RTF Feldes nicht angezeigt.

Kann man ein RTF Feld in einen Bericht einbinden ?
In der Seitenansicht des Formulars ist die RTF Box auch verschwunden.

Wäre cool, wenn Sie mir weiter helfen könnten.

Freue mich schon auf Ihre Antwort.

Gruß

Rainer Konz

Kommentar von cooljam am 03.07.2003 um 10:29

am Ende des Textes können keine neuen Zeilen eingefügt werden, irgendeine Idee, wie ich das hinbekomme?

Kommentar von rgbdh am 29.06.2003 um 17:15

Das Programm coloriert leider auch Zeichenfolgen.

Kommentar von e7 am 23.06.2003 um 20:30

Eigentlich ganz gut, allerdings sind im Code ein paar Leerzeichen zu wenig! Zwischen & und _ fehlt es

Kommentar von Pille am 13.05.2003 um 17:25

Habe noch ein paar Hinweise:

Der Code eignet sich 'nur' für das Highlighten nach dem laden einer Datei. Für das Highlighten während der Eingabe sollte man die Routine aus dem hiesigen Tutorial verwenden (http://www.activevb.de/tutorials/tut_colortext/colortext.html). Die beiden Varianten arbeiten mit ein paar Anpassungen gut miteinander zusammen.
Meine Methode arbeitet sehr statisch - es wird nicht 'geparst' - wer einen guten Parser sucht sollte sich die Klasse von 'VB Syntaxhighlighting' genauer ansehen(http://www.activevb.de/rubriken/klassen/index-klassen.html).

Kommentar von Jonathan am 10.05.2003 um 21:29

Super Tipp.
Hat allerdings 2 Fehler.
1. Man kann am Ende des Textes nicht die Enter-Taste drücken.
2. (betrifft nicht den Code) Tipp 0594: RTF Syntahxhighlighting ;-)