VB.Net Paste Enhanced Metafile from clipboard to Picture Box

1k Views Asked by At

I want to paste an Enhanced Metafile from Clipboard to a Picture Box in VB.Net. Actually, I did that, but I don't know if doing it in the right way.

I have this object from clipboard:

Dim obj As DataObject = Clipboard.GetDataObject()
Dim typ As String()
typ = objData.GetFormats() ' This returns "EnhancedMetafile" and "MetaFilePict"

and I want to paste it to a Picture Box.

The following code doesn't work:

    Dim objData As DataObject = Clipboard.GetDataObject()

    ' This if is always false
    If objData.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
        Dim bmp As System.Drawing.Bitmap = CType(objData.GetData(GetType(System.Drawing.Bitmap)), System.Drawing.Bitmap)
        PictureBox1.Image = bmp
    End If

Then I tried this (that worked, from here)):

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class ClipboardMetafileHelper
    <DllImport("user32.dll", EntryPoint:="OpenClipboard", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function OpenClipboard(ByVal hWnd As IntPtr) As Boolean
    End Function
    <DllImport("user32.dll", EntryPoint:="EmptyClipboard", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function EmptyClipboard() As Boolean
    End Function
    <DllImport("user32.dll", EntryPoint:="SetClipboardData", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function SetClipboardData(ByVal uFormat As Integer, ByVal hWnd As IntPtr) As IntPtr
    End Function
    <DllImport("user32.dll", EntryPoint:="GetClipboardData", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function GetClipboardData(ByVal uFormat As Integer) As IntPtr
    End Function
    <DllImport("user32.dll", EntryPoint:="CloseClipboard", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function CloseClipboard() As Boolean
    End Function
    <DllImport("gdi32.dll", EntryPoint:="CopyEnhMetaFileA", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function CopyEnhMetaFile(ByVal hemfSrc As IntPtr, ByVal hNULL As IntPtr) As IntPtr
    End Function
    <DllImport("gdi32.dll", EntryPoint:="DeleteEnhMetaFile", _
       SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Function DeleteEnhMetaFile(ByVal hemfSrc As IntPtr) As Boolean
    End Function

    ' Metafile mf is set to a state that is not valid inside this function.
    Public Shared Function PutEnhMetafileOnClipboard(ByVal hWnd As IntPtr, ByVal mf As Metafile) As Boolean
        Dim bResult As New Boolean()
        bResult = False
        Dim hEMF, hEMF2 As IntPtr
        hEMF = mf.GetHenhmetafile() ' invalidates mf
        If Not hEMF.Equals(New IntPtr(0)) Then
            hEMF2 = CopyEnhMetaFile(hEMF, New IntPtr(0))
            If Not hEMF2.Equals(New IntPtr(0)) Then
                If OpenClipboard(hWnd) Then
                    If EmptyClipboard() Then
                        Dim hRes As IntPtr
                        hRes = SetClipboardData(14, hEMF2)    ' 14 == CF_ENHMETAFILE
                        bResult = hRes.Equals(hEMF2)
                        CloseClipboard()
                    End If
                End If
            End If
            DeleteEnhMetaFile(hEMF)
        End If
        Return bResult
    End Function

    Public Shared Function GetEnhMetafileFromClipboard(ByVal hWnd As IntPtr) As Image
        OpenClipboard(hWnd) ' IntPtr.Zero
        Dim hemf As IntPtr = GetClipboardData(14) ' 14 == CF_ENHMETAFILE
        CloseClipboard()
        If hemf <> IntPtr.Zero Then
            Dim mf As New Metafile(hemf, True)
            Dim b As New Bitmap(mf.Width, mf.Height)
            Dim g As Graphics = Graphics.FromImage(b)
            g.FillRectangle(Brushes.White, 0, 0, 1000, 1000)
            Dim unit As GraphicsUnit = GraphicsUnit.Millimeter
            Dim rsrc As RectangleF = mf.GetBounds(unit)
            g.DrawImage(mf, New Rectangle(0, 0, mf.Width, mf.Height), rsrc, unit)
            Return b
        End If
        Return Nothing
    End Function

End Class

Then I call it with:

PictureBox1.Image = ClipboardMetafileHelper.GetEnhMetafileFromClipboard(Me.Handle)

The above code works but I was wondering if there is another way of pasting an Enhanced Metafile without the need of those dll's?

Thanks!!!

0

There are 0 best solutions below