PROBLEMAS COM "TRAVACAO" NA HORA DE PINTAR TOKENS

USUARIO.EXCLUIDOS 08/08/2007 21:05:38
#230104
Galera eu estou fazendo um editor de script e to fazendo um código que destaca comm cores os codigos de script.

Só que trava d+ , n sei qual foi meu erro =(

Olhem meu Código:
Citação:

Private Sub Pintar_Todos_Codigos()
If TotalNPCs = 0 Then: Exit Sub

BckSelStart = Text1.SelStart
BckSelLen = Text1.SelLength

For PrintCabeca = 1 To TotalNPCs
Pintar LinhaString(NPCLine(PrintCabeca)), 130
Next PrintCabeca

Pintar ";", vbRed

For PrintNumbers = 0 To 9
Pintar PrintNumbers, vbGreen
Next PrintNumbers

For PrintCommands = 0 To TOTI1

For sasauh = 1 To TOTI1
If InStr(1, UCase(Text1.Text), UCase(CadaComando(PrintCommands))) = 0 Then: PrintCommands = PrintCommands + 1: Else: GoTo LoopSingle
If PrintCommands > TOTI1 Then: Exit For
Next sasauh
Exit For
LoopSingle:
Pintar CadaComando(PrintCommands), vbBlue

Next PrintCommands

LockWindowUpdate Text1.hwnd
Text1.SelStart = BckSelStart
Text1.SelLength = BckSelLen
Text1.SelColor = vbDefault
LockWindowUpdate 0

End Sub

Private Sub Pintar(ByVal Pintom As String, ByVal Cor As Double)
    If Trim(Text1.Text) = "" Then Exit Sub
    
    Dim iPos As Double
    iPos = 1
    Do
            iPos = InStr(iPos, UCase(Text1.Text), UCase(Pintom))
            If iPos = 0 Then Exit Sub
            LockWindowUpdate Text1.hwnd
            Text1.SelStart = iPos - 1
            Text1.SelLength = Len(Pintom)
            Text1.SelColor = Cor
            iPos = iPos + 1
            LockWindowUpdate 0
    Loop
    
End Sub
USUARIO.EXCLUIDOS 09/08/2007 09:38:19
#230139
Amigo,

Vc tem 3 Loop's um dentro do outro, creio eu que ele roda em cima de todos os caractres da caixa de texto, realmente se vc chamar esta rotina toda vez que o cara digitar algo, vai travar toda hora.

creio que vc deve "Pintar" a palavra quando o cara pressionar espaço, ou verificar somente a última palavra digitada pelo usuário, se ela será pintada ou não... coisas do tipo.

Talvez vc tenha que mudar a sua forma de pensar, para fazer isso aí...
USUARIO.EXCLUIDOS 09/08/2007 12:12:04
#230182
Olha só... fiz um exemplinho abaixo. Ele não está 100% funcional, é mais pra vc pegar a lógica mesmo.

Text = RichTextBox


Dim Comandos(3) As String

[c]Private Sub Form_Load()
    Comandos(0) = "if"
    Comandos(1) = "then"
    Comandos(2) = "for"
    Comandos(3) = "next"
End Sub


Public Function IsComando(Comando As String) As Boolean
    IsComando = False
    
    For i = 0 To UBound(Comandos)
        If LCase(Comando) = LCase(Comandos(i)) Then
            IsComando = True
            Exit Function
        End If
    Next
End Function


Private Sub Text_Change()
    Dim PosAtual As Long
    Dim InicioPalavra As Long
    Dim Palavra As String
    Dim PosEnter As Long
    
    
    PosAtual = Text.SelStart
    InicioPalavra = InStr((Len(Text.Text) - PosAtual) + 1, StrReverse(Text.Text), " ") - 2
    'PosEnter = Len(Text.Text) - (InStr((Len(Text.Text) - PosAtual) + 1, StrReverse(Text.Text), vbCrLf) - 2)
    
    'If PosEnter > InicioPalavra Then
    '    InicioPalavra = PosEnter
    'End If
    
    If InicioPalavra > 0 Then
        InicioPalavra = Len(Text.Text) - InicioPalavra
    Else
        InicioPalavra = 1
    End If
    
    Palavra = Mid(Text.Text, InicioPalavra, (PosAtual - InicioPalavra) + 1)
    
    If IsComando(Palavra) Then
        Text.SelStart = InicioPalavra - 1
        Text.SelLength = (PosAtual - InicioPalavra) + 1
        Text.SelBold = True
        Text.SelStart = PosAtual
        Text.SelBold = False
    End If
End Sub

[/c]
USUARIO.EXCLUIDOS 09/08/2007 13:39:15
#230218
Olá =D
Po cara vlw por me ajudar =D
entendi algumas coisas outras n tipo, eu acho que laga por causa que tem 321 comandos =( n sei se eh =X

Eu dei uma minuscula simplificada no meu código com base no seu:

Citação:

Private Sub Pintar_Todos_Comandos()

If TotalNPCs = 0 Then: Exit Sub

LockWindowUpdate Me.hwnd
BckSelStart = Text1.SelStart
BckSelLen = Text1.SelLength

For PrintCabeca = 1 To TotalNPCs
Pintar LinhaString(NPCLine(PrintCabeca)), 130 ' Pinta os cabeçalhos dos scripts
Next PrintCabeca

Pintar ";", vbRed

For PrintCommands = 0 To UBound(CadaComando) ' CadaComando é a string de cada comando
repetir:

If PrintCommands > UBound(CadaComando) Then: Exit For
If InStr(1, UCase(Text1.Text), UCase(CadaComando(PrintCommands))) = 0 Then: PrintCommands = PrintCommands + 1: GoTo repetir

Pintar CadaComando(PrintCommands), vbBlue

Next PrintCommands

Text1.SelStart = BckSelStart
Text1.SelLength = BckSelLen
Text1.SelColor = vbDefault
LockWindowUpdate 0

End Sub


Citação:


Private Sub Pintar(ByVal Pintom As String, ByVal Cor As Double)
    If Trim(Text1.Text) = "" Then Exit Sub
    
    Dim iPos As Double
    iPos = 1
    Do
            iPos = InStr(iPos, UCase(Text1.Text), UCase(Pintom))
            If iPos = 0 Then Exit Sub
            Text1.SelStart = iPos - 1
            Text1.SelLength = Len(Pintom)
            Text1.SelColor = Cor
            iPos = iPos + 1
            LockWindowUpdate 0
    Loop
    
End Sub



e para explicar melhor, o "Pintar_Todos_Comandos" é chamado no text change , o q mais eu poderia mudar?

eh que sou novato e n entendi tudo do seu codigo =X

Muitissimo Obrigado =D
USUARIO.EXCLUIDOS 09/08/2007 14:26:29
#230241
Cara... se vc chamar seu código no Text_Change, ele vai entrar naquele monte de Loop, vai travar mesmo... esquece...

Não é pela quantidade de linhas ou comandos de seu código que trava, mais sim pela quantidade de vezes que ele executa cada For, Loop que tem ali...

Acho que vc vai precisar esquecer dele, e mudar a estratégia, ao invés de varrer todos os caracteres da caixa de texto, verificar somente a última palavra digitada, como no meu exemplo. O qq vc não entendeu dele??
USUARIO.EXCLUIDOS 09/08/2007 18:27:23
#230307
é que alem da pessoa digitar o programa adiciona tbm alguns comandos por botões e afins, e como eu poderia ja adicionar colorido? =X
to moh 'incucado' com esse barato de colori =X
eu tava pensando em só adicionar uma opção dipo "Destacar Comandos" mais seria interessante ja.
Ou eu tbm pensei em criar um timer de +/- 1 seg ativado quando aperta espaço no textbox e esse timer colori os comandos assim da menos lag,mais to loco com isso =X


e sobre u q eu n entendi =X

Citação:

InicioPalavra = InStr((Len(Text.Text) - PosAtual) + 1, StrReverse(Text.Text), " ") - 2



eu n entendi bem essa parte,principalmente esse strreverse =X
USUARIO.EXCLUIDOS 09/08/2007 19:14:36
#230311
strReverse retorna uma string ao Contrário.

O que eu fiz ali é o seguinte, ele pega a a posição que inicia a última palavra que foi digitada. Aí ele ve se é um comando, se for, ele deixa negrito!


Para fazer da forma que vc falou, nem precisa de Timer, faça assim ó:

Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc(" ") Then
        Pintar_Todos_Codigos
    End If
End Sub


Desta forma ficará mais rápido, ve se vai continuar travando...
USUARIO.EXCLUIDOS 09/08/2007 19:23:08
#230312
Diminuiu muito a travação,mais ainda trava,principalmente quando o texto é grande =(
WEBMASTER 09/08/2007 21:29:34
#230321
O ideal seria voce usar a API LockWindowUpdate (tem um artigo aqui sobre isso) que faria o congelamento, pintaria o componente e descongelaria ao final.

Faca um teste ;)
USUARIO.EXCLUIDOS 09/08/2007 21:56:33
#230325
Eu até concordo com o Web, mas descordo ao mesmo tempo.


Se no evento Change do TextBox, ele analisar somente a palavra mais perto de onde está o foco do mouse (foi o que tentei exemplificar), não vai travar nunca.
USUARIO.EXCLUIDOS 10/08/2007 14:07:04
#230370
@WebMaster
estou fazendo isso sim =D

@MarceloHF
cara mais como eu disse alem da digitação o programa auxilia inserindo alguns codigos =x
Página 1 de 2 [13 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar