Visual Basic koodin avainsanojen väritys HTML:ksi.
Saat www sivulle kelpaavaa koodia.
Esimerkkiprojektissa on textbox1 jossa multiline ja vertical scrollbar päällä. Button1 tekee koodivärityksen ja button2 kopioi leikepöydälle.
Koodissa on pakko olla HTMLää mukana, toivottavasti Laaksosen sydeemi ei mene sekaisin.
Itse funktio
'
Public Function ColorVBtoHTML(ByVal vb As String) As String
'**************************************************************
'* Function ColorVBtoHTML (ByVal vb As String) As String *
'* *
'* Muuttaa Visual Basic tekstin väritetyksi HTML koodiksi *
'* tnb 10/2004 vb.net 2003 *
'* Versio 1.0 *
'* Huom! ei toimi, jos Basic koodin seassa on HTML koodia *
'* Käyttö esim.: TextBox1.Text = ColorVBtoHTML(TextBox1.Text)*
'**************************************************************
'avainasanat jotka värjätään
Dim strBlueKeyWords As String = "#Const*#Else*#ElseIf*#End If*#If*#Region*#End Region*Alias*And*As*Base*Binary*Boolean*Byte*ByVal*Call*Case*CBool*CByte*CCur*CDate*CDbl*CDec*CInt*CLng*Close*Compare*Const*CSng*CStr*Currency*CVar*CVErr*Decimal*Declare*DefBool*DefByte*DefCur*DefDate*DefDbl*DefDec*DefInt*DefLng*DefObj*DefSng*DefStr*DefVar*Dim*Do*Double" & _
"*Each*Else*ElseIf*End*Enum*Eqv*Erase*Error*Exit*Explicit*False*For*Function*Get*Global*GoSub*GoTo*If*Imp*In*Input*Input*Integer*Is*LBound*Let*Lib*Like*Line*Lock*Long*Loop*LSet*Name*New*Next*Not*Object*On*Open*Option*Or*Output*Print*Private*Property*Public*Put*Random*Read*ReDim*Resume*Return*RSet*Seek*Select*Set*Single*Spc*Static*String" & _
"*Stop*Sub*Tab*Then*Then*True*Type*UBound*Unlock*Variant*Wend*While*With*Xor*Nothing*To*Abs*Add*AddItem*AppActivate*Array*Asc*Atn*Beep*Begin*BeginProperty*ChDir*ChDrive*Choose*Chr*Clear*Collection*Command*Cos*CreateObject*CurDir*DateAdd*DateDiff*DatePart*DateSerial*DateValue*Day*DDB*DeleteSetting*Dir*DoEvents*EndProperty*Environ*EOF*Err" & _
"*Exp*FileAttr*FileCopy*FileDateTime*FileLen*Fix*Format*FV*GetAllSettings*GetAttr*GetObject*GetSetting*Hex*Hide*Hour*InputBox*InStr*Int*Int*IPmt*IRR*IsArray*IsDate*IsEmpty*IsError*IsMissing*IsNull*IsNumeric*IsObject*Item*Kill*LCase*Left*Len*Load*Loc*LOF*Log*LTrim*Me*Mid*Minute*MIRR*MkDir*Month*Now*NPer*NPV*Oct*Pmt*PPmt*PV*QBColor*Raise" & _
"*Randomize*Rate*Remove*RemoveItem*Reset*RGB*Right*RmDir*Rnd*RTrim*SaveSetting*Second*SendKeys*SetAttr*Sgn*Shell*Sin*Sin*SLN*Space*Sqr*Str*StrComp*StrConv*Switch*SYD*Tan*Text*Time*Time*Timer*TimeSerial*TimeValue*Trim*TypeName*UCase*Unload*Val*VarType*WeekDay*Width*Year*Class*Ctype*Friend*Protected*Overloads*Overrides*Inherits*Imports*Implements"
Dim i, j, k, n, m As Integer
Dim sp As Char = Chr(1)
Dim Words() As String = Split(strBlueKeyWords, "*") ' splitataan avainsanat taulukkoon
Dim kk As Integer = Words.GetUpperBound(0)
Dim str2 As String = vb
Dim str4, str5 As String
Dim str3() As String = Split(str2, vbNewLine)
Dim sb As System.Text.StringBuilder
For n = 0 To str3.GetUpperBound(0) 'käydään läpi rivi kerrallaan
'tehdään stringbuilder jossa käsitellään teksti
sb = New StringBuilder(str3(n) & vbNewLine) ' splitatessa pois jäänyt rivinvaihto takaisin
'avainsanat sinisellä, jos ei kommentissa
str4 = str3(n)
str4 = str4.TrimStart(" "c)
If str4.Length > 0 Then
If str4.Chars(0) <> "'" Then ' ei ole kommenttimerkkiä alussa
m = sb.ToString.IndexOf("'", 0) ' kommentti rivin päässä
If m < 0 Then m = sb.ToString.Length
For i = 0 To kk
'" " sana " "
sb.Replace(" " & Words(i) & " ", " " & "<font" & sp & "color=""blue"">" & Words(i) & "</font>" & " ", 0, m)
m = sb.ToString.IndexOf("'", 0) ' kommentti rivin päässä
If m < 0 Then m = sb.ToString.Length
' " " sana newline
sb.Replace(" " & Words(i) & vbNewLine, "<font" & sp & "color=""blue"">" & " " & Words(i) & vbNewLine & "</font>", 0, m)
' onko sana rivin alussa
If sb.ToString.Length >= Words(i).Length Then
Dim strTest As String = sb.ToString.Substring(0, Words(i).Length)
If strTest = Words(i) Then
sb.Replace(Words(i), "<font" & sp & "color=""blue"">" & " " & Words(i) & "</font>")
End If
End If
Next
End If
'välilyönnit
sb.Replace(" ", " ")
'väliaikainen merkki pois
sb.Replace(sp, " ")
'
'kommentit vihreällä
Dim str As String = sb.ToString
k = 0 : Dim tosi As Boolean = True
Do While tosi
j = str.IndexOf(";'", k) : If j < 0 Then Exit Do
i = str.IndexOf(vbNewLine, j) : If i < 0 Then Exit Do
str = str.Insert(i, "</font>")
k = j + 1
Loop
sb = New StringBuilder(str) ' teksti takaisin builderiin
sb.Replace(";'", ";<font color=""green"">'")
'
' rivinvaihdot
sb.Replace(vbNewLine, "<br>")
'tab
sb.Replace(vbTab, " ")
'kommentti ekalla rivillä
If sb.Chars(0) = "'" Then
i = str.IndexOf(vbNewLine, 0)
sb.Insert(i, "</FONT>")
sb.Insert(0, "<font color=""green"">")
End If
str5 = str5 & sb.ToString
End If 'tyhjä
Next n
'valmis työ
Return "<FONT FACE=""Courier New"" SIZE=""-1"" COLOR=""#000000"">" & str5 & "</FONT>"
End Functionkoko esimerkki projekti
'
Imports System.text
Public Class Form1
Inherits System.Windows.Forms.Form
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
End Sub
'Form overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
Friend WithEvents Button1 As System.Windows.Forms.Button
Friend WithEvents Button2 As System.Windows.Forms.Button
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.TextBox1 = New System.Windows.Forms.TextBox
Me.Button1 = New System.Windows.Forms.Button
Me.Button2 = New System.Windows.Forms.Button
Me.SuspendLayout()
'
'TextBox1
'
Me.TextBox1.Location = New System.Drawing.Point(24, 24)
Me.TextBox1.Multiline = True
Me.TextBox1.Name = "TextBox1"
Me.TextBox1.ScrollBars = System.Windows.Forms.ScrollBars.Both
Me.TextBox1.Size = New System.Drawing.Size(472, 208)
Me.TextBox1.TabIndex = 0
Me.TextBox1.Text = "Paste text here, Color It, and copy paste where you need it."
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(24, 240)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(80, 32)
Me.Button1.TabIndex = 1
Me.Button1.Text = "Color It"
'
'Button2
'
Me.Button2.Location = New System.Drawing.Point(128, 240)
Me.Button2.Name = "Button2"
Me.Button2.Size = New System.Drawing.Size(72, 32)
Me.Button2.TabIndex = 2
Me.Button2.Text = "Copy All"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(512, 278)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Button1)
Me.Controls.Add(Me.TextBox1)
Me.Name = "Form1"
Me.Text = "Color VB.NET Code"
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
TextBox1.Text = ColorVBtoHTML(TextBox1.Text)
End Sub
Public Function ColorVBtoHTML(ByVal vb As String) As String
'**************************************************************
'* Function ColorVBtoHTML (ByVal vb As String) As String *
'* *
'* Muuttaa Visual Basic tekstin väritetyksi HTML koodiksi *
'* tnb 10/2004 vb.net 2003 *
'* Versio 1.0 *
'* Huom! ei toimi, jos Basic koodin seassa on HTML koodia *
'* Käyttö esim.: TextBox1.Text = ColorVBtoHTML(TextBox1.Text)*
'**************************************************************
'avainasanat jotka värjätään
Dim strBlueKeyWords As String = "#Const*#Else*#ElseIf*#End If*#If*#Region*#End Region*Alias*And*As*Base*Binary*Boolean*Byte*ByVal*Call*Case*CBool*CByte*CCur*CDate*CDbl*CDec*CInt*CLng*Close*Compare*Const*CSng*CStr*Currency*CVar*CVErr*Decimal*Declare*DefBool*DefByte*DefCur*DefDate*DefDbl*DefDec*DefInt*DefLng*DefObj*DefSng*DefStr*DefVar*Dim*Do*Double" & _
"*Each*Else*ElseIf*End*Enum*Eqv*Erase*Error*Exit*Explicit*False*For*Function*Get*Global*GoSub*GoTo*If*Imp*In*Input*Input*Integer*Is*LBound*Let*Lib*Like*Line*Lock*Long*Loop*LSet*Name*New*Next*Not*Object*On*Open*Option*Or*Output*Print*Private*Property*Public*Put*Random*Read*ReDim*Resume*Return*RSet*Seek*Select*Set*Single*Spc*Static*String" & _
"*Stop*Sub*Tab*Then*Then*True*Type*UBound*Unlock*Variant*Wend*While*With*Xor*Nothing*To*Abs*Add*AddItem*AppActivate*Array*Asc*Atn*Beep*Begin*BeginProperty*ChDir*ChDrive*Choose*Chr*Clear*Collection*Command*Cos*CreateObject*CurDir*DateAdd*DateDiff*DatePart*DateSerial*DateValue*Day*DDB*DeleteSetting*Dir*DoEvents*EndProperty*Environ*EOF*Err" & _
"*Exp*FileAttr*FileCopy*FileDateTime*FileLen*Fix*Format*FV*GetAllSettings*GetAttr*GetObject*GetSetting*Hex*Hide*Hour*InputBox*InStr*Int*Int*IPmt*IRR*IsArray*IsDate*IsEmpty*IsError*IsMissing*IsNull*IsNumeric*IsObject*Item*Kill*LCase*Left*Len*Load*Loc*LOF*Log*LTrim*Me*Mid*Minute*MIRR*MkDir*Month*Now*NPer*NPV*Oct*Pmt*PPmt*PV*QBColor*Raise" & _
"*Randomize*Rate*Remove*RemoveItem*Reset*RGB*Right*RmDir*Rnd*RTrim*SaveSetting*Second*SendKeys*SetAttr*Sgn*Shell*Sin*Sin*SLN*Space*Sqr*Str*StrComp*StrConv*Switch*SYD*Tan*Text*Time*Time*Timer*TimeSerial*TimeValue*Trim*TypeName*UCase*Unload*Val*VarType*WeekDay*Width*Year*Class*Ctype*Friend*Protected*Overloads*Overrides*Inherits*Imports*Implements"
Dim i, j, k, n, m As Integer
Dim sp As Char = Chr(1)
Dim Words() As String = Split(strBlueKeyWords, "*") ' splitataan avainsanat taulukkoon
Dim kk As Integer = Words.GetUpperBound(0)
Dim str2 As String = vb
Dim str4, str5 As String
Dim str3() As String = Split(str2, vbNewLine)
Dim sb As System.Text.StringBuilder
For n = 0 To str3.GetUpperBound(0) 'käydään läpi rivi kerrallaan
'tehdään stringbuilder jossa käsitellään teksti
sb = New StringBuilder(str3(n) & vbNewLine) ' splitatessa pois jäänyt rivinvaihto takaisin
'avainsanat sinisellä, jos ei kommentissa
str4 = str3(n)
str4 = str4.TrimStart(" "c)
If str4.Length > 0 Then
If str4.Chars(0) <> "'" Then ' ei ole kommenttimerkkiä alussa
m = sb.ToString.IndexOf("'", 0) ' kommentti rivin päässä
If m < 0 Then m = sb.ToString.Length
For i = 0 To kk
'" " sana " "
sb.Replace(" " & Words(i) & " ", " " & "<font" & sp & "color=""blue"">" & Words(i) & "</font>" & " ", 0, m)
m = sb.ToString.IndexOf("'", 0) ' kommentti rivin päässä
If m < 0 Then m = sb.ToString.Length
' " " sana newline
sb.Replace(" " & Words(i) & vbNewLine, "<font" & sp & "color=""blue"">" & " " & Words(i) & vbNewLine & "</font>", 0, m)
' onko sana rivin alussa
If sb.ToString.Length >= Words(i).Length Then
Dim strTest As String = sb.ToString.Substring(0, Words(i).Length)
If strTest = Words(i) Then
sb.Replace(Words(i), "<font" & sp & "color=""blue"">" & " " & Words(i) & "</font>")
End If
End If
Next
End If
'välilyönnit
sb.Replace(" ", " ")
'väliaikainen merkki pois
sb.Replace(sp, " ")
'
'kommentit vihreällä
Dim str As String = sb.ToString
k = 0 : Dim tosi As Boolean = True
Do While tosi
j = str.IndexOf(";'", k) : If j < 0 Then Exit Do
i = str.IndexOf(vbNewLine, j) : If i < 0 Then Exit Do
str = str.Insert(i, "</font>")
k = j + 1
Loop
sb = New StringBuilder(str) ' teksti takaisin builderiin
sb.Replace(";'", ";<font color=""green"">'")
'
' rivinvaihdot
sb.Replace(vbNewLine, "<br>")
'tab
sb.Replace(vbTab, " ")
'kommentti ekalla rivillä
If sb.Chars(0) = "'" Then
i = str.IndexOf(vbNewLine, 0)
sb.Insert(i, "</FONT>")
sb.Insert(0, "<font color=""green"">")
End If
str5 = str5 & sb.ToString
End If 'tyhjä
Next n
'valmis työ
Return "<FONT FACE=""Courier New"" SIZE=""-1"" COLOR=""#000000"">" & str5 & "</FONT>"
End Function
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
' kopioidaan leikepöydälle
TextBox1.SelectAll()
Clipboard.SetDataObject(TextBox1.SelectedText)
End Sub
End ClassAihe on jo aika vanha, joten et voi enää vastata siihen.