在日常的代码开发中。习惯于在自己的代码编辑器里设置自己喜欢的代码字体及颜色。在写博客的过程中，有不可避免的要粘贴一些自己写的代码。问题就来了，往往在博客中提供的代码显示工具显示的代码格式和之前在代码编辑器里就发生了变化。虽不是什么大问题，但总是觉得有点不舒服。
本人用的编辑器是VS系列。一次在无意中将代码复制后，贴到写字板中，发现格式没有发生变化，将文件保存后，用记事本打开，发现是保存为Rtf格式。也就是说，在VS中复制代码，实际内存中保存着该代码的Rtf格式，这样也就是保留了该代码的格式。那么接下来要做的事情就是写一段代码，将该Rtf格式的代码改写成Html格式的代码。由于两种格式之间相似度还是比较高的，所以写代码也不是一件很难的事。
要注意的是，由于该代码用到了HttpUtility类，因此还得手动添加对System.Web的引用，而不仅仅是添加一句“Imports System.Web”。
在调用的时候，启用clsFormatCode.CodeRtfToHtml(Clipboard.GetText(System.Windows.Forms.TextDataFormat.Rtf))这句代码就可以了。
下面是代码，用的是VB2005。
Imports System.Web
Public Class clsFormatCode
Private Shared Function CodeRtfToHtml(ByVal RtfCode As String, ByVal DefaultFont As String)
Dim tS As New System.Text.StringBuilder
RtfCode = RtfCode.Replace(vbNewLine, "")
tS.AppendLine("<style>")
Dim I As Integer, J As Integer, K As Integer = 1
I = RtfCode.IndexOf("{\colortbl;") + 11
Do While RtfCode.Chars(I + 1) <> "}"
J = RtfCode.IndexOf(";", I + 1)
tS.AppendLine(".cf" & K & " {color:" & GetColorHex(RtfCode.Substring(I + 1, J - I)) & "}")
K += 1
I = J
Loop
tS.AppendLine("</style>")
tS.AppendLine(DefaultFont)
I = RtfCode.IndexOf("\fs") + 3
K = I
Dim CurColor As String = "\cf0"
J = RtfCode.IndexOf("\", I)
Do While J <> -1
If RtfCode.Substring(J, 2) = "\\" Then
I = J + 2
ElseIf RtfCode.Substring(J, 2) = "\{" Then
I = J + 2
ElseIf RtfCode.Substring(J, 2) = "\}" Then
I = J + 2
ElseIf RtfCode.Substring(J, 4) = "\par" Then
tS.Append(GetText(RtfCode.Substring(K, J - K), CurColor))
I = J + 5
K = J + 5
tS.Append("<br />" & vbNewLine)
ElseIf RtfCode.Substring(J, 3) = "\cf" Then
tS.Append(GetText(RtfCode.Substring(K, J - K), CurColor))
K = RtfCode.IndexOf(" ", J + 1) - J
CurColor = RtfCode.Substring(J, K)
I = J + K + 1
K = I
Else
I = J + 1
End If
J = RtfCode.IndexOf("\", I)
Loop
tS.Append(GetText(RtfCode.Substring(K, RtfCode.Length - K - 1), CurColor))
tS.AppendLine("</div>")
Return tS.ToString
End Function
Public Shared Function CodeRtfToHtml(ByVal RtfCode As String, ByVal Font As String, ByVal FontSize As String)
Return CodeRtfToHtml(RtfCode, String.Format("<div style='color:black;font-family:{0};font-size:{1};'>", Font, FontSize))
End Function
Public Shared Function CodeRtfToHtml(ByVal RtfCode As String) As String
Return CodeRtfToHtml(RtfCode, "<div style='color:black;font-family:Verdana;font-size:12pt;'>")
End Function
Private Shared Function GetText(ByVal Text As String, ByVal CurColor As String) As String
Text = Text.Replace("\\", "\")
Text = Text.Replace("\{", "{")
Text = Text.Replace("\}", "}")
Text = Text.Replace(" ", " ")
If CurColor = "\cf0" Then
Return HttpUtility.HtmlEncode(Text)
Else
Return "<span class='" & CurColor.Substring(1) & "'>" & HttpUtility.HtmlEncode(Text) & "</span>"
End If
End Function
Private Shared Function GetColorHex(ByVal ColorText As String) As String
Dim SR As Integer = ColorText.IndexOf("\red")
Dim SG As Integer = ColorText.IndexOf("\green")
Dim SB As Integer = ColorText.IndexOf("\blue")
Dim R As Integer = CInt(ColorText.Substring(SR + 4, SG - SR - 4))
Dim G As Integer = CInt(ColorText.Substring(SG + 6, SB - SG - 6))
Dim B As Integer = CInt(ColorText.Substring(SB + 5, ColorText.Length - 1 - SB - 5))
Return "#" & R.ToString("X2") & G.ToString("X2") & B.ToString("X2")
End Function
End Class
Public Class clsFormatCode
Private Shared Function CodeRtfToHtml(ByVal RtfCode As String, ByVal DefaultFont As String)
Dim tS As New System.Text.StringBuilder
RtfCode = RtfCode.Replace(vbNewLine, "")
tS.AppendLine("<style>")
Dim I As Integer, J As Integer, K As Integer = 1
I = RtfCode.IndexOf("{\colortbl;") + 11
Do While RtfCode.Chars(I + 1) <> "}"
J = RtfCode.IndexOf(";", I + 1)
tS.AppendLine(".cf" & K & " {color:" & GetColorHex(RtfCode.Substring(I + 1, J - I)) & "}")
K += 1
I = J
Loop
tS.AppendLine("</style>")
tS.AppendLine(DefaultFont)
I = RtfCode.IndexOf("\fs") + 3
K = I
Dim CurColor As String = "\cf0"
J = RtfCode.IndexOf("\", I)
Do While J <> -1
If RtfCode.Substring(J, 2) = "\\" Then
I = J + 2
ElseIf RtfCode.Substring(J, 2) = "\{" Then
I = J + 2
ElseIf RtfCode.Substring(J, 2) = "\}" Then
I = J + 2
ElseIf RtfCode.Substring(J, 4) = "\par" Then
tS.Append(GetText(RtfCode.Substring(K, J - K), CurColor))
I = J + 5
K = J + 5
tS.Append("<br />" & vbNewLine)
ElseIf RtfCode.Substring(J, 3) = "\cf" Then
tS.Append(GetText(RtfCode.Substring(K, J - K), CurColor))
K = RtfCode.IndexOf(" ", J + 1) - J
CurColor = RtfCode.Substring(J, K)
I = J + K + 1
K = I
Else
I = J + 1
End If
J = RtfCode.IndexOf("\", I)
Loop
tS.Append(GetText(RtfCode.Substring(K, RtfCode.Length - K - 1), CurColor))
tS.AppendLine("</div>")
Return tS.ToString
End Function
Public Shared Function CodeRtfToHtml(ByVal RtfCode As String, ByVal Font As String, ByVal FontSize As String)
Return CodeRtfToHtml(RtfCode, String.Format("<div style='color:black;font-family:{0};font-size:{1};'>", Font, FontSize))
End Function
Public Shared Function CodeRtfToHtml(ByVal RtfCode As String) As String
Return CodeRtfToHtml(RtfCode, "<div style='color:black;font-family:Verdana;font-size:12pt;'>")
End Function
Private Shared Function GetText(ByVal Text As String, ByVal CurColor As String) As String
Text = Text.Replace("\\", "\")
Text = Text.Replace("\{", "{")
Text = Text.Replace("\}", "}")
Text = Text.Replace(" ", " ")
If CurColor = "\cf0" Then
Return HttpUtility.HtmlEncode(Text)
Else
Return "<span class='" & CurColor.Substring(1) & "'>" & HttpUtility.HtmlEncode(Text) & "</span>"
End If
End Function
Private Shared Function GetColorHex(ByVal ColorText As String) As String
Dim SR As Integer = ColorText.IndexOf("\red")
Dim SG As Integer = ColorText.IndexOf("\green")
Dim SB As Integer = ColorText.IndexOf("\blue")
Dim R As Integer = CInt(ColorText.Substring(SR + 4, SG - SR - 4))
Dim G As Integer = CInt(ColorText.Substring(SG + 6, SB - SG - 6))
Dim B As Integer = CInt(ColorText.Substring(SB + 5, ColorText.Length - 1 - SB - 5))
Return "#" & R.ToString("X2") & G.ToString("X2") & B.ToString("X2")
End Function
End Class