[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Convert .NET Image to VB6 IPictureDisp

Posted on 2006-04-18
9
Medium Priority
?
2,772 Views
Last Modified: 2008-03-03
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.
0
Comment
Question by:JR2003
  • 5
  • 4
9 Comments
 
LVL 96

Expert Comment

by:Bob Learned
ID: 16481478
0
 
LVL 18

Author Comment

by:JR2003
ID: 16481910
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
 
LVL 96

Accepted Solution

by:
Bob Learned earned 2000 total points
ID: 16482468
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 18

Author Comment

by:JR2003
ID: 16487430
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
 
LVL 96

Expert Comment

by:Bob Learned
ID: 16488026
Since GetIPictureFromPicture is a static (shared) member, then you can call it like this:

   IPictureConverter.GetIPictureFromPicture(Me.PictureBox1.Image)

Bob
0
 
LVL 18

Author Comment

by:JR2003
ID: 16489278
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
 
LVL 96

Expert Comment

by:Bob Learned
ID: 16489311
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
 
LVL 18

Author Comment

by:JR2003
ID: 16489682
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
 
LVL 96

Expert Comment

by:Bob Learned
ID: 16489691
You can always do what ever works, and what ever you are satisfied with.

Bob
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Parsing a CSV file is a task that we are confronted with regularly, and although there are a vast number of means to do this, as a newbie, the field can be confusing and the tools can seem complex. A simple solution to parsing a customized CSV fi…
It was really hard time for me to get the understanding of Delegates in C#. I went through many websites and articles but I found them very clumsy. After going through those sites, I noted down the points in a easy way so here I am sharing that unde…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Loops Section Overview

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question