Valhalla Legends Forums Archive | Battle.net Bot Development | colors

AuthorMessageTime
Camel
i recently added d2 style color support to my bot when i had an idea: a standard for sending colors in rgb format. i dont know if this has been done before, so someone interrupt me (yeah, right) if it has.

i'm thinkin' of stealing the <0xFF>C idea, but using <0xFF>D or sumthing, followed by a 6 char hexdump of the rgb value of the text color
the code i'm using for ˙Cx would be easily modified to suit ˙Dxxxxxx.

opinions!?
February 25, 2003, 11:44 PM
warz
what would be the use? i mean, if there's an actual meaning to supporting colors in that manner, by all means share..
February 25, 2003, 11:52 PM
haZe
are they sexy? :P
maybe but not as dead sexy as me! ::)
well anyways, yes, by all means share it
February 26, 2003, 7:09 AM
St0rm.iD
How about you use a subset of HTML?
[code]
Option Explicit

Private Type KeyValue
   key As String
   Value As String
End Type

Public Sub ParseHTML(rtb As RichTextBox, html As String, tmp As RichTextBox, tmppic As PictureBox)
   Dim i As Long
   Dim intag As Boolean
   Dim tag As String
   Dim inbetween As Boolean
   Dim between As String
   Dim firsttag As String
   
   For i = 1 To Len(html)
       If Mid(html, i, 1) = "<" Then inbetween = False
       If Not inbetween Then
           If intag = True Then
               tag = tag & Mid(html, i, 1)
               If Mid(html, i, 1) = ">" Then
                   intag = False
                   If Mid(tag, 2, 1) <> "/" And Right(tag, 1) = ">" Then
                       'this isnt an ending tag, so we're in between tags
                       inbetween = True
                       firsttag = tag
                       between = ""
                       If Not ExecuteTagCommand(rtb, tag, between, tmp, tmppic) Then
                           If rtb.SelColor <> vbWhite Then rtb.SelColor = vbWhite
                           rtb.SelText = tag & between
                           rtb.SelStart = Len(rtb.Text)
                       End If
                       If LCase(Left(tag, 4)) = "<img" Then
                           inbetween = False
                           ExecuteTagCommand rtb, tag, between, tmp, tmppic
                       End If
                   ElseIf Mid(tag, 2, 1) = "/" And Right(tag, 1) = ">" Then
                       'this is an ending tag, we're not in between anymore
                       inbetween = False
                       ExecuteTagCommand rtb, firsttag, between, tmp, tmppic
                       tag = ""
                       between = ""
                   End If
               End If
           Else
               If Mid(html, i, 1) = "<" Then
                   intag = True
                   tag = Mid(html, i, 1)
               End If
           End If
       Else
           'between two tags
           between = between & Mid(html, i, 1)
       End If
       
       If Not inbetween And Not intag And Mid(html, i, 1) <> ">" Then
           'rtb.Text = rtb.Text & Mid(html, i, 1)
           ExecuteTagCommand rtb, "*", Mid(html, i, 1), tmp, tmppic
       End If
   Next i
   If inbetween Then
       ExecuteTagCommand rtb, "*", between, tmp, tmppic
   ElseIf intag Then
       ExecuteTagCommand rtb, "*", tag, tmp, tmppic
   End If
End Sub

Private Function ExecuteTagCommand(rtb As RichTextBox, tag As String, between As String, tmp As RichTextBox, tmppic As PictureBox) As Boolean
   'executes what a tag says
   Dim oldsize As Long
   Dim tagproc As Boolean
   
   tagproc = True
   
   oldsize = tmp.SelFontSize
   tmp.Text = ""
   tag = LCase(tag)
   
   'these are the simple tags
   'ones that don't require paramaters
   If tag = "<strong>" Then tag = "<b>"
   If tag = "<emphasis>" Then tag = "<i>"
   
   If Left(tag, 2) = "<h" And Len(tag) = 4 Then
       'header tag
       tmp.Text = between
       tmp.SelStart = 0
       tmp.SelLength = Len(between)
       tmp.SelFontSize = tmp.SelFontSize + ((tmp.SelFontSize \ 4) * (8 - Val("0" & Mid(tag, 3, 1))))
       rtb.SelStart = Len(rtb.Text)
       rtb.SelLength = 0
       rtb.SelRTF = tmp.TextRTF
   End If
   
   Select Case tag
       Case "<b>"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           tmp.SelBold = True
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case "<i>"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           tmp.SelItalic = True
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case "<u>"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           tmp.SelUnderline = True
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case "<small>"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           tmp.SelFontSize = (oldsize \ 4) * 3 '3/4's original font size
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case "<big>"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           tmp.SelFontSize = (oldsize \ 4) * 6 '6/4's original font size
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case "*"
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case Else
           tagproc = False
   End Select
   
   If Not tagproc And InStr(tag, " ") <> 0 Then
       'tag has params
       'these types of tags include <font>
       Dim varstr As String
       varstr = Mid(tag, InStr(tag, " ") + 1, Len(tag) - (InStr(tag, " ") + 1))
       
       tagproc = ParseAdvancedTag(rtb, tag, varstr, between, tmp, tmppic)
   End If
       
   rtb.SelStart = Len(rtb.Text)
   tmp.SelBold = False
   tmp.SelItalic = False
   tmp.SelUnderline = False
   tmp.SelFontSize = oldsize
   ExecuteTagCommand = tagproc
End Function

Private Function ParseAdvancedTag(rtb As RichTextBox, tag As String, varstr As String, between As String, tmp As RichTextBox, tmppic As PictureBox) As Boolean
   On Error Resume Next
   'this parses tags with paramaters
   Dim params() As KeyValue
   'stuff the keyvalue pairs into an array
   Dim vars As Variant
   Dim i As Long
   
   If InStr(varstr, " ") <> 0 Then
       vars = Split(varstr, " ")
   Else
       ReDim vars(0)
       vars(0) = varstr
   End If
   ReDim params(UBound(vars))
   
   For i = LBound(vars) To UBound(vars)
       params(i).key = Trim(Left(vars(i), InStr(vars(i), "=") - 1))
       params(i).Value = Trim(Right(vars(i), Len(vars(i)) - InStr(vars(i), "=")))
       If Left(params(i).Value, 1) = Chr(34) Then
           params(i).Value = Mid(params(i).Value, 2, Len(params(i).Value) - 2)
       End If
   Next i
   Select Case Left(tag, InStr(tag, " ") - 1)
       Case "<font"
           Dim oldcolor As Long, oldfont As String, oldsize As Long
           oldcolor = tmp.SelColor
           oldfont = tmp.SelFontName
           oldsize = tmp.SelFontSize
           tmp.Text = between
           tmp.SelStart = 0
           tmp.SelLength = Len(between)
           For i = LBound(params) To UBound(params)
               If params(i).key = "color" Then
                   If Len(params(i).Value) <= 6 And Val("&h" & params(i).Value) <= &HFFFFFF Then
                       tmp.SelColor = Val("&h" & params(i).Value)
                   End If
               ElseIf params(i).key = "face" Then
                   tmp.SelFontName = params(i).Value
               ElseIf params(i).key = "size" Then
                   If Len(params(i).Value) <= 2 And Val("0" & params(i).Value) <= 28 Then
                       tmp.SelFontSize = Val("0" & params(i).Value)
                   End If
               End If
           Next i
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
           tmp.SelColor = oldcolor
           tmp.SelFontName = oldfont
           tmp.SelFontSize = oldsize
       Case "<img"
           Dim file As String
           Dim i2 As Long
           Dim oldclip As String
           
           For i2 = LBound(params) To UBound(params)
               If params(i2).key = "src" Then
                   file = params(i2).Value
                   Exit For
               End If
           Next i2
           If InStr(LCase(file), "con") Or InStr(LCase(file), "apn") Or InStr(LCase(file), "nul") Or InStr(LCase(file), "prn") Or InStr(LCase(file), "aux") Or InStr(LCase(file), "config$") Or InStr(LCase(file), "clock$") Or InStr(LCase(file), "com1") Or InStr(LCase(file), "com2") Or InStr(LCase(file), "com3") Or InStr(LCase(file), "lpt1") Or InStr(LCase(file), "lpt2") Or InStr(LCase(file), "lpt3") Then file = ""
           oldclip = Clipboard.GetText
           
           Clipboard.Clear
           DownloadFile file, "C:\" & Right(file, Len(file) - InStrRev(file, "/"))
           tmppic.Picture = LoadPicture("C:\" & Right(file, Len(file) - InStrRev(file, "/")))
           Clipboard.SetData tmppic.Picture
           SendMessage tmp.hWnd, &H302, 0, 0
           Kill "C:\" & Right(file, Len(file) - InStrRev(file, "/"))
           Clipboard.SetText oldclip
           rtb.SelStart = Len(rtb.Text)
           rtb.SelLength = 0
           rtb.SelRTF = tmp.TextRTF
       Case Else
           ParseAdvancedTag = False
           Exit Function
   End Select
   ParseAdvancedTag = True
End Function

[/code]
February 26, 2003, 4:54 PM
MesiaH
wow thats insanely large, but a very good idea, i never even thought of doing that lol
February 26, 2003, 6:01 PM
Camel
[quote]How about you use a subset of HTML?[/quote]
interesting
wouldn't it be simpler to use an IE or something control to display all chat? then you couldnt need to parse anything...
i dunno tho heh, i've never tried using one of those as a text box :P
February 26, 2003, 7:13 PM
St0rm.iD
Nah that'd suck, simply because people would do shit like:

<script language="javascript">
while (1) { alert("haha you suck.") }
</script>

Or they'd comment out some of the chat

<!-- yeah i totally agree he is homosexual -->

Stuff like that.
February 26, 2003, 10:13 PM
MesiaH
yes but if you use an HTML control, you have to input data into the DocumentSource string, which would allow you to edit everything before you put it in, so you could filter out unwanted tags.
February 26, 2003, 10:19 PM
St0rm.iD
Don't forget that your HTML check *can* fail, and the IE control is really really heavyweight.
February 26, 2003, 10:47 PM
iago
Just use warcraft III colors, "|cxxRRGGBB" or something like that..
February 26, 2003, 10:54 PM
Camel
[quote]Nah that'd suck, simply because people would do shit like:

<script language="javascript">
while (1) { alert("haha you suck.") }
</script>

Or they'd comment out some of the chat

<!-- yeah i totally agree he is homosexual -->

Stuff like that.[/quote]

ever heard of a DTD? you can disable all of that crap
February 27, 2003, 12:50 AM
Skywing
How about support for Unicode chat?  Perhaps Base64 encoded...
February 27, 2003, 12:58 AM
MesiaH
thats a nice concept, id be up for makin some source for that, give some ideas
February 27, 2003, 5:27 PM
St0rm.iD
[quote]

ever heard of a DTD? you can disable all of that crap[/quote]


Yeah, but you can't deny using a full-fledged web browser for the chat window is heavyweight and overkill ;)
February 27, 2003, 6:40 PM
Camel
[quote]Yeah, but you can't deny using a full-fledged web browser for the chat window is heavyweight and overkill ;)[/quote]
if you can't see the code, it doesnt exist.  ;D
February 27, 2003, 8:21 PM
n00blar
(If your wondering why he made this topic) I would assume he wants it to be something that is "universally implemented" in all bots so everybot will translate chat to certain colors.
February 27, 2003, 8:27 PM

Search