Using DLL with Variant Functions

 

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))