How do I insert an image into a RichTextBox without using the clipboard, and using VB.NET?

Robert Gustafson 606 Reputation points
2022-01-27T00:24:31.417+00:00

WHAT I HAVE:
Visual Basic 2019, .NET 4.6.1+, WinForms

MY PROBLEM:

I've been trying to adapt the code from Khendys Gordon's CodeProject article "Insert Plain Text and Images into RichTextBox at Runtime" into VB.NET code that places an Image into a standard RichTextBox without relying on the clipboard. The following module I've created, when added to a WinForms project, is supposed encapsulate an Image inside a Windows metafile, then create the RTF text for the image. (Apparently, the RichTextBox [as well as WordPad] ignores RTF for a picture if it's not in that ancient format--or so the article says!) It's derived from the source code of the aforementioned CodeProoject project. For some reason, though, when I trying something like

InsertImage(RichTextBox1, MyImage)

in a host project, the above method doesn't insert any image. What is missing or wrong about the module code below?

 Imports System.Drawing.Imaging
 Imports System.Drawing.Text
 Imports System.IO
 Imports System.Runtime.InteropServices
 Imports System.Text

 Module InsertImageModule

    '    options for call to EmfToWmfBits()
    Private Enum EmfToWmfBitsFlags
        EmfToWmfBitsFlagsDefault = &H0
        EmfToWmfBitsFlagsEmbedEmf = &H1
        EmfToWmfBitsFlagsIncludePlaceable = &H2 'place header into WMF so that it's placeable
        EmfToWmfBitsFlagsNoXORClip = &H4 'no clipping
    End Enum

    '    constants for image insertion
    Private Const MM_ISOTROPIC As Integer = 7 'keep 1:1 aspect ration
    Private Const MM_ANISOTROPIC As Integer = 8 'adjust x and y separately
    Private Const HMM_PER_INCH As Integer = 2540 'himetrics per inch
    Private Const TWIPS_PER_INCH As Integer = 1440 'twips per inch

    '   declares for image insertion
    <DllImportAttribute("gdiplus.dll")>
    Private Function GdipEmfToWmfBits(ByVal mfHandle As IntPtr, ByVal _bufferSize As UInteger, ByVal _buffer() As Byte, ByVal _mappingMode As Integer, ByVal _flags As EmfToWmfBitsFlags) As UInteger
    End Function
    <DllImport("gdi32.dll")>
    Private Function DeleteEnhMetaFile(ByVal hemf As IntPtr) As Boolean
    End Function


    Public Sub InsertImage(RichTextBox As RichTextBox, _
        image As Image)
    Dim sb As New StringBuilder()
    sb.Append("{\rtf1\ansi\ansicpg1252\deff0\deflang1033\uc1")
    sb.Append(GetFontTable(RichTextBox.Font))
    sb.Append("{\pct\wmetafile8")
    sb.Append(GetImagePrefix(RichTextBox, image))
    sb.Append(GetRtfImage(RichTextBox, image))
    sb.Append("} }")
    RichTextBox.SelectedRtf = sb.ToString()
    End Sub

    '   procedures for image insertion

    Private Function GetFontTable(font As Font) As String
    '   create font-table header for image RTF
    Dim sb As New StringBuilder()
    '   header
    sb.Append("{\fonttbl{\f0")
    '   font family
    Select Case font.FontFamily.Name
      Case FontFamily.GenericSerif.Name
          sb.Append("\froman")
      Case FontFamily.GenericSansSerif.Name
          sb.Append("\fswiss")
      Case FontFamily.GenericMonospace.Name
          sb.Append("\fmodern")
      Case Else
          sb.Append("\fnil")
    End Select
    '   character set, font name, and trailer
    sb.Append("\fcharset0 ") : sb.Append(font.Name) : sb.Append(";}}")
    Return sb.ToString()
    End Function

    Private Function GetImagePrefix(RichTextBox As RichTextBox, _
        ByVal image As Image) As String
    '   get RTF prefix for image
    Dim sb As New StringBuilder()
    Using gr As Graphics = RichTextBox.CreateGraphics
        '   current width of the image in himetrics
        Dim picw As Integer = _
            CInt(Math.Truncate(Math.Round((image.Width / gr.DpiX) * HMM_PER_INCH)))
        sb.Append("\picw") : sb.Append(picw)
        '   current height of the image himetrics
        Dim pich As Integer = _
            CInt(Math.Truncate(Math.Round((image.Height / gr.DpiY) * HMM_PER_INCH)))
        sb.Append("\pich") : sb.Append(pich)
        '    target width of the image in twips
        Dim picwgoal As Integer = _
            CInt(Math.Truncate(Math.Round((image.Width / gr.DpiX) * TWIPS_PER_INCH)))
        sb.Append("\picwgoal") : sb.Append(picwgoal)
        '   target height of the image in twips
        Dim pichgoal As Integer = _
            CInt(Math.Truncate(Math.Round((image.Height / gr.DpiY) * TWIPS_PER_INCH)))
        sb.Append("\pichgoal") : sb.Append(pichgoal) : sb.Append(" ")
    End Using
    Return sb.ToString()
    End Function

    Private Function GetRtfImage(RichTextBox As RichTextBox, _
        ByVal image As Image) As String
    '   get RTF for image info
    Dim sb As StringBuilder = Nothing
    '   store enhanced metafile in memory stream
    Dim ms As MemoryStream = Nothing, mf As Metafile = Nothing
    Try
        sb = New StringBuilder() : ms = New MemoryStream()
        '   get graphics content from RichTextBox
        Using gr As Graphics = RichTextBox.CreateGraphics
            '   create enhanced metafile from the graphics context
            Dim hDC As IntPtr = gr.GetHdc()
            mf = New Metafile(ms, hDC) : gr.ReleaseHdc(hDC)
        End Using
             ' Get a graphics context from the Enhanced Metafile
        Using gr As Graphics = Graphics.FromImage(mf)
            '   draw image onto metafile
             gr.DrawImage(image, New Rectangle(0, 0, image.Width, image.Height))
        End Using
        ' Get the handle of the Enhanced Metafile
        Dim mfHandle As IntPtr = mf.GetHenhmetafile()
        '   get size of buffer for metafile info
        Dim _bufferSize As UInteger = _
            GdipEmfToWmfBits(mfHandle, 0, Nothing, MM_ANISOTROPIC, _
                EmfToWmfBitsFlags.EmfToWmfBitsFlagsDefault)
        Dim _buffer(CInt(_bufferSize - 1)) As Byte
        '   copy metafile info into buffer and get actual size
        Dim _convertedSize As UInteger = _
            GdipEmfToWmfBits(mfHandle, _bufferSize, _buffer, MM_ANISOTROPIC, _
                EmfToWmfBitsFlags.EmfToWmfBitsFlagsDefault)
        '    copy buffer contents into string of hex values
        For index As Integer = 0 To _buffer.Length - 1
            sb.Append(String.Format("{0:X2}", _buffer(index)))
        Next index
        DeleteEnhMetaFile(mfHandle) 'prevents memory leak
        Return sb.ToString()
     Finally
        '   handle metafile and memory-stream disposal
        If mf IsNot Nothing Then
            mf.Dispose()
        End If
        If ms IsNot Nothing Then
            ms.Close() : ms.Dispose()
        End If
    End Try
    End Function
End Module

Please provide me with a solution ASAP. Keep it simple, and keep it in VB.NET!

Windows Forms
Windows Forms
A set of .NET Framework managed libraries for developing graphical user interfaces.
1,830 questions
VB
VB
An object-oriented programming language developed by Microsoft that is implemented on the .NET Framework. Previously known as Visual Basic .NET.
2,574 questions
Accepted answer
  1. Jiachen Li-MSFT 26,591 Reputation points Microsoft Vendor
    2022-01-27T05:49:19.477+00:00

    Hi @Robert Gustafson ,
    According to the Rich Text Format (RTF) Specification, version 1.6
    You should use sb.Append("{\pict\wmetafile8") on line 37 of the code you provided.
    Hope this could be helpful.
    Best Regards.
    Jiachen Li

    ----------

    If the answer is helpful, please click "Accept Answer" and upvote it.
    Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

1 additional answer

Sort by: Most helpful
Most helpful Newest Oldest
  1. Viorel 112.1K Reputation points
    2022-01-27T04:07:09.063+00:00

    Try using “\pict” instead of “\pct”.

    0 comments