Thanks for your incredible DLL. It works fine from VBA.
This is a sample code, simple and easy to use the library, when you working without saving to disk
From my point of view, the samples included in Wrapper dir are really complicated


:::VB6, VBA
Option Explicit
'You need also the DLL Declarations
'API Declaration (ByRef is dangerous but more flexible)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'input: a valid dib&, FIF format
'return: string (image data)
Private Function szMemDib$(dib&, FIF As FREE_IMAGE_FORMAT, Optional QUALITY&)
Const JPEG_QUALITYSUPERB& = &H80
On Local Error GoTo ErrszMemDib
Dim stream&, lBuffer&, lLen&, szBuffer$
    'if JPG and no quality specified, use extra quality
    If (FIF = FIF_JPEG) And (QUALITY = 0) Then QUALITY& = JPEG_QUALITYSUPERB&
    'prepare memory stream
    stream& = FreeImage_OpenMemory()
    'save dib to an stream
    If FreeImage_SaveToMemory(FIF, dib, stream, QUALITY&) Then
        'read the memory and get the length
        Call FreeImage_AcquireMemory(stream&, lBuffer&, lLen&)
        If lLen& > 0 Then
            'prepare buffer
            szBuffer$ = Space(lLen&)
            'copy pointer to buffer
            Call CopyMemory(ByVal szBuffer$, ByVal lBuffer&, lLen&)
            szMemDib$ = szBuffer$
        End If
    End If
    'unload the stream
    Call FreeImage_CloseMemory(stream&)
Exit Function
'control de errores
ErrszMemDib:
    Select Case MsgBox(Err.Description & ": " & Err.Source, vbQuestion Or vbAbortRetryIgnore, "App.Title")
        Case vbRetry: Resume 0
        Case vbAbort: Exit Function
        Case vbIgnore: Resume Next
    End Select
End Function

And call it like this


:::VB6, VBA
    dib& = FreeImage_Load(FIF_BMP, arcPhoto$)
    If dib& Then
        szParaCod$ = szMemDib$(dib&, FIF)
        Call FreeImage_Unload(dib&)
        If Len(szParaCod$) Then
            If SavePhoto Then

                'just a sample
                'if you need save to disk use DLL...
                'iFreeFile& = FreeImage_Save&(FIF, dib&, arcPhoto$)

                'or use native code                
                iFreeFile& = FreeFile
                Open arcPhoto$ For Binary Shared As #iFreeFile&
                    Put #iFreeFile&, 1, szParaCod$
                Close #iFreeFile&
            End If
        End If
    End If
 
Last edit: Míchel Rodríguez 2014-05-14