Dawolf: Extraer imagen de un RTF cargado en un RichTextBox (Visual Basic .Net)

Hace poco me encontré con este problema y después de mirar diferentes ejemplos y documentación llegue a la siguiente solución.

En documentos RTF las imágenes incrustadas se identifican con un tag “{\pict\”. Solo hay que buscarlo y extraer de dicho tag la cadena hexadecimal que guarda la información de la imagen, transformarla a un array binario y cargarlo en un nuevo objeto imagen con las dimensiones que también hemos extraído del tag.

Espero que a alguien le sea útil. Al final del código os dejo el proyecto ejemplo para descargar.

Imports System.IO
Imports System.Text

Public Class Form1

#Region "Variables y Constantes"

    'twip (TWentIeth of a Point) es un punto, una unidad de medida de pantalla.
    'Segun documentacion microsoft: http://www.microsoft.com/en-us/download/details.aspx?id=10725 
    'En un rtf el ancho y el largo de la imagen se guarda en twips 
    'Un twip equivale aprox. a 26.15 pixels
    Const TWIP As Decimal = 26.450704225352109

#End Region

#Region "Eventos"

    Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles Me.Load

        Me.RichTextBox1.LoadFile("c:\documento.rtf")

    End Sub

    Private Sub ButtonExtraer_Click(sender As System.Object, e As System.EventArgs) Handles ButtonExtraer.Click

        'Extraemos los datos
        '-------------------
        Dim imagenHex As String

        imagenHex = ExtraerImagenHexadecimal(RichTextBox1.Rtf)

        Dim elementos As String()

        elementos = ExtraerDatosImagen(RichTextBox1.Rtf)

        Dim ImgWidth As Integer = (CInt(elementos(3).Replace("picw", "")) / TWIP)
        Dim ImgHeight As Integer = (CInt(elementos(4).Replace("pich", "")) / TWIP)

        Dim imagenBuffer As Byte()

        imagenBuffer = PasarABinario(imagenHex)

        'Generamos y Exportamos la imagen
        '--------------------------------
        Dim image As Image

        Dim MemoryStream As Stream = New MemoryStream(imagenBuffer)

        image = System.Drawing.Image.FromStream(MemoryStream)

        Dim rect As New Rectangle(0, 0, ImgWidth, ImgHeight)

        Dim thumb As Bitmap = New Bitmap(ImgWidth, ImgHeight)

        Dim pint As Graphics = Graphics.FromImage(thumb)

        pint.DrawImage(image, rect)

        thumb.Save("c:\Imagen.jpg", System.Drawing.Imaging.ImageFormat.Jpeg)

        MemoryStream.Close()

    End Sub

#End Region

#Region "Procediminetos y Funciones"

    ''' 
    ''' Extrae la imagen en hexadecimal del texto del rtf
    ''' 
    ''' 
    ''' 
    ''' 
    Public Function ExtraerImagenHexadecimal(ByVal texto As String)

        Dim pictTagIdx As Integer = texto.IndexOf("{\pict\")
        Dim startIndex As Integer = texto.IndexOf(" ", pictTagIdx) + 1
        Dim endIndex As Integer = texto.IndexOf("}", startIndex)

        Return texto.Substring(startIndex, endIndex - startIndex)

    End Function

    ''' 
    ''' Extrae los Datos de la imagen
    ''' 
    ''' 
    ''' 
    ''' 
    Public Function ExtraerDatosImagen(ByVal texto As String) As String()

        Dim pictTagIdx As Integer = texto.IndexOf("{\pict\")
        Dim startIndex As Integer = texto.IndexOf(" ", pictTagIdx)
        Dim endIndex As Integer = texto.IndexOf("}", startIndex)

        Dim cadena As String

        cadena = texto.Substring(pictTagIdx, startIndex - pictTagIdx)

        Dim elementos As String() = cadena.Split("\")

        Return elementos

    End Function

    ''' 
    ''' Pasa la cadena Hexadecimal a un array binario
    ''' 
    ''' 
    ''' 
    ''' 
    Public Function PasarABinario(ByVal imageDataHex As String) As Byte()

        If imageDataHex Is Nothing Or imageDataHex.Trim = "" Then

            Throw New ArgumentNullException("imageDataHex")

        End If

        Dim hexDigits As Integer = imageDataHex.Length
        Dim dataSize As Integer = hexDigits / 2
        Dim imageDataBinary(dataSize) As Byte

        Dim hex As New StringBuilder(2)

        Dim dataPos As Integer = 0

        Dim c As Char

        For i As Integer = 0 To hexDigits - 1

            c = imageDataHex(i)

            If Char.IsWhiteSpace(c) Then

                Continue For

            End If

            hex.Append(imageDataHex(i))

            If hex.Length = 2 Then

                imageDataBinary(dataPos) = Byte.Parse(hex.ToString(), System.Globalization.NumberStyles.HexNumber)

                dataPos = dataPos + 1

                hex.Remove(0, 2)

            End If

        Next

        Return imageDataBinary

    End Function

#End Region

End Class