Visual Basic

Structure imgdes
        Dim ibuff As Integer
        Dim stx As Integer
        Dim sty As Integer
        Dim endx As Integer
        Dim endy As Integer
        Dim buffwidth As Integer
        Dim palette As Integer
        Dim colors As Integer
        Dim imgtype As Integer
        Dim bmh As Integer
        Dim hBitmap As Integer
    End Structure

Structure GUID
        Dim Data1 As Integer
        Dim Data2 As Short
        Dim Data3 As Short
        'Dim Data4() As Byte
        <VBFixedArray(7)> Dim Data4() As Byte

        'UPGRADE_TODO: "Initialize" must be called to initialize instances of this structure. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="B4BFF9E0-8631-45CF-910E-62AB3970F27B"'
        Public Sub InitializeMe()
            ReDim Data4(7)
        End Sub
    End Structure

Public Function image_to_picturebox(ByRef srceimg As imgdes) As System.Drawing.Image
        Dim rcode As Object
        Dim retval As Integer
        Dim Pic As New PicBmp
        ' IPicture requires a reference to "Standard OLE Types."
        ' in VB6 Select: Project, References, and check OLE Automation
        Dim IPic As System.Drawing.Image
        'UPGRADE_WARNING: Arrays in structure IID_IDispatch may need to be initialized before they can be used. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="814DF224-76BD-4BB4-BFFB-EA359CB9FC48"'
        Dim IID_IDispatch As New GUID
        Dim tempimage As imgdes

        If (srceimg.hBitmap = 0) Then
            ' We have a packed dib, gotta make it a dib section-type of image
            'UPGRADE_WARNING: Couldn't resolve default property of object rcode. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            rcode = dibtoimage(srceimg.bmh, tempimage)
            'UPGRADE_WARNING: Couldn't resolve default property of object rcode. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            If rcode = NO_ERROR Then
                ' Replace previous image
                freeimage(srceimg)
                copyimgdes(tempimage, srceimg)
            End If
        End If

        ' Fill in with IDispatch Interface ID.
        IID_IDispatch.InitializeMe()
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With

        ' Fill Pic with necessary parts.
        With Pic
            .Size = Len(Pic) ' Length of structure.
            .Type = 1 ' Type of Picture (bitmap).
            .hBmp = srceimg.hBitmap ' Handle to bitmap.
            .hPal = 0 ' Handle to palette (may be null).
        End With

        ' Create Picture object.
        retval = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

        'MsgBox(retval.ToString)
        If (retval = 0) Then
            image_to_picturebox = IPic
        Else
            image_to_picturebox = My.Resources.notavi
        End If

    End Function

Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (ByRef PicDesc As PicBmp, ByRef RefIID As GUID, ByVal fPictureOwnsHandle As Integer, ByRef IPic As System.Drawing.Image) As Integer