Tipp 0536 SyntaxHighlighting
Autor/Einsender:
Datum:
  Lothar Kriegerow
10.09.2007
Entwicklungsumgebung:   VB 6
SyntaxHighlighting ist ein Tipp, der aufzeigt, wie bestimmte Worte in einer RichTextBox farblich hervorgehoben werden können. Diesen Effekt kennt jeder aus der IDE von VB.
Dieses Beispiel wurde für die SQL-Syntax entwickelt, kann jedoch problemlos auf andere Sprach-Syntaxe wie VB/VB.Net oder PHP angepasst werden. Weiterhin ist es möglich eine Formatierung durchzuführen, so wie es der eine oder andere vom Query-Analyzer kennt.
Dadurch diese Formatierung wird das SQL-Statement übersichtlich dargestellt, und wenn sich die User an diese Formatierungen halten würden, würde es die Verständlichkeit und Übersicht so mancher Statements erheblich erhöhen.
 
Option Explicit

Dim SchriftGr As Single
Dim Wd() As String
Dim Aktiv As Boolean

Sub WorteDefinieren()
  Dim Blau As Long
  Dim Rot As Long
  Dim Rosa As Long
  Dim Grau As Long
  Dim Braun As Long

  Blau = RGB(0, 0, 255)
  Rot = RGB(255, 0, 0)
  Grau = RGB(128, 128, 128)
  Braun = RGB(128, 0, 0)
  Rosa = RGB(255, 0, 255)

  ReDim Wd(1 To 2, 1 To 71)

  Wd(1, 1) = "SELECT": Wd(2, 1) = Blau
  Wd(1, 2) = "AS": Wd(2, 2) = Blau
  Wd(1, 3) = "FROM": Wd(2, 3) = Blau
  Wd(1, 4) = "INSERT": Wd(2, 4) = Blau
  Wd(1, 5) = "INTO": Wd(2, 5) = Blau
  Wd(1, 6) = "'": Wd(2, 6) = Rot
  Wd(1, 7) = ",": Wd(2, 7) = Grau
  Wd(1, 8) = "BETWEEN": Wd(2, 8) = Grau
  Wd(1, 9) = "WHERE": Wd(2, 9) = Blau
  Wd(1, 10) = "AND": Wd(2, 10) = Grau
  '...
  '...
End Sub

Private Sub cmdFormatiere_Click()
  Call Formatieren(1)
End Sub

Sub Formatieren(Optional Herkunft As Integer)
  Static iPos As Integer
  Dim SP As Integer
  Dim KF As Integer
  Dim I As Integer
  Dim i1 As Integer
  Dim L As Integer
  Dim T As String
  Dim T2 As String
  Dim L0 As Integer
  Dim L1 As Integer
  Dim L2 As Integer

  If Aktiv = True Then Exit Sub
  Aktiv = True

  iPos = txtSQL.SelStart
  txtSQL.Enabled = False
  SP = 0
  txtSQL.SelStart = 0
  txtSQL.SelLength = 0

  For I = 1 To 3
    txtSQL.Text = Replace(txtSQL.Text, "   ", " ")
    txtSQL.Text = Replace(txtSQL.Text, "  ", " ")
  Next

  txtSQL.Text = Replace(txtSQL.Text, "--/  ", "--/")
  txtSQL.Text = Replace(txtSQL.Text, "--/ ", "--/")
  txtSQL.Text = Replace(txtSQL.Text, ",", ", ")
  txtSQL.Text = Replace(txtSQL.Text, "><", "<>")
  txtSQL.Text = Replace(txtSQL.Text, Chr$(9), " ")

  If Herkunft = 1 Then Call Wortumbruch

  Call TextEdit(txtSQL.Text)
  Call WortInHochkomma(txtSQL.Text)

  txtSQL.SelStart = 0
  txtSQL.SelLength = 0
  txtSQL.SelColor = RGB(0, 0, 0)

  If InStr(txtSQL.Text, "--/") > 0 Then
    L0 = Len(txtSQL.Text)
    L2 = 1

    Do While InStr(L2, txtSQL.Text, "--/") > 0
      L1 = InStr(L2, txtSQL.Text, "--/")
      L2 = InStr(L1, txtSQL.Text, vbCrLf)
      If L2 = 0 Then L2 = Len(txtSQL.Text)
      txtSQL.SelStart = L1 - 1
      txtSQL.SelLength = L2 - L1 + 1
      txtSQL.SelColor = RGB(0, 190, 0)
    Loop
  End If

  txtSQL.Enabled = True
  txtSQL.SelStart = iPos
  txtSQL.SetFocus
  Aktiv = False
End Sub

Sub TextEdit(ByVal txt As String)
  Static InNutzung As Boolean
  Dim Lang As Long
  Dim APos As Long
  Dim NPos As Long
  Dim EPos As Long
  Dim Word As String
  Dim SPos As Long

  If InNutzung Then Exit Sub
  InNutzung = True

  SPos = txtSQL.SelStart
  txt = Replace(txt, Chr$(13), " ")
  txt = Replace(txt, Chr$(10), " ")
  APos = 1: EPos = 1
  txtSQL.SelStart = 0
  txtSQL.SelLength = Len(txtSQL.Text)
  txtSQL.SelColor = 0

  Do
    APos = InStr(EPos, txt, " ")
    If APos > 0 Then
      Word = Mid$(txt, EPos, APos - EPos)
      EPos = APos + 1
    Else
      If EPos > 0 Then
        Lang = Len(txt)
        Word = Mid$(txt, EPos, Lang - EPos + 1)
        APos = EPos
      Else
        Lang = Len(txt)
        Word = Mid$(txt, 1, Lang)
      End If

      If Word <> "" Then Call Wordkontrolle(Word, APos)
      Exit Do
    End If

    If Word <> "" Then
       Call Wordkontrolle(Word, APos - Len(Word))
    End If

  Loop

  txtSQL.SelStart = SPos
  txtSQL.SelColor = 0
  InNutzung = False
End Sub

Sub WortInHochkomma(ByVal txt As String)
  Dim I As Integer
  Dim L As Integer
  Dim G
  Dim iStart As Integer
  Dim iEnd As Integer
  Dim WordTMP As String

  iEnd = Len(txt)
  L = UBound(Split(txt, "'"), 1)
  If L Mod 2 = 1 Or L < 1 Then Exit Sub

  G = Split(txt, "'")
  iStart = Len(G(0))    ' Erstes Hochkomma ermitteln

  Do
    iStart = InStr(iStart, txt, "'") + 1
    iEnd = InStr(iStart, txt, "'")

    WordTMP = Mid$(txt, iStart, iEnd - iStart)
    txtSQL.SelStart = iStart - 1
    txtSQL.SelLength = Len(WordTMP)
    txtSQL.SelColor = QBColor(12)
    iStart = iEnd + 1
  Loop While InStr(iStart, txt, "'") > 0

End Sub

Sub Wordkontrolle(ByVal Word As String, ByVal P As Long)
  Dim Gefunden As Integer
  Dim I As Integer
  Dim WordTMP As String

  WordTMP = UCase$(Word)
  If InStr(WordTMP, "(") > 0 Then WordTMP = Left$(WordTMP, _
       InStr(WordTMP, "(") - 1)

  Gefunden = False

  For I = 1 To UBound(Wd(), 2)
    If UCase$(WordTMP) = Wd(1, I) Then
      Gefunden = True
      txtSQL.SelStart = P - 1
      txtSQL.SelLength = Len(WordTMP)
      txtSQL.SelColor = Val(Wd(2, I))
      txtSQL.SelText = UCase$(WordTMP)
      txtSQL.SelStart = P + 1
      Exit For
    End If
  Next

  If Gefunden = False Then
    txtSQL.SelStart = P - 1
    txtSQL.SelLength = Len(Word)
    txtSQL.SelColor = 0
    txtSQL.SelText = Word
    txtSQL.SelStart = P + 1
  End If

  txtSQL.SelLength = 0
  txtSQL.SelColor = 0

  DoEvents
End Sub

Sub Wortumbruch()
  txtSQL.Text = Replace(txtSQL.Text, " INNER ", vbCrLf & _
     "INNER ", , , vbTextCompare)
  txtSQL.Text = Replace(txtSQL.Text, " GO ", vbCrLf & _
     "GO ", , , vbTextCompare)
  txtSQL.Text = Replace(txtSQL.Text, " ADD ", vbCrLf & _
     "ADD ", , , vbTextCompare)
  ' ...
  ' ...
End Sub

Private Sub Form_Load()
  Call WorteDefinieren
End Sub

Private Sub txtSQL_Change()
  Call Formatieren
End Sub
 
Weitere Links zum Thema
Textverarbeitung mit der RichTextBox
Hinweis
Der Quellcode wurde, um die Übersicht zu wahren, an einigen Stellen gekürzt. Weiterhin ist das Downloadprojekt noch an den wichtigsten Stellen ausreichend kommentiert. Um diesen Tipp ausführen zu können, muss das Microsoft Rich Textbox Control als Komponente in das Projekt eingebunden werden.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5,5 kB) Downloads bisher: [ 321 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 12. September 2011