ErrOr
11-26-2001, 06:37 PM
hello
i have this java script:
<SCRIPT LANGUAGE = "VBScript">
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,By te,ByVal,Circle,Close,Const,Currency,Date,Decimal, Declare,Dim,Do,Double,Each,Else,ElseIf,Empty,End,E num,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,Private,Property,Public,ReDim,Resu me,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 have this java script:
<SCRIPT LANGUAGE = "VBScript">
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,By te,ByVal,Circle,Close,Const,Currency,Date,Decimal, Declare,Dim,Do,Double,Each,Else,ElseIf,Empty,End,E num,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,Private,Property,Public,ReDim,Resu me,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