colors

Camel · February 25, 2003, 05:44 PM

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!?

warz · February 25, 2003, 05:52 PM

what would be the use? i mean, if there's an actual meaning to supporting colors in that manner, by all means share..

haZe · February 26, 2003, 01:09 AM

are they sexy?

maybe but not as dead sexy as me!

well anyways, yes, by all means share it

Banana fanna fo fanna · February 26, 2003, 10:54 AM

How about you use a subset of HTML?

Code Select

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

Mesiah / haiseM · February 26, 2003, 12:01 PM

wow thats insanely large, but a very good idea, i never even thought of doing that lol

Camel · February 26, 2003, 01:13 PM

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

Banana fanna fo fanna · February 26, 2003, 04:13 PM

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



Stuff like that.

Mesiah / haiseM · February 26, 2003, 04:19 PM

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.

Banana fanna fo fanna · February 26, 2003, 04:47 PM

Don't forget that your HTML check *can* fail, and the IE control is really really heavyweight.

iago · February 26, 2003, 04:54 PM

Just use warcraft III colors, "|cxxRRGGBB" or something like that..

Camel · February 26, 2003, 06:50 PM

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



Stuff like that.

ever heard of a DTD? you can disable all of that crap

Skywing · February 26, 2003, 06:58 PM

How about support for Unicode chat? Perhaps Base64 encoded...

Mesiah / haiseM · February 27, 2003, 11:27 AM

thats a nice concept, id be up for makin some source for that, give some ideas

Banana fanna fo fanna · February 27, 2003, 12:40 PM

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 ;)

Camel · February 27, 2003, 02:21 PM

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

colors

Camel

warz

haZe

Camel

Camel

Camel