VB.NET'te RichTextBox kullanarak renkli yazılı mail gönderme nasıldır?

[Vatansever]

VB.NET'te RichTextBox kullanarak mail göndermek istiyorum ama RichTextBox içine
yazılan renkli yazılar farklı fontlar vesaire herşey sanki TextBox içindeki gibi tüm özelliklerini
kaybetmiş olarak karşıya gönderiliyor bu problemi nasıl çözerim

Aşağıdaki kodu internetten buldum projeme göre düzenleyerek kullandım projemdeki kodun aynısıdır düzgün çalışıyor.

Imports System.Net.Mail
Public Class Form1
    Private Sub Button1_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Button1.Click
        Try
            Dim SmtpServer As New SmtpClient()
            Dim mail As New MailMessage()
            SmtpServer.Credentials = New _
        Net.NetworkCredential("username@gmail.com", "password")
            SmtpServer.Port = 587
            SmtpServer.Host = "smtp.gmail.com"
            mail = New MailMessage()
            mail.From = New MailAddress("YOURusername@gmail.com")
            mail.To.Add("TOADDRESS")
            mail.Subject = "Test Mail"
            mail.Body = "This is for testing SMTP mail from GMAIL"
            SmtpServer.Send(mail)
            MsgBox("mail send")
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Sub
End Class

 

[craftingMaterial]

Mail'i HTML içerikli göndermelisin. O yüzden ilk önce RichTextEditor'den stilleri okuyup bir şekilde tüm içeriği HTML'e dönüştürmen gerekiyor...

Edit : Aklıma bir yöntem daha geldi; kendi WYSIWYG editörünü yazarsan bu işlem daha da kolaylaşır ama bu sefer de WYSIWYG editörü yazman zaman alır

 

[Vatansever]

Mail'i HTML içerikli göndermelisin. O yüzden ilk önce RichTextEditor'den stilleri okuyup bir şekilde tüm içeriği HTML'e dönüştürmen gerekiyor...

Edit : Aklıma bir yöntem daha geldi; kendi WYSIWYG editörünü yazarsan bu işlem daha da kolaylaşır ama bu sefer de WYSIWYG editörü yazman zaman alır

Uyyy ne diisuuun

Daha basit yöntemler yokmu mesela bedava bir kaynak kod aşağıdaki adresteki güzel basit görünüyor koduda çok az ama pek anlayamadım sanki iki ayrı projeden birleştirilmiş gibi bilmiyorum bir arkadaş bunu sadeleştirebilirse bu olur gibi ben anlayamadım proje çalışınca combobox görünüyor ama kodlarda bununla ilgili bişey göremiyorum yada formda eklenmiş göremiyorum bu beni biraz aştı
Proje Adresi
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=7551&lngWId=10

Yada RichTextBox1 içindekileri html'ye dönüştürme kodu gibi
ADRES
mesela aşağıdaki kod gibi ben denedim ama kodlar hata veriyor bir bakarmısın
http://www.visual-basic.it/Dettagli...tainerSrc=[G]Containers/_default/No+Container

YADA Bu adreste
http://www.dreamincode.net/forums/topic/31472-convert-a-rich-text-into-html-conversion/

Imports System.Windows.Forms
Imports System.Drawing
Namespace RtfToHtml
  Public Class RtfToHtml
    Implements IDisposable
    ' la classe implementa questa interfaccia per permetterne l'uso con il costrutto Using,
    Dim TagPointListExist As Boolean = False, TagIndentExist As Boolean = False, _
    NumberIndent As Integer = 0, TagApExist As Boolean = False, TagPedExist As Boolean = False, _
    RichTextBoxRtf As New RichTextBox, RichTextBoxRtfCompare As New RichTextBox
    Public Sub New(ByVal objectRichTextBox As RichTextBox)
      RichTextBoxRtf.BackColor = objectRichTextBox.BackColor
      RichTextBoxRtfCompare.BackColor = objectRichTextBox.BackColor
      RichTextBoxRtf.BulletIndent = objectRichTextBox.BulletIndent
      RichTextBoxRtfCompare.BulletIndent = objectRichTextBox.BulletIndent
      RichTextBoxRtf.SelectionBackColor = RichTextBoxRtf.BackColor
      RichTextBoxRtfCompare.SelectionBackColor = RichTextBoxRtf.BackColor
      RichTextBoxRtf.Rtf = objectRichTextBox.Rtf
      RichTextBoxRtfCompare.Rtf = objectRichTextBox.Rtf
    End Sub
    Public ReadOnly Property FormatHtml() As String
      Get
        Return ConvertToHtml(RichTextBoxRtf)
      End Get
    End Property
    Private Function ConvertToHtml(ByVal objectRtf As RichTextBox) As String
      Dim BuildString As String = "", i As Integer, j As Integer, start As Integer, _
      lenghtLine As Integer, bWrite As Boolean, sb As New System.Text.StringBuilder
      sb.AppendLine("<html><body bgcolor=" & """" & GetHexColor(objectRtf.BackColor) & """>")
      For i = 0 To objectRtf.Lines.Length - 1
        If objectRtf.Lines(i).Length = 0 Then
          sb.Append("<div><br>")
        Else
          start = SelectStartIndex(objectRtf, i) : lenghtLine = objectRtf.Lines(i).Length
          objectRtf.Select(start, lenghtLine)
          If objectRtf.SelectionIndent > 0 Then
            sb.AppendLine()
            sb.Append(SelectLeftIndent(objectRtf.SelectionIndent))
          End If
          sb.AppendLine()
          sb.Append(SelectBullet(objectRtf.SelectionBullet) & "<div ")
          sb.Append(SelectAlignment(objectRtf.SelectionAlignment) & _                    SelectIndentBullet(objectRtf.BulletIndent))
          For j = start To start + lenghtLine - 1
            bWrite = True : objectRtf.Select(j, 1)
            If j > start Then
              RichTextBoxRtfCompare.Select(j - 1, 1)
              If RichTextBoxRtfCompare.SelectionBackColor = objectRtf.SelectionBackColor And _
                 RichTextBoxRtfCompare.SelectionCharOffset = objectRtf.SelectionCharOffset And _
                 RichTextBoxRtfCompare.SelectionColor = objectRtf.SelectionColor And _
                 RichTextBoxRtfCompare.SelectionFont.Style = objectRtf.SelectionFont.Style And _
                 RichTextBoxRtfCompare.SelectionFont.Name = objectRtf.SelectionFont.Name And _
                 RichTextBoxRtfCompare.SelectionFont.Size = objectRtf.SelectionFont.Size Then
                bWrite = False
              Else
                sb.Append("</span></font>")
                If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
                If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
              End If
            End If
            If bWrite = True Then
              sb.Append(SelectCharOffSet(objectRtf.SelectionCharOffset))
              sb.Append("<font color=" & """" & GetHexColor(objectRtf.SelectionColor) & """>")
              sb.Append("<span style=""font: " & objectRtf.SelectionFont.Size &                         "pt/normal; font-family: ")
              sb.Append(objectRtf.SelectionFont.Name)
              If objectRtf.SelectionFont.Bold = True Then
                sb.Append("; font-weight: 700;")
              Else
                sb.Append("; font-weight: 200;")
              End If
              If objectRtf.SelectionFont.Italic = True Then sb.Append(" font-style: italic;")
              If objectRtf.SelectionFont.Underline = True Then _                 sb.Append(" text-decoration: underline;")
              sb.Append(" background-color: " & GetHexColor(objectRtf.SelectionBackColor))
              sb.Append(SelectApPed(objectRtf.SelectionCharOffset))
              sb.Append(""">")
            End If
            If objectRtf.SelectedText = " " Then
              sb.Append("  ")
            Else
              sb.Append(objectRtf.SelectedText)
            End If
            If j = start + lenghtLine - 1 Then
              sb.Append("</span></font>")
              If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
              If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
            End If
          Next
        End If
        sb.Append("</div>")
        If Me.TagPointListExist = True Then _           Me.TagPointListExist = False : sb.Append("</li>" & "</ul>")
        If Me.TagIndentExist = True Then
          sb.AppendLine()
          For j = 1 To Me.NumberIndent
            sb.Append("</blockquote>")
          Next
          TagIndentExist = False : Me.NumberIndent = 0
        End If
        sb.AppendLine()
      Next
      sb.AppendLine()
      sb.Append("</body></html>")
      Return sb.ToString
    End Function
    Private Function GetHexColor(ByVal colore As Color) As String
      Return "#" & colore.R.ToString("X2") & colore.G.ToString("X2") & colore.B.ToString("X2")
    End Function
    Private Function SelectStartIndex(ByVal objectRtf As RichTextBox, _                                      ByVal line As Integer) As Integer
      Dim totalChars As Integer = 0
      If line > 0 Then _         For i As Integer = 0 To line - 1 : totalChars += objectRtf.Lines(i).Length + 1 : Next
      Return totalChars
    End Function
    Private Function SelectIndentBullet(ByVal misureBullets As Integer) As String
      Dim stringIndent As String = ""
      Select Case misureBullets
        Case Is > 40 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; "
        Case Is > 30 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; "
        Case Is > 20 : stringIndent = "&nbsp; &nbsp; &nbsp; "
        Case Is > 10 : stringIndent = "&nbsp; &nbsp; "
        Case Is > 0 : stringIndent = "&nbsp; "
      End Select
      Return stringIndent
    End Function
    Private Function SelectLeftIndent(ByVal misureLeftMargin As Integer) As String
      Dim stringBuild As String = ""
      Select Case misureLeftMargin
        Case Is > 175
          Me.NumberIndent = 6
          stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote><blockquote>"
        Case Is > 140
          Me.NumberIndent = 5
          stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote>"
        Case Is > 105
          Me.NumberIndent = 4 : stringBuild = "<blockquote><blockquote><blockquote><blockquote>"
        Case Is > 70
          Me.NumberIndent = 3 : stringBuild = "<blockquote><blockquote><blockquote>"
        Case Is > 35
          Me.NumberIndent = 2 : stringBuild = "<blockquote><blockquote>"
        Case Is > 0
          Me.NumberIndent = 1 : stringBuild = "<blockquote>"
      End Select
      Me.TagIndentExist = True
      Return stringBuild
    End Function
    Private Function SelectCharOffSet(ByVal value As Integer) As String
      Select Case value
        Case Is < 0 : Me.TagApExist = True : Return "<sub>"
        Case Is > 0 : Me.TagPedExist = True : Return "<sup>"
      End Select
      Return ""
    End Function
    Private Function SelectAlignment(ByVal alignment As Integer) As String
      Select Case alignment
        Case Is = 0 : Return "align=""left"">"
        Case Is = 1 : Return "align=""right"">"
        Case Is = 2 : Return "align=""center"">"
      End Select
      Return ""
    End Function
    Private Function SelectBullet(ByVal value As Boolean) As String
      If value = True Then
        Me.TagPointListExist = True
        Return "<ul><li>"
      Else
        Return ""
      End If
    End Function
    Private Function SelectSize(ByVal value As Integer) As Integer
      Select Case value
        Case Is > 65 : Return 7
        Case Is > 50 : Return 6
        Case Is > 35 : Return 5
        Case Is > 20 : Return 4
        Case Is > 10 : Return 3
        Case Is > 5 : Return 2
        Case Is > 0 : Return 1
      End Select
    End Function
    Private Function SelectApPed(ByVal value As Integer) As String
      If TagApExist = True Or TagPedExist = True Then
        Select Case value
          Case Is = 5 : Return "; vertical-align: bottom"
          Case Is = 4 : Return "; vertical-align: middle"
          Case Is = 3 : Return "; vertical-align: text-bottom"
          Case Is = 2 : Return "; vertical-align: text-top"
          Case Is = 1 : Return "; vertical-align: top"
          Case Is = -1 : Return "; vertical-align: bottom"
          Case Is = -2 : Return "; vertical-align: middle"
          Case Is = -3 : Return "; vertical-align: text-bottom"
          Case Is = -4 : Return "; vertical-align: text-top"
          Case Is > -5 : Return "; vertical-align: top"
        End Select
      End If
      Return ""
    End Function
#Region " IDisposable Support "
    Private disposedValue As Boolean = False    ' To detect redundant calls
    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
      If Not Me.disposedValue Then
        If disposing Then
          ' TODO: free other state (managed objects).
        End If
        ' TODO: free your own state (unmanaged objects).
        ' TODO: set large fields to null.
      End If
      Me.disposedValue = True
    End Sub
    ' This code added by Visual Basic to correctly implement the disposable pattern.
    Public Sub Dispose() Implements IDisposable.Dispose
      ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
      Dispose(True)
      GC.SuppressFinalize(Me)
    End Sub
#End Region
  End Class
End Namespace

Private Sub Form1_Load(ByVal sender As System.Object,                          ByVal e As System.EventArgs) Handles MyBase.Load
    RichTextBox1.Rtf = "{\rtf1\ansi\ansicpg1252\deff0\deflang1040{\fonttbl{\f0\fnil\fprq1\fcharset0 Courier New;}{\f1\fswiss\fcharset0 Arial;}}" & _
                        Environment.NewLine & _
                       "{\colortbl ;\red0\green0\blue255;}" & _
                        Environment.NewLine & _
                       "{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\f0\fs20     Dim s As String\par" & _
                        Environment.NewLine & _
                       "    Using o As New RtfToHtml.RtfToHtml(RichTextBox1)\par" & _
                        Environment.NewLine & _
                       "    s = o.FormatHtml \par" & _
                        Environment.NewLine & _
                       "    End Using\cf0\f1\par" & _
                        Environment.NewLine & _
                       "}"
    Dim s As String
    Using o As New RtfToHtml.RtfToHtml(RichTextBox1)
      s = o.FormatHtml
    End Using
    Using sw As New StreamWriter(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Document.htm")
      sw.Write(s)
    End Using
  End Sub

 

[algea]

Senin buldukların ile ufak bir derleme yaptım. Dosyayı buradan indirebilirsin.


Uploaded with ImageShack.us
frmMain.vb:

Imports System.IO
Imports System.Net.Mail
Public Class frmMain
    Private Sub cmdLoadRtf_Click(sender As Object, e As EventArgs) Handles cmdLoadRtf.Click
        rtfMailMessageBody.LoadFile(Application.StartupPath + "\" + "EmailBody.rtf")
    End Sub

    Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
        txtMailMessageFrom.Text = "gmail_username@gmail.com"
        txtMailMessageTo.Text = "hotmail_username@hotmail.com"
        txtMailMessageSubject.Text = "GMail Test"
    End Sub

    Private Sub cmdSendEmail_Click(sender As Object, e As EventArgs) Handles cmdSendEmail.Click
        Dim s As String
        Using o As New RtfToHtml.RtfToHtml(rtfMailMessageBody)
            s = o.FormatHtml
        End Using
        
        Dim MyMailMessage As New MailMessage()

        'From requires an instance of the MailAddress type
        MyMailMessage.From = New MailAddress(txtMailMessageFrom.Text)

        'To is a collection of MailAddress types
        MyMailMessage.To.Add(txtMailMessageTo.Text)

        MyMailMessage.Subject = txtMailMessageSubject.Text
        MyMailMessage.IsBodyHtml = True
        MyMailMessage.Body = s

        'Create the SMTPClient object and specify the SMTP GMail server
        Dim SMTPServer As New SmtpClient("smtp.gmail.com")
        SMTPServer.Port = 587
        SMTPServer.Credentials = New System.Net.NetworkCredential("gmail_username", "gmail_password")
        SMTPServer.EnableSsl = True

        Try
            SMTPServer.Send(MyMailMessage)
            MessageBox.Show("Email Sent")
        Catch ex As SmtpException
            MessageBox.Show(ex.Message)
        End Try
    End Sub
End Class

ConvertHTML.vb:

Imports System.Windows.Forms
Imports System.Drawing
Namespace RtfToHtml
    Public Class RtfToHtml
        Implements IDisposable
        ' la classe implementa questa interfaccia per permetterne l'uso con il costrutto Using,
        Dim TagPointListExist As Boolean = False, TagIndentExist As Boolean = False, _
        NumberIndent As Integer = 0, TagApExist As Boolean = False, TagPedExist As Boolean = False, _
        RichTextBoxRtf As New RichTextBox, RichTextBoxRtfCompare As New RichTextBox

        Public Sub New(ByVal objectRichTextBox As RichTextBox)
            RichTextBoxRtf.BackColor = objectRichTextBox.BackColor
            RichTextBoxRtfCompare.BackColor = objectRichTextBox.BackColor
            RichTextBoxRtf.BulletIndent = objectRichTextBox.BulletIndent
            RichTextBoxRtfCompare.BulletIndent = objectRichTextBox.BulletIndent
            RichTextBoxRtf.SelectionBackColor = RichTextBoxRtf.BackColor
            RichTextBoxRtfCompare.SelectionBackColor = RichTextBoxRtf.BackColor
            RichTextBoxRtf.Rtf = objectRichTextBox.Rtf
            RichTextBoxRtfCompare.Rtf = objectRichTextBox.Rtf
        End Sub

        Public ReadOnly Property FormatHtml() As String
            Get
                Return ConvertToHtml(RichTextBoxRtf)
            End Get
        End Property

        Private Function ConvertToHtml(ByVal objectRtf As RichTextBox) As String
            Dim BuildString As String = "", i As Integer, j As Integer, start As Integer, _
            lenghtLine As Integer, bWrite As Boolean, sb As New System.Text.StringBuilder
            sb.AppendLine("<html><body bgcolor=" & """" & GetHexColor(objectRtf.BackColor) & """>")

            For i = 0 To objectRtf.Lines.Length - 1
                If objectRtf.Lines(i).Length = 0 Then
                    sb.Append("<div><br>")
                Else
                    start = SelectStartIndex(objectRtf, i) : lenghtLine = objectRtf.Lines(i).Length
                    objectRtf.Select(start, lenghtLine)
                    If objectRtf.SelectionIndent > 0 Then
                        sb.AppendLine()
                        sb.Append(SelectLeftIndent(objectRtf.SelectionIndent))
                    End If
                    sb.AppendLine()
                    sb.Append(SelectBullet(objectRtf.SelectionBullet) & "<div ")
                    sb.Append(SelectAlignment(objectRtf.SelectionAlignment) & _
                              SelectIndentBullet(objectRtf.BulletIndent))
                    For j = start To start + lenghtLine - 1
                        bWrite = True : objectRtf.Select(j, 1)
                        If j > start Then
                            RichTextBoxRtfCompare.Select(j - 1, 1)
                            If RichTextBoxRtfCompare.SelectionBackColor = objectRtf.SelectionBackColor And _
                               RichTextBoxRtfCompare.SelectionCharOffset = objectRtf.SelectionCharOffset And _
                               RichTextBoxRtfCompare.SelectionColor = objectRtf.SelectionColor And _
                               RichTextBoxRtfCompare.SelectionFont.Style = objectRtf.SelectionFont.Style And _
                               RichTextBoxRtfCompare.SelectionFont.Name = objectRtf.SelectionFont.Name And _
                               RichTextBoxRtfCompare.SelectionFont.Size = objectRtf.SelectionFont.Size Then

                                bWrite = False
                            Else
                                sb.Append("</span></font>")
                                If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
                                If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
                            End If
                        End If
                        If bWrite = True Then
                            sb.Append(SelectCharOffSet(objectRtf.SelectionCharOffset))
                            sb.Append("<font color=" & """" & GetHexColor(objectRtf.SelectionColor) & """>")
                            sb.Append("<span style=""font: " & objectRtf.SelectionFont.Size &
                                      "pt/normal; font-family: ")
                            sb.Append(objectRtf.SelectionFont.Name)
                            If objectRtf.SelectionFont.Bold = True Then
                                sb.Append("; font-weight: 700;")
                            Else
                                sb.Append("; font-weight: 200;")
                            End If
                            If objectRtf.SelectionFont.Italic = True Then sb.Append(" font-style: italic;")
                            If objectRtf.SelectionFont.Underline = True Then _
                               sb.Append(" text-decoration: underline;")
                            sb.Append(" background-color: " & GetHexColor(objectRtf.SelectionBackColor))
                            sb.Append(SelectApPed(objectRtf.SelectionCharOffset))
                            sb.Append(""">")
                        End If
                        If objectRtf.SelectedText = " " Then
                            sb.Append("  ")
                        Else
                            sb.Append(objectRtf.SelectedText)
                        End If
                        If j = start + lenghtLine - 1 Then
                            sb.Append("</span></font>")
                            If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
                            If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
                        End If
                    Next
                End If
                sb.Append("</div>")
                If Me.TagPointListExist = True Then _
                   Me.TagPointListExist = False : sb.Append("</li>" & "</ul>")
                If Me.TagIndentExist = True Then
                    sb.AppendLine()
                    For j = 1 To Me.NumberIndent
                        sb.Append("</blockquote>")
                    Next
                    TagIndentExist = False : Me.NumberIndent = 0
                End If
                sb.AppendLine()
            Next
            sb.AppendLine()
            sb.Append("</body></html>")
            Return sb.ToString
        End Function

        Private Function GetHexColor(ByVal colore As Color) As String
            Return "#" & colore.R.ToString("X2") & colore.G.ToString("X2") & colore.B.ToString("X2")
        End Function

        Private Function SelectStartIndex(ByVal objectRtf As RichTextBox, _
                                          ByVal line As Integer) As Integer
            Dim totalChars As Integer = 0
            If line > 0 Then _
               For i As Integer = 0 To line - 1 : totalChars += objectRtf.Lines(i).Length + 1 : Next
            Return totalChars
        End Function

        Private Function SelectIndentBullet(ByVal misureBullets As Integer) As String
            Dim stringIndent As String = ""
            Select Case misureBullets
                Case Is > 40 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; "
                Case Is > 30 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; "
                Case Is > 20 : stringIndent = "&nbsp; &nbsp; &nbsp; "
                Case Is > 10 : stringIndent = "&nbsp; &nbsp; "
                Case Is > 0 : stringIndent = "&nbsp; "
            End Select
            Return stringIndent
        End Function

        Private Function SelectLeftIndent(ByVal misureLeftMargin As Integer) As String
            Dim stringBuild As String = ""
            Select Case misureLeftMargin
                Case Is > 175
                    Me.NumberIndent = 6
                    stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote><blockquote>"
                Case Is > 140
                    Me.NumberIndent = 5
                    stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote>"
                Case Is > 105
                    Me.NumberIndent = 4 : stringBuild = "<blockquote><blockquote><blockquote><blockquote>"
                Case Is > 70
                    Me.NumberIndent = 3 : stringBuild = "<blockquote><blockquote><blockquote>"
                Case Is > 35
                    Me.NumberIndent = 2 : stringBuild = "<blockquote><blockquote>"
                Case Is > 0
                    Me.NumberIndent = 1 : stringBuild = "<blockquote>"
            End Select
            Me.TagIndentExist = True
            Return stringBuild
        End Function

        Private Function SelectCharOffSet(ByVal value As Integer) As String
            Select Case value
                Case Is < 0 : Me.TagApExist = True : Return "<sub>"
                Case Is > 0 : Me.TagPedExist = True : Return "<sup>"
            End Select
            Return ""
        End Function

        Private Function SelectAlignment(ByVal alignment As Integer) As String
            Select Case alignment
                Case Is = 0 : Return "align=""left"">"
                Case Is = 1 : Return "align=""right"">"
                Case Is = 2 : Return "align=""center"">"
            End Select
            Return ""
        End Function

        Private Function SelectBullet(ByVal value As Boolean) As String
            If value = True Then
                Me.TagPointListExist = True
                Return "<ul><li>"
            Else
                Return ""
            End If
        End Function

        Private Function SelectSize(ByVal value As Integer) As Integer
            Select Case value
                Case Is > 65 : Return 7
                Case Is > 50 : Return 6
                Case Is > 35 : Return 5
                Case Is > 20 : Return 4
                Case Is > 10 : Return 3
                Case Is > 5 : Return 2
                Case Is > 0 : Return 1
            End Select
        End Function

        Private Function SelectApPed(ByVal value As Integer) As String
            If TagApExist = True Or TagPedExist = True Then
                Select Case value
                    Case Is = 5 : Return "; vertical-align: bottom"
                    Case Is = 4 : Return "; vertical-align: middle"
                    Case Is = 3 : Return "; vertical-align: text-bottom"
                    Case Is = 2 : Return "; vertical-align: text-top"
                    Case Is = 1 : Return "; vertical-align: top"
                    Case Is = -1 : Return "; vertical-align: bottom"
                    Case Is = -2 : Return "; vertical-align: middle"
                    Case Is = -3 : Return "; vertical-align: text-bottom"
                    Case Is = -4 : Return "; vertical-align: text-top"
                    Case Is > -5 : Return "; vertical-align: top"
                End Select
            End If
            Return ""
        End Function

#Region " IDisposable Support "
        Private disposedValue As Boolean = False    ' To detect redundant calls
        ' IDisposable
        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: free other state (managed objects).
                End If
                ' TODO: free your own state (unmanaged objects).
                ' TODO: set large fields to null.
            End If
            Me.disposedValue = True
        End Sub
        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region
    End Class
End Namespace

 

[Vatansever]

Senin buldukların ile ufak bir derleme yaptım. Dosyayı buradan indirebilirsin.


Uploaded with ImageShack.us
frmMain.vb:

Imports System.IO
Imports System.Net.Mail
Public Class frmMain
    Private Sub cmdLoadRtf_Click(sender As Object, e As EventArgs) Handles cmdLoadRtf.Click
        rtfMailMessageBody.LoadFile(Application.StartupPath + "\" + "EmailBody.rtf")
    End Sub

    Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
        txtMailMessageFrom.Text = "gmail_username@gmail.com"
        txtMailMessageTo.Text = "hotmail_username@hotmail.com"
        txtMailMessageSubject.Text = "GMail Test"
    End Sub

    Private Sub cmdSendEmail_Click(sender As Object, e As EventArgs) Handles cmdSendEmail.Click
        Dim s As String
        Using o As New RtfToHtml.RtfToHtml(rtfMailMessageBody)
            s = o.FormatHtml
        End Using
        
        Dim MyMailMessage As New MailMessage()

        'From requires an instance of the MailAddress type
        MyMailMessage.From = New MailAddress(txtMailMessageFrom.Text)

        'To is a collection of MailAddress types
        MyMailMessage.To.Add(txtMailMessageTo.Text)

        MyMailMessage.Subject = txtMailMessageSubject.Text
        MyMailMessage.IsBodyHtml = True
        MyMailMessage.Body = s

        'Create the SMTPClient object and specify the SMTP GMail server
        Dim SMTPServer As New SmtpClient("smtp.gmail.com")
        SMTPServer.Port = 587
        SMTPServer.Credentials = New System.Net.NetworkCredential("gmail_username", "gmail_password")
        SMTPServer.EnableSsl = True

        Try
            SMTPServer.Send(MyMailMessage)
            MessageBox.Show("Email Sent")
        Catch ex As SmtpException
            MessageBox.Show(ex.Message)
        End Try
    End Sub
End Class

ConvertHTML.vb:

Imports System.Windows.Forms
Imports System.Drawing
Namespace RtfToHtml
    Public Class RtfToHtml
        Implements IDisposable
        ' la classe implementa questa interfaccia per permetterne l'uso con il costrutto Using,
        Dim TagPointListExist As Boolean = False, TagIndentExist As Boolean = False, _
        NumberIndent As Integer = 0, TagApExist As Boolean = False, TagPedExist As Boolean = False, _
        RichTextBoxRtf As New RichTextBox, RichTextBoxRtfCompare As New RichTextBox

        Public Sub New(ByVal objectRichTextBox As RichTextBox)
            RichTextBoxRtf.BackColor = objectRichTextBox.BackColor
            RichTextBoxRtfCompare.BackColor = objectRichTextBox.BackColor
            RichTextBoxRtf.BulletIndent = objectRichTextBox.BulletIndent
            RichTextBoxRtfCompare.BulletIndent = objectRichTextBox.BulletIndent
            RichTextBoxRtf.SelectionBackColor = RichTextBoxRtf.BackColor
            RichTextBoxRtfCompare.SelectionBackColor = RichTextBoxRtf.BackColor
            RichTextBoxRtf.Rtf = objectRichTextBox.Rtf
            RichTextBoxRtfCompare.Rtf = objectRichTextBox.Rtf
        End Sub

        Public ReadOnly Property FormatHtml() As String
            Get
                Return ConvertToHtml(RichTextBoxRtf)
            End Get
        End Property

        Private Function ConvertToHtml(ByVal objectRtf As RichTextBox) As String
            Dim BuildString As String = "", i As Integer, j As Integer, start As Integer, _
            lenghtLine As Integer, bWrite As Boolean, sb As New System.Text.StringBuilder
            sb.AppendLine("<html><body bgcolor=" & """" & GetHexColor(objectRtf.BackColor) & """>")

            For i = 0 To objectRtf.Lines.Length - 1
                If objectRtf.Lines(i).Length = 0 Then
                    sb.Append("<div><br>")
                Else
                    start = SelectStartIndex(objectRtf, i) : lenghtLine = objectRtf.Lines(i).Length
                    objectRtf.Select(start, lenghtLine)
                    If objectRtf.SelectionIndent > 0 Then
                        sb.AppendLine()
                        sb.Append(SelectLeftIndent(objectRtf.SelectionIndent))
                    End If
                    sb.AppendLine()
                    sb.Append(SelectBullet(objectRtf.SelectionBullet) & "<div ")
                    sb.Append(SelectAlignment(objectRtf.SelectionAlignment) & _
                              SelectIndentBullet(objectRtf.BulletIndent))
                    For j = start To start + lenghtLine - 1
                        bWrite = True : objectRtf.Select(j, 1)
                        If j > start Then
                            RichTextBoxRtfCompare.Select(j - 1, 1)
                            If RichTextBoxRtfCompare.SelectionBackColor = objectRtf.SelectionBackColor And _
                               RichTextBoxRtfCompare.SelectionCharOffset = objectRtf.SelectionCharOffset And _
                               RichTextBoxRtfCompare.SelectionColor = objectRtf.SelectionColor And _
                               RichTextBoxRtfCompare.SelectionFont.Style = objectRtf.SelectionFont.Style And _
                               RichTextBoxRtfCompare.SelectionFont.Name = objectRtf.SelectionFont.Name And _
                               RichTextBoxRtfCompare.SelectionFont.Size = objectRtf.SelectionFont.Size Then

                                bWrite = False
                            Else
                                sb.Append("</span></font>")
                                If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
                                If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
                            End If
                        End If
                        If bWrite = True Then
                            sb.Append(SelectCharOffSet(objectRtf.SelectionCharOffset))
                            sb.Append("<font color=" & """" & GetHexColor(objectRtf.SelectionColor) & """>")
                            sb.Append("<span style=""font: " & objectRtf.SelectionFont.Size &
                                      "pt/normal; font-family: ")
                            sb.Append(objectRtf.SelectionFont.Name)
                            If objectRtf.SelectionFont.Bold = True Then
                                sb.Append("; font-weight: 700;")
                            Else
                                sb.Append("; font-weight: 200;")
                            End If
                            If objectRtf.SelectionFont.Italic = True Then sb.Append(" font-style: italic;")
                            If objectRtf.SelectionFont.Underline = True Then _
                               sb.Append(" text-decoration: underline;")
                            sb.Append(" background-color: " & GetHexColor(objectRtf.SelectionBackColor))
                            sb.Append(SelectApPed(objectRtf.SelectionCharOffset))
                            sb.Append(""">")
                        End If
                        If objectRtf.SelectedText = " " Then
                            sb.Append("  ")
                        Else
                            sb.Append(objectRtf.SelectedText)
                        End If
                        If j = start + lenghtLine - 1 Then
                            sb.Append("</span></font>")
                            If TagApExist = True Then TagApExist = False : sb.Append("</sup>")
                            If TagPedExist = True Then TagPedExist = False : sb.Append("</sub>")
                        End If
                    Next
                End If
                sb.Append("</div>")
                If Me.TagPointListExist = True Then _
                   Me.TagPointListExist = False : sb.Append("</li>" & "</ul>")
                If Me.TagIndentExist = True Then
                    sb.AppendLine()
                    For j = 1 To Me.NumberIndent
                        sb.Append("</blockquote>")
                    Next
                    TagIndentExist = False : Me.NumberIndent = 0
                End If
                sb.AppendLine()
            Next
            sb.AppendLine()
            sb.Append("</body></html>")
            Return sb.ToString
        End Function

        Private Function GetHexColor(ByVal colore As Color) As String
            Return "#" & colore.R.ToString("X2") & colore.G.ToString("X2") & colore.B.ToString("X2")
        End Function

        Private Function SelectStartIndex(ByVal objectRtf As RichTextBox, _
                                          ByVal line As Integer) As Integer
            Dim totalChars As Integer = 0
            If line > 0 Then _
               For i As Integer = 0 To line - 1 : totalChars += objectRtf.Lines(i).Length + 1 : Next
            Return totalChars
        End Function

        Private Function SelectIndentBullet(ByVal misureBullets As Integer) As String
            Dim stringIndent As String = ""
            Select Case misureBullets
                Case Is > 40 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; "
                Case Is > 30 : stringIndent = "&nbsp; &nbsp; &nbsp; &nbsp; "
                Case Is > 20 : stringIndent = "&nbsp; &nbsp; &nbsp; "
                Case Is > 10 : stringIndent = "&nbsp; &nbsp; "
                Case Is > 0 : stringIndent = "&nbsp; "
            End Select
            Return stringIndent
        End Function

        Private Function SelectLeftIndent(ByVal misureLeftMargin As Integer) As String
            Dim stringBuild As String = ""
            Select Case misureLeftMargin
                Case Is > 175
                    Me.NumberIndent = 6
                    stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote><blockquote>"
                Case Is > 140
                    Me.NumberIndent = 5
                    stringBuild = "<blockquote><blockquote><blockquote><blockquote><blockquote>"
                Case Is > 105
                    Me.NumberIndent = 4 : stringBuild = "<blockquote><blockquote><blockquote><blockquote>"
                Case Is > 70
                    Me.NumberIndent = 3 : stringBuild = "<blockquote><blockquote><blockquote>"
                Case Is > 35
                    Me.NumberIndent = 2 : stringBuild = "<blockquote><blockquote>"
                Case Is > 0
                    Me.NumberIndent = 1 : stringBuild = "<blockquote>"
            End Select
            Me.TagIndentExist = True
            Return stringBuild
        End Function

        Private Function SelectCharOffSet(ByVal value As Integer) As String
            Select Case value
                Case Is < 0 : Me.TagApExist = True : Return "<sub>"
                Case Is > 0 : Me.TagPedExist = True : Return "<sup>"
            End Select
            Return ""
        End Function

        Private Function SelectAlignment(ByVal alignment As Integer) As String
            Select Case alignment
                Case Is = 0 : Return "align=""left"">"
                Case Is = 1 : Return "align=""right"">"
                Case Is = 2 : Return "align=""center"">"
            End Select
            Return ""
        End Function

        Private Function SelectBullet(ByVal value As Boolean) As String
            If value = True Then
                Me.TagPointListExist = True
                Return "<ul><li>"
            Else
                Return ""
            End If
        End Function

        Private Function SelectSize(ByVal value As Integer) As Integer
            Select Case value
                Case Is > 65 : Return 7
                Case Is > 50 : Return 6
                Case Is > 35 : Return 5
                Case Is > 20 : Return 4
                Case Is > 10 : Return 3
                Case Is > 5 : Return 2
                Case Is > 0 : Return 1
            End Select
        End Function

        Private Function SelectApPed(ByVal value As Integer) As String
            If TagApExist = True Or TagPedExist = True Then
                Select Case value
                    Case Is = 5 : Return "; vertical-align: bottom"
                    Case Is = 4 : Return "; vertical-align: middle"
                    Case Is = 3 : Return "; vertical-align: text-bottom"
                    Case Is = 2 : Return "; vertical-align: text-top"
                    Case Is = 1 : Return "; vertical-align: top"
                    Case Is = -1 : Return "; vertical-align: bottom"
                    Case Is = -2 : Return "; vertical-align: middle"
                    Case Is = -3 : Return "; vertical-align: text-bottom"
                    Case Is = -4 : Return "; vertical-align: text-top"
                    Case Is > -5 : Return "; vertical-align: top"
                End Select
            End If
            Return ""
        End Function

#Region " IDisposable Support "
        Private disposedValue As Boolean = False    ' To detect redundant calls
        ' IDisposable
        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: free other state (managed objects).
                End If
                ' TODO: free your own state (unmanaged objects).
                ' TODO: set large fields to null.
            End If
            Me.disposedValue = True
        End Sub
        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region
    End Class
End Namespace

Evet güzel olmuş ama bir problemle karşılaştım bilmem sende karşılaştınmı?
bu problem gönderdiğim yazılarda fontların türünü boyutunu değiştiriyorum yazıları bold yapıyorum richtextbox içindede aynen görünüyor ama gönderilen email'e adresime giderek baktığımda font boyutları standartta kalmış benim yaptığım boyutlarda değil diğer özellikleri aktarılmış görünüyor benim richtextbox'uma henüz font rengi butonu eklemediğim için renklerde bir sorun varmı test edemedim

Kodum

Gönder butonunun en başına
        Dim s As String
        Using o As New RtfToHtml.RtfToHtml(Me.RichTextBox1)
            s = o.FormatHtml
        End Using

Gönder butonunda olması gereken yere
            mail.IsBodyHtml = True
            mail.Body = s

Aşağıdaki kodla rtf dosyası oluşturup bunda herşey düzgün görünüyormu diye baktım herşey düzgün
Me.RichTextBox1.SaveFile(Application.StartupPath & "\tmp.rtf")

 

[algea]

RTFtoHTML düzgün çalışıyor. Font isimleri, font boyutları, font renklerini, font özelliklerini çevirebiliyor. Fakat RTF belgede resim ve tabloları maalesef çeviremiyor. Net Framework’de ne yazık ki RTF'den HTML'ye çevirmek için ekstra yöntem yok. Google'da başka örneklere baktım 3. parti ücretli çözümler var. Konuyla bende ilgileniyorum daha uygun ya da yetenekli RTF’den HTML’ye çevirme yöntemleri bulabilirsen haber ver.

 

[Vatansever]

RTFtoHTML düzgün çalışıyor. Font isimleri, font boyutları, font renklerini, font özelliklerini çevirebiliyor. Fakat RTF belgede resim ve tabloları maalesef çeviremiyor. Net Framework’de ne yazık ki RTF'den HTML'ye çevirmek için ekstra yöntem yok. Google'da başka örneklere baktım 3. parti ücretli çözümler var. Konuyla bende ilgileniyorum daha uygun ya da yetenekli RTF’den HTML’ye çevirme yöntemleri bulabilirsen haber ver.

Deneyip sonuçları yazarmısın?
KOD1

Imports System.IO
Imports System.Text
Public Class Form1
  Dim MS As New MenuStrip
  Dim WithEvents PasteRTF As New ToolStripButton
  Dim WithEvents CopyHTML As New ToolStripButton
  Dim RTB As New RichTextBox
  Dim DataFile As String = Application.StartupPath + "\Data.txt"
  Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
    If File.Exists(DataFile) Then
      Dim Data() As String = File.ReadAllText(DataFile).Split(","c)
      Me.Left = Integer.Parse(Data(0).Substring(3, Data(0).Length - 3))
      Me.Top = Integer.Parse(Data(1).Substring(2, Data(1).Length - 2))
      Me.Width = 434
      Me.Width = Integer.Parse(Data(2).Substring(6, Data(2).Length - 6))
      Me.Height = Integer.Parse(Data(3).Substring(7, Data(3).Length - 8))
    End If
    Me.Text = "MSDN forums code formatter by johnwein"
    PasteRTF.Text = "Paste RTF"
    CopyHTML.Text = "Copy HTML"
    MS.Items.Add(PasteRTF)
    MS.Items.Add(CopyHTML)
    MS.Parent = Me
    RTB.Parent = Me
    RTB.Dock = DockStyle.Fill
    RTB.BringToFront()
  End Sub
  Private Sub PasteRTF_Click(ByVal sender As Object, ByVal e As EventArgs) Handles PasteRTF.Click
    RTB.Clear()
    RTB.Paste(DataFormats.GetFormat(DataFormats.Rtf))
  End Sub
  Private Sub CopyHTML_Click(ByVal sender As Object, ByVal e As EventArgs) Handles CopyHTML.Click
    Clipboard.Clear()
    Dim Conv As New RtfToHtml
    Clipboard.SetData(DataFormats.Html, Conv.RtfToHtml(RTB.Rtf))
  End Sub
  Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
    File.WriteAllText(DataFile, Me.Bounds.ToString)
  End Sub
End Class

Public Class RtfToHtml
  Dim SR As StringReader
  Dim SW As StringWriter
  Dim Clrtbl As List(Of String)
  Function RtfToHtml(ByVal RtfIn As String) As String
    SR = New StringReader(RtfIn)
    SW = New StringWriter()
    Dim S As String = GetColorTable()
    SW.Write("<span style=" + Chr(34) + "font-family: Courier new; font-size: x-medium" + Chr(34) + "><span>")
    Do
      WriteLine(S)
      S = SR.ReadLine
    Loop Until S Is Nothing
    SW.Write("</span>")
    Return SW.ToString
  End Function
  Sub WriteLine(ByVal S As String)
    Dim I, J As Integer
    If S(0) = "}" And S.Length = 1 Then Return
    For I = 0 To S.Length - 1
      Select Case S(I)
        Case "\"c
          Select Case S(I + 1)
            Case "{"c, "}"c, "\"c
              I += 1
              SW.Write(S(I))
              Continue For
            Case Else
              I += 1
              For J = I To S.Length - 1
                If S(J) = " " Or S(J) = "\" Then Exit For
              Next
              If S.Substring(I, 2) = "cf" Then WriteColor(S(I + 2))
              I = If(J < S.Length, If(S(J) = " ", J, J - 1), J)
          End Select
        Case "<"c
          SW.Write("&lt;")
        Case ">"c
          SW.Write("&gt;")
        Case "&"c
          SW.Write("&amp;")
        Case " "c
          SW.Write("&nbsp;")
        Case Else
          SW.Write(S(I))
      End Select
    Next
    SW.Write("<br>" + Environment.NewLine)
  End Sub
  Sub WriteColor(ByVal C As Char)
    Dim I As Integer
    I = Integer.Parse(C) - 1
    If I < 0 Then
      SW.Write("</span><span>")
    Else
      SW.Write("</span><span style=" + Chr(34) + "Color: " + Clrtbl(I) + ";" + Chr(34) + ">")
    End If
  End Sub
  Function GetColorTable() As String
    Dim I, J As Integer, C, S, S1(), S2() As String
    Clrtbl = New List(Of String)
    Do
      S = SR.ReadLine
      If S Is Nothing Then Return S
      I = S.IndexOf("{\colortbl")
      If I >= 0 Then Exit Do
      I = S.IndexOf("\pard")
      If I > 0 Then Return S.Substring(I + 5)
    Loop
    S1 = S.Substring(I, S.IndexOf("}"c) - I).Split(";"c)
    Dim Clrs() As Integer = {3, 5, 4} 'Length of the colors
    For I = 1 To S1.Length - 2
      S2 = S1(I).Split("\"c)
      C = "#"
      For J = 1 To 3
        C += Hex(Integer.Parse(S2(J).Substring(Clrs(J - 1)))).PadLeft(2, "0"c)
      Next
      Clrtbl.Add(C)
    Next
    Do
      I = S.IndexOf("\pard")
      If I > 0 Then Return S.Substring(I + 5)
      S = SR.ReadLine
    Loop Until S Is Nothing
    Return S
  End Function
End Class

KOD2 RTFtoHTML.vb class dosyası

''' <summary>
''' An object that converts RTF to HTML
''' </summary>
''' <remarks>
'''   Completed: 11/02/2006
'''   Author: George H. Slaterpryce III
'''   Modifications: none
'''   *************************************************************************
'''   *************************************************************************
'''   License: This code is free to use in private or commercial 
'''   applications, re-distribution of this code is allowed in whole 
'''   or in part so long as this header remains intact. All modifications 
'''   and further development to this code should be indicated by adding the 
'''   name of the author and the modifications/improvements under the 
'''   "Modifications:" section.
'''   Modification Listings should be in the format of.
'''   (#) Description of modification (Name, Date)
'''   *************************************************************************
'''   *************************************************************************
''' </remarks>
Public Class RTFtoHTML

#Region "Private Members"

  ' A RichTextBox control to use to help with parsing.
  Private _rtfSource As New System.Windows.Forms.RichTextBox

#End Region

#Region "Read/Write Properties"

  ''' <summary>
  ''' Returns/Sets The RTF formatted text to parse
  ''' </summary>
  Public Property rtf() As String
    Get
      Return _rtfSource.Rtf
    End Get
    Set(ByVal value As String)
      _rtfSource.Rtf = value
    End Set
  End Property

#End Region

#Region "ReadOnly Properties"

  ''' <summary>
  ''' Returns the HTML code for the provided RTF
  ''' </summary>
  Public ReadOnly Property html() As String
    Get
      Return GetHtml()
    End Get
  End Property

#End Region

#Region "Private Functions"

  ''' <summary>
  ''' Returns an HTML Formated Color string for the style from a system.drawing.color
  ''' </summary>
  ''' <param name="clr">The color you wish to convert</param>
  Private Function HtmlColorFromColor(ByRef clr As System.Drawing.Color) As String
    Dim strReturn As String = ""
    If clr.IsNamedColor Then
      strReturn = clr.Name.ToLower
    Else
      strReturn = clr.Name
      If strReturn.Length > 6 Then
        strReturn = strReturn.Substring(strReturn.Length - 6, 6)
      End If
      strReturn = "#" & strReturn
    End If
    Return strReturn
  End Function

  ''' <summary>
  ''' Provides the font style per given font
  ''' </summary>
  ''' <param name="fnt">The font you wish to convert</param>
  Private Function HtmlFontStyleFromFont(ByRef fnt As System.Drawing.Font) As String
    Dim strReturn As String = ""
    'style
    If fnt.Italic Then
      strReturn &= "italic "
    Else
      strReturn &= "normal "
    End If
    'variant
    strReturn &= "normal "
    'weight
    If fnt.Bold Then
      strReturn &= "bold "
    Else
      strReturn &= "normal "
    End If
    'size
    strReturn &= fnt.SizeInPoints & "pt/normal "
    'family
    strReturn &= fnt.FontFamily.Name
    Return strReturn
  End Function

  ''' <summary>
  ''' Parses the given rich text and returns the html.
  ''' </summary>
  Private Function GetHtml() As String
    Dim strReturn As String = "<div>"
    Dim clrForeColor As System.Drawing.Color = Color.Black
    Dim clrBackColor As System.Drawing.Color = Color.Black
    Dim fntCurrentFont As System.Drawing.Font = _rtfSource.Font
    Dim altCurrent As System.Windows.Forms.HorizontalAlignment = HorizontalAlignment.Left
    Dim intPos As Integer = 0
    For intPos = 0 To _rtfSource.Text.Length - 1
      _rtfSource.Select(intPos, 1)
      'Forecolor
      If intPos = 0 Then
        strReturn &= "<span style=""color:" & HtmlColorFromColor(_rtfSource.SelectionColor) & """>"
        clrForeColor = _rtfSource.SelectionColor
      Else
        If _rtfSource.SelectionColor <> clrForeColor Then
          strReturn &= "</span>"
          strReturn &= "<span style=""color:" & HtmlColorFromColor(_rtfSource.SelectionColor) & """>"
          clrForeColor = _rtfSource.SelectionColor
        End If
      End If
      'Background color
      If intPos = 0 Then
        strReturn &= "<span style=""background-color:" & HtmlColorFromColor(_rtfSource.SelectionBackColor) & """>"
        clrBackColor = _rtfSource.SelectionBackColor
      Else
        If _rtfSource.SelectionBackColor <> clrBackColor Then
          strReturn &= "</span>"
          strReturn &= "<span style=""background-color:" & HtmlColorFromColor(_rtfSource.SelectionBackColor) & """>"
          clrBackColor = _rtfSource.SelectionBackColor
        End If
      End If
      'Font
      If intPos = 0 Then
        strReturn &= "<span style=""font:" & HtmlFontStyleFromFont(_rtfSource.SelectionFont) & """>"
        fntCurrentFont = _rtfSource.SelectionFont
      Else
        If _rtfSource.SelectionFont.GetHashCode <> fntCurrentFont.GetHashCode Then
          strReturn &= "</span>"
          strReturn &= "<span style=""font:" & HtmlFontStyleFromFont(_rtfSource.SelectionFont) & """>"
          fntCurrentFont = _rtfSource.SelectionFont
        End If
      End If
      'Alignment
      If intPos = 0 Then
        strReturn &= "<p style=""text-align:" & _rtfSource.SelectionAlignment.ToString & """>"
        altCurrent = _rtfSource.SelectionAlignment
      Else
        If _rtfSource.SelectionAlignment <> altCurrent Then
          strReturn &= "</p>"
          strReturn &= "<p style=""text-align:" & _rtfSource.SelectionAlignment.ToString & """>"
          altCurrent = _rtfSource.SelectionAlignment
        End If
      End If
      strReturn &= _rtfSource.Text.Substring(intPos, 1)
    Next
    'close all the spans
    strReturn &= "</span>"
    strReturn &= "</span>"
    strReturn &= "</span>"
    strReturn &= "</p>"
    strReturn &= "</div>"
    strReturn = strReturn.Replace(Convert.ToChar(10), "<br />")
    Return strReturn
  End Function

#End Region

End Class

'RTFtoHTML.vb dosyasının kodunun yazım şekli
''Assume you have a RichTextBox on your 
''form named rtbFoo and a button named btnBar

  Private Sub btnBar_Click(ByVal sender as object, _
          e as System.EventArgs) Handles btnBar.Click
    dim r2h as new RTFtoHTML
    r2h.rtf = rtbFoo.rtf
    messagebox.show(r2h.html)
  End Sub

 

[algea]

Yolladıkların daha öncekiler ile benzer nitelikte ve herşeyi çevirmiyor

 

[craftingMaterial]

En sağlam yöntem WYSIWYG editör yazmanız Çok da zor bir şey değil biraz araştırma yaparsanız bulursunuz zaten