Option Explicit On
Option Strict On

Imports System.IO
Imports System.Text

Public Class Form1

    Private WebBrowser1 As New WebBrowser
    Private ColorList As New Dictionary(Of Color, String)
    Private Toolstrip1 As New ToolStrip
    Private WithEvents ToolstripButton1 As New ToolStripButton
    Private RichTextBox1 As New RichTextBox

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        Me.Text = "VBtoHTML"
        Me.ToolstripButton1.Text = "HTMLì¬"
        Me.Toolstrip1.Items.Add(Me.ToolstripButton1)
        Me.Controls.AddRange({RichTextBox1, Toolstrip1})
        Me.RichTextBox1.Dock = DockStyle.Fill
        ColorList.Add(Color.Blue, "keyword")
        ColorList.Add(Color.Black, "normal")
        ColorList.Add(Color.FromArgb(&HFF2B91AF), "Class")
        ColorList.Add(Color.FromArgb(&HFFA31515), "String")
        ColorList.Add(Color.Green, "remark")
    End Sub

    Private Sub ToolstripButton1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ToolstripButton1.Click
        If Me.RichTextBox1.Text = String.Empty Then Exit Sub
        Dim Html As String = VBtoHTML(Me.RichTextBox1)
        Dim FileName As String = Application.StartupPath & "\Temp.htm"
        Dim Writer As New StreamWriter(FileName, False, Encoding.GetEncoding("shift-jis"))
        Writer.WriteLine("<!DOCTYPE html>")
        Writer.WriteLine("<html lang=""ja"">")
        Writer.WriteLine("<head>")
        Writer.WriteLine("<meta charset=""shift_jis""> ")
        Writer.WriteLine("<style type=""text/css"">")
        Writer.WriteLine(".vbcode { color: black;")
        Writer.WriteLine("          background-color: white;}")
        For Each c As KeyValuePair(Of Color, String) In ColorList
            Dim ColorName As String = If(c.Key.IsNamedColor, c.Key.Name, "#" & Hex(c.Key.ToArgb And &HFFFFFF))
            Writer.WriteLine("." & c.Value & "{ color: " & ColorName & "; }")
        Next
        Writer.WriteLine("</style>")
        Writer.WriteLine("</head>")
        Writer.WriteLine("<body>")
        Writer.WriteLine("<pre class=""vbcode"">")
        Writer.Write(Html)
        Writer.WriteLine("</pre>")
        Writer.WriteLine("</body>")
        Writer.WriteLine("</html>")
        Writer.Close()
        Me.WebBrowser1.Navigate(FileName, True)
    End Sub

    Public Function VBtoHTML(RichTextBox As RichTextBox) As String
        Dim Html As New StringBuilder
        Dim Word As New StringBuilder
        RichTextBox.Select(0, 1)
        Dim CurrentColor = RichTextBox.SelectionColor
        Dim TextLength As Integer = RichTextBox.TextLength
        For i As Integer = 0 To RichTextBox.TextLength
            RichTextBox.Select(i, 1)
            Dim Chr As String = RichTextBox.SelectedText
            Select Case Chr
                Case "&"
                    Chr = "&amp;"
                Case "<"
                    Chr = "&lt;"
                Case ">"
                    Chr = "&gt;"
            End Select
            Dim ChrColor As Color = RichTextBox.SelectionColor
            If ChrColor <> CurrentColor OrElse i = TextLength Then
                Dim ClassName As String = ColorList(CurrentColor)
                Dim Text As String = Word.ToString
                Html.Append("<span class=""" & ClassName & """>" & Text & "</span>")
                CurrentColor = ChrColor
                Word.Clear()
            End If
            Word.Append(Chr)
        Next
        Return Html.ToString
    End Function

End Class