Convert .NET Image to VB6 IPictureDisp

I need to call a VB6 ActiveX component from my .NET project. One of the parameters that the ActiveX component expects is an IPictureDisp image. The image I have is a .NET System.Drawing.Image.

I need a function that will convert the System.Drawing.Image to a stdole.IPictureDisp object.
LVL 18
JR2003Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bob LearnedCommented:
0
JR2003Author Commented:
TheLearnedOne

It would but... The function in the link has a GetPictureFromIPicture function.
I need a GetIPictureDispFromPicture function to convert an image to an IPictureDisp.

Thanks
0
Bob LearnedCommented:
I haven't the time to test, but try this:

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

<ComImport(), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), Guid("0000000C-0000-0000-C000-000000000046")> _
Public Interface IStream
  ' Methods
  Function Clone() As <MarshalAs(UnmanagedType.Interface)> IStream
  Sub Commit(ByVal grfCommitFlags As Integer)
  Function CopyTo(<InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal pstm As IStream, <InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal cb As Long, <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pcbRead As Long()) As <MarshalAs(UnmanagedType.I8)> Long
  Sub LockRegion(<InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal libOffset As Long, <InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal cb As Long, ByVal dwLockType As Integer)
  Function Read(ByVal buf As IntPtr, ByVal len As Integer) As Integer
  Sub Revert()
  Function Seek(<InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal dlibMove As Long, ByVal dwOrigin As Integer) As <MarshalAs(UnmanagedType.I8)> Long
  Sub SetSize(<InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal libNewSize As Long)
  Sub Stat(<Out()> ByVal pStatstg As STATSTG, ByVal grfStatFlag As Integer)
  Sub UnlockRegion(<InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal libOffset As Long, <InAttribute(), MarshalAs(UnmanagedType.I8)> ByVal cb As Long, ByVal dwLockType As Integer)
  Function Write(ByVal buf As IntPtr, ByVal len As Integer) As Integer
End Interface

<ComImport(), Guid("7BF80980-BF32-101A-8BBB-00AA00300CAB"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IPicture
  ' Methods
  Function GetAttributes() As Integer
  Function GetCurDC() As IntPtr
  Function GetHandle() As IntPtr
  Function GetHeight() As Integer
  Function GetHPal() As IntPtr
  Function GetKeepOriginalFormat() As <MarshalAs(UnmanagedType.Bool)> Boolean
  Function GetPictureType() As <MarshalAs(UnmanagedType.I2)> Short
  Function GetWidth() As Integer
  Sub PictureChanged()
  Sub Render(ByVal hDC As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal cxSrc As Integer, ByVal cySrc As Integer, ByVal rcBounds As IntPtr)
  <PreserveSig()> _
  Function SaveAsFile(<InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal pstm As IStream, ByVal fSaveMemCopy As Integer, <Out()> ByRef pcbSize As Integer) As Integer
  Sub SelectPicture(ByVal hdcIn As IntPtr, <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal phdcOut As IntPtr(), <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal phbmpOut As IntPtr())
  Sub SetHPal(ByVal phpal As IntPtr)
  Sub SetKeepOriginalFormat(<InAttribute(), MarshalAs(UnmanagedType.Bool)> ByVal pfkeep As Boolean)
End Interface

<ComImport(), InterfaceType(ComInterfaceType.InterfaceIsIDispatch), Guid("7BF80981-BF32-101A-8BBB-00AA00300CAB")> _
Public Interface IPictureDisp
  ' Methods
  Sub Render(ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal cxSrc As Integer, ByVal cySrc As Integer)

  ' Properties
  ReadOnly Property Handle() As IntPtr
  ReadOnly Property Height() As Integer
  ReadOnly Property HPal() As IntPtr
  ReadOnly Property PictureType() As Short
  ReadOnly Property Width() As Integer
End Interface

Public Class IPictureConverter

  Private Shared Function GetPictureFromParams(ByVal pict As Object, ByVal handle As IntPtr, ByVal type As Integer, ByVal paletteHandle As IntPtr, ByVal width As Integer, ByVal height As Integer) As Image
    Select Case type
      Case -1
        Return Nothing
      Case 0
        Return Nothing
      Case 1
        Return Image.FromHbitmap(handle, paletteHandle)
      Case 2
        Dim header1 As New WmfPlaceableFileHeader
        header1.BboxRight = CType(width, Short)
        header1.BboxBottom = CType(height, Short)
        Return CType(New Metafile(handle, header1, False).Clone, Image)
      Case 3
        Return CType(Icon.FromHandle(handle).Clone, Image)
      Case 4
        Return CType(New Metafile(handle, False).Clone, Image)
    End Select
    Throw New ArgumentException("Unknown image type")
  End Function  'GetPictureFromParams

  Protected Shared Function GetPictureFromIPicture(ByVal picture As IPicture) As Image
    If (picture Is Nothing) Then
      Return Nothing
    End If
    Dim ptr1 As IntPtr = IntPtr.Zero
    Dim picture1 As IPicture = CType(picture, IPicture)
    Dim num1 As Integer = picture1.GetPictureType
    If (num1 = 1) Then
      Try
        ptr1 = picture1.GetHPal()
      Catch exception1 As COMException
      End Try
    End If
    Return GetPictureFromParams(picture1, picture1.GetHandle, num1, ptr1, picture1.GetWidth, picture1.GetHeight)
  End Function  'GetPictureFromIPicture

  Protected Shared Function GetPictureFromIPictureDisp(ByVal picture As IPictureDisp) As Image
    If (picture Is Nothing) Then
      Return Nothing
    End If
    Dim ptr1 As IntPtr = IntPtr.Zero
    Dim disp1 As IPictureDisp = CType(picture, IPictureDisp)
    Dim num1 As Integer = disp1.PictureType
    If (num1 = 1) Then
      Try
        ptr1 = disp1.HPal
      Catch exception1 As COMException
      End Try
    End If
    Return GetPictureFromParams(disp1, disp1.Handle, num1, ptr1, disp1.Width, disp1.Height)
  End Function

  Protected Shared Function GetIPictureFromPicture(ByVal image As Image) As Object
    If (image Is Nothing) Then
      Return Nothing
    End If
    Dim obj1 As Object = GetPICTDESCFromPicture(image)
    Return OleCreateIPictureIndirect(obj1, New Guid("7BF80980-BF32-101A-8BBB-00AA00300CAB"), True)
  End Function

  <DllImport("olepro32.dll", EntryPoint:="OleCreatePictureIndirect", ExactSpelling:=True, PreserveSig:=False)> _
  Public Shared Function OleCreateIPictureIndirect(<MarshalAs(UnmanagedType.AsAny)> ByVal pictdesc As Object, ByRef iid As Guid, ByVal fOwn As Boolean) As IPicture
  End Function

  <StructLayout(LayoutKind.Sequential)> _
  Public Class PICTDESCbmp
    ' Methods
    Public Sub New(ByVal bitmap As Bitmap)
      Me.cbSizeOfStruct = Marshal.SizeOf(GetType(PICTDESCbmp))
      Me.picType = 1
      Me.hbitmap = IntPtr.Zero
      Me.hpalette = IntPtr.Zero
      Me.unused = 0
      Me.hbitmap = bitmap.GetHbitmap
    End Sub

    ' Fields
    Friend cbSizeOfStruct As Integer
    Friend hbitmap As IntPtr
    Friend hpalette As IntPtr
    Friend picType As Integer
    Friend unused As Integer
  End Class

  <StructLayout(LayoutKind.Sequential)> _
  Public Class PICTDESCemf
    ' Methods
    Public Sub New(ByVal metafile As Metafile)
      Me.cbSizeOfStruct = Marshal.SizeOf(GetType(PICTDESCemf))
      Me.picType = 4
      Me.hemf = IntPtr.Zero
      Me.unused1 = 0
      Me.unused2 = 0
    End Sub

    ' Fields
    Friend cbSizeOfStruct As Integer
    Friend hemf As IntPtr
    Friend picType As Integer
    Friend unused1 As Integer
    Friend unused2 As Integer
  End Class

  Private Shared Function GetPICTDESCFromPicture(ByVal image As Image) As Object
    Dim obj1 As Object = Nothing
    If TypeOf image Is Bitmap Then
      obj1 = New PICTDESCbmp(CType(image, Bitmap))
    Else
      If TypeOf image Is Metafile Then
        obj1 = New PICTDESCemf(CType(image, Metafile))
      End If
    End If
    If (obj1 Is Nothing) Then
      Throw New ArgumentException("Unknown image")
    End If
    Return obj1
  End Function

End Class

I added GetIPictureFromPicture.

Bob
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

JR2003Author Commented:
How am I supposed to use this code?
I pastred it all into a vb file but I'm not sure how to passs my image in and get an stdole.stdPicture out?
0
Bob LearnedCommented:
Since GetIPictureFromPicture is a static (shared) member, then you can call it like this:

   IPictureConverter.GetIPictureFromPicture(Me.PictureBox1.Image)

Bob
0
JR2003Author Commented:
Thanks, points are yours.

I've also found another shorter bit of code that seems to work. Is there any advantage in using your code over this code?

When put this code in a vb file I get an error when I click on the class that it can't load it in the designer. Any ideas how to fix this? Here's the error:
"The designer must create an instance of type 'System.Windows.Forms.AxHost' but it cannot because the type is declared as abstract."


Here's the class.

Public Class OLECvt

    Inherits System.Windows.Forms.AxHost

    Public Sub New()
        MyBase.New("")
    End Sub
    ' convert an Image to a OLE Picture object
    Public Shared Function ToOLEPic(ByVal i As Image) As stdole.StdPicture
        Return GetIPictureDispFromPicture(i)
    End Function
    ' convert an Image to an OLE Picture ' IPictureDisp interface
    Public Shared Function ToOLE_IPictureDisp(ByVal i As Image) As stdole.IPictureDisp()
        Return GetIPictureDispFromPicture(i)
    End Function
    ' convert a Font to an OLE Font object  
    Public Shared Function ToOLEFont(ByVal f As Font) As stdole.StdFont
        Return GetIFontFromFont(f)
    End Function
    ' convert a Font to an OLE Font IFontDisp ' interface
    Public Shared Function ToOLE_IFontDisp(ByVal f As Font) As stdole.IFontDisp
        Return GetIFontFromFont(f)
    End Function

End Class


0
Bob LearnedCommented:
I tried different scenarios, including what you tried, but in the end I just used Reflector to look at what AxHost does and strip out what I needed (interface declarations, API calls, etc.).   If you can get it to work, your code is much simpler. Since AxHost is an abstract class, it has different rules that I have yet to figure out.

Bob
0
JR2003Author Commented:
The error in design mode is just an annoyance when you click on the class Visual Studio expects to edit it on the designer when all I need to do is edit the code. It doesn't affect the running of the code so I'm prepared to put up with it.
0
Bob LearnedCommented:
You can always do what ever works, and what ever you are satisfied with.

Bob
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic.NET

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.