I need a little help trying to parse messages that have been tweaked so they allow your messages to be different colors. ( Trivia Bot does, Stealthbot can parse it. )
I am sorry I seem so newbish right, It's morning and I can't remember what this is called again.
I am not asking for an entire function just a little help. * Pretty sure you'll understand *
Colors from which client?
hes talking about stracraft when you do ÁU the color displays Blue on the client he wants it where if the bot see's that then the "addc" for that text will be blue
Split by Á
Then for each item in the array you split the message by, determine the color, and add the rest of that array item to the RTB.
Quote from: Newby on May 04, 2004, 09:19 AM
Split by Á
Then for each item in the array you split the message by, determine the color, and add the rest of that array item to the RTB.
I understand arrays and such but how do I split all the word(s) with Á in front and add it to the array? Every single one and then have it also change it to actual colors in the Richtextbox?
if (message.indexOf("Á") > 0) {
String array[] = null;
array = message.split("Á");
{
if instr(message, "Á") then
dim array() as string
array = split(message, "Á")
end if
Edit: Code tags.
Just an extension to what fr0zen already posted.
NOTE: This code was untested and was found to not work. I've fixed the code and it can be found here (http://forum.valhallalegends.com/phpbbs/index.php?board=17;action=display;threadid=6652&start=0;start=15#msg58570).
'// Put me somewhere :P
Const Message as String = "ÁUThis is an example string. ÁYBlah blah blah blah blah (more useless text). ÁRInsert some retarded comment here. ÁVBlah blah blah blah blah." & vbCrLf
'/* This example will Split this string. */
Dim ColorParse() as String
'/* MerF!? */
Dim ColorByte as String
'/* This is just to make the code a little
'** easier to read. */
If InStr(1, Message, "Á", vbTextCompare) <> 0 Then
ColorParse = Split(Message, "Á")
For i = 0 to UBount(ColorParse)
ColorByte = Left(ColorParse(i), 1)
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i) - 1)
AddText txtOutput, GetColor(ColorByte), ColorParse(i)
Next i
End If
GetColor()
Public Function GetColor(byval ColorByte as String) as vbColorConstants
'// I think it's vbColorConstant. It might be different :P
Select Case ColorByte
. . .
End Select
. . .
End Function
Thank you Eli_1
Dim ColorParse() As String
'/* MerF!? */
Dim ColorByte As String
Dim i As Integer
'/* This is just to make the code a little
'** easier to read. */
If InStr(1, Message, "Á", vbTextCompare) 0 Then
ColorParse = Split(Message, "Á")
For i = 0 To UBound(ColorParse)
ColorByte = Left(ColorParse(i), 1)
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i) - 1))
'AddText txtOutput, GetColor(ColorByte), ColorParse(i)
Next i
End If
its says
variable required - can't assign to this expression
at:
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i) - 1))
Why?
Quote
at:
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i) - 1))
Ya, that's my bad. I wrote that code on the fly when I was posting and never tested it. That's happening because of a mis-placed parenthasis.
Fixed.
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i)) - 1)
I was looking at this, and i placed a message box after:
If InStr(1, Message, "Á", vbTextCompare) = 1 Then
[/vbcode]
and friend said something with Á message box didn't go off
Quote from: BaDDBLooD on May 04, 2004, 06:52 PM
I was looking at this, and i placed a message box after:
If InStr(1, Message, "Á", vbTextCompare) = 1 Then
[/vbcode]
and friend said something with Á message box didn't go off
If InStr(Message, "Á", vbTextCompare) >= 1 Then
MsgBox "Found Á"
end if
If InStr(Message, "Á", vbTextCompare) <> 0 Then
MsgBox "Found Á"
end if
Edit> added the latter.
If InStr(Message, "Á", vbTextCompare) >= 1 Then
MsgBox "Found Á"e
end if
That's not the syntax InStr takes.
It should be InStr(Start, S1, S2, Seach type).
Your doing InStr(S1, S2, Search type).
This should work:
InStr(1, Message, "Á", vbTextCompare) >= 1 Then
MsgBox "Found Á"e
end if
And to BaDDBLooD,
If InStr(1, Message, "Á", vbTextCompare) = 1 Then.
InStr returns the first instance of the "search string" (Á in this instance). That's why you do <> 0. InStr can return any number greater than 0, and less than or equal to Len(Message) -- depending on where in the string Á is.
yeah it still doesn't work
EDIT: Actually... the InStr function has NEVER worked for me... ;[
If InStr(1, Message, "Á", vbTextCompare) returns 0, then 'Message' doesn't contain that character...
And I just tryed testing the code I wrote, and there's more than 1 error. I'm fixing it right now -- I'll post when I finish.
Quote from: Eli_1 on May 04, 2004, 07:05 PM
If InStr(Message, "Á", vbTextCompare) >= 1 Then
MsgBox "Found Á"e
end if
That's not the syntax InStr takes.
It should be InStr(Start, S1, S2, Seach type).
Your doing InStr(S1, S2, Search type).
This should work:
InStr(1, Message, "Á", vbTextCompare) >= 1 Then
MsgBox "Found Á"e
end if
And to BaDDBLooD,
If InStr(1, Message, "Á", vbTextCompare) = 1 Then.
InStr returns the first instance of the "search string" (Á in this instance). That's why you do <> 0. InStr can return any number greater than 0, and less than or equal to Len(Message) -- depending on where in the string Á is.
Start is optional.
Edit> The search type is optional as well, I use alot of InStr("Haystack", "Needle") <> 0
if i didn't have start, it gave me a error :|
Ok, I got it fixed. If you copy and paste this in a new project, then it will run. If it doesn't run, you suck :X.
ASSUMES: You have a RichTextBox on the form named txtOutput
Code:
Private Sub Form_Load()
'// Put me somewhere :P
Const Message As String = "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁYI'm" & _
vbCrLf & "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁVA" & _
vbCrLf & "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁRLoser" & _
vbCrLf & "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁVWith" & _
vbCrLf & "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁYA" & _
vbCrLf & "ÁU%%%%%%%%%%%%%%%%%%%%%%%%%%%%ÁYFÁZLÁYoÁYoÁVD ÁUBÁVoÁRT!" _
& vbCrLf
'/* This example will Split this string. */
Dim ColorParse() As String
'/* MerF!? */
Dim ColorByte As String
'/* This is just to make the code a little
'** easier to read. */
If InStr(1, Message, "Á", vbTextCompare) <> 0 Then
ColorParse = Split(Message, "Á")
AddText txtOutput, vbYellow, "<FLooD_iZ_LaME> "
For i = 0 To UBound(ColorParse)
If ColorParse(i) <> "" Then
ColorByte = Left(ColorParse(i), 1)
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i)) - 1)
AddText txtOutput, GetColor(ColorByte), ColorParse(i)
End If
Next i
End If
End Sub
Private Function GetColor(ByVal ColorByte As String) As ColorConstants
Select Case ColorByte
Case "Y": GetColor = vbRed
Case "U": GetColor = vbCyan
Case "R": GetColor = vbYellow
Case "V": GetColor = vbGreen
Case "Z": GetColor = vbMagenta
End Select
End Function
Private Function AddText(OutputTO As RichTextBox, _
ByVal Color As ColorConstants, _
ByVal Data As String)
With OutputTO
.SelStart = Len(.Text)
.SelColor = Color
.SelText = Data
.SelStart = Len(.Text)
End With
End Function
Yo dude, try this for your Message Constant:
[7:51:12 PM] <sCaReD@Azeroth ÁQ.::.ÁRFÁPlawedÁQ-ÁRBÁPotÁQ.::. ÁR|ÁQ-v1.17c-ÁR| ÁQ---.ÁRBÁPyÁQ.ÁRFÁPleet-ÁQ>
doesn't work ;p
That happens for a reason.
Quote[7:51:12 PM] <sCaReD@Azeroth ÁQ.::.ÁRFÁPlawedÁQ-ÁRBÁPotÁQ.::. ÁR|ÁQ-v1.17c-ÁR| ÁQ---.ÁRBÁPyÁQ.ÁRFÁPleet-ÁQ>
will never be the 'Message'. Considering so many people use CSB, the UserEmote event is raised with these parameters (IIRC).
Username, Message
Quote
Username = sCaReD@Azeroth
Message = ÁQ.::.ÁRFÁPlawedÁQ-ÁRBÁPotÁQ.::. ÁR|ÁQ-v1.17c-ÁR| ÁQ---.ÁRBÁPyÁQ.ÁRFÁPleet-ÁQ
The timestamp is added seperatly on peoples bots. so are the emote tags (< >). Now, if you try that again using the Message stated above, then it will work -- some characters will appear blank though. That's because I didn't include all the color constants.
Edit:
I changed my GetColor() function to this:
Private Function GetColor(ByVal ColorByte As String) As ColorConstants
Select Case ColorByte
Case "Y": GetColor = vbRed
Case "U": GetColor = vbCyan
Case "R": GetColor = vbYellow
Case "V": GetColor = vbGreen
Case "Z": GetColor = vbMagenta
Case "Q": GetColor = vbMagenta
Case "P": GetColor = vbGreen
End Select
End FunctionI changed my Message constant to what's named above and ran the program. This is the output that was shown.
Quote
<FLooD_iZ_LaME> .::.Flawed-Bot.::. |-v1.17c-| ---.By.Fleet-
yes, i know it works. i'm just saying the username is something that you didn't handle :)
Quote from: BaDDBLooD on May 04, 2004, 08:00 PM
yes, i know it works. i'm just saying the username is something that you didn't handle :)
That's because it is something that should never come up in a real scenario. Username and Message are always seperate and my function assumes that.
Your right.
Thanks you for the Function, can you give me your info so i can Comment you at the top of the code?
ELi you can im me on aol at BaDD OwNs JoO
i still have some questions :|
baddblood didnt you say u were banned from these fourms?
hmm...this has nothing to do with helping, but when you have a single character constant shouldn't you put it in single parenthasis, or does it no matter in VB?
I don't if this is fixed but I only had one problem with this and it was that it would output the text in my RTB for each split part how can I get it to change the colors in sentence but keep the sentence intact? I don't want it to be like:
Networks
says
hi
When the original sentence is Networks says hi.
By the way I haven't tested the new code but I assuming it still does it the same way and I figured out how yours works.
Your the second person that asked about that. My example uses a very simple AddChat function. Post the AddChat function your using, that's probably your problem.
If the addtext function works okay then I'll just use that.
Quote from: Mephisto on May 05, 2004, 08:55 AM
hmm...this has nothing to do with helping, but when you have a single character constant shouldn't you put it in single parenthasis, or does it no matter in VB?
I'm assuming your asking that because you program in C++? No, it doesn't matter in VB. There is no such thing as single quotes -- that is reserved for comments.
Why do you want to add support for a bug? I just filter them out. ;D
Quote
"There are no such thing as bugs, only features" - don'tknowwho
I other words, it's pretty. And for a bot that has a primary purpose of chatting, that "feature" should be supported. The majority of the bot users on b.net use their bot for chatting, and they like talking in colors. Why deprive their little hearts the joy it causes them? ;)
[edit] Looking up "deprive" because it doesn't look right to me.
[edit] Nope it's right. :P
Quote from: Eli_1 on May 05, 2004, 02:41 PM
Quote from: Mephisto on May 05, 2004, 08:55 AM
hmm...this has nothing to do with helping, but when you have a single character constant shouldn't you put it in single parenthasis, or does it no matter in VB?
I'm assuming your asking that because you program in C++? No, it doesn't matter in VB. There is no such thing as single quotes -- that is reserved for comments.
Yes.
Would be pretty hard to copy the clients flaw correctly.
If you log on using a client, you'd notice that the color stops at the end of each line, so unless your chat box has the same dimensions as Starcraft's, replicating the bug correctly is pretty much impossible.
Example:
ÁY Test for multiple ÁR words?
Using you addtext function this causes it to still show it up in the rtb as shown:
Test for muliple
words
I was looking for it to be a whole entire sentence.
Quote from: Networks on May 05, 2004, 05:36 PM
Example:
ÁY Test for multiple ÁR words?
Using you addtext function this causes it to still show it up in the rtb as shown:
Test for muliple
words
I was looking for it to be a whole entire sentence.
Don't append Chr(10) || Chr(13) to the end of each line you add.
It'll addtext which makes it addtext the colorparse(i) which is at every split.
Quote from: Newby on May 05, 2004, 05:46 PM
Don't append Chr(10) || Chr(13) to the end of each line you add.
That's vbCrLf btw, networks. This is because most of the AddChat functions people use have it automaticly append vbCrLf to the text you pass to it.
Quote from: Eli_1 on May 05, 2004, 06:31 PM
Quote from: Newby on May 05, 2004, 05:46 PM
Don't append Chr(10) || Chr(13) to the end of each line you add.
That's vbCrLf btw, networks. This is because most of the AddChat functions people use have it automaticly append vbCrLf to the text you pass to it.
I am using the addtext function you posted. Am i still wrong. You might as well give me your AIM s/n if you have one. You seem to answer a majority of my questions. :p
Before we go to AIM, post how your calling the AddText function I posted. I think you might be doing something like:
AddText RTB, GetColor(qwerty), Parse(i) & VbCrlF
Quote from: hismajesty on May 05, 2004, 03:03 PM
Why do you want to add support for a bug? I just filter them out. ;D
haha, I was going to say that, too.
Private Function AddText(OutputTO As RichTextBox, _
ByVal Color As ColorConstants, _
ByVal Data As String)
With OutputTO
.SelStart = Len(.text)
.SelColor = Color
.SelText = Data
.SelStart = Len(.text)
End With
End Function
'Color Parsing
Dim ColorParse() As String
Dim ColorByte As String
Dim i As Integer
If InStr(1, Message, "Á", vbTextCompare) <> 0 Then
ColorParse = Split(Message, "Á")
For i = 0 To UBound(ColorParse)
If ColorParse(i) <> "" Then
ColorByte = Left(ColorParse(i), 1)
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i)) - 1)
AddText Form1.RTB1, GetColor(ColorByte), "[" & Time & "] < " & Username & "> " & ColorParse(i) & vbNewLine
End If
Next i
Exit Sub
End If
'End of color parsing
At least provide your s/n on battle.net? And server?
Quote from: Networks on May 05, 2004, 05:36 PM
Example:
ÁY Test for multiple ÁR words?
Using you addtext function this causes it to still show it up in the rtb as shown:
Test for muliple
words
I was looking for it to be a whole entire sentence.
Missing the point. Unless your chat box is the exact width of Starcrafts, the bot will have a possibility of seeing colors differently than it would on a Blizzard client.
AddText Form1.RTB1, GetColor(ColorByte), "[" & Time & "] < " & Username & "> " & ColorParse(i) & vbNewLine
is where your problem lies -- Chr(10) & Chr(13), vbCrLf, and vbNewLine are all exactly the same thing. Instead, try rewriting your function like this.
If InStr(1, Message, "Á", vbTextCompare) <> 0 Then
AddText Form1.RTB1, vbGreen, "[" & Time & "] < " & Username & "> "
ColorParse = Split(Message, "Á")
For i = 0 To UBound(ColorParse)
If ColorParse(i) <> "" Then
ColorByte = Left(ColorParse(i), 1)
ColorParse(i) = Right(ColorParse(i), Len(ColorParse(i)) - 1)
AddText Form1.RTB1, GetColor(ColorByte), ColorParse(i)
End If
Next i
AddText Form1.RTB1, vbBlack, vbCrLf '// go to next line
Exit Sub
End If
Why not just parse the damn thing and rather than using AddChat, make a modified function such as AddC that doesn't append a NewLine to it. Then when you're done parsing colors, append a NewLine.
You don't need to *replicate* the UTF-8 bug as it is shown in the Blizzard clients -- I suspect that if color lives longer than to the end of the line, people will be happier.
Quote from: Myndfyre on May 05, 2004, 09:18 PM
Why not just parse the damn thing and rather than using AddChat, make a modified function such as AddC that doesn't append a NewLine to it. Then when you're done parsing colors, append a NewLine.
That's what the AddText function I posted is. :D
Quote from: Myndfyre on May 05, 2004, 09:18 PM
You don't need to *replicate* the UTF-8 bug as it is shown in the Blizzard clients -- I suspect that if color lives longer than to the end of the line, people will be happier.
Amen.
Can someone please give me an example on how you can "Filter" the colors out?
Quote from: Kk)Blaze(kK on May 07, 2004, 09:19 PM
Can someone please give me an example on how you can "Filter" the colors out?
If InStr(Message, "Á") <> 0 Then Exit Sub
LoRd, wouldn't that filter out the entire line? Not just the color codes? I think he wants to filter out _just_ the colors in which case he should use replace them with null strings. I helped him on aim.
Quote from: hismajesty on May 07, 2004, 09:46 PM
LoRd, wouldn't that filter out the entire line? Not just the color codes? I think he wants to filter out _just_ the colors in which case he should use replace them with null strings. I helped him on aim.
Remove each Á and the corresponding letter after it? o_O
Thank you again...
Quote from: hismajesty on May 07, 2004, 09:46 PM
LoRd, wouldn't that filter out the entire line? Not just the color codes? I think he wants to filter out _just_ the colors in which case he should use replace them with null strings. I helped him on aim.
Usally, messages containing color codes contain nothing more than pointless spam.
Quote from: LoRd[nK] on May 07, 2004, 11:24 PM
Quote from: hismajesty on May 07, 2004, 09:46 PM
LoRd, wouldn't that filter out the entire line? Not just the color codes? I think he wants to filter out _just_ the colors in which case he should use replace them with null strings. I helped him on aim.
Usally, messages containing color codes contain nothing more than pointless spam.
I'd have to agree there.
Quote from: LoRd[nK] on May 07, 2004, 11:24 PM
Quote from: hismajesty on May 07, 2004, 09:46 PM
LoRd, wouldn't that filter out the entire line? Not just the color codes? I think he wants to filter out _just_ the colors in which case he should use replace them with null strings. I helped him on aim.
Usally, messages containing color codes contain nothing more than pointless spam.
So you're going on a 'usually,' it may be just me but I'd rather only filter the color codes instead of the entire line just in case something isn't pointless.
Make everyone happy and leave color options in your bot settings. :P
Color settings:
(0)Show colors.
( )Remove color codes from messages.
( )Do not show messages containing colors.
That is a good idea eli!
Quote from: LoRd[nK] on May 07, 2004, 09:30 PM
Quote from: Kk)Blaze(kK on May 07, 2004, 09:19 PM
Can someone please give me an example on how you can "Filter" the colors out?
If InStr(Message, "Á") <> 0 Then Exit Sub
I don't think that will get all messages. There are other redundant encodings besides that...
Quote from: Blaze on May 07, 2004, 09:19 PM
Can someone please give me an example on how you can "Filter" the colors out?
Public Function RidColors(ByVal message As String) As String
Dim i As Integer, check() As String, fill As String
fill = "ÁQ, ÁY, ÁZ, ÁV, ÁR, ÁT, ÁS, ÁW, ÁD, ÁG, ÁU"
check() = Split(fill, ", ")
For i = 0 To UBound(check())
message = Replace(message, check(i), vbNullString)
Next i
RidColors = message
End FunctionEdit: In your events that you want to filter out messages call it like so:
RidColors(message)
Just curious but when sending: ÁQ Hi Hello
Should it be coloring just "hi" or the whole sentence?
Quote from: Networks on May 10, 2004, 08:58 AM
Just curious but when sending: ÁQ Hi Hello
Should it be coloring just "hi" or the whole sentence?
The whole line providing that you don't have another color code somewhere else on that same line.
Quote from: Networks on May 10, 2004, 08:58 AM
Just curious but when sending: ÁQ Hi Hello
Should it be coloring just "hi" or the whole sentence?
My point about not having to "replicate" exactly the bug is that people are trying for a certain behavior here. I would implement it so that the color went for the whole line, until the next color definition.
Feature! It's a feature damnit!
Not to mention a very sexy feature
Edit: I went ahead and added this feature to my bot even, because it's just that sexy.
Well I guess it's not so much of a bug anymore if bnet to patch it.
This feature shall live on... Regardless...
Nice avatar, dickless. Angelfire doesn't allow off-site linking.
At any rate, I figured I'd post a C++ version for you who aren't stuck in the dredges of VB:
char *pPtr = strtok(szTxtToAppend, "Á");
while(pPtr != NULL){
switch(pPtr[0]){
case 'Y':
AppendText(RED, pPtr + 1);
break;
case 'U':
AppendText(CYAN, pPtr + 1);
break;
case 'R':
AppendText(YELLOW, pPtr + 1);
break;
case 'V':
AppendText(GREEN, pPtr + 1);
break;
case 'Z':
AppendText(PURPLE, pPtr + 1);
break;
default:
AppendText(Color, pPtr);
break;
}
pPtr = strtok(NULL, "Á");
}
I've heard that SC/BW messages are encoded using Unicode, but I've never had to do anything special for it. I wrote my own little function to handle this and when I tried running it with fooÁUbar to test, instead my bot showed fooÃ?Ubar, with that little square between the à and ?U that is shown for unrecognised characters. Taking a hex dump of the message (66 6F 6F C3 81 55 62 61 72) suggests that 2 bytes are being sent to represent the accented A. Is this, in fact, wide-character encoding, and if so how can I convert it?
I believe that happens when you in the actual starcraft client, not on some bot. I guess it just doesn't work when your on the game and sending messages in unicode. You might want to just hit Clan Recruitment and test it =p.
Just ran a test, and here's what letters produce what colors:
ÁA-ÁO: (no effect)
ÁQ: gray
ÁR: green
ÁS, ÁX, ÁZ: yellow
ÁT, ÁU, ÁV: blue
ÁP, ÁW: white
ÁY: red
And here's the VB function I use to translate the color codes into actual colors. It also supports a default color that you can pass if the color code is not recognised.Private Function SCColorToVBColor(ColorCode As String, Optional ByVal Default& = vbWhite) As Long
Select Case ColorCode
Case "Y": SCColorToVBColor = vbRed
Case "U", "T", "V": SCColorToVBColor = vbCyan
Case "S", "X", "Z": SCColorToVBColor = vbYellow
Case "R": SCColorToVBColor = vbGreen
Case "P", "W": SCColorToVBColor = vbWhite
Case "Q": SCColorToVBColor = &H808080
Case Else: SCColorToVBColor = Default
End Select
End Function
Can you post your addchat that you use with that or show me and example on how to use it?
btw, shouldn't your function include the A character?
Lol come on man, code for all of this has already been posted. All he posted was the GetColor function, which was already posted, with the correct colors.
Here (http://forum.valhallalegends.com/phpbbs/index.php?board=17;action=display;threadid=6652;start=15) -- it's the second post down, by me.
Quote from: shadypalm88 on May 11, 2004, 09:48 PM
I've heard that SC/BW messages are encoded using Unicode, but I've never had to do anything special for it. I wrote my own little function to handle this and when I tried running it with fooÁUbar to test, instead my bot showed fooÃ?Ubar, with that little square between the à and ?U that is shown for unrecognised characters. Taking a hex dump of the message (66 6F 6F C3 81 55 62 61 72) suggests that 2 bytes are being sent to represent the accented A. Is this, in fact, wide-character encoding, and if so how can I convert it?
Look for information about UTF-8. Blizzard uses a (broken) UTF-8 encoding implementation that allows redundant encodings.
There are many redundant encodings for those characters, not just the most commonly seen one.
Be careful about implementing this bug, because there are lots of things you probably don't want appearing in the middle of your text (e.g. nulls, newlines, and so on).
Well, someone did ask for it, so here's my AddChat function that supports SC colors. It works differently than others posted here since it does not use Split(), which seemed to me like it wouldn't work properly if the message didn't start with a color. This sub also handles non-colored messages just fine.
The arguments it takes:
sText: Any text you want placed before the message. You can use this to show the person's username.
sColor: The color to be applied to sText.
Message: The message that someone on B.net sent that you would like to display.
mColor: The default color to apply to Message.
eText: Optional text to tack on to the end of the message. Uses the same color as the starting text.
And here it is:Public Sub AddC_SCColors(sText As String, sColor As Long, ByVal Message As String, _
mColor As ColorConstants, Optional eText As String = "")
'-----------------------------------------------------'
' From Myriad 1.0 Private Alpha '
' By Cloaked '
'-----------------------------------------------------'
Dim i&, L&, CC As Long, ct As String, cChar As String
'Do some initializing.
i = 1
L = Len(Message)
ct = ""
CC = mColor
With frmMain.rtbChannel
'Timestamp
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = vbWhite
.SelText = "[" & Format(Time, "h:mm:ss AM/PM") & "] "
'Starting text
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = sColor
.SelText = sText
End With
'Main message loop
While i <= L
cChar = Mid$(Message, i, 1)
If cChar = "Á" Then
'Color detection
With frmMain.rtbChannel
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = CC
.SelText = ct
End With
ct = ""
i = i + 1
CC = SCColorToVBColor(Mid$(Message, i, 1), sColor)
ElseIf Mid$(Message, i, 2) = "Ã?" Then
'Crude support for the accented A represented in UTF-8 (?)
With frmMain.rtbChannel
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = CC
.SelText = ct
End With
ct = ""
i = i + 2
CC = SCColorToVBColor(Mid$(Message, i, 1), sColor)
Else
ct = ct & cChar
End If
i = i + 1
Wend
With frmMain.rtbChannel
'Flush what's left in the message buffer
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = CC
.SelText = ct
'Add newline characters
If Len(eText) = 0 Then
eText = vbCrLf
Else
eText = eText & vbCrLf
End If
'Add ending text
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = sColor
.SelText = eText
End With
End Sub
Your AddChat function is unneccesarily bloated. You can accomplish the same functionality with
Public Sub AddChat(ParamArray saElements() As Variant)
Dim strTimeStamp As String, As Boolean, Data As String
If BotData.GUI.Timestamp = True Then
strTimeStamp = "[" & Format$(Time, "hh:mm:ss") & "] "
End If
Dim i As Integer
For i = LBound(saElements) To UBound(saElements) Step 2
With frmMain.rtbChat
.SelFontName = GUI.FontName
.SelFontSize = GUI.FontSize
.SelStart = Len(.Text)
.SelLength = 0
.SelColor = saElements(i)
.SelText = saElements(i + 1) & Left$(vbCrLf, -2 * CLng((i + 1) = UBound(saElements)))
.SelStart = Len(.Text)
Data = Data & saElements(i + 1)
End With
Next i
End Sub
You call it like so
AddChat Color, Text, Color, Text, _
Easy to implement with that SC to VB color function.
Updated for you sane C++ users
char *pPtr = strtok(szTxtToAppend, "Á");
while(pPtr != NULL){
switch(pPtr[0]){
case 'Q':
AppendText(GRAY, pPtr + 1);
break;
case 'R':
AppendText(GREEN, pPtr + 1);
break;
case 'S':
case 'X':
case 'Z':
AppendText(YELLOW, pPtr + 1);
break;
case 'T':
case 'U':
case 'V':
AppendText(LIGHTBLUE, pPtr + 1);
break;
case 'P':
case 'W':
AppendText(WHITE, pPtr + 1);
break;
case 'Y':
AppendText(GRAY, pPtr + 1);
break;
default:
AppendText(Color, pPtr);
break;
}
pPtr = strtok(NULL, "Á");
}
Quote from: DarkMinion on May 13, 2004, 03:42 PM
Updated for you sane C++ users
char *pPtr = strtok(szTxtToAppend, "Á");
while(pPtr != NULL){
switch(pPtr[0]){
case 'Q':
AppendText(GRAY, pPtr + 1);
break;
case 'R':
AppendText(GREEN, pPtr + 1);
break;
case 'S':
case 'X':
case 'Z':
AppendText(YELLOW, pPtr + 1);
break;
case 'T':
case 'U':
case 'V':
AppendText(LIGHTBLUE, pPtr + 1);
break;
case 'P':
case 'W':
AppendText(WHITE, pPtr + 1);
break;
case 'Y':
AppendText(GRAY, pPtr + 1);
break;
default:
AppendText(Color, pPtr);
break;
}
pPtr = strtok(NULL, "Á");
}
How about updated with complete UTF-8 processing? :p
I'm lazy ???