Feedback

VB - Umwandlung System.Drawing.Icon nach IPictureDisp u.a für VB6

Veröffentlicht von am 17.12.2008
(2 Bewertungen)
Generell ist es mit Hilfe des AxHosts aus System.Windows.Forms ohne größere Schwierigkeiten möglich, ein System.Drawing.Bitmap nach IPictureDisp für VB6 zu konvertieren.
Allerdings trifft man auf Schwierigkeiten, wenn man das selbige mit System.Drawing.Icon versucht. Dazu ist ein Umweg über die ImageList von Windows von Nöten, um ein gültiges HICON-Handle zu erzeugen.

Diese Klasse wandelt ein System.Drawing.Icon nach IPictureDisp um, welches direkt in VB6 z.B. für die Form.Icon-Eigenschaft verwendet werden kann.
Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Imports stdole

<System.Runtime.InteropServices.ComVisible(False)> _
Friend Class PictureWrapper
    Inherits AxHost

    Public Sub New()
        MyBase.New("59EE46BA-677D-4d20-BF10-8D8067CB8B33")
    End Sub

    'Konvertierung eines System.Drawing.Image nach IPictureDisp (Type = Bitmap, HBITMAP)
    Public Shared Shadows Function ImageToIPictureDisp(ByVal oImage As System.Drawing.Image) As IPictureDisp
        Dim oResult As IPictureDisp
        oResult = DirectCast(AxHost.GetIPictureDispFromPicture(oImage), IPictureDisp)
        Return oResult
    End Function

    'Konvertierung eines System.Drawing.Icon nach IPictureDisp (Type = Icon, HICON)
    Public Shared Shadows Function IconToIPictureDisp(ByVal oIcon As System.Drawing.Icon) As IPictureDisp
        Dim oIml As New System.Windows.Forms.ImageList

        Return BitmapToIcon.ConvertIconToIPictureDisp(oIcon)
    End Function

    'Klasse zum Umwandeln eines System.Drawing.Icon nach HICON
    Private Class BitmapToIcon

        Private Const ILC_COLORDDB As Integer = &HFE
        Private Const ILC_COLOR As Integer = &H0
        Private Const ILC_COLOR4 As Integer = &H4
        Private Const ILC_COLOR8 As Integer = &H8
        Private Const ILC_COLOR16 As Integer = &H10
        Private Const ILC_COLOR24 As Integer = &H18
        Private Const ILC_COLOR32 As Integer = &H20

        'Um ein ICON-Handle zu erzeugen, muss der Weg über die ImageList von Windows gegangen werden.
        <DllImport("comctl32.dll")> Private Shared Function ImageList_Add(ByVal himl As IntPtr, ByVal hbmImage As IntPtr, ByVal hbmMask As IntPtr) As Integer
        End Function
        <DllImport("comctl32.dll")> Private Shared Function ImageList_Create(ByVal cx As Integer, ByVal cy As Integer, ByVal flags As Integer, ByVal cInitial As Integer, ByVal cGrow As Integer) As IntPtr
        End Function
        <DllImport("comctl32.dll")> Private Shared Function ImageList_Destroy(ByVal himl As IntPtr) As Boolean
        End Function
        <DllImport("comctl32.dll")> Private Shared Function ImageList_GetIcon(ByVal himl As IntPtr, ByVal iIndex As Int32, ByVal iFlags As UInt32) As IntPtr
        End Function
        <DllImport("oleaut32.dll", EntryPoint:="OleCreatePictureIndirect", ExactSpelling:=True, PreserveSig:=False)> _
        Private Shared Function OleCreateIPictureIndirect(<MarshalAs(UnmanagedType.AsAny)> ByVal pictdesc As Object, ByRef iid As System.Guid, ByVal fOwn As Boolean) As IPictureDisp
        End Function


        <StructLayout(LayoutKind.Sequential)> Private Class PICTDESC
            Public cbSizeOfStruct As Integer
            Public picType As Integer
            Public union1 As IntPtr
            Public union2 As Integer
            Public union3 As Integer

            Public Shared Function CreateIconPICTDESC(ByVal hicon As IntPtr) As PICTDESC
                Dim oPictdesc As New PICTDESC

                oPictdesc.cbSizeOfStruct = 12
                oPictdesc.picType = 3 ' Quelle HICON
                oPictdesc.union1 = hicon ' Handle auf das Icon

                Return oPictdesc

            End Function

            Public Sub New()

            End Sub

        End Class

        Public Shared Function ConvertIconToIPictureDisp(ByVal oIcon As System.Drawing.Icon) As IPictureDisp

            Dim Result As IPictureDisp = Nothing
            'GUID für IPictureDisp
            Dim oIGuid As System.Guid = New System.Guid("7BF80980-BF32-101A-8BBB-00AA00300CAB")
            Dim oStruct As PICTDESC = Nothing
            Dim iTempResult As Integer = 0
            Dim hImageList As IntPtr = Nothing
            Dim iColorDepth As Integer = -1
            Dim hIcon As IntPtr = Nothing
            Dim oTempBMP As System.Drawing.Bitmap

            Try
                'Zunächst Umwandlung des System.Drawing.Icons nach IPictureDisp(HBITMAP)
                oTempBMP = oIcon.ToBitmap
                'Pixelformat auf Api-Konstante mappen
                Select Case oTempBMP.PixelFormat
                    Case Imaging.PixelFormat.Format4bppIndexed
                        iColorDepth = ILC_COLOR4
                    Case Imaging.PixelFormat.Format8bppIndexed
                        iColorDepth = ILC_COLOR8
                    Case Imaging.PixelFormat.Format16bppArgb1555, _
                         Imaging.PixelFormat.Format16bppGrayScale, _
                         Imaging.PixelFormat.Format16bppRgb555, _
                         Imaging.PixelFormat.Format16bppRgb565
                        iColorDepth = ILC_COLOR16
                    Case Imaging.PixelFormat.Format24bppRgb
                        iColorDepth = ILC_COLOR24
                    Case Imaging.PixelFormat.Format32bppArgb, _
                         Imaging.PixelFormat.Format32bppPArgb, _
                         Imaging.PixelFormat.Format32bppRgb
                        iColorDepth = ILC_COLOR32
                    Case Else
                        iColorDepth = ILC_COLOR8
                End Select

                'Imagelist anlegen
                hImageList = ImageList_Create(oIcon.Width, oIcon.Height, iColorDepth, 1, 1)
                'Hinzufügen des des umgewandelten Bildes in die ImageList
                iTempResult = ImageList_Add(hImageList, New IntPtr(PictureWrapper.ImageToIPictureDisp(oTempBMP).Handle), New IntPtr(0))
                'Abrufen des Bitmaps als HICON
                hIcon = ImageList_GetIcon(hImageList, 0, 0)

                'Kapslung des HICON in PICTDESC
                oStruct = PICTDESC.CreateIconPICTDESC(hIcon)
                'Generierung eines IPictureDisp aus HICON
                Result = OleCreateIPictureIndirect(DirectCast(oStruct, Object), oIGuid, True)
                'ImageList wieder löschen
                ImageList_Destroy(hImageList)

            Catch ex As Exception

            End Try

            Return Result

        End Function

    End Class

End Class

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!