Const KeyColor = "#0021E6"
Const REMColor = "#008000"
Dim oWindow,oDocument,oSelect,oSelectRange,key,grep
Set oWindow = window.external.menuArguments
Set oSource = oWindow.event.srcElement
Set oDocument = oWindow.document
Set oSelect = oDocument.selection
Set oSelectRange = oSelect.createRange()
'KeyWords, Add more keywords if You Want !
KeyWords="Access,Alias,And,Append,As,Binary,Boolean,ByRef,Byte,ByVal,Circle,Close,Const,Cu rrency,Date,Decimal,Declare,Dim,Do,Double,Each,Else,ElseIf,Empty,End,Enum,Erase, Error,Event,Exit,False,For,Function,Get,Global,GoTo,If,In,Input,Integer,Let,Lib, Line,Lock,Long,Loop,Mod,New,Next,Not,Null,Object,On,Open,Or,Output,Preserve,Priv ate,Property,Public,ReDim,Resume,Set,Shared,Single,String,Sub,Then,To,True,Type, Until,Variant,Wend,While,WithEvents,Write,Xor"
key = Split(KeyWords, ",")
Set grep = New regexp
If oSource.tagName = "TEXTAREA" Then
oSelectRange.text = "[code]" & GetColoredCode(oSelectRange.text) & "[ /code]"
End If
Function GetColoredCode(Stxt)
Dim i,j,Data,RepData,lineArray,QtArray,Matches
Data = " " & Stxt & " "
grep.Global = True
grep.IgnoreCase = True
For i = 0 To UBound(key)
grep.Pattern = "[\s(, ]" & key(i) & "[\s), ]"
Set Matches = grep.Execute(Data)
For Each Mch In Matches
RepData = Left(Mch.Value, 1) & "" & key(i) & "" & Right(Mch.Value, 1)
Data = Replace(Data, Mch.Value, RepData, 1, 1, vbTextCompare)
Next
Next
Data = Mid(Data, 2, Len(Data) - 2)
lineArray = Split(Data, vbCrLf)
For i = 0 To UBound(lineArray)
QtArray = Split(lineArray(i), Chr(34))
For j = 0 To UBound(QtArray)
Apop = InStr(1, QtArray(j), "'")
If ((j Mod 2 = 0) Or (j = UBound(QtArray))) And Apop > 0 Then
QtArray = CommentFrom(QtArray, j, Apop)
Exit For
ElseIf (j Mod 2 <> 0) Then
QtArray(j) = StripTags(QtArray(j))
End If
Next
lineArray(i) = Join(QtArray, Chr(34))
Next
Data = Join(lineArray, vbCrLf)
Data = Replace(Data, "", "")
Data = Replace(Data, "", "")
Data = Replace(Data, "", "")
Data = Replace(Data, "", "")
GetColoredCode = Data
End Function
Function CommentFrom(srcArray,ByVal idx,ByVal pos)
Dim i,hd
If pos = 1 Then
hd = ""
Else
hd = Left(srcArray(idx), pos - 1)
End If
srcArray(idx) = hd & "" & StripTags(Mid(srcArray(idx), pos))
If idx < UBound(srcArray) Then
For i = idx + 1 To UBound(srcArray)
srcArray(i) = StripTags(srcArray(i))
Next
End If
srcArray(UBound(srcArray)) = srcArray(UBound(srcArray)) & ""
CommentFrom = srcArray
End Function
Function StripTags(ByVal Strin)
StripTags = Strin
grep.Pattern = "\[/?CLR\]"
If grep.Test(Strin) Then
StripTags = grep.Replace(Strin, "")
End If
End Function
</SCRIPT>
i think you know what it does,, any way it used to color the words so it looks like a visual basic code,, just like [ php ] tag..
now i wsant to use this in my forums,, how and where should i add this??
thanx
i dont exactly understand what you want to do but u can use javascript just like u would use it in html
I took a look at your code. Correct me if I'm wrong, this code searchs for things between the tag code in brackets right? If so you would only have to put it in your showthread template.
Be aware that since your using Client Side vbScript and not Javascript that as far as I know your code will only work in Internet Explorer.