Страница: 1 |
Страница: 1 |
Вопрос: Посветка VBS
Добавлено: 29.07.07 13:31
Автор вопроса: Valya | ICQ: 419-283-432
Как в Richtextbox сделать подсветку синтаксиса VBS (нежелательно без ActiveX)?
--Спасибо
Ответы
Всего ответов: 5
Номер ответа: 1
Автор ответа:
HACKER
Разработчик Offline Client
Вопросов: 236
Ответов: 8362
Профиль | | #1
Добавлено: 29.07.07 17:15
Richtextbox позволяет делать текст разноцветным. В принципе это всё что надо. Собрать список ключевых слов, выделить их другим цветом. Также найти текст в ковычках, выделить его тоже другим цветом, потом цифры, спецсимволы, ну и т.д..
Вообщем просто парсинг текста, соответственно нужны функции работы с текстом, и приямые руки.
Номер ответа: 2
Автор ответа:
shuffle
Администратор
ICQ: 201502381
Вопросов: 15
Ответов: 737
Профиль | | #2
Добавлено: 29.07.07 18:34
Есть пример подсветки синтаксиса паскакаля. Достаточно изменить в коде ключевые слова на нужные.
В модуле:
Public thisLine
Public tstart
Public tend
Public holdtend
Public holdtstart
Public TopLine
Public foundpos
Public commentchar As String
Public longvar As String
Public Declare Function LockWindowUpdate Lib "user32" _
 ByVal hwndLock As Long) As Long
Public Function ColorizeWord(Rich1 As RichTextBox, Word As String, color As OLE_COLOR)
Do Until Rich1.GetLineFromChar(tstart) <> thisLine
tstart = tstart - 1
If tstart < 0 Then
tstart = 0
Exit Do
End If
Loop
startline = Rich1.GetLineFromChar(Rich1.SelStart)
If Rich1.SelLength > 0 Then Exit Function
Rich1.Enabled = False
tstart = tstart
If tstart = 0 Then
tstart = 1
End If
tstart = tstart - Len(Word)
Do
nowline = Rich1.GetLineFromChar(Rich1.SelStart)
If nowline <> startline Then GoTo endx
holdtstart = tstart + Len(Word)
commentposx = InStr(holdtstart, Rich1.Text, commentchar, vbTextCompare)
If holdtstart < 1 Then
holdtstart = 1
End If
tstart = tstart + Len(Word)
foundpos = InStr(tstart, Rich1.Text, Word, vbTextCompare)
If foundpos > tend Then GoTo endx '''''''''''''''''''''
If foundpos < 1 Then GoTo endx
If foundpos < 2 Then
sletter = ""
Else
sletter = Mid(Rich1.Text, foundpos - 1, 1)
End If
eletter = Mid(Rich1.Text, foundpos + Len(Word), 1)
If foundpos > 0 Then
If foundpos = 1 Then
tstart = tstart - 1
End If
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
'###################################################
If Word = commentchar Then
tend = Rich1.SelStart
Do Until Rich1.GetLineFromChar(tend) <> thisLine
tend = tend + 1
If tend > Len(Rich1.Text) Then
tend = Len(Rich1.Text) + 1
Exit Do
End If
Loop
Rich1.SelStart = foundpos - 1
Rich1.SelLength = tend - (foundpos - 1)
Rich1.SelColor = color
Rich1.SelLength = 0
Rich1.SelStart = currchar
Rich1.SelColor = &H0&
Exit Function
Exit Do
End If
''''''''''''''''''''''''''''''
If Word = longvar Then
tend = Rich1.SelStart
Do Until Rich1.GetLineFromChar(tend) <> thisLine
tend = tend + 1
If tend > Len(Rich1.Text) Then
tend = Len(Rich1.Text) + 1
Exit Do
End If
Loop
pos = tstart
Do
foundpos = InStr(pos, Rich1.Text, longvar, vbTextCompare)
For i = foundpos To tend
If foundpos < 1 Then Exit For
If i = tend Then Exit For
Rich1.SelStart = i - 1
Rich1.SelLength = 1
If Rich1.SelText = "" Then Exit For
Select Case Asc(Rich1.SelText)
Case 48 To 57
Rich1.SelColor = color
Case 36
Rich1.SelColor = color
Case 97 To 122
Rich1.SelColor = color
Case 65 To 90
Rich1.SelColor = color
Case 145
Rich1.SelColor = color
Case 146
Rich1.SelColor = color
Case 143
Rich1.SelColor = color
Case 143
Rich1.SelColor = color
Case Else
Exit For
End Select
Next
pos = foundpos + 2
Loop While foundpos > 0
GoTo endx
End If
If tstart = 0 Then
tstart = 1
End If
commentposx = InStr(tstart, Rich1.Text, commentchar, vbTextCompare)
If commentposx > 0 Then
If Rich1.SelStart > commentposx Then GoTo endx
End If
If Len(Word) = 1 Then
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = "" And sletter = "" Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = "" And sletter = " " Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = " " And sletter = "" Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = " " And sletter = " " Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = "" And sletter = Chr(10) Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = " " And sletter = Chr(10) Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(10) And sletter = "" Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(10) And sletter = " " Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(10) And sletter = Chr(10) Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(13) And sletter = Chr(10) Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(13) And sletter = "" Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
If eletter = Chr(13) And sletter = " " Then
theword = Rich1.SelText
originaltext = Rich1.SelText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelText = firstchar & rest
Rich1.SelStart = foundpos - 1
Rich1.SelLength = Len(Word)
Rich1.SelColor = color
End If
Rich1.SelLength = 0
End If
If foundpos = 1 Then
tstart = tstart + 1
End If
Loop While foundpos > 0
endx:
Rich1.SelStart = currchar
Rich1.SelColor = &H0&
foundpos = 0
eletter = ""
sletter = ""
Rich1.Enabled = True
End Function
Public Function clearwordcolors(Rich1 As RichTextBox)
If Rich1.SelLength > 0 Then Exit Function
Rich1.Enabled = False
currchar = Rich1.SelStart
thisLine = Rich1.GetLineFromChar(Rich1.SelStart)
'Form1.Caption = KeyCode
tstart = Rich1.SelStart
tend = Rich1.SelStart
With Rich1
Do Until .GetLineFromChar(tstart) <> thisLine
tstart = tstart - 1
If tstart < 0 Then
tstart = 0
Exit Do
End If
Loop
Do Until .GetLineFromChar(tend) <> thisLine
tend = tend + 1
If tend > Len(.Text) Then
tend = Len(.Text) + 1
Exit Do
End If
Loop
End With
If tstart = 1 Then
tend = tend - 2
End If
If tstart > 1 Then
tstart = tstart + 1
tend = tend - 1
End If
holdtstart = tstart
holdtend = tend
Rich1.SelStart = tstart
Rich1.SelLength = tend - tstart
Rich1.SelColor = &H0&
Rich1.SelLength = 0
Rich1.SelStart = currchar
holdtend = tend
Rich1.Enabled = True
End Function
В форме:
Rich1.Top = 0
Rich1.Left = 0
Rich1.Width = Me.Width - 150
Rich1.Height = Me.Height - 300
End Sub
Private Sub Rich1_KeyUp(KeyCode As Integer, Shift As Integer)
setcolors
End Sub
Private Sub Rich1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
setcolors
End Sub
Public Sub setcolors()
commentchar = "'"
longvar = "$"
If KeyCode = 13 Then Exit Sub
LockWindowUpdate Me.hWnd
clearwordcolors Rich1
ColorizeWord Rich1, longvar, &H80& 'This is for vars with no fixed lenght e.g (in perl _
it could be $122434 0r $myvarx or $x ..... Always set this ($) as first word to colorize
ColorizeWord Rich1, commentchar, &H8000& 'This char is for comments like this
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
ColorizeWord Rich1, "var", &H80000002
ColorizeWord Rich1, "program", &H80000002
ColorizeWord Rich1, "const", &H80000002
ColorizeWord Rich1, "label", &H80000002
ColorizeWord Rich1, "uses", &H80000002
ColorizeWord Rich1, "exit", &H800000
ColorizeWord Rich1, "then", &H800000
ColorizeWord Rich1, "goto", &H800000
ColorizeWord Rich1, "case", &H800000
ColorizeWord Rich1, "select", &H800000
ColorizeWord Rich1, "end", &H800000
ColorizeWord Rich1, "Select Case", &H800000
ColorizeWord Rich1, "End select", &H800000
ColorizeWord Rich1, "for", &H800000
ColorizeWord Rich1, "each", &H800000
ColorizeWord Rich1, "loop", &H800000
ColorizeWord Rich1, "While", &H800000
ColorizeWord Rich1, "Until", &H800000
ColorizeWord Rich1, "for each", &H800000
ColorizeWord Rich1, "Next", &H800000
ColorizeWord Rich1, "True", &H800000
ColorizeWord Rich1, "False", &H800000
ColorizeWord Rich1, "sub", &H800000
ColorizeWord Rich1, "function", &H800000
ColorizeWord Rich1, "Integer", &H800000
ColorizeWord Rich1, "As", &H800000
ColorizeWord Rich1, "Private", &H800000
ColorizeWord Rich1, "Dim", &H800000
ColorizeWord Rich1, "else", &H800000
ColorizeWord Rich1, "else if", &H800000
ColorizeWord Rich1, "Public", &H80000002
ColorizeWord Rich1, "Close", &H80000002
ColorizeWord Rich1, "Open", &H80000002
ColorizeWord Rich1, "End If", &H800000
ColorizeWord Rich1, "If", &H800000
ColorizeWord Rich1, "", &H800000
ColorizeWord Rich1, "", &H800000
LockWindowUpdate 0&
Rich1.Enabled = True
If Rich1.Visible = True Then
Rich1.SetFocus
End If
End Sub
Номер ответа: 3
Автор ответа:
Valya
ICQ: 419-283-432
Вопросов: 15
Ответов: 14
Профиль | | #3
Добавлено: 30.07.07 20:36
СПАСИБО ОГРОМНОЕ!!!!!
---
А еще малый вопрос а этот код подойдет к VB.net 2005?
Номер ответа: 4
Автор ответа:
shuffle
Администратор
ICQ: 201502381
Вопросов: 15
Ответов: 737
Профиль | | #4
Добавлено: 30.07.07 21:02
Нет. Для .NET можешь использовать пример на C#
http://www.codeproject.com/cs/miscctrl/SyntaxHighlighting.asp
Номер ответа: 5
Автор ответа:
Valya
ICQ: 419-283-432
Вопросов: 15
Ответов: 14
Профиль | | #5
Добавлено: 12.08.07 00:39
Если кому надо, то вот готовый:
Модуль
Module Module1
Public currchar
Public thisLine
Public tstart
Public tend
Public holdtend
Public holdtstart
Public TopLine
Public foundpos
Public commentchar As String
Public longvar As String
Public Declare Function LockWindowUpdate Lib "user32" _
 ByVal hwndLock As Long) As Long
Public Function ColorizeWord(ByVal Rich1 As RichTextBox, ByVal Word As String, ByVal color As ConsoleColor)
 im startline, nowline, commentposx, sletter, eletter, pos, theword, originaltext, _
firstchar, rest ', color
 o Until Rich1.GetLineFromCharIndex(tstart) <> thisLine
tstart = tstart - 1
If tstart < 0 Then
tstart = 0
Exit Do
End If
Loop
startline = Rich1.GetLineFromCharIndex(Rich1.SelectionStart)
If Rich1.SelectionLength > 0 Then Exit Function
Rich1.Enabled = False
tstart = tstart
If tstart = 0 Then
tstart = 1
End If
tstart = tstart - Len(Word)
 o
nowline = Rich1.GetLineFromCharIndex(Rich1.SelectionStart)
If nowline <> startline Then GoTo endx
holdtstart = tstart + Len(Word)
commentposx = InStr(holdtstart, Rich1.Text, commentchar, vbTextCompare)
If holdtstart < 1 Then
holdtstart = 1
End If
tstart = tstart + Len(Word)
foundpos = InStr(tstart, Rich1.Text, Word, vbTextCompare)
If foundpos > tend Then GoTo endx '''''''''''''''''''''
If foundpos < 1 Then GoTo endx
If foundpos < 2 Then
sletter = ""
Else
sletter = Mid(Rich1.Text, foundpos - 1, 1)
End If
eletter = Mid(Rich1.Text, foundpos + Len(Word), 1)
If foundpos > 0 Then
If foundpos = 1 Then
tstart = tstart - 1
End If
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
'###################################################
If Word = commentchar Then
tend = Rich1.SelectionStart
 o Until Rich1.GetLineFromCharIndex(tend) <> thisLine
tend = tend + 1
If tend > Len(Rich1.Text) Then
tend = Len(Rich1.Text) + 1
Exit Do
End If
Loop
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = tend - (foundpos - 1)
Rich1.SelectionColor = Drawing.Color.Black 'color
Rich1.SelectionLength = 0
Rich1.SelectionStart = currchar
Rich1.SelectionColor = Drawing.Color.Black '&H0&
Exit Function
Exit Do
End If
''''''''''''''''''''''''''''''
If Word = longvar Then
tend = Rich1.SelectionStart
 o Until Rich1.GetLineFromCharIndex(tend) <> thisLine
tend = tend + 1
If tend > Len(Rich1.Text) Then
tend = Len(Rich1.Text) + 1
Exit Do
End If
Loop
pos = tstart
 o
foundpos = InStr(pos, Rich1.Text, longvar, vbTextCompare)
 im i
For i = foundpos To tend
If foundpos < 1 Then Exit For
If i = tend Then Exit For
Rich1.SelectionStart = i - 1
Rich1.SelectionLength = 1
If Rich1.SelectedText = "" Then Exit For
Select Case Asc(Rich1.SelectedText)
Case 48 To 57
Rich1.SelectionColor = Drawing.Color.Blue ' color
Case 36
Rich1.SelectionColor = Drawing.Color.Blue
Case 97 To 122
Rich1.SelectionColor = Drawing.Color.Blue
Case 65 To 90
Rich1.SelectionColor = Drawing.Color.Blue
Case 145
Rich1.SelectionColor = Drawing.Color.Blue
Case 146
Rich1.SelectionColor = Drawing.Color.Blue
Case 143
Rich1.SelectionColor = Drawing.Color.Blue
Case 143
Rich1.SelectionColor = Drawing.Color.Blue
Case Else
Exit For
End Select
Next
pos = foundpos + 2
Loop While foundpos > 0
GoTo endx
End If
If tstart = 0 Then
tstart = 1
End If
commentposx = InStr(tstart, Rich1.Text, commentchar, vbTextCompare)
If commentposx > 0 Then
If Rich1.SelectionStart > commentposx Then GoTo endx
End If
If Len(Word) = 1 Then
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = "" And sletter = "" Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = "" And sletter = " " Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = " " And sletter = "" Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = " " And sletter = " " Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = "" And sletter = Chr(10) Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = " " And sletter = Chr(10) Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(10) And sletter = "" Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(10) And sletter = " " Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(10) And sletter = Chr(10) Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(13) And sletter = Chr(10) Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(13) And sletter = "" Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
If eletter = Chr(13) And sletter = " " Then
theword = Rich1.SelectedText
originaltext = Rich1.SelectedText
theword = LCase(theword)
firstchar = Mid(theword, 1, 1)
rest = Mid(theword, 2, Len(theword))
firstchar = UCase(firstchar)
Rich1.SelectedText = firstchar & rest
Rich1.SelectionStart = foundpos - 1
Rich1.SelectionLength = Len(Word)
Rich1.SelectionColor = Drawing.Color.Blue
End If
Rich1.SelectionLength = 0
End If
If foundpos = 1 Then
tstart = tstart + 1
End If
Loop While foundpos > 0
endx:
Rich1.SelectionStart = currchar
Rich1.SelectionColor = Drawing.Color.Black
foundpos = 0
eletter = ""
sletter = ""
Rich1.Enabled = True
End Function
Public Function clearwordcolors(ByVal Rich1 As RichTextBox)
If Rich1.SelectionLength > 0 Then Exit Function
Rich1.Enabled = False
currchar = Rich1.SelectionStart
thisLine = Rich1.GetLineFromCharIndex(Rich1.SelectionStart)
'Form1.Caption = KeyCode
tstart = Rich1.SelectionStart
tend = Rich1.SelectionStart
With Rich1
 o Until .GetLineFromCharIndex(tstart) <> thisLine
tstart = tstart - 1
If tstart < 0 Then
tstart = 0
Exit Do
End If
Loop
 o Until .GetLineFromCharIndex(tend) <> thisLine
tend = tend + 1
If tend > Len(.Text) Then
tend = Len(.Text) + 1
Exit Do
End If
Loop
End With
If tstart = 1 Then
tend = tend - 2
End If
If tstart > 1 Then
tstart = tstart + 1
tend = tend - 1
End If
holdtstart = tstart
holdtend = tend
Rich1.SelectionStart = tstart
Rich1.SelectionLength = tend - tstart
Rich1.SelectionColor = Color.Black
Rich1.SelectionLength = 0
Rich1.SelectionStart = currchar
holdtend = tend
Rich1.Enabled = True
End Function
End Module
Форма
Public Class Form1
Private Sub Rich1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Rich1.KeyUp
setcolors()
End Sub
Private Sub Rich1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Rich1.MouseUp
setcolors()
End Sub
Public Sub setcolors()
commentchar = ";"
longvar = "$"
'If .KeyCode = 13 Then Exit Sub
' LockWindowUpdate(Me.hwnd)
clearwordcolors(Rich1)
ColorizeWord(Rich1, longvar, ConsoleColor.DarkGreen) 'This is for vars with no fixed lenght e.g (in perl _
'it could be $122434 0r $myvarx or $x ..... Always set this ($) as first word to colorize
ColorizeWord(Rich1, commentchar, ConsoleColor.Red) 'This char is for comments like this
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
ColorizeWord(Rich1, "var", ConsoleColor.DarkGray)
ColorizeWord(Rich1, "program", &H80000002)
ColorizeWord(Rich1, "const", &H80000002)
ColorizeWord(Rich1, "label", &H80000002)
ColorizeWord(Rich1, "uses", &H80000002)
ColorizeWord(Rich1, "exit", &H800000)
ColorizeWord(Rich1, "then", &H800000)
ColorizeWord(Rich1, "goto", &H800000)
ColorizeWord(Rich1, "case", &H800000)
ColorizeWord(Rich1, "select", &H800000)
ColorizeWord(Rich1, "end", &H800000)
ColorizeWord(Rich1, "Select Case", &H800000)
ColorizeWord(Rich1, "End select", &H800000)
ColorizeWord(Rich1, "for", &H800000)
ColorizeWord(Rich1, "each", &H800000)
ColorizeWord(Rich1, "loop", &H800000)
ColorizeWord(Rich1, "While", &H800000)
ColorizeWord(Rich1, "Until", &H800000)
ColorizeWord(Rich1, "for each", &H800000)
ColorizeWord(Rich1, "Next", &H800000)
ColorizeWord(Rich1, "True", &H800000)
ColorizeWord(Rich1, "False", &H800000)
ColorizeWord(Rich1, "sub", &H800000)
ColorizeWord(Rich1, "function", &H800000)
ColorizeWord(Rich1, "Integer", &H800000)
ColorizeWord(Rich1, "As", &H800000)
ColorizeWord(Rich1, "Private", &H800000)
ColorizeWord(Rich1, "im", &H800000)
ColorizeWord(Rich1, "else", &H800000)
ColorizeWord(Rich1, "else if", &H800000)
ColorizeWord(Rich1, "Public", &H80000002)
ColorizeWord(Rich1, "Close", &H80000002)
ColorizeWord(Rich1, "Open", &H80000002)
ColorizeWord(Rich1, "End If", &H800000)
ColorizeWord(Rich1, "If", &H800000)
ColorizeWord(Rich1, "", &H800000)
ColorizeWord(Rich1, "", &H800000)
'LockWindowUpdate(0&
Rich1.Enabled = True
If Rich1.Visible = True Then
Rich1.Focus()
End If
End Sub
End Class