|
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
|
|