VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cJpeg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Base 0

'Class Name:   cJpeg.cls  "JPEG Encoder Class"
'Author:       John Korejwa  <korejwa@tiac.net>
'Version:      0.9 beta  [26 / November / 2003]
'
'
'Legal:
'        This class is intended for and was uploaded to www.planetsourcecode.com
'
'        This product includes JPEG compression code developed by John Korejwa.  <korejwa@tiac.net>
'        Source code, written in Visual Basic, is freely available for non-commercial,
'        non-profit use at www.planetsourcecode.com.
'
'
'Credits:
'        Special thanks to Barry G., a government research scientist who took an interest in my
'        steganography software and research in late 1999.  I never met Barry in person, but he
'        was kind enough to buy and mail me a book with the ISO DIS 10918-1 JPEG standard.
'
'
'Description:  This class contains code for compressing pictures, sampled via hDC, into
'              baseline .JPG files.  Please report any errors or unusual behavior to the email
'              address above.
'
'Dependencies: None
'


'JPEG Marker Constants                (Note: VB compiler does not compile unused constants)
                                      'Non-Differential Huffman Coding
Private Const SOF0    As Long = &HC0& 'Baseline DCT
Private Const SOF1    As Long = &HC1& 'Extended sequential DCT
Private Const SOF2    As Long = &HC2& 'Progressive DCT
Private Const SOF3    As Long = &HC3& 'Spatial (sequential) lossless
                                      'Differential Huffman coding
Private Const SOF5    As Long = &HC5& 'Differential sequential DCT
Private Const SOF6    As Long = &HC6& 'Differential progressive DCT
Private Const SOF7    As Long = &HC7& 'Differential spatial
                                      'Non-Differential arithmetic coding
Private Const JPG     As Long = &HC8& 'Reserved for JPEG extentions
Private Const SOF9    As Long = &HC9& 'Extended sequential DCT
Private Const SOF10   As Long = &HCA& 'Progressive DCT
Private Const SOF11   As Long = &HCB& 'Spatial (sequential) lossless
                                      'Differential arithmetic coding
Private Const SOF13   As Long = &HCD& 'Differential sequential DCT
Private Const SOF14   As Long = &HCE& 'Differential progressive DCT
Private Const SOF15   As Long = &HCF& 'Differential Spatial
                                      'Other Markers
Private Const DHT     As Long = &HC4& 'Define Huffman tables
Private Const DAC     As Long = &HCC& 'Define arithmetic coding conditioning(s)
Private Const RSTm    As Long = &HD0& 'Restart with modulo 8 count "m"
Private Const RSTm2   As Long = &HD7& 'to 'Restart with modulo 8 count "m"
Private Const SOI     As Long = &HD8& 'Start of image
Private Const EOI     As Long = &HD9& 'End of image
Private Const SOS     As Long = &HDA& 'Start of scan
Private Const DQT     As Long = &HDB& 'Define quantization table(s)
Private Const DNL     As Long = &HDC& 'Define number of lines
Private Const DRI     As Long = &HDD& 'Define restart interval
Private Const DHP     As Long = &HDE& 'Define hierarchical progression
Private Const EXP     As Long = &HDF& 'Expand reference components
Private Const APP0    As Long = &HE0& 'Reserved for application segments
Private Const APPF    As Long = &HEF& '  to Reserved for application segments
Private Const JPGn    As Long = &HF0& 'Reserved for JPEG Extentions
Private Const JPGn2   As Long = &HFD& '  to Reserved for JPEG Extentions
Private Const COM     As Long = &HFE& 'Comment
Private Const RESm    As Long = &H2&  'Reserved
Private Const RESm2   As Long = &HBF& '  to Reserved
Private Const TEM     As Long = &H1&  'For temporary use in arithmetic coding

'Consider these arrays of constants.
'They are initialized with the class and do not change.
Private QLumin(63)    As Integer 'Standard Luminance   Quantum (for 50% quality)
Private QChrom(63)    As Integer 'Standard Chrominance Quantum (for 50% quality)
Private FDCTScale(7)  As Double  'Constants for scaling FDCT Coefficients
Private IDCTScale(7)  As Double  'Constants for scaling IDCT Coefficients
Private ZigZag(7, 7)  As Long    'Zig Zag order of 8X8 block of samples

'API constants
Private Const BLACKONWHITE    As Long = 1 'nStretchMode constants for
Private Const COLORONCOLOR    As Long = 3 '  SetStretchBltMode() API function
Private Const HALFTONE        As Long = 4 'HALFTONE not supported in Win 95, 98, ME

Private Const BI_RGB          As Long = 0
Private Const DIB_RGB_COLORS  As Long = 0


'Variable types needed for DIBSections.
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 RGBQUAD
    rgbBlue           As Byte
    rgbGreen          As Byte
    rgbRed            As Byte
    rgbReserved       As Byte
End Type
Private Type BITMAPINFOHEADER
    biSize            As Long
    biWidth           As Long
    biHeight          As Long
    biPlanes          As Integer
    biBitCount        As Integer
    biCompression     As Long
    biSizeImage       As Long
    biXPelsPerMeter   As Long
    biYPelsPerMeter   As Long
    biClrUsed         As Long
    biClrImportant    As Long
End Type
Private Type BITMAPINFO
    bmiHeader         As BITMAPINFOHEADER
    bmiColors         As RGBQUAD
End Type

'API needed for creating DIBSections for sampling and pixel access.
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection2 Lib "gdi32" Alias "CreateDIBSection" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long   'lplpVoid changed to ByRef
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)


'Custom variable types used for this JPEG encoding implementation
Private Type QUANTIZATIONTABLE
    Qk(63)            As Integer 'Quantization Values
    FScale(63)        As Single  'Multiplication values to scale and Quantize   FDCT output
    IScale(63)        As Single  'Multiplication values to scale and DeQuantize IDCT input
End Type
Private Type HUFFMANTABLE
    BITS(15)          As Byte    'Number of huffman codes of length i+1
    HUFFVAL(255)      As Byte    'Huffman symbol values
    EHUFSI(255)       As Long    'Huffman code size for symbol i
    EHUFCO(255)       As Long    'Huffman code      for symbol i
    MINCODE(15)       As Long    '
    MAXCODE(15)       As Long    'Largest code value for length i+1
End Type
Private Type COMPONENT
    Ci                As Long    'Component ID                       [0-255]
    Hi                As Long    'Horizontal Sampling Factor         [1-4]
    Vi                As Long    'Vertical   Sampling Factor         [1-4]
    Tqi               As Long    'Quantization Table Select          [0-3]
    data()            As Integer 'DCT Coefficients
End Type

Private PP            As Long    'Sample Precision [8, 12]
Private YY            As Long    'Number of lines             [Image Height]
Private XX            As Long    'Number of samples per line  [Image Width]
Private Nf            As Long    'Number of components in Frame

Private HMax          As Long    'Maximum horizontal sampling frequency
Private VMax          As Long    'Maximum vertical   sampling frequency

Private m_Data()      As Byte    'JPEG File Data
Private m_Chr         As Long    'Current Character in m_Data
Private m_Ptr         As Long    'Byte index in m_Data
Private m_Bit         As Long    'Bit  index in m_Chr

Private m_Block(7, 7) As Single  'Buffer for calculating DCT

Private QTable(3)     As QUANTIZATIONTABLE  '4 Quantization Tables
Private HuffDC(3)     As HUFFMANTABLE       '4 DC Huffman Tables
Private HuffAC(3)     As HUFFMANTABLE       '4 AC Huffman Tables
Private Comp()        As COMPONENT          'Scan Components

Private m_Quality     As Long
Private m_Comment     As String



'========================================================================================
'              D I S C R E T E   C O S I N E   T R A N S F O R M A T I O N
'========================================================================================
Private Sub FDCT()
    Static t0   As Single 'Given an 8X8 block of discretely sampled values [m_Block(0-7, 0-7)],
    Static t1   As Single 'replace them with their (scaled) Forward Discrete Cosine Transformation values.
    Static t2   As Single '80 (+64) multiplications and 464 additions are needed.
    Static t3   As Single 'Values are scaled on output, meaning that each of the 64 elements must be
    Static t4   As Single 'multiplied by constants for a final FDCT.  These final constants are combined
    Static t5   As Single 'with Quantization constants, so a final 64 multiplications combine the
    Static t6   As Single 'completion of the FDCT and Quantization in one step.
    Static t7   As Single
    Static t8   As Single
    Static i    As Long

    For i = 0 To 7                  'Process 1D FDCT on each row
        t0 = m_Block(i, 0) + m_Block(i, 7)
        t1 = m_Block(i, 0) - m_Block(i, 7)
        t2 = m_Block(i, 1) + m_Block(i, 6)
        t3 = m_Block(i, 1) - m_Block(i, 6)
        t4 = m_Block(i, 2) + m_Block(i, 5)
        t5 = m_Block(i, 2) - m_Block(i, 5)
        t6 = m_Block(i, 3) + m_Block(i, 4)
        t7 = m_Block(i, 3) - m_Block(i, 4)

        t7 = t7 + t5
        t8 = t0 - t6
        t6 = t6 + t0
        t0 = t2 + t4
        t2 = (t2 - t4 + t8) * 0.707106781186548   'Cos(2# * PI / 8#)
        t4 = t1 + t3
        t3 = (t3 + t5) * 0.707106781186548        'Cos(2# * PI / 8#)
        t5 = (t4 - t7) * 0.382683432365091        'Cos(3# * PI / 8#)
        t7 = t7 * 0.541196100146196 - t5          'Cos(PI / 8#) - Cos(3# * PI / 8#)
        t4 = t4 * 1.30656296487638 - t5           'Cos(PI / 8#) + Cos(3# * PI / 8#)
        t5 = t1 + t3
        t1 = t1 - t3

        m_Block(i, 0) = t6 + t0
        m_Block(i, 4) = t6 - t0
        m_Block(i, 1) = t5 + t4
        m_Block(i, 7) = t5 - t4
        m_Block(i, 2) = t8 + t2
        m_Block(i, 6) = t8 - t2
        m_Block(i, 5) = t1 + t7
        m_Block(i, 3) = t1 - t7
    Next i

    For i = 0 To 7                   'Process 1D FDCT on each column
        t0 = m_Block(0, i) + m_Block(7, i)
        t1 = m_Block(0, i) - m_Block(7, i)
        t2 = m_Block(1, i) + m_Block(6, i)
        t3 = m_Block(1, i) - m_Block(6, i)
        t4 = m_Block(2, i) + m_Block(5, i)
        t5 = m_Block(2, i) - m_Block(5, i)
        t6 = m_Block(3, i) + m_Block(4, i)
        t7 = m_Block(3, i) - m_Block(4, i)

        t7 = t7 + t5
        t8 = t0 - t6
        t6 = t6 + t0
        t0 = t2 + t4
        t2 = (t2 - t4 + t8) * 0.707106781186548   'Cos(2# * PI / 8#)
        t4 = t1 + t3
        t3 = (t3 + t5) * 0.707106781186548        'Cos(2# * PI / 8#)
        t5 = (t4 - t7) * 0.382683432365091        'Cos(3# * PI / 8#)
        t7 = t7 * 0.541196100146196 - t5          'Cos(PI / 8#) - Cos(3# * PI / 8#)
        t4 = t4 * 1.30656296487638 - t5           'Cos(PI / 8#) + Cos(3# * PI / 8#)
        t5 = t1 + t3
        t1 = t1 - t3

        m_Block(0, i) = t6 + t0
        m_Block(4, i) = t6 - t0
        m_Block(1, i) = t5 + t4
        m_Block(7, i) = t5 - t4
        m_Block(2, i) = t8 + t2
        m_Block(6, i) = t8 - t2
        m_Block(5, i) = t1 + t7
        m_Block(3, i) = t1 - t7
    Next i
End Sub




'================================================================================
'                 H U F F M A N   T A B L E   G E N E R A T I O N
'================================================================================
Private Sub OptimizeHuffman(TheHuff As HUFFMANTABLE, freq() As Long)
'Generate optimized values for BITS and HUFFVAL in a HUFFMANTABLE
'based on symbol frequency counts.  freq must be dimensioned freq(0-256)
'and contain counts of symbols 0-255.  freq is destroyed in this procedure.
    Dim i              As Long
    Dim j              As Long
    Dim k              As Long
    Dim n              As Long
    Dim V1             As Long
    Dim V2             As Long
    Dim others(256)    As Long
    Dim codesize(256)  As Long
    Dim BITS(256)      As Long
    Dim swp            As Long
    Dim swp2           As Long


    For i = 0 To 256  'Initialize others to -1, (this value terminates chain of indicies)
        others(i) = -1
    Next i
    freq(256) = 1     'Add dummy symbol to guarantee no code will be all '1' bits

   'Generate BITS(256)Pii ers(    ts15MBpKai) - m_Blocm(   Dim V2     - m_BlockDim V2   be alsiw'Cos(P

  i)O
  i)O
  i)O
  i)  'Am_BYu '5O
  AesteNB================Dimji) = -1
    NeF4e     As Long


    rmAires) "f  rmAirohoD i)OTBlock(iValon Ta6 = m
    fn)
'6) = ynI O Nm'replace them with their miEcitiE   As Long


        n= 0 =
'        cP d,e     Al======= (NeF6(thly sampled values [m_Block(0-7, 0-7)],
    Static t1   As Single 'replace them with their (s)
 +(.
      Al=====lace(6bmg===eFMALonf====2w     Rv+fs Single 'replacer