Hi Jim
following, a module written in vb6 to convert a byte array to StdPicture.
Perhaps it help you
Option Explicit
'_________________________________________________________________________________ ' ' API Declarations '_________________________________________________________________________________ Private Declare Function CreateStreamOnHGlobal Lib "ole32" _ (ByVal hGlobal As Long, _ ByVal fDeleteOnRelease As CBoolean, _ ppstm As Any) As Long Private Declare Function OleLoadPicture Lib "olepro32" _ (pStream As Any, _ ByVal lSize As Long, _ ByVal fRunmode As CBoolean, _ 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 Function GlobalAlloc Lib "kernel32" ( _ ByVal uFlags As Long, _ ByVal dwBytes 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 GlobalFree 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 VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" ( _ Ptr() As Any) As Long Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" ( _ ByVal hObject As Long, _ ByVal nCount As Long, _ lpObject As Any) As Long '_________________________________________________________________________________ ' ' UDT Declarations '_________________________________________________________________________________ Private Type GUID ' 16 bytes (128 bits) dwData1 As Long ' 4 bytes wData2 As Integer ' 2 bytes wData3 As Integer ' 2 bytes abData4(7) As Byte ' 8 bytes, zero based End Type Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private Type SAFEARRAY2D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 1) As SAFEARRAYBOUND End Type Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Public Enum CBoolean cFalse = 0 ' 0& cTrue ' 1& End Enum ' ' Constants '_________________________________________________________________________________ 'string for stdPicture Class Private Const sIID_stdPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'defines what type of memory to allocate Private Const GMEM_MOVEABLE = &H2 'Return values for CreateStreamOnHGlobal Private Const S_OK = &H0 Private Const E_INVALIDARG = &H80070057 Private Const E_OUTOFMEMORY = &H8007000E 'Return values for CLSIDFromString Private Const NOERROR = 0 Private Const CO_E_CLASSSTRING = &H800401F3 Private Const REGDB_E_WRITEREGDB = &H80040151
Public Function BitsBFromFile(FileName As String) As Byte() Dim hFich As Integer Dim Datas() As Byte ReDim Datas(FileLen(FileName)) hFich = FreeFile Open App.Path & "\tmp.bmp" For Binary As #hFich Get #hFich, , Datas() Close #hFich BitsBFromFile = Datas() End Function Public Function BitsBFromPic(Pic As StdPicture) As Byte() Dim hFich As Integer Dim Datas() As Byte If Pic = 0 Then Set Pic = LoadPicture(App.Path & "\Signature.bmp") End If SavePicture Pic, App.Path & "\tmp.bmp" ReDim Datas(FileLen(App.Path & "\tmp.bmp")) hFich = FreeFile Open App.Path & "\tmp.bmp" For Binary As #hFich Get #hFich, , Datas() Close #hFich Kill App.Path & "\tmp.bmp" BitsBFromPic = Datas() End Function
Public Function PicFromBitsB(bData() As Byte) As StdPicture On Error GoTo Errored Dim lReturn As Long 'long return value Dim lSize As Long 'long size of byte array Dim hMem As Long 'handle to allocated memory Dim lpMem As Long 'long pointer to allocated memory Dim CLSID_stdPicture As GUID 'Class Identifier for stdPicture Dim oIStream As stdole.IUnknown 'IStream Oject 'get data size lSize = (UBound(bData) - LBound(bData)) + 1 If lSize = 0 Then Set PicFromBitsB = LoadPicture(App.Path & "\Signature.bmp") Exit Function End If 'allocate global memory object and return handle hMem = GlobalAlloc(GMEM_MOVEABLE, lSize) If hMem = 0 Then GoTo Errored 'lock the memory by handle and return pointer to it lpMem = GlobalLock(hMem) If lpMem = 0 Then GoTo Errored 'copy the picture data to the memory and unlock the handle CopyMemory ByVal lpMem, bData(LBound(bData)), lSize Call GlobalUnlock(hMem) 'create an IStream object from the pic data lReturn = CreateStreamOnHGlobal(hMem, cTrue, oIStream) If lReturn <> S_OK Then GoTo Errored 'convert our stdPicture string to GUID lReturn = CLSIDFromString(StrPtr(sIID_stdPicture), CLSID_stdPicture) If lReturn <> NOERROR Then GoTo Errored 'create an stdPicture object from IStream and return PicFromBits as pointer lReturn = OleLoadPicture(ByVal ObjPtr(oIStream), lSize, cFalse, CLSID_stdPicture, PicFromBitsB) If lReturn <> S_OK Then GoTo Errored Errored: 'clean up if needed If hMem <> 0 Then GlobalFree (hMem) End Function
'-----------------
'usage sample
'------------------
Dim sImgTemp As Variant
sImgTemp = mvarDoc.RenderPageToVariant(72, 1, 1)
Set pctTemp.Picture = PicFromBitsB(CStr(sImgTemp))
|