Reply
Posted 09 August 2007 - 10:11 PM
Private Sub TSB_Send_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSB_Send.Click Me.Status.Items.Clear() Dim strHTML As String If Me.RTE_Body.Text = Nothing Then Me.RichTextBox1.Text = "" Else strHTML = ConvertToHTML(RTE_Body) RichTextBox1.Text = strHTML.ToString End If 'Call send_mail() Dim t1 As Thread = Nothing t1 = New Thread(AddressOf send_mail) t1.Start() End Sub --------------------- Public Function ConvertToHTML(ByVal Box As RichTextBox) As String ' Takes a RichTextBox control and returns a ' simple HTML-formatted version of its contents Dim strHTML As String Dim strColour As String Dim blnBold As Boolean Dim blnItalic As Boolean Dim strFont As String Dim shtSize As Short Dim lngOriginalStart As Long Dim lngOriginalLength As Long Dim intCount As Integer ' If nothing in the box, exit If Box.Text.Length = 0 Then Exit Function End If ' Store original selections, then select first character lngOriginalStart = 0 lngOriginalLength = Box.TextLength Box.Select(0, 1) ' Add HTML header strHTML = "<html>" ' Set up initial parameters strColour = Box.SelectionColor.ToKnownColor.ToString blnBold = Box.SelectionFont.Bold blnItalic = Box.SelectionFont.Italic strFont = Box.SelectionFont.FontFamily.Name shtSize = Box.SelectionFont.Size ' Include first 'style' parameters in the HTML strHTML += "<span style=""font-family: " & strFont & _ "; font-size: " & shtSize & "pt; color: " _ & strColour & """>" ' Include bold tag, if required If blnBold = True Then strHTML += "<b>" End If ' Include italic tag, if required If blnItalic = True Then strHTML += "<i>" End If ' Finally, add our first character strHTML += Box.Text.Substring(0, 1) ' Loop around all remaining characters For intCount = 2 To Box.Text.Length ' Select current character Box.Select(intCount - 1, 1) ' If this is a line break, add HTML tag If Box.Text.Substring(intCount - 1, 1) = _ Convert.ToChar(10) Then strHTML += "<br>" End If ' Check/implement any changes in style If Box.SelectionColor.ToKnownColor.ToString <> _ strColour Or Box.SelectionFont.FontFamily.Name _ <> strFont Or Box.SelectionFont.Size <> shtSize _ Then strHTML += "</span><span style=""font-family: " _ & Box.SelectionFont.FontFamily.Name & _ "; font-size: " & Box.SelectionFont.Size & _ "pt; color: " & _ Box.SelectionColor.ToKnownColor.ToString & """>" End If ' Check for bold changes If Box.SelectionFont.Bold <> blnBold Then If Box.SelectionFont.Bold = False Then strHTML += "</b>" Else strHTML += "<b>" End If End If ' Check for italic changes If Box.SelectionFont.Italic <> blnItalic Then If Box.SelectionFont.Italic = False Then strHTML += "</i>" Else strHTML += "<i>" End If End If ' Add the actual character strHTML += Mid(Box.Text, intCount, 1) ' Update variables with current style strColour = Box.SelectionColor.ToKnownColor.ToString blnBold = Box.SelectionFont.Bold blnItalic = Box.SelectionFont.Italic strFont = Box.SelectionFont.FontFamily.Name shtSize = Box.SelectionFont.Size Next ' Close off any open bold/italic tags If blnBold = True Then strHTML += "" If blnItalic = True Then strHTML += "" ' Terminate outstanding HTML tags strHTML += "</span></html>" ' Restore original RichTextBox selection Box.Select(lngOriginalStart, lngOriginalLength) ' Return HTML Return strHTML End Function
MOD EDIT: added [code] tags ~ jayman9
MultiQuote
| 