[VB] Colorazione RTF lenta...

[DanieleC88]

Sto usando questo codice per la colorazione RTF, ma é lentissimo... invece i normali VB, Delphi, C++ e via dicendo hanno una colorazione del codice instantanea ! cosa c'é che non va?

Option Compare Text

Const vbSp As String * 1 = " "

Const flgSetup As String * 7 = "[Setup]"
Const flgUnInstall As String * 11 = "[UnInstall]"
Const flgPublic As String * 6 = "Public"
Const flgPrivate As String * 7 = "Private"
Const flgFunct As String * 8 = "Function"
Const flgSub As String * 3 = "Sub"
Const flgEnd As String * 3 = "End"

Public Declare Function LockWindowUpdate Lib "User32" _
(ByVal hWndLock As Long) As Long

Sub RTFCodeFormat(tRTF As RichTextBox)
Dim R As Byte, G As Byte, B As Byte
Dim tmpRTF As String, anRTF As String, _
tblColors As String, newColors As String, _
tSel As Long, tLen As Long, txtLen As Long, _
tChanged As Boolean, txtLeft As String, _
newLeft As String

tSel = tRTF.SelStart
tLen = tRTF.SelLength
txtLen = Len(tRTF.Text)
tRTF.SelStart = 0
tRTF.SelLength = Len(tRTF.Text)
tRTF.SelColor = Colors.ForeColor
txtLeft = Left(tRTF.Text, tRTF.SelStart)
tRTF.Text = Replace(tRTF.Text, "(", " {apriparentesi}")
tRTF.Text = Replace(tRTF.Text, ")", "{chiudiparentesi} ")
tRTF.Text = Replace(tRTF.Text, "=", " {uguale} ")
tRTF.Text = Replace(tRTF.Text, "&", " & ")
tRTF.Text = Replace(tRTF.Text, "{uguale}", "=")
tRTF.Text = Replace(tRTF.Text, "{apriparentesi}", "(")
tRTF.Text = Replace(tRTF.Text, "{chiudiparentesi}", ")")
tRTF.Text = Replace(tRTF.Text, (vbLf & " ("), (vbLf & "("))
tRTF.Text = Replace(tRTF.Text, (") " & vbCr), (")" & vbCr))
tRTF.Text = Replace(tRTF.Text, " ", " ")
newLeft = Left(tRTF.Text, tRTF.SelStart)
If (Not txtLeft = newLeft) Then tChanged = True
rtfLine = tRTF.GetLineFromChar(tRTF.SelStart)

ColorRTF tRTF, """", Colors.Quotes
ColorRTF tRTF, "(", Colors.Quotes
ColorRTF tRTF, ")", Colors.Quotes
'#################################
ColorRTF tRTF, flgSetup, Colors.Head
ColorRTF tRTF, flgUnInstall, Colors.Head
'#################################
ColorRTF tRTF, "InstallPath", Colors.Keywords
ColorRTF tRTF, "DesktopLink", Colors.Keywords
ColorRTF tRTF, "QuickLaunch", Colors.Keywords
ColorRTF tRTF, "ProgramGroup", Colors.Keywords
ColorRTF tRTF, "ProgGroupName", Colors.Keywords
ColorRTF tRTF, "DeskLinkName", Colors.Keywords
ColorRTF tRTF, "QuickLaunchName", Colors.Keywords
ColorRTF tRTF, "InstallPath", Colors.Keywords
'__________________________________________
ColorRTF tRTF, "%root%", Colors.Keywords
ColorRTF tRTF, "%windir%", Colors.Keywords
ColorRTF tRTF, "%progdir%", Colors.Keywords
ColorRTF tRTF, "%system%", Colors.Keywords

If tChanged Then
tSel = (tSel + (Len(tRTF.Text) - txtLen))
End If
tRTF.SelLength = tLen
tRTF.SelStart = tSel
tRTF.SelColor = Colors.ForeColor
End Sub

Sub ColorRTF(ByVal RTB As RichTextBox, ByVal cWord As String, ByVal cColor As OLE_COLOR)
Dim rTxt As String, _
sPos As Long, _
inStrPos As Long

rTxt = RTB.Text
Do
sPos = (sPos + 1)
inStrPos = InStr(sPos, rTxt, cWord)
If (Not inStrPos = 0) Then
RTB.SelStart = (inStrPos - 1)
RTB.SelLength = Len(cWord)
RTB.SelColor = cColor
RTB.SelText = cWord
sPos = (sPos + (Len(cWord) - 1))
End If
Loop Until (inStrPos = 0)
End Sub

Public Function Replace(ByVal Text As String, ByVal OriginalStr As String, ByVal ConvertStr As String, Optional ByVal OnlyOneTime As Boolean = False) As String
If (Text = "" Or OriginalStr = "") Then Exit Function 'Or ConvertStr = ""

i = 0
Do Until i >= Len(Text)
i = (i + 1)
midTXT = Mid(Text, i, Len(OriginalStr))
If (midTXT = OriginalStr) Then
BkTemp = (i - 1)
NxTemp = (i + Len(OriginalStr))

If (NxTemp > Len(Text)) Then NxTemp = ""
If (BkTemp < 1) Then BkTemp = ""

' If ((BkTemp = "") Or (NxTemp = "")) Then
' If (BkTemp = "") Then Text = (ConvertStr & NxTemp)
' If (NxTemp = "") Then Text = (BkTemp & ConvertStr)
' Else
If (Not BkTemp = "" Or Not CountASCIIVal(BkTemp) = 0) Then
BkTemp = Mid(Text, 1, BkTemp)
End If
If (Not NxTemp = "" Or Not CountASCIIVal(NxTemp) = 0) Then
NxTemp = Mid(Text, NxTemp)
End If

Text = (BkTemp & ConvertStr & NxTemp)
If OnlyOneTime Then
GoTo CloseFunct
End If
'Debug.Print Text
'End If
End If
Loop

CloseFunct:
Replace = Text
Exit Function
End Function
[/code]