VB.Net Вставить расширенный метафайл из буфера обмена в Picture Box

Я хочу вставить расширенный метафайл из буфера обмена в графический блок в VB.Net. На самом деле, я сделал это, но я не знаю, правильно ли я это делаю.

У меня есть этот объект из буфера обмена:

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

и я хочу вставить его в Picture Box.

Следующий код не работает:

    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

Затем я попробовал это (это сработало, отсюда)):

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

Тогда я называю это с:

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

Приведенный выше код работает, но мне было интересно, есть ли другой способ вставки расширенного метафайла без необходимости dll's?

Спасибо!!!

0 ответов

Другие вопросы по тегам