Keskustelu: Koodit: VB.NET: VB tekstin väritys HTML:ksi

'
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(" ", "&nbsp;")
                '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, "&nbsp;&nbsp;&nbsp;&nbsp;")

                '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

'
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(" ", "&nbsp;")
                '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, "&nbsp;&nbsp;&nbsp;&nbsp;")

                '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 Class