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