Why won't this work? 1

[rjr9999]

Ok, maybe I'm just tired or something, but this looks like it should work perfectly to me. The object is, it will read the text (strData) it will then extract escape codes, marking them at the same time (this part works fine). It is then supposed to display the color starting from where the escape code pointed and ending with the next escape code, unless it's a modifier. The problem here, is unfortunately, it doesn't display the color...WHY? Any help is always appriciated Good luck, you'll probably need it .

Code to follow
-----------------------------------------------------------
ascChar(1) = "" ' Normal Display
ascChar(2) = "" ' Bold On
ascChar(3) = "" ' Underline
ascChar(4) = "" ' Blink On
ascChar(5) = "" ' Reverse Video
ascChar(6) = "" ' Invisible
ascChar(7) = "" ' Black Text
ascChar(8) = "" ' Red Text
ascChar(9) = "" ' Green Text
ascChar(10) = "" ' Yellow Text
ascChar(11) = "" ' Blue text
ascChar(12) = "" ' Magenta Text
ascChar(13) = "" ' Cyan Text
ascChar(14) = "" ' White Text
ascChar(15) = "" ' Black BG
ascChar(16) = "" ' Red BG
ascChar(17) = "" ' Green BG
ascChar(18) = "" ' Yellow BG
ascChar(19) = "" ' Blue BG
ascChar(20) = "" ' Magenta BG
ascChar(21) = "" ' Cyan BG
ascChar(22) = "" ' White BG
ascChar(23) = "" ' Black Text (Bright)
ascChar(24) = "" ' Red Text (Bright)
ascChar(25) = "" ' Green Text (Bright)
ascChar(26) = "" ' Yellow Text (Bright)
ascChar(27) = "" ' Blue text (Bright)
ascChar(28) = "" ' Magenta Text (Bright)
ascChar(29) = "" ' Cyan Text (Bright)
ascChar(30) = "" ' White Text (Bright)
Dim found As Long
Dim lastFound As Long
Dim strStart(1 To 10000) As Long
Dim strColor(1 To 10000) As Integer
Dim cutout(1 To 10000) As Long
Dim strOn As Long
Dim aryText() As String
Dim strOut As String
cutout(1) = 0

' Mark escape codes
For I = 1 To UBound(ascChar)
found = 1
lastFound = 1
strOn = 1
Do While found <> 0
found = InStr(lastFound, strData, ascChar(I))
If found <> 0 Then
lastFound = found + 1
strStart(strOn) = found
strColor(strOn) = I
Select Case I
Case 1 To 6
cutout(strOn) = cutout(strOn) - 4
Case 7 To 22
cutout(strOn) = cutout(strOn) - 5
Case Else
cutout(strOn) = cutout(strOn) - 7
End Select
strOn = strOn + 1
End If
Loop
Next

' Extract escape codes
strOut = strData
For X = 1 To UBound(ascChar)
aryText = Split(strOut, ascChar(X))
For I = 0 To UBound(aryText)
If I = 0 Then
strOut = Mid(aryText(I), 1)
Else
strOut = strOut & Mid(aryText(I), 1)
End If
Next
Next

' Print the output
Text1.SelStart = 66000
Text1.SelText = strOut

' Display the colors
For I = 1 To (strOn - 1)
Select Case strColor(I)
' I didn't add all of them yet, just for testing
' purposes...but don't worry, that's not the
' problem
Case 13
Text1.SelStart = strStart(I)
Text1.SelLength = 65000
Text1.SelColor = vbBlue
Case 9
Text1.SelStart = strStart(I)
Text1.SelLength = 65000
Text1.SelColor = vbGreen
End Select
Next I
End Sub
-----------------------------------------------------------
Rob
&quot;Programming is like art...It makes me feel like chopping my ear off.&quot;

 

[strongm]

Rob,

The primary reason it doesn't work is because when you exit the routine that mark's the escape codes strON is always equal to 1. This is due to where you initalise the variable in the For...Next loop. Move it outside:

' Mark escape codes
strOn = 1
For I = 1 To UBound(ascChar)
found = 1
lastFound = 1
Do While found <> 0
found = InStr(lastFound, strData, ascChar(I))
If found <> 0 Then
lastFound = found + 1
strStart(strOn) = found
strColor(strOn) = I
Select Case I
Case 1 To 6
cutout(strOn) = cutout(strOn) - 4
Case 7 To 22
cutout(strOn) = cutout(strOn) - 5
Case Else
cutout(strOn) = cutout(strOn) - 7
End Select
strOn = strOn + 1
End If
Loop
Next


I think you'll discover some other issues once you make this modification, but it is this strOn value which is currently preventing any visible color changes.

Regards,
Mike

 

[rjr9999]

heh told you I was tired , thanks Rob
&quot;Programming is like art...It makes me feel like chopping my ear off.&quot;