'Beispiel : VB Kompatible Grafiken aus einer Resource-Datei laden.
 
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
  ByVal dwBytes As Long)  As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As _
  Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As _
Long, ByVal cDelOnSetFree As cSuccess, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal _
lSize As Long, ByVal cInitValuePicProperty As cSuccess, riid As GUID, ppvObj As _
Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" ByVal lpsz As Any, pclsid _
As GUID)  As Long
Private Declare Sub MoveMemory Lib "kernel32"  Alias "RtlMoveMemory"  ( _
aDestination As Any,  aSource As Any,  ByVal dwLength As Long)
 
Private Const GMEM_MOVEABLE = &H2
 
Private Enum cSuccess
    csFalse = 0
    csTrue = 1
End Enum
 
Private Type GUID
    dwData1       As Long
    wData2        As Integer
    wData3        As Integer
    abData4(7)    As Byte
End Type
 
Private Const CAP_KEY = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const Success = 0
 
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case Is = 0
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("bmpFile", _
              "bmp"))
        Case Is = 1
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("curFile", _
              "cur"))
        Case Is = 2
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("jpgFile", _
              "jpg"))
        Case Is = 3
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("gifFile", _
              "gif"))
        Case Is = 4
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("icoFile", _
              "ico"))
        Case Is = 5
            Set Picture1 = fLoadPictureFromResourceFile(LoadResData("wmfFile", _
              "wmf"))
        Case Is = 6
            Unload Me
    End Select
End Sub
 
Private Function fLoadPictureFromResourceFile(btPicture() As Byte) As IPicture
    Dim lLower          As Long
    Dim lhMemory        As Long
    Dim lHeigher        As Long
    Dim lLock           As Long
    Dim gui             As GUID
    Dim ppstm           As stdole.IUnknown
 
    On Error GoTo ErrGetOut
    lLower = LBound(btPicture)
 
    On Error GoTo 0
    lHeigher = (UBound(btPicture) - lLower) + 1
 
    lhMemory = GlobalAlloc(GMEM_MOVEABLE, lHeigher)
 
    If lhMemory Then
        lLock = GlobalLock(lhMemory)
 
        If lLock Then
            MoveMemory ByVal lLock, btPicture(lLower), lHeigher
                Call GlobalUnlock(lhMemory)
                If (CreateStreamOnHGlobal(lhMemory, csTrue, ppstm) = Success) _
                  Then
                    If (CLSIDFromString(StrPtr(CAP_KEY), gui) = Success) Then
                        Call OleLoadPicture(ByVal ObjPtr(ppstm), lHeigher, _
                          csFalse, gui, fLoadPictureFromResourceFile)
                    End If
                End If
            End If
        End If
ErrGetOut:
End Function