- Код: Выделить всё
richTxt.Font.Name = "Courier New"
-- ошибка.
2. Как установить фокус (или что писать вместо SetFocus)?
3. Что писать вместо richTxt.SelStart, .SelLength?
richTxt.Font.Name = "Courier New"
richTxt.SelectionStart = 0
richTxt.SelectionLength = 0
Private Sub ZarezervirSlova(ByVal richTxt As RichTextBox)
Dim s As Integer = 1 'Объявляем переменную s для работы с числами
Dim i As Integer
For i = 0 To richTxt.Text.Length
If InStr(s, richTxt.Text, "Sub") <> 0 Then 'Сверяется 2 значения
richTxt.Focus() 'На RichTxt ставим курсор
richTxt.SelectionStart = InStr(s, richTxt.Text, "Sub") - 1 'Устанавливаем курсор перед нужным словом
richTxt.SelectionLength = Len("Sub")
richTxt.SelectionColor = Color.Blue
s = InStr(s, richTxt.Text, "Sub") + Len("Sub") ' Изменяем переменную на позицию курсора
Else ' Если в тексте больше нет искомого слова, то переходим кверху.
richTxt.SelectionStart = 0
richTxt.SelectionLength = 0
End If
Next i
End Sub
InStr(s, richTxt.Text, "Sub")
Len("Sub")
!Viper! писал(а):
- Код: Выделить всё
InStr(s, richTxt.Text, "Sub")
Это у тебя выполняется 3 раза. стоит сделать один вызов и запомнить позицию
- Код: Выделить всё
Len("Sub")
Вычисляешь длину константы - стоит вычислить один раз и присвоить значение константе (вернее переменной только для чтения)
Это все с беглого просмотра
И зачем тебе переменная s? Искать начинаешь всяко с 1
Роман-вб писал(а):
- Код: Выделить всё
...
If InStr(s, richTxt.Text, "Sub") <> 0
...
richTxt.SelectionStart = InStr(s, richTxt.Text, "Sub")
...
s = InStr(s, richTxt.Text, "Sub") + Len("Sub")
...
Private Sub ZarezervirSlova(ByVal richTxt As RichTextBox)
Dim s As Integer = 1 'Объявляем переменную qw для работы с числами
Dim i As Integer, ss As Integer
For i = 0 To richTxt.Text.Length
ss = InStr(s, richTxt.Text, "Sub")
If ss <> 0 Then 'Сверяется 2 значения
richTxt.Focus() 'На RichTxt ставим курсор
richTxt.SelectionStart = ss - 1 'Устанавливаем курсор перед нужным словом
richTxt.SelectionLength = Len("Sub")
richTxt.SelectionColor = Color.Blue
s = ss + Len("Sub") ' Изменяем переменную на позицию курсора
Else ' Если в тексте больше нет искомого слова, то переходим кверху.
richTxt.SelectionStart = 0
richTxt.SelectionLength = 0
End If
Next i
End Sub
Private Sub OnFind(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFind.Click
FindAndMark("Sub", rtb)
End Sub
Public Sub FindAndMark(ByVal sFind As String, ByVal rtb As RichTextBox)
Dim nLen As Integer = sFind.Length
Dim sText As String = rtb.Text
Dim nLenTxt As Integer = sText.Length
If nLen = 0 OrElse nLenTxt = 0 Then
Return
End If
Dim iPos As Integer = 1
Do
iPos = InStr(iPos, sText, sFind)
If iPos = 0 Then
Return
End If
With rtb
.SelectionStart = iPos - 1
.SelectionLength = nLen
.SelectionColor = Color.Red
.Focus()
End With
iPos += nLen
Loop
End Sub
Роман-вб писал(а):2) В цикле, потому что вызывается эта подпрограмма 1 раз
Public Sub FindAndMark(ByVal rtb As RichTextBox, ByVal ParamArray sFind() As String)
Dim nLen As Integer = sFind.Length
Dim nLenTxt As Integer = rtb.Text.Length
If nLen = 0 OrElse nLenTxt = 0 Then
Return
End If
Dim iPos As Integer = 1
Do
iPos = InStr(iPos, rtb.Text, sFind(7))
If iPos = 0 Then
Return
End If
rtb.SelectionStart = iPos - 1
rtb.SelectionLength = nLen
rtb.SelectionColor = Color.Blue
iPos += nLen
Loop
End Sub
Imports System.Text.RegularExpressions
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim Rgx As New Regex("\w+", RegexOptions.Multiline)
If Rgx.IsMatch(Rtb.Text) Then
'Перебор всех слов
For Each M As Match In Rgx.Matches(Rtb.Text)
Rtb.SelectionBackColor = Rtb.BackColor
Rtb.SelectionStart = M.Index
Rtb.SelectionLength = M.Length
Rtb.SelectionBackColor = Color.Blue
Application.DoEvents()
Threading.Thread.Sleep(1000)
Next
End If
End Sub
End Class
Роман-вб писал(а):!Viper!
А как сделать, чтобы находились только такие подстроки, каоторые являются отдельным словом и не входят в состав другого слова?
Dim s As String
For Each s in sFind
...
Next
Dim i As Integer
For i = 0 To sFind.Length - 1
...
Next
Call FindAndMark(richTxt, "Sub", "Function", "Private", "Public")
Public Sub FindAndMark(ByVal rtb As RichTextBox, ByVal ParamArray sFind() As String)
Dim nLen As Integer = sFind.Length
Dim nLenTxt As Integer = rtb.Text.Length
If nLen = 0 OrElse nLenTxt = 0 Then
Return
End If
Dim iPos As Integer = 1
Do
iPos = InStr(iPos, rtb.Text, sFind())
If iPos = 0 Then
Return
End If
rtb.SelectionStart = iPos - 1
rtb.SelectionLength = nLen
rtb.SelectionColor = Color.Blue
iPos += nLen
Loop
End Sub
Public Sub FindAndMark(ByVal rtb As RichTextBox, ByVal ParamArray sFind() As String)
Dim nLenTxt As Integer = rtb.Text.Length
If nLenTxt = 0 Then
Return
End If
Dim s As String
For Each s In sFind
Dim nLen As Integer = s.Length
If nLen > 0 Then
Dim iPos As Integer = 1
Do
iPos = InStr(iPos, rtb.Text, s)
If iPos <> 0 Then
rtb.SelectionStart = iPos - 1
rtb.SelectionLength = nLen
rtb.SelectionColor = Color.Blue
iPos += nLen
End If
Loop
End If
Next
End Sub
Call FindAndMark(richTxt, "Sub", "Function", "Private", "Public")
Сейчас этот форум просматривают: Mail.ru [бот] и гости: 63