Attribute VB_Name = "mdlJPeg"
Option Explicit

'/////////////////////////////////////////////////////////

Private Declare Function ijlInit Lib "ijl15.dll" (jcprops As Any) As Long
Private Declare Function ijlFree Lib "ijl15.dll" (jcprops As Any) As Long
Private Declare Function ijlWrite Lib "ijl15.dll" (jcprops As Any, iotype As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Enum IJLERR
    IJL_OK = 0
    IJL_INTERRUPT_OK = 1
    IJL_ROI_OK = 2
    
    ' /* The following "error" values indicate an error has occurred. */
    IJL_EXCEPTION_DETECTED = -1
    IJL_INVALID_ENCODER = -2
    IJL_UNSUPPORTED_SUBSAMPLING = -3
    IJL_UNSUPPORTED_BYTES_PER_PIXEL = -4
    IJL_MEMORY_ERROR = -5
    IJL_BAD_HUFFMAN_TABLE = -6
    IJL_BAD_QUANT_TABLE = -7
    IJL_INVALID_JPEG_PROPERTIES = -8
    IJL_ERR_FILECLOSE = -9
    IJL_INVALID_FILENAME = -10
    IJL_ERROR_EOF = -11
    IJL_PROG_NOT_SUPPORTED = -12
    IJL_ERR_NOT_JPEG = -13
    IJL_ERR_COMP = -14
    IJL_ERR_SOF = -15
    IJL_ERR_DNL = -16
    IJL_ERR_NO_HUF = -17
    IJL_ERR_NO_QUAN = -18
    IJL_ERR_NO_FRAME = -19
    IJL_ERR_MULT_FRAME = -20
    IJL_ERR_DATA = -21
    IJL_ERR_NO_IMAGE = -22
    IJL_FILE_ERROR = -23
    IJL_INTERNAL_ERROR = -24
    IJL_BAD_RST_MARKER = -25
    IJL_THUMBNAIL_DIB_TOO_SMALL = -26
    IJL_THUMBNAIL_DIB_WRONG_COLOR = -27
    IJL_BUFFER_TOO_SMALL = -28
    IJL_UNSUPPORTED_FRAME = -29
    IJL_ERR_COM_BUFFER = -30
    IJL_RESERVED = -99
End Enum

Private Type JPEG_CORE_PROPERTIES_VB
    UseJPEGPROPERTIES As Long                      '// default = 0
    
    '// DIB specific I/O data specifiers.
    DIBBytes As Long ';                  '// default = NULL 4
    DIBWidth As Long ';                  '// default = 0 8
    DIBHeight As Long ';                 '// default = 0 12
    DIBPadBytes As Long ';               '// default = 0 16
    DIBChannels As Long ';               '// default = 3 20
    DIBColor As Long ';                  '// default = IJL_BGR 24
    DIBSubsampling As Long  ';            '// default = IJL_NONE 28
    
    '// JPEG specific I/O data specifiers.
    JPGFile As Long 'LPTSTR              JPGFile;                32   '// default = NULL
    JPGBytes As Long ';                  '// default = NULL 36
    JPGSizeBytes As Long ';              '// default = 0 40
    JPGWidth As Long ';                  '// default = 0 44
    JPGHeight As Long ';                 '// default = 0 48
    JPGChannels As Long ';               '// default = 3
    JPGColor As Long           ';                  '// default = IJL_YCBCR
    JPGSubsampling As Long  ';            '// default = IJL_411
    JPGThumbWidth As Long ' ;             '// default = 0
    JPGThumbHeight As Long ';            '// default = 0
    
    '// JPEG conversion properties.
    cconversion_reqd As Long ';          '// default = TRUE
    upsampling_reqd As Long ';           '// default = TRUE
    jquality As Long ';                  '// default = 75.  100 is my preferred quality setting.
    
    '// Low-level properties - 20,000 bytes.  If the whole structure
    ' is written out then VB fails with an obscure error message
    ' "Too Many Local Variables" !
    ' These all default if they are not otherwise specified so there
    ' is no trouble.
    jprops(0 To 19999) As Byte
End Type

Public Function SaveToJPegPtr(DestJPegPtr() As Byte, SrcBitmapData() As Byte, ByVal Width As Long, ByVal Height As Long, Optional ByVal Quality As Long = 75) As Long
    Dim buffer() As Byte
    Dim jcprops As JPEG_CORE_PROPERTIES_VB
    Dim jerr As IJLERR
    Dim Size As Long
    
    ' //////////////
    ' Constants
    Const IJL_JBUFF_WRITEWHOLEIMAGE = 9&
    Const IJL_BGR = 2&
    Const IJL_YCBCR = 3&
    Const IJL_411 = 1&
    
    jerr = ijlInit(jcprops)
    If jerr = IJL_OK Then
        jcprops.jquality = Quality
        jcprops.DIBWidth = Width
        jcprops.DIBHeight = Height
        jcprops.JPGWidth = Width
        jcprops.JPGHeight = Height
        jcprops.DIBBytes = VarPtr(SrcBitmapData(0))
        jcprops.DIBPadBytes = 0
        jcprops.DIBChannels = 3
        jcprops.JPGChannels = 3
        jcprops.DIBColor = IJL_BGR
        jcprops.JPGColor = IJL_YCBCR
        jcprops.JPGSubsampling = IJL_411
        jcprops.DIBSubsampling = 0
        jcprops.JPGFile = 0
    
        Size = Width * Height * 3
        ReDim buffer(Size) As Byte
    
        jcprops.JPGSizeBytes = Size
        jcprops.JPGBytes = buffer
    
        jerr = ijlWrite(jcprops, IJL_JBUFF_WRITEWHOLEIMAGE)
        
        If jerr = IJL_OK Then
            ' Now fill in the jpeg data
            Size = jcprops.JPGSizeBytes
            ReDim DestJPegPtr(Size) As Byte
    
            CopyMemory ByVal VarPtr(DestJPegPtr(0)), ByVal VarPtr(buffer(0)), Size
        End If
    
        jerr = ijlFree(jcprops)
    End If
    
    Erase buffer
    SaveToJPegPtr = Size
End Function