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!?
what would be the use? i mean, if there's an actual meaning to supporting colors in that manner, by all means share..
are they sexy? :P
maybe but not as dead sexy as me! ::)
well anyways, yes, by all means share it
How about you use a subset of HTML?
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
wow thats insanely large, but a very good idea, i never even thought of doing that lol
QuoteHow about you use a subset of HTML?
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
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.
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.
Don't forget that your HTML check *can* fail, and the IE control is really really heavyweight.
Just use warcraft III colors, "|cxxRRGGBB" or something like that..
QuoteNah 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.
ever heard of a DTD? you can disable all of that crap
How about support for Unicode chat? Perhaps Base64 encoded...
thats a nice concept, id be up for makin some source for that, give some ideas
Quoteever heard of a DTD? you can disable all of that crap
Yeah, but you can't deny using a full-fledged web browser for the chat window is heavyweight and overkill ;)
QuoteYeah, but you can't deny using a full-fledged web browser for the chat window is heavyweight and overkill ;)
if you can't see the code, it doesnt exist. ;D
(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.