' Here is my code. I tested it by adding a resource 101 on "CUSTOM"
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Const GMEM_MOVEABLE = &H2
Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, myGUID As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hMem&, ByVal DeleteOnRelease&, pStream As IUnknown) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (ByVal pStream As IUnknown, ByVal memSize&, ByVal fRunMode&, myGUID As Any, pPicture As IPicture) As Long
Private Sub Command1_Click()
Const IID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Dim hMem&, lpMem&, bArr() As Byte, myGUID(0 To 15) As Byte
Dim pStream As IUnknown, myPic As IPicture
' Формирование массива
bArr = LoadResData(101, "CUSTOM")
hMem = GlobalAlloc(GMEM_MOVEABLE, UBound(bArr) + 1)
If (hMem) Then
lpMem = GlobalLock(hMem)
If (lpMem) Then
Call CopyMemory(ByVal lpMem&, bArr(0), UBound(bArr) + 1)
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, pStream) = 0 Then
If CLSIDFromString(StrPtr(IID_IPicture), myGUID(0)) = 0 Then
If OleLoadPicture(pStream, UBound(bArr) + 1, 0, myGUID(0), myPic) = 0 Then
' Фух! Сделали
Set Picture1.Picture = myPic
End If
End If
End If
End If
Call GlobalFree(hMem)
End If
Erase bArr
End Sub
Сейчас этот форум просматривают: AhrefsBot, Majestic-12 [Bot] и гости: 50