Announcement

Collapse
No announcement yet.

Saving to JPG without 3rd party dlls?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Saving to JPG without 3rd party dlls?

    Im trying to do this without the need of GDI+ or any other tools.
    Has anybody done this?

    If noone has, or wants to share, i would have to go trough the JPG
    format to do it manually... ugh.

  • #2
    Actually, i think GDI+ is included with WinXP, so, no need for my installer to include it.
    Im going to see if i can get it to work with GDI+.

    I need to convert my BMP to JPG and pass it as stream without writing to file.

    Comment


    • #3
      I have been using the following code to save directly to jpg files. The include file is based on some code I found in these forums (I think it was from Philipp Weidmann) and I did a search for it so I could put a link to it. But I could not find it, so I will post it here. I only had to modify it slightly to fix a couple bugs causing memory leaks and crashes. It seems to work perfectly now. (word of caution, the include file uses several globals that would probably be better changed to statics. I did rename them to use g_ names so they would stand out more and cause fewer conflicts.)

      Here is the include file:
      Code:
      '------------------------------------------------------------------------------------
      ' PBJPEG.BAS - PowerBasic JPEG Encoder
      '------------------------------------------------------------------------------------
      '
      #If Not %DEF(%WINAPI)
      #Include "win32api.inc"                 'add win32api if not already added
      #ENDIF
      
      %NOMSG = 0  'Change to 0 to display error messages for debuging or 1 to not show messages
      
      '------------------------------------------------------------------------------------
      ' JPEG Marker Constants
      '------------------------------------------------------------------------------------
      ' Non-Differential Huffman Coding
      %SOF0   = &HC0&     ' Baseline DCT
      %SOF1   = &HC1&     ' Extended sequential DCT
      %SOF2   = &HC2&     ' Progressive DCT
      %SOF3   = &HC3&     ' Spatial (sequential) lossless
      
      ' Differential Huffman coding
      %SOF5   = &HC5&     ' Differential sequential DCT
      %SOF6   = &HC6&     ' Differential progressive DCT
      %SOF7   = &HC7&     ' Differential spatial
      
      ' Non-Differential arithmetic coding
      %JPG    = &HC8&     ' Reserved for JPEG extentions
      %SOF9   = &HC9&     ' Extended sequential DCT
      %SOF10  = &HCA&     ' Progressive DCT
      %SOF11  = &HCB&     ' Spatial (sequential) lossless
      
      ' Differential arithmetic coding
      %SOF13  = &HCD&     ' Differential sequential DCT
      %SOF14  = &HCE&     ' Differential progressive DCT
      %SOF15  = &HCF&     ' Differential Spatial
      
      ' Other Markers
      %DHT    = &HC4&     ' Define Huffman tables
      %DAC    = &HCC&     ' Define arithmetic coding conditioning(s)
      %RSTM   = &HD0&     ' Restart with modulo 8 count "m"
      %RSTM2  = &HD7&     '   to Restart with modulo 8 count "m"
      %SOI    = &HD8&     ' Start of image
      %EOI    = &HD9&     ' End of image
      %SOS    = &HDA&     ' Start of scan
      %DQT    = &HDB&     ' Define quantization table(s)
      %DNL    = &HDC&     ' Define number of lines
      %DRI    = &HDD&     ' Define restart interval
      %DHP    = &HDE&     ' Define hierarchical progression
      %VEXP   = &HDF&     ' Expand reference components
      %APP0   = &HE0&     ' Reserved for application segments
      %APPF   = &HEF&     '   to Reserved for application segments
      %JPGN   = &HF0&     ' Reserved for JPEG Extentions
      %JPGN2  = &HFD&     '   to Reserved for JPEG Extentions
      %COM    = &HFE&     ' Comment
      %RESM   = &H2&      ' Reserved
      %RESM2  = &HBF&     '   to Reserved
      %TEM    = &H1&      ' For temporary use in arithmetic coding
      
      
      %TWOE00 = &H1&
      %TWOE01 = &H2&
      %TWOE02 = &H4&
      %TWOE03 = &H8&
      %TWOE04 = &H10&
      %TWOE05 = &H20&
      %TWOE06 = &H40&
      %TWOE07 = &H80&
      %TWOE08 = &H100&
      %TWOE09 = &H200&
      %TWOE10 = &H400&
      %TWOE11 = &H800&
      %TWOE12 = &H1000&
      %TWOE13 = &H2000&
      %TWOE14 = &H4000&
      %TWOE15 = &H8000&
      
      
      
      ' Consider these arrays of constants.
      ' They are initialized with the module and do not change.
      Global g_QLumin()       As Byte      ' Standard Luminance Quantum (for 50% quality)
      Global g_QChrom()       As Byte      ' Standard Chrominance Quantum (for 50% quality)
      Global g_TwoP()         As Long      ' Powers of two 2^P
      Global g_TwoR()         As Long      ' Powers of two 2^(R-1)
      Global g_TwoB()         As Byte      ' The number of bits in value
      Global g_EIDCTScale()   As Long      ' Encoding Constants for scaling IntDCT Coefficients
      Global g_DIDCTScale()   As Long      ' Decoding Constants for scaling IntDCT Coefficients
      Global g_ZigZag()       As Long      ' Zig Zag order of 8X8 block of samples
      
      ' Custom variable types used for this JPEG encoding implementation
      Type QUANTIZATIONTABLE
         Qk(63)        As Integer ' Quantization Values
         FScale(63)    As Long    ' Multiplication values to scale and Quantize FDCT output
         IScale(63)    As Long    ' Multiplication values to scale and DeQuantize IDCT input
      End Type
      
      Type HUFFMANTABLE
         vBits(15)     As Byte    ' Number of huffman codes of length i+1
         HuffVal(255)  As Byte    ' Huffman symbol values
         EHufLN(255)   As Byte    ' Huffman codelength in Bits for symbol i
         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
      
      Type vComponent
         Ci            As Long         ' Component ID                [0-255]
         vHi           As Long         ' Horizontal Sampling Factor  [1-4]
         Vi            As Long         ' Vertical   Sampling Factor  [1-4]
         Tqi           As Long         ' Quantization Table Select   [0-3]
         ptrData       As Integer Ptr  ' A dirty workaround to the PB UDT dynamic array issue
      End Type
      
      
      '------------------------------------------------------------------------------------
      ' Global variables
      '------------------------------------------------------------------------------------
      Global g_PP       As Long    ' Sample Precision [8, 12]
      Global g_YY       As Long    ' Number of lines             [Image Height] after clipping
      Global g_XX       As Long    ' Number of samples per line  [Image Width]  after clipping
      Global g_Nf       As Long    ' Number of components in Frame
      
      Global g_HMax     As Long    ' Maximum horizontal sampling frequency
      Global g_VMax     As Long    ' Maximum vertical sampling frequency
      
      Global g_m_Data() As Byte    ' JPEG File Data
      Global g_m_Chr    As Long    ' Current Character in g_m_Data
      Global g_m_Ptr    As Long    ' Byte index in g_m_Data
      Global g_m_Bit    As Long    ' Bit index in g_m_Chr
      
      Global g_m_Block() As Long   ' Buffer for calculating intDCT  (7,7)
      
      Global g_QTable()    As QUANTIZATIONTABLE  ' 4 Quantization Tables
      Global g_HuffDC()    As HUFFMANTABLE       ' 4 DC Huffman Tables
      Global g_HuffAC()    As HUFFMANTABLE       ' 4 AC Huffman Tables
      Global g_Comp()      As vComponent         ' Scan Components
      
      Global g_CompData0() As Integer            ' DCT Coefficients [DC(0),AC(1-63)]*nBlocks
      Global g_CompData1() As Integer
      Global g_CompData2() As Integer
      
      Global g_m_Quality   As Long
      Global g_m_Comment   As String
      
      
      '------------------------------------------------------------------------------------
      ' Function prototypes
      '------------------------------------------------------------------------------------
      Declare Function piaUBOUND(ByRef iArray() As Integer) As Long
      Declare Sub piaREDIM(ByRef iArray() As Integer, ByVal lValue As Long)
      Declare Sub piaREDIMPRESERVE(ByRef iArray() As Integer, ByVal lValue As Long)
      Declare Sub piaSET(ByRef iArray() As Integer, ByVal lNdx As Long, ByVal sValue As Integer)
      Declare Function piaGET(ByRef iArray() As Integer, ByVal lNdx As Long) As Integer
      Declare Sub intDCT()
      Declare Sub TransformAndQuantize(ByRef vPixel() As Byte, ByVal CompIndex As Long, ByRef FScale() As Long, _
      ByVal vWidth As Long, ByVal Height As Long, ByVal RowMod As Long)
      Declare Function PBJPEG_SetQuality(ByVal vQuality As Long) As Long
      Declare Sub ExpandDQT(ByVal Tqi As Long)
      Declare Sub BuildHuffman(ByRef TheHuff As HUFFMANTABLE, ByRef Freq() As Long)
      Declare Sub ExpandHuffman(ByRef TheHuff As HUFFMANTABLE, ByVal MaxSymbol As Long)
      Declare Function CodeLength(ByRef TheHuff As HUFFMANTABLE, ByRef Freq() As Long) As Long
      Declare Sub WriteBitsBegin()
      Declare Sub WriteBitsEnd()
      Declare Sub WriteBits(ByVal mask As Long, ByVal code As Long)
      Declare Sub EncodeCoefficients(ByRef vData() As Integer, ByRef p As Long, ByRef Pred As Long, _
      ByVal Td As Long, ByVal Ta As Long)
      Declare Sub CollectStatisticsAC(ByRef vData() As Integer, ByRef FreqAC() As Long)
      Declare Sub CollectStatisticsDCNonInterleaved(ByRef vData() As Integer, ByRef FreqDC() As Long)
      Declare Sub CollectStatisticsDCInterleaved(ByRef vData() As Integer, ByRef FreqDC() As Long, _
      ByVal vHi As Long, ByVal Vi As Long)
      Declare Sub PBJPEG_SetSamplingFrequencies(ByVal H1 As Long, ByVal v1 As Long, _
      ByVal H2 As Long, ByVal v2 As Long, _
      ByVal H3 As Long, ByVal v3 As Long)
      Declare Function PBJPEG_SampleHDC(ByVal lHDC As Long, _
      ByVal lWidth As Long, _
      ByVal lHeight As Long, _
      ByVal lSrcLeft As Long, _
      ByVal lSrcTop As Long) As Long
      Declare Function PBJPEG_AddComment(ByVal vComment As String) As Long
      Declare Sub InsertJFIF()
      Declare Sub InsertSOF(ByVal SOFMarker As Long)
      Declare Sub InsertCOM(ByVal TheComment As String)
      Declare Sub InsertDQT(ByVal MarkerPos As Long, ByVal Tqi As Long)
      Declare Sub InsertDHT(ByVal MarkerPos As Long, ByVal HIndex As Long, ByVal isAC As Long)
      Declare Sub InsertMarker(ByVal TheMarker As Long)
      Declare Sub InsertSOSNonInterleaved(ByVal CompIndex As Long, ByVal Td As Long, ByVal Ta As Long)
      Declare Sub InsertSOSInterleaved(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
      ByVal FirstIndex As Long, ByVal SecondIndex As Long)
      Declare Sub InsertSequentialScans(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
      ByVal FirstIndex As Long, ByVal SecondIndex As Long)
      Declare Function OptimizeHuffmanTables(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
      ByVal FirstIndex As Long, ByVal SecondIndex As Long) As Long
      Declare Function PBJPEG_SaveFile(FileName As String) As Long
      Declare Function PBJPEG_Initialize() As Long
      Declare Sub Init_BitMasks()
      Declare Sub GenEIDCT()
      Declare Function nBits(ByVal v As Long) As Long
      
      
      '------------------------------------------------------------------------------------
      ' Pointer-based handling of Integer arrays
      '------------------------------------------------------------------------------------
      ' Based on the work of Stan Durham
      Function piaUBOUND(ByRef iArray() As Integer) As Long
         Function = UBound(iArray())
      End Function
      
      '------------------------------------------------------------------------------------
      
      Sub piaREDIM(ByRef iArray() As Integer, ByVal lValue As Long)
         ReDim iArray(lValue)
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub piaREDIMPRESERVE(ByRef iArray() As Integer, ByVal lValue As Long)
         ReDim Preserve iArray(lValue)
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub piaSET(ByRef iArray() As Integer, ByVal lNdx As Long, ByVal sValue As Integer)
         iArray(lNdx) = sValue
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Function piaGET(ByRef iArray() As Integer, ByVal lNdx As Long) As Integer
         Function = iArray(lNdx)
      End Function
      
      
      '------------------------------------------------------------------------------------
      ' Integer discrete cosine transformation
      '------------------------------------------------------------------------------------
      Sub intDCT()
         Try
            ' Integer Lifted, Loeffler factorisation 22 shifts, 40 adds by Jie Liang, Trac Tran
            ' See IEEE TRANSACTIONS ON SIGNAL PROCESSING VOL49, #12 DEC 2001
            
            ' This is carefully optimized and its easy to screw its performance up
            ' However its ideally suited to asm, so go for it Vlad!
            Local t0 As Long, t1 As Long, t2  As Long, t3  As Long
            Local t4 As Long, t5 As Long, t6  As Long, t7  As Long
            Local t8 As Long, t9 As Long, t10 As Long, t11 As Long
            Local i  As Long
      
            For i = 0 To 7                                  ' Process 1D intDCT on each row
               t0 = g_m_Block(i, 0)
               t8 = g_m_Block(i, 7)
               t7 = t0 - t8
               t0 = t0 + t8
               
               t1 = g_m_Block(i, 1)
               t8 = g_m_Block(i, 6)
               t6 = t1 - t8
               t1 = t1 + t8
               
               t2 = g_m_Block(i, 2)
               t8 = g_m_Block(i, 5)
               t5 = t2 - t8
               t2 = t2 + t8
               
               t3 = g_m_Block(i, 3)
               t8 = g_m_Block(i, 4)
               t4 = t3 - t8
               t3 = t3 + t8
               
               ' Top half
               t8 = t0 + t3
               t9 = t1 + t2
               t8 = t8 + t9
               g_m_Block(i, 0) = t8
               g_m_Block(i, 4) = t8 \ 2 - t9                             ' 1/2 *t8
               
               t10 = t1 - t2
               t11 = t0 - t3
               t10 = (t11 \ 4 + t11 \ 8 + t11 \ 32) - t10              ' 13/32*t11
               g_m_Block(i, 6) = t10
               g_m_Block(i, 2) = t11 - (t10 \ 4 + t10 \ 16 + t10 \ 32)   ' -11/32*t10
               
               ' Bottom half
               t7 = t7 - (t4 \ 4 + t4 \ 32 + t4 \ 64)                  ' -19/64*t4
               t4 = t4 + (t7 \ 2 + t7 \ 16)                            ' + 9/16*t7
               t7 = t7 - (t4 \ 4 + t4 \ 32 + t4 \ 64)                  ' -19/64*t4
               
               t6 = t6 - (t5 \ 16 + t5 \ 32)                           ' - 3/32*t5
               t5 = t5 + (t6 \ 8 + t6 \ 16)                            ' + 3/16*t6
               t6 = t6 - (t5 \ 16 + t5 \ 32)                           ' - 3/32*t5
               
               g_m_Block(i, 3) = t7 - t5
               g_m_Block(i, 5) = t4 - t6
               
               t8 = t4 + t6
               t11 = t5 + t7 + t8
               g_m_Block(i, 1) = t11
               g_m_Block(i, 7) = t11 \ 2 - t8                            ' 1/2
            Next i
            
            For i = 0 To 7                                  ' Process 1D intDCT on each column
               t0 = g_m_Block(0, i)
               t8 = g_m_Block(7, i)
               t7 = t0 - t8
               t0 = t0 + t8
               
               t1 = g_m_Block(1, i)
               t8 = g_m_Block(6, i)
               t6 = t1 - t8
               t1 = t1 + t8
               
               t2 = g_m_Block(2, i)
               t8 = g_m_Block(5, i)
               t5 = t2 - t8
               t2 = t2 + t8
               
               t3 = g_m_Block(3, i)
               t8 = g_m_Block(4, i)
               t4 = t3 - t8
               t3 = t3 + t8
               
               ' Top half
               t8 = t0 + t3
               t9 = t1 + t2
               t8 = t8 + t9
               g_m_Block(0, i) = t8
               g_m_Block(4, i) = t8 \ 2 - t9                             ' 1/2 *t8
               
               t10 = t1 - t2
               t11 = t0 - t3
               t10 = (t11 \ 4 + t11 \ 8 + t11 \ 32) - t10              ' 13/32*t11
               g_m_Block(6, i) = t10
               g_m_Block(2, i) = t11 - (t10 \ 4 + t10 \ 16 + t10 \ 32)   ' -11/32*t10
               
               ' Bottom half
               t7 = t7 - (t4 \ 4 + t4 \ 32 + t4 \ 64)                  ' -19/64*t4
               t4 = t4 + (t7 \ 2 + t7 \ 16)                            ' + 9/16*t7
               t7 = t7 - (t4 \ 4 + t4 \ 32 + t4 \ 64)                  ' -19/64*t4
               
               t6 = t6 - (t5 \ 16 + t5 \ 32)                           ' - 3/32*t5
               t5 = t5 + (t6 \ 8 + t6 \ 16)                            ' + 3/16*t6
               t6 = t6 - (t5 \ 16 + t5 \ 32)                           ' - 3/32*t5
               
               g_m_Block(3, i) = t7 - t5
               g_m_Block(5, i) = t4 - t6
               
               t8 = t4 + t6
               t11 = t5 + t7 + t8
               g_m_Block(1, i) = t11
               g_m_Block(7, i) = t11 \ 2 - t8                            ' 1/2
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error1",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Quantization
      '------------------------------------------------------------------------------------
      Sub TransformAndQuantize(ByRef vPixel() As Byte, ByVal CompIndex As Long, ByRef FScale() As Long, _
         ByVal vWidth As Long, ByVal Height As Long, ByVal RowMod As Long)
         Try
            Local i        As Long   ' Pixel Index (Horizontal)
            Local j        As Long   ' Pixel Index (Vertical)
            Local k        As Long   ' Index of an 8X8 block of pixels
            Local p        As Long   ' DCT Index (horizontal)
            Local q        As Long   ' DCT Index (vertical)
            Local t        As Long   ' COMPONENT in Zig Zag order at index BlkPtr
            Local n        As Long   ' Size of Image
            Local BlkPtr   As Long   ' Index for quantized intDCT value (in component data)
            Local BlkMod   As Long   ' StepWidth for a Block
            Local RowModS  As Long   ' Length of a Sample Row
            Local BlkModS  As Long   ' Length of a Sample Row of Blocks
            Local fr       As Long
            Local fg       As Long
            Local fb       As Long
            Local fc       As Long
            
            Select Case CompIndex
               Case 0   ' Luminance rm = 0.299; gm = 0.587; bm = 0.114; s = 128
                  fr = 19595&: fg = 38470: fb = 7471&: fc = 8388608
               Case 1   ' Chrominance [Blue-Yellow] rm = -0.16874; gm = -0.33126; bm = 0.5; s = 0
                  fr = -11059&: fg = -21709&: fb = 32768: fc = 0
               Case 2   ' Chrominance [Red-Green] rm = 0.5; gm = -0.41869; bm = -0.08131; s=0
                  fr = 32768: fg = -27439&: fb = -5329&: fc = 0
            End Select
            
            'REDIM g_Comp(CompIndex).vData(vWidth * Height - 1)
            piaREDIM ByVal g_Comp(CompIndex).ptrData, vWidth * Height - 1
            
            ' Reset output Quantized intDCT Coefficient Index
            BlkPtr = 0
            
            n = Height * RowMod
            RowModS = vWidth * 3
            BlkMod = RowMod - 24
            BlkModS = 8 * RowMod - RowModS
            i = 0
            
            Do While i < n
               k = RowModS
               
               Do
                  j = i
                  
                  ' Get 8X8 block of level shifted YCbCr values
                  For q = 0 To 7
                     For p = 0 To 7
                        g_m_Block(p, q) = fr * vPixel(i + 2) + fg * vPixel(i + 1) + fb * vPixel(i) - fc
                        i = i + 3
                     Next p
                     i = i + BlkMod
                  Next q
                  
                  ' Take 8X8 block of unscaled DCT coefficients [g_m_Block(0-7, 0-7)],
                  ' Scale, Quantize, and store the results in data() array of
                  ' COMPONENT in Zig Zag order at index BlkPtr
                  
                  ' Calculate the integer DCT (it is scaled by 65536)
                  Call intDCT
                  
                  For q = 0 To 7
                     For p = 0 To 7
                        t = g_ZigZag(p, q)
                        '                    g_Comp(CompIndex).vData(BlkPtr + t) = (((g_m_Block(p, q) + 16384&) \ 32768) * _
                        '                                                        FScale(t) + 131072) \ 262144
                        '                                                      Keep 1 decimal bit
                        piaSET ByVal g_Comp(CompIndex).ptrData, BlkPtr + t, (((g_m_Block(p, q) + 16384&) \ 32768) * _
                        FScale(t) + 131072) \ 262144
                        '   2* true scale           4*scale
                     Next p
                  Next q
                  
                  BlkPtr = BlkPtr + 64
                  
                  i = j + 24
                  ' Start Next Block this Row
                  k = k - 24
               Loop Until k = 0
               
               i = i + BlkModS
            Loop
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error2",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Image quality adjustment
      '------------------------------------------------------------------------------------
      Function PBJPEG_SetQuality(ByVal vQuality As Long) As Long
         Try
            ' The JPEG compression standard does not have a formal definition for image Quality.
            ' This implementation defines Quality as an integer value between 1 and 100, and
            ' generates quantization tables based on the value given.
            '
            ' Quality < 50  -  Poor image quality with high compression
            ' Quality = 75  -  Good quality pictures for displaying on a monitor or web page ...
            '                  Typical for general use
            ' Quality = 92  -  High quality with non-optimal compression ... Appropriate for printing ...
            '                  Typical digital camera "max quality" setting
            ' Quality > 95  -  Wasteful ... very poor compression with little image quality improvement.
            '                  Use 24-bit BMP TrueColor if you need quality this high.
            Local i           As Long
            Local qvalue      As Long
            Local maxvalue    As Long
            Local scalefactor As Long
            
            If g_PP = 12 Then
               maxvalue = 65535
            Else
               maxvalue = 255
            End If
            
            If vQuality > 0 And vQuality <= 100 Then
               g_m_Quality = vQuality
            Else
               g_m_Quality = 75    ' Else default 75
            End If
            
            If (g_m_Quality < 50) Then
               If g_m_Quality = 0 Then
                  scalefactor = 5000
               Else
                  scalefactor = 5000 \ g_m_Quality
               End If
            Else
               If g_m_Quality >= 100 Then
                  scalefactor = 0
               Else
                  scalefactor = 200 - g_m_Quality * 2
               End If
            End If
            
            For i = 0 To 63
               qvalue = (g_QLumin(i) * scalefactor + 50) \ 100
               
               If qvalue <= 0 Then
                  qvalue = 1
               ElseIf qvalue > maxvalue Then
                  qvalue = maxvalue
               End If
               
               g_QTable(0).Qk(i) = qvalue
            Next i
            
            For i = 0 To 63
               qvalue = (g_QChrom(i) * scalefactor + 50) \ 100
               
               If qvalue <= 0 Then
                  qvalue = 1
               ElseIf qvalue > maxvalue Then
                  qvalue = maxvalue
               End If
               
               g_QTable(1).Qk(i) = qvalue
            Next i
            
            ExpandDQT 0
            ExpandDQT 1
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error3",,Error$(Err)
         End Try
      End Function
      
      '------------------------------------------------------------------------------------
      
      Sub ExpandDQT(ByVal Tqi As Long)
         Try
            Local i        As Long
            Local j        As Long
            Local k        As Long
            Local maxvalue As Long
            
            If g_PP = 12 Then
               maxvalue = 65535
            Else
               maxvalue = 255
            End If
            
            For i = 0 To 7
               For j = 0 To 7
                  k = g_ZigZag(i, j)
                  
                  If g_QTable(Tqi).Qk(k) < 1 Or g_QTable(Tqi).Qk(k) > maxvalue Then
                     If %NOMSG = 0 Then MsgBox "Bad Quantization Table",,"JPEG encode error"
                     ' Bad Quantization Table
                  End If
                  
                  g_QTable(Tqi).FScale(k) = (g_EIDCTScale(i, j) + g_QTable(Tqi).Qk(k) \ 2) \ _
                  g_QTable(Tqi).Qk(k) ' g_QTable(Tqi).Qk(k)=1..maxval
                  ' FScale always 0..65536/131072
               Next j
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error4",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Huffman table generation
      '------------------------------------------------------------------------------------
      Sub BuildHuffman(ByRef TheHuff As HUFFMANTABLE, ByRef Freq() As Long)
         Try
            ' 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.
            Local i             As Long
            Local j             As Long
            Local k             As Long
            Local n             As Long
            Local w             As Long
            Local v1            As Long
            Local v2            As Long
            Dim   others(256)   As Long
            Dim   codesize(256) As Long
            Dim   vBits(256)    As Long
            Local swp           As Long
            Local swp2          As Long
            
            ' Initialization
            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 codesize() [find huffman code sizes]
            Do                  ' Do loop for (#non-zero-frequencies - 1) times
               v1 = -1                            ' Find highest v1 for least value of freq(v1)>0
               v2 = -1                            ' Find highest v2 for next least value of freq(v2)>0
               swp = 2147483647                   ' Max Long variable
               swp2 = 2147483647
               
               For i = 0 To 256
                  w = Freq(i)
                  
                  If w <> 0 Then
                     If w <= swp2 Then
                        If w <= swp Then
                           swp2 = swp
                           v2 = v1
                           swp = w
                           v1 = i
                        Else
                           swp2 = w
                           v2 = i
                        End If
                     End If
                  End If
               Next i
               
               If v2 = -1 Then
                  Freq(v1) = 0                   ' All elements in freq are now set to zero
                  Exit Do                        ' Done
               End If
               
               Freq(v1) = Freq(v1) + Freq(v2)     ' Merge the two branches
               Freq(v2) = 0
               codesize(v1) = codesize(v1) + 1    ' Increment all codesizes in v1's branch
               
               Do While others(v1) >= 0
                  v1 = others(v1)
                  codesize(v1) = codesize(v1) + 1
               Loop
               
               others(v1) = v2                    ' Chain v2 onto v1's branch
               codesize(v2) = codesize(v2) + 1    ' Increment all codesizes in v2's branch
               
               Do While others(v2) >= 0
                  v2 = others(v2)
                  codesize(v2) = codesize(v2) + 1
               Loop
            Loop
            
            ' Count BITS [find the number of codes of each size]
            n = 0
            
            For i = 0 To 256
               w = codesize(i)
               
               If w <> 0 Then
                  vBits(w) = vBits(w) + 1
                  If n < w Then n = w    ' Keep track of largest codesize
               End If
            Next i
            
            ' Adjust BITS [limit code lengths to 16 bits]
            i = n
            
            Do While i > 16
               Do While vBits(i) > 0
                  For j = i - 2 To 1 Step -1          ' Since symbols are paired for the longest Huffman
                     If vBits(j) > 0 Then Exit For   ' code, the symbols are removed from this length
                  Next j                              ' category two at a time.  The prefix for the pair
                  ' (which is one bit shorter) is allocated to one
                  vBits(i) = vBits(i) - 2             ' of the pair;  then, (skipping the BITS entry for
                  vBits(i - 1) = vBits(i - 1) + 1     ' that prefix length) a code word from the next
                  vBits(j + 1) = vBits(j + 1) + 2     ' shortest non-zero BITS entry is converted into
                  vBits(j) = vBits(j) - 1             ' a prefix for two code words one bit longer.
               Loop
               
               i = i - 1
            Loop
            
            vBits(i) = vBits(i) - 1                     ' Remove dummy symbol code from the code length count
            
            ' Copy BITS and HUFFVAL to the HUFFMANTABLE [HUFFVAL sorted by code length, then by value]
            For i = 1 To 16
               TheHuff.vBits(i - 1) = vBits(i)
            Next i
            
            k = 0
            
            For i = 1 To n
               For j = 0 To 255
                  If codesize(j) = i Then
                     TheHuff.HuffVal(k) = j
                     k = k + 1
                  End If
               Next j
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error5",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub ExpandHuffman(ByRef TheHuff As HUFFMANTABLE, ByVal MaxSymbol As Long)
         Try
            ' Given a HUFFMANTABLE with valid BITS and HUFFVAL, generate tables for
            ' EHUFCO, EHUFSI, MAXCODE, and MINCODE so the table may be used for compression
            ' and/or decompression.  In JPEG, MaxSymbol is 255 for an AC Huffman Table.  For
            ' DC Tables, MaxSymbol is 11 for PP=8 bit precission, or 15 for PP=12 bit precission.
            Local i      As Long   ' Index for BITS
            Local j      As Long   ' Index for HUFFVAL
            Local k      As Long   ' Index for last HUFFVAL of length (i+1)
            Local si     As Long   ' Huffman code size  ( =2^i )
            Local code   As Long   ' Huffman code
            Local symbol As Long   ' Huffman symbol
            
            For i = 0 To 255
               TheHuff.EHufLN(i) = 0
               TheHuff.EHufSI(i) = 0      ' Clear existing values so we can
               TheHuff.EHufCO(i) = -1     ' Check for duplicate huffman symbols
            Next i
            
            j = 0
            si = 1
            code = 0
            
            For i = 0 To 15
               k = j + TheHuff.vBits(i)
               
               If k > 256 Then
                  If %NOMSG = 0 Then MsgBox "Bad Huffman Table (More than 256 symbols)",,"JPEG encode error"
                  ' Bad Huffman Table
                  ' (More than 256 symbols)
               End If
               
               If j = k Then                                      ' No codes of length i+1
                  TheHuff.MinCode(i) = j - code
                  TheHuff.MaxCode(i) = -1
               Else
                  TheHuff.MinCode(i) = j - code
                  
                  Do While j < k
                     symbol = TheHuff.HuffVal(j)                ' Read symbol, make sure it's valid
                     
                     If symbol > MaxSymbol Then
                        If %NOMSG = 0 Then MsgBox "Bad Huffman Table (Invalid symbol)",,"JPEG encode error"
                        ' Bad Huffman Table
                        ' (Invalid symbol)
                     End If
                     If TheHuff.EHufCO(symbol) >= 0 Then
                        If %NOMSG = 0 Then MsgBox "Bad Huffman Table (Duplicate symbol)",,"JPEG encode error"
                        ' Bad Huffman Table
                        ' (Duplicate symbol)
                     End If
                     
                     TheHuff.EHufLN(symbol) = i
                     TheHuff.EHufSI(symbol) = si                ' Assign code for symbol
                     TheHuff.EHufCO(symbol) = code
                     code = code + 1
                     j = j + 1
                  Loop
                  
                  TheHuff.MaxCode(i) = code - 1
               End If
               
               si = si + si
               
               If code >= si Then
                  If %NOMSG = 0 Then MsgBox "Bad Huffman Table (Code does not fit into available bits)",,"JPEG encode error"
                  ' Bad Huffman Table
                  ' (Code does not fit into available bits)
               End If
               
               code = code + code
            Next i
            
            If j = 0 Then
               If %NOMSG = 0 Then MsgBox "Bad Huffman Table (No huffman symbols???)",,"JPEG encode error"
               ' Bad Huffman Table
               ' (No huffman symbols???)
            End If
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error6",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Function CodeLength(ByRef TheHuff As HUFFMANTABLE, ByRef Freq() As Long) As Long
         Try
            ' Estimate a worstcase code length for an entire table
            Local j   As Long
            Local k   As Long
            Local sum As Long
            
            sum = 0
            
            For j = 0 To 255
               If Freq(j) <> 0 Then
                  k = TheHuff.EHufLN(j) + nBits(j)    ' Length of size category + value, in bits
                  sum = sum + Freq(j) * k             ' Sum all occurances of this coefficient, in bits
               End If
            Next j
            
            Function = (sum + 7) \ 8
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error7",,Error$(Err)
         End Try
      End Function
      
      
      '------------------------------------------------------------------------------------
      ' Entropy coding
      '------------------------------------------------------------------------------------
      Sub WriteBitsBegin()
         g_m_Chr = 0
         g_m_Bit = 128
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub WriteBitsEnd()
         If g_m_Bit <> 128 Then WriteBits g_m_Bit, -1
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub WriteBits(ByVal mask As Long, ByVal code As Long)
         Try
            Do While mask > 0
               If (code And mask) <> 0 Then g_m_Chr = (g_m_Chr Or g_m_Bit)
               
               If g_m_Bit = 1 Then             ' We completed a byte ...
                  g_m_Data(g_m_Ptr) = g_m_Chr     ' Add it to the stream
                  
                  If g_m_Chr = 255 Then       ' Pad a zero byte and advance pointer
                     g_m_Ptr = g_m_Ptr + 1     ' Advance pointer
                     g_m_Data(g_m_Ptr) = 0     ' Insert zero
                  End If
                  
                  g_m_Ptr = g_m_Ptr + 1         ' Advance pointer
                  g_m_Chr = 0                 ' Clear byte buffer and reset bit index
                  g_m_Bit = 128
               Else                          ' Increment to next bit position to write
                  g_m_Bit = g_m_Bit \ 2
               End If
               
               mask = mask \ 2
            Loop
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error8",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub EncodeCoefficients(ByRef vData() As Integer, ByRef p As Long, ByRef Pred As Long, _
         ByVal Td As Long, ByVal Ta As Long)
         Try
            ' Use Huffman tables to compress a block of 64 quantized DCT coefficients to the local
            ' g_m_Data() byte array.  The coefficients are input in the data() array starting at index p.
            ' Pred is the predictor for the DC coefficient.  Td and Ta are indexes to the local DC and AC
            ' Huffman Tables to use.
            Local r    As Long
            Local rs   As Long
            Local code As Long
            Local p2   As Long
            
            p2 = p + 64
            
            code = vData(p) - Pred
            Pred = vData(p)
            p = p + 1
            
            If code = 0 Then
               WriteBits g_HuffDC(Td).EHufSI(0), g_HuffDC(Td).EHufCO(0)      ' Append symbol for size category
            Else
               rs = nBits(code)
               If code < 0 Then code = code - 1
               WriteBits g_HuffDC(Td).EHufSI(rs), g_HuffDC(Td).EHufCO(rs)    ' Append symbol for size category
               WriteBits g_TwoR(rs), code                                  ' Append diff
            End If
            
            r = 0
            
            Do
               code = vData(p)
               
               If code = 0 Then
                  r = r + 16
               Else
                  Do While r > 240
                     WriteBits g_HuffAC(Ta).EHufSI(240), g_HuffAC(Ta).EHufCO(240)   ' Append RUN16 (a run of 16 zeros)
                     r = r - 256
                  Loop
                  
                  rs = nBits(code)
                  If code < 0 Then code = code - 1
                  WriteBits g_HuffAC(Ta).EHufSI(r + rs), g_HuffAC(Ta).EHufCO(r + rs) ' Append run length, size category
                  WriteBits g_TwoR(rs), code                                       ' Append AC value
                  r = 0
               End If
               
               p = p + 1
            Loop While p < p2   ' Should be equal on exit
            
            If r <> 0 Then WriteBits g_HuffAC(Ta).EHufSI(0), g_HuffAC(Ta).EHufCO(0)    ' Append EOB (end of block)
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error9",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Collecting statistics
      '------------------------------------------------------------------------------------
      ' These procedures collect statistics of run-length and size categories of DCT coefficients
      ' so optimized Huffman tables can be generated to compress them.
      Sub CollectStatisticsAC(ByRef vData() As Integer, ByRef FreqAC() As Long)
         Try
            Local code As Long
            Local n    As Long    ' Number of coefficients in data()
            Local p    As Long    ' Index for current data() coefficient
            Local p2   As Long
            Local r    As Long    ' Run length of zeros
            Local rs   As Long    ' Run-length/Size-category Symbol
            
            n = UBound(vData) + 1 ' +1 not necessary
            p = 0
            
            Do While p < n
               p = p + 1
               p2 = p + 63
               r = 0
               
               Do While p < p2  ' Should be equal on exit
                  code = vData(p)                            ' Is always <=|255| ??
                  
                  If code = 0 Then
                     r = r + 16                            ' 16*count of zeroes
                  Else
                     Do While r > 240
                        FreqAC(240) = FreqAC(240) + 1     ' Runs of 16 zeros
                        r = r - 256
                     Loop
                     
                     rs = r + nBits(code)                  ' Number of bits for this code
                     FreqAC(rs) = FreqAC(rs) + 1           ' Freq of 16*nzeroes + nbits(code)+1
                     r = 0
                  End If
                  
                  p = p + 1
               Loop
               
               If r <> 0 Then FreqAC(0) = FreqAC(0) + 1      ' EOB value
            Loop
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error10",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub CollectStatisticsDCNonInterleaved(ByRef vData() As Integer, ByRef FreqDC() As Long)
         Try
            Local Pred As Long     ' DC Predictor
            Local n    As Long     ' Number of coefficients in data()
            Local p    As Long     ' Index for current data() coefficient
            Local rs   As Long     ' Size category for Diff
            
            n = UBound(vData) + 1
            p = 0
            Pred = 0
            
            Do While p < n
               rs = nBits(vData(p) - Pred)   ' Number of bits in delta from last value
               Pred = vData(p)
               FreqDC(rs) = FreqDC(rs) + 1   ' Frequencies of bitsizes
               p = p + 64
            Loop
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error11",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub CollectStatisticsDCInterleaved(ByRef vData() As Integer, ByRef FreqDC() As Long, _
         ByVal vHi As Long, ByVal Vi As Long)
         Try
            Local p()  As Long    ' Index to .data in component f for scanline g
            Local f    As Long    ' Index counter (component)
            Local g    As Long    ' Index counter (sampling factor, vertical)
            Local h    As Long    ' Index counter (sampling factor, horizontal)
            Local i    As Long    ' Index counter (MCU horizontal)
            Local j    As Long    ' Index counter (MCU vertical)
            Local n    As Long    ' Number of coefficients in data()
            Local s    As Long    ' Size category for Diff
            Local Pred As Long    ' DC Predictor
            Local pLF  As Long    ' Line Feed for p in data
            Local MCUr As Long    ' Number of complete 8X8 blocks in rightmost MCU
            Local MCUx As Long    ' Number of MCUs per scanline
            Local MCUy As Long    ' Number of MCU scanlines
            
            n = UBound(vData) + 1
            ReDim p(Vi - 1)
            
            MCUx = (g_XX + 8 * g_HMax - 1) \ (8 * g_HMax)
            MCUy = ( g_YY + 8 * g_VMax - 1) \ (8 * g_VMax)
            
            h = (-Int(-g_XX * vHi / g_HMax) + 7) \ 8 ' Width of scanline in data (MCUs)
            
            For g = 0 To Vi - 1                  ' Initialize .data pointers
               p(g) = 64 * h * g
            Next g
            
            pLF = 64 * h * (Vi - 1)              ' Initialize .data pointer advancer
            
            MCUr = (h Mod vHi)                   ' Number of complete 8X8 Blocks in rightmost MCU
            If MCUr = 0 Then MCUr = vHi
            
            For j = 1 To MCUy - 1
               ' MCUs across a scanline
               For i = 1 To MCUx - 1
                  For g = 1 To Vi
                     For h = 1 To vHi
                        s = nBits(vData(p(g - 1)) - Pred)  ' Number of bits in diff
                        Pred = vData(p(g - 1))
                        FreqDC(s) = FreqDC(s) + 1
                        p(g - 1) = p(g - 1) + 64
                     Next h
                  Next g
               Next i
               
               ' Rightmost MCU
               For g = 1 To Vi
                  For h = 1 To vHi
                     If h > MCUr Then                       ' Pad with dummy block
                        s = 0
                     Else
                        s = nBits(vData(p(g - 1)) - Pred)  ' Number of bits in diff
                        Pred = vData(p(g - 1))
                        p(g - 1) = p(g - 1) + 64
                     End If
                     
                     FreqDC(s) = FreqDC(s) + 1
                  Next h
               Next g
               
               ' Advance data pointers
               For g = 0 To Vi - 1
                  p(g) = p(g) + pLF
               Next g
            Next j
            
            ' Bottommost MCU Scanline
            For i = 1 To MCUx
               For g = 1 To Vi
                  For h = 1 To vHi
                     If p(g - 1) >= n Or (i = MCUx And h > MCUr) Then ' Pad with dummy block
                        s = 0
                     Else
                        s = nBits(vData(p(g - 1)) - Pred)            ' Number of bits in Diff
                        Pred = vData(p(g - 1))
                        p(g - 1) = p(g - 1) + 64
                     End If
                     
                     FreqDC(s) = FreqDC(s) + 1
                  Next h
               Next g
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error12",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Image sampling
      '------------------------------------------------------------------------------------
      ' This class always samples and compresses pictures in YCbCr colorspace.  The first component, Y,
      ' represents the Luminance of the pixels.  This is "how bright" a pixel is.  The Cb and Cr
      ' components are Chrominance, which is a measure of how far from neutral-white (toward a color)
      ' a pixel is.  The human visual sensory system can discriminate Luminance differences about
      ' twice as well as it can discriminate Chrominance differences.
      '
      ' Virtually all JPEG files are in YCbCr colorspace.  Other JPEG compliant colorspaces exist, but
      ' they are used in specialty equipment.  For example, people in the astronomy or medical fields
      ' choose colorspaces that best record the information they are interested in, and don't care about
      ' how pretty the picture looks to a person when displayed on a computer monitor.
      ' [Apple/Machintosh sometimes uses a four component colorspace, but that colorspace is rare and
      ' not widely supported]
      '
      ' Sampling frequencies define how often each component is sampled.  Higher frequencies store more
      ' information, while lower frequencies store less.  Typically, sampling frequencies are set at
      ' 2,2, 1,1, 1,1.  This corresponds to the human visual sensory system.  The first component,
      ' Luminance, is sampled twice as much because our eyes notice differences in Luminance quite easily.
      ' The two Chrominance components are sampled half as much as because our eyes can't distinguish
      ' the difference in color changes as well.  One Luminance value is sampled for every pixel, and
      ' one Chrominance value is sampled for each 2X2 block of pixels.
      '
      ' Digital cameras typically record at sampling frequencies of 1,1, 1,1, 1,1.  This samples every
      ' pixel for all three components.  The quality of the picture is a little better when viewed by
      ' a person, but the compression benefits drop significantly.  If the picture to be compressed
      ' is from a Scanner or Digital camera, and you plan on printing it in the future, and storage
      ' space is not a problem, then sampling at these frequencies makes sense.  Otherwise, if you only
      ' plan on using the picture to display on a monitor or a web page, [2,2, 1,1, 1,1] makes the
      ' most sense.
      '
      ' The JPEG standard specifies that sampling frequencies may range from 1-4 for each component
      ' in both directions.  However, if any component has a sampling frequency of '3', and another
      ' component has a coresponding sampling frequency of '2' or '4', the downsampling process
      ' will map fractional pixels to sample values.  This is leagal in the JPEG standard, and this
      ' class will compress fractional pixel samplings, but this is not widely supported.  It is
      ' highly recommended to AVOID SAMPLING FACTORS OF 3 for maximum compatability with JPEG decoders.
      '
      ' Some JPEG encoders avoid the fractional pixel problem by only allowing the end user to pick
      ' a "sub-sampling" value.  In such "Sub Sampling" schemes, all Chrominance frequencies are set
      ' to one, and the (one or two) sub-sampling value(s) specify Luminance frequencies.
      '
      ' There should *never* be an error raised if you are using this class correctly.  It should
      ' not be possible for the end user to specify illegal sampling frequency values!
      ' [For tinkerers - If you delete the error raising code and specify illegal sampling
      ' frequencies, this class will procede to create a non-JPEG compliant file with the values
      ' specified]
      Sub PBJPEG_SetSamplingFrequencies(ByVal H1 As Long, ByVal v1 As Long, _
         ByVal H2 As Long, ByVal v2 As Long, _
         ByVal H3 As Long, ByVal v3 As Long)
         Local i As Long
      
         Try
            
            If H1 < 1 Or H1 > 4 Then
               If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err1"
               ' Invalid Sampling Value
            End If
            If v1 < 1 Or v1 > 4 Then
               ' Invalid Sampling Value
               If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err2"
            End If
            
            If (H2 Or H3 Or v2 Or v3) = 0 Then  ' If H2,H3,V2,V3 are all zero ...
               g_Nf = 1          ' Luminance only.
               ReDim g_Comp(0)
               g_Comp(0).vHi = 1 ' Set up for sampling Greyscale
               g_Comp(0).Vi = 1  ' (Black and White picture)
               g_Comp(0).ptrData = VarPtr(g_CompData0())
            Else
               If H2 < 1 Or H2 > 4 Then
                  ' Invalid Sampling Value
                  If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err3"
               End If
               If H3 < 1 Or H3 > 4 Then
                  ' Invalid Sampling Value
                  If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err4"
               End If
               If v2 < 1 Or v2 > 4 Then
                  ' Invalid Sampling Value
                  If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err5"
               End If
               If v3 < 1 Or v3 > 4 Then
                  ' Invalid Sampling Value
                  If %NOMSG = 0 Then MsgBox "Invalid Sampling Value",,"Err6"
               End If
               
               g_Nf = 3          ' YCbCr
               ReDim g_Comp(2)
               
               g_Comp(0).vHi = H1
               g_Comp(0).Vi = v1
               g_Comp(0).Tqi = 0
               g_Comp(0).ptrData = VarPtr(g_CompData0())
               g_Comp(1).vHi = H2
               g_Comp(1).Vi = v2
               g_Comp(1).Tqi = 1
               g_Comp(1).ptrData = VarPtr(g_CompData1())
               g_Comp(2).vHi = H3
               g_Comp(2).Vi = v3
               g_Comp(2).Tqi = 1
               g_Comp(2).ptrData = VarPtr(g_CompData2())
            End If
            
            g_HMax = -1
            g_VMax = -1
            
            For i = 0 To g_Nf - 1   ' Determine max h, v sampling factors
               If g_HMax < g_Comp(i).vHi Then g_HMax = g_Comp(i).vHi
               If g_VMax < g_Comp(i).Vi Then g_VMax = g_Comp(i).Vi
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error13",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Function PBJPEG_SampleHDC(ByVal lHDC As Long, _
         ByVal lWidth As Long, _
         ByVal lHeight As Long, _
         ByVal lSrcLeft As Long, _
         ByVal lSrcTop As Long) As Long
         ' Given a valid hDC and dimensions, generate component samplings of an Image.
         ' A DIBSection is created to hold Sample(s) of the Image, from which the Image is
         ' decomposed into YCbCr components.
         ' Returns: 0 = Success
         '          1 = API error while generating a DIBSection
         Try
            Local BI       As BITMAPINFO ' Type containing the Bitmap information
            Local hDIb     As Long       ' Handle to the DIBSection
            Local hBmpOld  As Long       ' Handle to the old bitmap in the DC, for clear up
            Local hDC      As Long       ' Handle to the Device context holding the DIBSection
            Local pBits     As Dword Ptr   ' Address of memory pointing to the DIBSection's bits
            
            Local f        As Long       ' Index counter for components
            Local g        As Long
            Local vPixel() As Byte       ' Byte array containing pixel data
            Local lRowMod  As Long       ' Width of A Row in Bytes
            
            Local xs       As Long       ' Sample width
            Local ys       As Long       ' Sample height
            Local xs8      As Long       ' Sample width  (padded to 8 pixel barrier)
            Local ys8      As Long       ' Sample height (padded to 8 pixel barrier)
            Local xsLast   As Long       ' Sample width  (for previous component)
            Local ysLast   As Long       ' Sample height (for previous component)
            Dim FScale(63) As Long
            
            g_PP = 8
            g_XX = lWidth                ' The to be sampled image block
             g_YY = lHeight               ' The to be sampled image block
            
            ' Create a DIBSection to store Sampling(s) of the Image
            hDC = CREATECOMPATIBLEDC(0)
      
            If hDC = 0 Then
               Function = 1         ' CreateCompatibleDC() API Failure
               If %NOMSG = 0 Then MsgBox "CreateCompatibleDC() API Failure",,"JPEG encode error"
            Else
      
      
               'BI.bmiHeader.biSizeImage = ((BI.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC) * BI.bmiHeader.biHeight '4 byte barrier
               'hDIb = CreateDIBSection2(hDC, BI, DIB_RGB_COLORS, lPtr, 0, 0)
      
               lWidth = (g_XX + 7) And &HFFFFFFF8     ' 8 byte barrier for 8X8 data units
               lHeight = (g_YY + 7) And &HFFFFFFF8
               'MsgBox "width=" + Str$(lWidth) + "height=" + Str$(lHeight)
               lRowMod = ((lWidth * 3 + 3) And &HFFFFFFFC)'(((lWidth * 24&) + 31&) And Not 31&) \ 8&
               BI.bmiHeader.biSize = Len(BI.bmiHeader)
               BI.bmiHeader.biWidth = lWidth
               BI.bmiHeader.biHeight = -lHeight     ' Top to bottom please
               BI.bmiHeader.biPlanes = 1
               BI.bmiHeader.biBitCount = 24
               BI.bmiHeader.biCompression = %BI_RGB
               BI.bmiHeader.biSizeImage = (lRowMod * lHeight)  ' 4 byte barrier
               
               hDIb = CREATEDIBSECTION(hDC, BI, %DIB_RGB_COLORS, ByVal VarPtr(pBits), 0, 0)
               
               If hDIb = 0 Then
                  Function = 1     ' CreateDIBSection() API Failure
                  If %NOMSG = 0 Then MsgBox "CreateDIBSection() API Failure",,"JPEG encode error"
               Else
                  GdiFlush
      
                  hBmpOld = SELECTOBJECT(hDC, hDIb)          ' Select DIBSection into DC
                  
                  If SETSTRETCHBLTMODE(hDC, %HALFTONE) = 0 Then SETSTRETCHBLTMODE hDC, %COLORONCOLOR
                  
                  For f = 0 To g_Nf - 1
                     g_Comp(f).Ci = f + 1     ' Assign an ID to this component
                     
                     xs = -Int(-g_XX * g_Comp(f).vHi / g_HMax)    ' Determine Sample dimensions
                     ys = -Int(-g_YY * g_Comp(f).Vi / g_VMax)
                     xs8 = ((xs + 7) And &HFFFFFFF8)        ' Sample dimensions with 8X8 barrier
                     ys8 = ((ys + 7) And &HFFFFFFF8)
                     
                     If xs8 <> xsLast Or ys8 <> ysLast Then ' We need to Sample the Image
                        If xs = g_XX And ys = g_YY Then        ' Just copy the image to our DIBSection
                           BITBLT hDC, 0, 0, xs, ys, lHDC, lSrcLeft, lSrcTop, %SRCCOPY
                        Else                               ' Resample/Resize the Image
                           STRETCHBLT hDC, 0, 0, xs, ys, lHDC, lSrcLeft, lSrcTop, lWidth, lHeight, %SRCCOPY
                        End If
                        
                        If xs < xs8 Then                   ' Pad right of Sample to 8 block barrier
                           STRETCHBLT hDC, xs + 1, 0, xs8 - xs, ys, hDC, xs, 0, 1, ys, %SRCCOPY
                        End If
                        
                        If ys < ys8 Then                   ' Pad bottom of Sample to 8 block barrier
                           STRETCHBLT hDC, 0, ys + 1, xs8, ys8 - ys, hDC, 0, ys, xs8, 1, %SRCCOPY
                        End If
                     End If
                     
                     ' Copy the DIB section's pixels to the vPixel array
                     ' This is so dirty it hurts
                     ReDim vPixel((lRowMod * lHeight)-1)
      
                     'LogThis "Starting vPixel mod 4 = " + Str$((UBound(vPixel)+1) Mod 4)
                     
                     For g = 0 To UBound(vPixel)
                        'If (g Mod 100000) = 0 Or (g > 2359196) Then LogThis "on vPixel " + Str$(g)
                        vPixel(g) = Peek(pBits + g)       '<------  had GPF on large images on second encoding
                     Next g
      
                     'MoveMemory (ByVal VarPtr(vPixel(0)), _ '	// address Of Copy destination 
                     '            ByVal pBits,             _ ' *Source,	// address Of block To Copy 
                     '            ByVal UBound(vPixel) + 1)  ' Length 	// Size, In bytes, Of block To Copy  
                     
      
                     'LogThis "UBound(vPixel)=" + Str$(UBound(vPixel))
                     
                     For g = 0 To UBound(FScale)
                        FScale(g) = g_QTable(g_Comp(f).Tqi).FScale(g)
                     Next g
                     
                     ' Read 8X8 blocks of pixels, convert from RGB->YCbCr colorspace, FDCT and Quantize
                     ' the data, store the results in .Data() of this component
                     Call TransformAndQuantize(vPixel(), f, FScale(), xs8, ys8, lRowMod)
                     'CALL TransformAndQuantize(vPixel(), f, g_QTable(g_Comp(f).Tqi).FScale(), xs8, ys8, lRowMod)
      
                     xsLast = xs
                     ysLast = ys
                  Next f
                  
                  SELECTOBJECT hDC, hBmpOld ' Select CompatibleDC  (unselect DIBSection)
                  DELETEOBJECT hDIb         ' Delete DIBSection
               End If
               
               DELETEDC hDC              ' Delete CompatibleDC
            End If
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error14",,Error$(Err)
         End Try
      End Function
      
      '------------------------------------------------------------------------------------
      
      Function PBJPEG_AddComment(ByVal vComment As String) As Long
         ' Assigning a value to this property will add the text Comment to the JPEG file.
         If Len(vComment) > 65535 Then
            If %NOMSG = 0 Then MsgBox "Illegal Comment Length",,"JPEG encode error"
            ' Illegal Comment Length
         Else
            g_m_Comment = vComment
         End If
         
      End Function
      
      
      '------------------------------------------------------------------------------------
      ' Emiting markers
      '------------------------------------------------------------------------------------
      Sub InsertJFIF()
         Try
            If g_m_Ptr + 17 > UBound(g_m_Data) Then
               If %NOMSG = 0 Then MsgBox "Copymemory will write past bounds of g_m_Data()",,"JPEG encode error"
               ' Copymemory will write past bounds of g_m_Data()
            Else
               Poke VarPtr(g_m_Data(g_m_Ptr + 0)), &H1000E0FF    ' APP0 Marker, Length(APP0)=16
               Poke VarPtr(g_m_Data(g_m_Ptr + 4)), &H4649464A    ' "JFIF"
               Poke VarPtr(g_m_Data(g_m_Ptr + 8)), &H10100       ' "/0", Version Major=1, Version Minor=1
               ' Units=0  [0=pixel, 1=dpi, 2=dots/cm]
               Poke VarPtr(g_m_Data(g_m_Ptr + 12)), &H1000100    ' Horizontal pixel density = 1 (dot per pixel)
               ' Vertical pixel density = 1 (dot per pixel)
               Poke VarPtr(g_m_Data(g_m_Ptr + 16)), &H0           ' Thumbnail horizontal pixel count = 0
               g_m_Ptr = g_m_Ptr + 18                                   ' Thumbnail vertical pixel count = 0
            End If
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error15",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertSOF(ByVal SOFMarker As Long)
         Try
            Local i  As Long   ' Insert a Start Of Frame marker segment
            Local Lx As Long   ' PP, YY, XX, Nf, and Ci,Hi,Vi,Tqi, must already be set
            
            Lx = 8 + 3 * g_Nf
            g_m_Data(g_m_Ptr) = 255                    ' SOF
            g_m_Data(g_m_Ptr + 1) = SOFMarker And 255
            g_m_Data(g_m_Ptr + 2) = Lx \ 256           ' Frame Header Length
            g_m_Data(g_m_Ptr + 3) = Lx And 255
            g_m_Data(g_m_Ptr + 4) = g_PP                 ' Sample precision [8, 12]
            g_m_Data(g_m_Ptr + 5) = g_YY \ 256           ' Number of Lines
            g_m_Data(g_m_Ptr + 6) = g_YY And 255
            g_m_Data(g_m_Ptr + 7) = g_XX \ 256           ' Number of samples per line
            g_m_Data(g_m_Ptr + 8) = g_XX And 255
            g_m_Data(g_m_Ptr + 9) = g_Nf                 ' Number of image components in frame
            g_m_Ptr = g_m_Ptr + 10
            
            For i = 0 To g_Nf - 1                    ' For each component ...
               g_m_Data(g_m_Ptr) = g_Comp(i).Ci         ' Component identifier
               g_m_Data(g_m_Ptr + 1) = g_Comp(i).vHi * 16 Or g_Comp(i).Vi  ' Horizontal/Vertical sampling factors
               g_m_Data(g_m_Ptr + 2) = g_Comp(i).Tqi    ' Quantization table selector
               g_m_Ptr = g_m_Ptr + 3
            Next i
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error16",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertCOM(ByVal TheComment As String)
         Try
            Local i  As Long
            Local Lx As Long
            
            Lx = Len(TheComment) + 2
            
            If Lx > 2 Then
               g_m_Data(g_m_Ptr) = 255               ' COM marker
               g_m_Data(g_m_Ptr + 1) = %COM
               g_m_Data(g_m_Ptr + 2) = Lx \ 256      ' COM marker segment length
               g_m_Data(g_m_Ptr + 3) = Lx And 255
               g_m_Ptr = g_m_Ptr + 4
               
               For i = 1 To Len(TheComment)      ' Comment text
                  g_m_Data(g_m_Ptr) = Asc(Mid$(TheComment, i, 1))
                  g_m_Ptr = g_m_Ptr + 1
               Next i
            End If
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error17",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertDQT(ByVal MarkerPos As Long, ByVal Tqi As Long)
         Try
            Local i As Long  ' Call with MarkerPos = g_m_Ptr to insert a single table with its own DQT marker
            ' Call multiple times with the same MarkerPos to include
            ' multiple tables under the same DQT marker
            
            If g_m_Ptr < MarkerPos + 4 Then   ' Insert Marker
               g_m_Ptr = MarkerPos + 4
               g_m_Data(g_m_Ptr - 4) = 255
               g_m_Data(g_m_Ptr - 3) = %DQT
            End If
            
            For i = 0 To 63
               If g_QTable(Tqi).Qk(i) > 255 Then Exit For
            Next i
            
            If i = 64 Then                  ' 8 bit precision
               g_m_Data(g_m_Ptr) = Tqi
               g_m_Ptr = g_m_Ptr + 1
               
               For i = 0 To 63
                  g_m_Data(g_m_Ptr) = g_QTable(Tqi).Qk(i)
                  g_m_Ptr = g_m_Ptr + 1
               Next i
            Else                            ' 16 bit precision
               If g_PP <> 12 Then
                  If %NOMSG = 0 Then MsgBox "Illegal precision in Quantization Table",,"JPEG encode error"
                  ' Illegal precision in Quantization Table
               End If
               
               g_m_Data(g_m_Ptr) = Tqi Or 16
               g_m_Ptr = g_m_Ptr + 1
               
               For i = 0 To 63
                  g_m_Data(g_m_Ptr) = g_QTable(Tqi).Qk(i) \ 256
                  g_m_Data(g_m_Ptr + 1) = g_QTable(Tqi).Qk(i) And 255
                  g_m_Ptr = g_m_Ptr + 2
               Next i
            End If
            
            g_m_Data(MarkerPos + 2) = (g_m_Ptr - MarkerPos - 2) \ 256&  ' Insert Marker segment length
            g_m_Data(MarkerPos + 3) = (g_m_Ptr - MarkerPos - 2) And 255&
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error18",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertDHT(ByVal MarkerPos As Long, ByVal HIndex As Long, ByVal isAC As Long)
         Try
            Local i As Long  ' Call with MarkerPos = g_m_Ptr to insert a single table with its own DHT marker
            Local j As Long  ' Call multiple times with the same MarkerPos to include
            ' multiple tables under the same DHT marker
            
            If g_m_Ptr < MarkerPos + 4 Then   ' Insert Marker
               g_m_Ptr = MarkerPos + 4
               g_m_Data(g_m_Ptr - 4) = 255
               g_m_Data(g_m_Ptr - 3) = %DHT
            End If
            
            If isAC Then
               g_m_Data(g_m_Ptr) = HIndex Or 16
               g_m_Ptr = g_m_Ptr + 1
               j = 0
               
               For i = 0 To 15
                  g_m_Data(g_m_Ptr) = g_HuffAC(HIndex).vBits(i)
                  g_m_Ptr = g_m_Ptr + 1
                  j = j + g_HuffAC(HIndex).vBits(i)
               Next i
               
               For i = 0 To j - 1
                  g_m_Data(g_m_Ptr) = g_HuffAC(HIndex).HuffVal(i)
                  g_m_Ptr = g_m_Ptr + 1
               Next i
            Else
               g_m_Data(g_m_Ptr) = HIndex
               g_m_Ptr = g_m_Ptr + 1
               j = 0
               
               For i = 0 To 15
                  g_m_Data(g_m_Ptr) = g_HuffDC(HIndex).vBits(i)
                  g_m_Ptr = g_m_Ptr + 1
                  j = j + g_HuffDC(HIndex).vBits(i)
               Next i
               
               For i = 0 To j - 1
                  g_m_Data(g_m_Ptr) = g_HuffDC(HIndex).HuffVal(i)
                  g_m_Ptr = g_m_Ptr + 1
               Next i
            End If
            
            g_m_Data(MarkerPos + 2) = (g_m_Ptr - MarkerPos - 2) \ 256&   ' Insert Marker segment length
            g_m_Data(MarkerPos + 3) = (g_m_Ptr - MarkerPos - 2) And 255&
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error19",,Error$(Err)
         End Try
      
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertMarker(ByVal TheMarker As Long)
         g_m_Data(g_m_Ptr) = 255
         g_m_Data(g_m_Ptr + 1) = TheMarker
         g_m_Ptr = g_m_Ptr + 2
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Emiting scans
      '------------------------------------------------------------------------------------
      Sub InsertSOSNonInterleaved(ByVal CompIndex As Long, ByVal Td As Long, ByVal Ta As Long)
         Try
            ' Insert an SOS marker and scan data for a non-interleaved Sequential scan.
            Local p    As Long     ' Index to .data in component
            Local n    As Long
            Local Pred As Long     ' Predictor for DC coefficient
            
            ' Insert SOS Marker Segment
            g_m_Data(g_m_Ptr) = 255                    ' SOS Marker
            g_m_Data(g_m_Ptr + 1) = %SOS
            g_m_Data(g_m_Ptr + 2) = 8 \ 256            ' Marker Segment Length
            g_m_Data(g_m_Ptr + 3) = 8 And 255
            g_m_Data(g_m_Ptr + 4) = 1                  ' Ns     - Number of components in Scan [1-4]
            g_m_Ptr = g_m_Ptr + 5
            g_m_Data(g_m_Ptr) = g_Comp(CompIndex).Ci     ' Csj    - Component ID
            g_m_Data(g_m_Ptr + 1) = Td * 16 Or Ta      ' Td, Ta - DC, AC entropy coder selector
            g_m_Ptr = g_m_Ptr + 2
            g_m_Data(g_m_Ptr) = 0                      ' Ss     - Start of spectral selection
            g_m_Data(g_m_Ptr + 1) = 63                 ' Se     - End of spectral selection
            g_m_Data(g_m_Ptr + 2) = 0                  ' Ah, Al - Successive approximation bit high/low
            g_m_Ptr = g_m_Ptr + 3
            
            ' Insert non-interleaved sequential entropy coded data
            p = 0
            'n = UBOUND(g_Comp(CompIndex).vData) + 1
            n = piaUBOUND(ByVal g_Comp(CompIndex).ptrData) + 1
            Pred = 0
            
            WriteBitsBegin
            
            Do While p <> n
               EncodeCoefficients ByVal g_Comp(CompIndex).ptrData, p, Pred, Td, Ta
            Loop
            
            WriteBitsEnd
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error20",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      Sub InsertSOSInterleaved(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
         ByVal FirstIndex As Long, ByVal SecondIndex As Long)
         Try
            ' Insert an SOS marker and scan data for an interleaved Sequential scan.
            Local f         As Long      ' Index counter (component)
            Local g         As Long      ' Index counter (sampling factor, vertical)
            Local h         As Long      ' Index counter (sampling factor, horizontal)
            Local i         As Long      ' Index counter (MCU horizontal)
            Local j         As Long      ' Index counter (MCU vertical)
            Local Lx        As Long      ' Marker Segment Length
            Local Ns        As Long      ' Number of components in Scan [1-4]
            Local MCUx      As Long      ' Number of MCUs per scanline
            Local MCUy      As Long      ' Number of MCU scanlines
            
            Local p()       As Long      ' Index to .data in component f for scanline g
            Local pLF()     As Long      ' Line Feed for p in .data for component f
            Local Pred()    As Long      ' Predictor for DC coefficient in component f
            Local MCUr()    As Long      ' Number of complete 8X8 blocks in rightmost MCU for component f
            Dim   Pad64(63) As Integer   ' 8X8 padding block for completing MCUs
            
            Ns = SecondIndex - FirstIndex + 1
            Lx = 6 + 2 * Ns
            
            ' Insert SOS Marker Segment
            g_m_Data(g_m_Ptr) = 255                          ' SOS Marker
            g_m_Data(g_m_Ptr + 1) = %SOS
            g_m_Data(g_m_Ptr + 2) = Lx \ 256                 ' Marker Segment Length
            g_m_Data(g_m_Ptr + 3) = Lx And 255
            g_m_Data(g_m_Ptr + 4) = Ns                       ' Ns     - Number of components in Scan [1-4]
            g_m_Ptr = g_m_Ptr + 5
            
            For i = FirstIndex To SecondIndex
               g_m_Data(g_m_Ptr) = g_Comp(CompIndex(i)).Ci    ' Csj
               g_m_Data(g_m_Ptr + 1) = Td(i) * 16 Or Ta(i)  ' Td, Ta
               g_m_Ptr = g_m_Ptr + 2
            Next i
            
            g_m_Data(g_m_Ptr) = 0                            ' Ss     - Start of spectral selection
            g_m_Data(g_m_Ptr + 1) = 63                       ' Se     - End of spectral selection
            g_m_Data(g_m_Ptr + 2) = 0                        ' Ah, Al - Successive approximation bit high/low
            g_m_Ptr = g_m_Ptr + 3
            
            ' Insert interleaved sequential entropy coded data
            ReDim p(FirstIndex To SecondIndex, g_VMax - 1)
            ReDim Pred(FirstIndex To SecondIndex)
            ReDim pLF(FirstIndex To SecondIndex)
            ReDim MCUr(FirstIndex To SecondIndex)
            
            MCUx = (g_XX + 8 * g_HMax - 1) \ (8 * g_HMax)
            MCUy = (g_YY + 8 * g_VMax - 1) \ (8 * g_VMax)
            
            For f = FirstIndex To SecondIndex
               h = (-Int(-g_XX * g_Comp(CompIndex(f)).vHi / g_HMax) + 7) \ 8  ' Width of scanline in .data (MCUs)
               
               For g = 0 To g_Comp(CompIndex(f)).Vi - 1                   ' Initialize .data pointers
                  p(f, g) = 64 * h * g
               Next g
               
               pLF(f) = 64 * h * (g_Comp(CompIndex(f)).Vi - 1)            ' Initialize .data pointer advancer
               
               MCUr(f) = (h Mod g_Comp(CompIndex(f)).vHi)                 ' Number of complete 8X8 Blocks in rightmost MCU
               If MCUr(f) = 0 Then MCUr(f) = g_Comp(CompIndex(f)).vHi
            Next f
            
            WriteBitsBegin
            
            For j = 1 To MCUy - 1
               ' Encode MCUs across a scanline
               For i = 1 To MCUx - 1
                  For f = FirstIndex To SecondIndex ' 0 To Ns - 1
                     For g = 1 To g_Comp(CompIndex(f)).Vi
                        For h = 1 To g_Comp(CompIndex(f)).vHi
                           EncodeCoefficients ByVal g_Comp(CompIndex(f)).ptrData, p(f, g - 1), Pred(f), Td(f), Ta(f)
                        Next h
                     Next g
                  Next f
               Next i
               
               ' Encode Rightmost MCU
               For f = FirstIndex To SecondIndex   ' 0 To Ns - 1
                  For g = 1 To g_Comp(CompIndex(f)).Vi
                     For h = 1 To g_Comp(CompIndex(f)).vHi
                        If h > MCUr(f) Then     ' Pad with dummy block
                           Pad64(0) = Pred(f)
                           EncodeCoefficients Pad64(), 0, Pred(f), Td(f), Ta(f)
                        Else
                           EncodeCoefficients ByVal g_Comp(CompIndex(f)).ptrData, p(f, g - 1), Pred(f), Td(f), Ta(f)
                        End If
                     Next h
                  Next g
               Next f
               
               ' Advance .data pointers
               For f = FirstIndex To SecondIndex
                  For g = 0 To g_Comp(CompIndex(f)).Vi - 1
                     p(f, g) = p(f, g) + pLF(f)
                  Next g
               Next f
            Next j
            
            ' Encode Bottommost MCU Scanline
            For i = 1 To MCUx
               For f = FirstIndex To SecondIndex
                  For g = 1 To g_Comp(CompIndex(f)).Vi
                     For h = 1 To g_Comp(CompIndex(f)).vHi
                        If p(f, g - 1) > piaUBOUND(ByVal g_Comp(CompIndex(f)).ptrData) Or (i = MCUx And h > MCUr(f)) Then
                           ' Pad with dummy block
                           Pad64(0) = Pred(f)
                           EncodeCoefficients Pad64(), 0, Pred(f), Td(f), Ta(f)
                        Else
                           EncodeCoefficients ByVal g_Comp(CompIndex(f)).ptrData, p(f, g - 1), Pred(f), Td(f), Ta(f)
                        End If
                     Next h
                  Next g
               Next f
            Next i
            
            WriteBitsEnd
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error21",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      
      Sub InsertSequentialScans(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
         ByVal FirstIndex As Long, ByVal SecondIndex As Long)
         Try
            ' Insert scan components CompIndex(FirstIndex) to CompIndex(SecondIndex) sequentially in compliance
            ' with JPEG rules. Components are interleaved whenever possible to emit as few scans as possible.
            Local f    As Long     ' First Index
            Local g    As Long     ' Second Index
            Local nb   As Long     ' Number of 8X8 blocks in MCU
            Local flag As Long     ' True when ready to insert scan(s)
            
            f = FirstIndex
            g = FirstIndex
            nb = 0
            flag = %FALSE
      
            Do While f <= SecondIndex
               nb = nb + g_Comp(CompIndex(g)).vHi * g_Comp(CompIndex(g)).Vi
               g = g + 1
               
               If nb > 10 Then		'%MAXNB     = 10        ' Max 8X8 blocks in MCU  (10 for JPEG compliance)
                  flag = %TRUE
                  If f <> g - 1 Then g = g - 1
               Else
                  If (g - f) = 3 Or g > SecondIndex Then flag = %TRUE
               End If
               
               If flag Then
                  If f = g - 1 Then
                     InsertSOSNonInterleaved CompIndex(f), Td(f), Ta(f)
                  Else
                     InsertSOSInterleaved CompIndex(), Td(), Ta(), f, g - 1
                  End If
                  
                  nb = 0
                  f = g
                  flag = %FALSE
               End If
            Loop
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error22",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Writing file
      '------------------------------------------------------------------------------------
      Function OptimizeHuffmanTables(ByRef CompIndex() As Long, ByRef Td() As Long, ByRef Ta() As Long, _
         ByVal FirstIndex As Long, ByVal SecondIndex As Long) As Long
         Try
            ' Optimize Huffman tables for the component indexes given.
            ' Returns an estimate of the number of bytes needed for entropy coded data.
            ' Estimate assumes a single scan, and entropy coded FF bytes are not followed by a zero stuff byte.
            Local f         As Long   ' First Index
            Local g         As Long   ' Second Index
            Local i         As Long
            Local j         As Long
            Local k         As Long
            Local CodeLen   As Long   ' Total bytes required for entropy coded data
            Local nb        As Long   ' Number of 8X8 blocks in MCU
            
            
            Dim   Freq(256) As Long   ' Frequency count for optimizing Huffman tables
            Local Freq2()   As Long   ' Copy of freq, used for calcultating entropy coded data size
            Local IsInter() As Long   ' True if component i will be interleaved
            Local TdUsed()  As Long   ' True if g_HuffDC(i) is used
            Local TaUsed()  As Long   ' True if g_HuffAC(i) is used
            Local flag      As Long   ' True when ready to include scan(s)
            
            ReDim IsInter(FirstIndex To SecondIndex)
            ReDim TaUsed(3)
            ReDim TdUsed(3)
            
            ' Determine which components will be interleaved by InsertSequentialScans(), which tables are used
            f = FirstIndex
            g = FirstIndex
            nb = 0
            flag = %FALSE
            
            Do While f <= SecondIndex
               nb = nb + g_Comp(CompIndex(g)).vHi * g_Comp(CompIndex(g)).Vi
               g = g + 1
               
               If nb > 10 Then	'%MAXNB          = 10      ' Max 8X8 blocks in MCU  (10 for JPEG compliance)
                  flag = %TRUE
                  If f <> g - 1 Then g = g - 1
               Else
                  If (g - f) = 3 Or g > SecondIndex Then flag = %TRUE
               End If
               
               If flag Then
                  If f = g - 1 Then
                     TdUsed(Td(f)) = %TRUE
                     TaUsed(Ta(f)) = %TRUE
                     IsInter(f) = %FALSE
                  Else
                     For i = f To g - 1
                        TdUsed(Td(i)) = %TRUE
                        TaUsed(Ta(i)) = %TRUE
                        IsInter(i) = %TRUE
                     Next i
                  End If
                  
                  nb = 0
                  f = g
                  flag = %FALSE
               End If
            Loop
            
            ' Optimize huffman tables for the scan sequence
            CodeLen = 0
            
            For i = 0 To 3
               If TdUsed(i) Then
                  For f = FirstIndex To SecondIndex
                     If Td(f) = i Then
                        If IsInter(f) Then
                           Call CollectStatisticsDCInterleaved(ByVal g_Comp(CompIndex(f)).ptrData, Freq(), _
                           g_Comp(CompIndex(f)).vHi, g_Comp(CompIndex(f)).Vi)
                        Else
                           Call CollectStatisticsDCNonInterleaved(ByVal g_Comp(CompIndex(f)).ptrData, Freq())
                        End If
                     End If
                  Next f
                  
                  ' Optimize and create this DC table
                  'Freq2() = Freq()
                  ReDim Freq2(UBound(Freq))
                  
                  For k = 0 To UBound(Freq)
                     Freq2(k) = Freq(k)
                  Next k
                  
                  Call BuildHuffman(g_HuffDC(i), Freq())
                  Call ExpandHuffman(g_HuffDC(i), IIf(g_PP = 12, 15, 11))
                  CodeLen = CodeLen + CodeLength(g_HuffDC(i), Freq2())
               End If
               
               If TaUsed(i) Then
                  For f = FirstIndex To SecondIndex
                     If Td(f) = i Then Call CollectStatisticsAC(ByVal g_Comp(CompIndex(f)).ptrData, Freq())
                  Next f
                  
                  ' Optimize and create this AC table
                  'Freq2() = Freq()
                  ReDim Freq2(UBound(Freq))
                  
                  For k = 0 To UBound(Freq)
                     Freq2(k) = Freq(k)
                  Next k
      
                  Call BuildHuffman(g_HuffAC(i), Freq())
                  Call ExpandHuffman(g_HuffAC(i), 255)
                  CodeLen = CodeLen + CodeLength(g_HuffAC(i), Freq2())
               End If
            Next i
            
            Function = CodeLen
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error23",,Error$(Err)
         End Try
      End Function
      
      '------------------------------------------------------------------------------------
      
      Function PBJPEG_SaveFile(FileName As String) As Long
         Try
            Dim CompIndex() As Long    ' Indexes of Components to be included
            Dim Td()        As Long    ' DC Huffman Table Selectors
            Dim Ta()        As Long    ' AC Huffman Table Selectors
            Dim FileNum     As Integer
            Dim i           As Long
            
            If Len(FileName) = 0 Then
               Function = 1           ' FileName not given
            Else
               If (Len(Dir$(FileName, %NORMAL Or %READONLY Or %HIDDEN Or %SYSTEM Or %ARCHIVE)) > 0) Then
                  Function = 2       ' File already exists
               Else
                  ReDim CompIndex(g_Nf - 1)
                  ReDim Td(g_Nf - 1)
                  ReDim Ta(g_Nf - 1)
                  
                  For i = 0 To g_Nf - 1
                     CompIndex(i) = i
                     Td(i) = IIf(i = 0, 0, 1)
                     Ta(i) = IIf(i = 0, 0, 1)
                  Next i
                  
                  i = OptimizeHuffmanTables(CompIndex(), Td(), Ta(), 0, g_Nf - 1)
                  
                  ' Estimate maximum possible file size needed
                  ReDim g_m_Data(i * 2 + 1000 + Len(g_m_Comment))
                  g_m_Ptr = 0
                  
                  InsertMarker %SOI                                  ' SOI - Start of Image
                  InsertJFIF                                         ' JFIF
                  
                  If Len(g_m_Comment) > 0 Then InsertCOM g_m_Comment     ' COM - Comment
                  InsertCOM "PowerBasic JPEG Encoder by Philipp E. Weidmann" & $CRLF _
                  & "" & $CRLF _
                  & "Ported & adapted from cJPEGI by Ron van Tilbug and cJPEG by John Korejwa"
                  
                  InsertDQT g_m_Ptr, 0                                 ' DQT - Define Quantization Tables
                  If g_Nf > 1 Then InsertDQT g_m_Ptr, 1
                  
                  InsertSOF %SOF0                                    ' SOF - Start of Frame
                  
                  InsertDHT g_m_Ptr, 0, %FALSE                         ' DHT - Define Huffman Tables
                  InsertDHT g_m_Ptr, 0, %TRUE
                  
                  If g_Nf > 1 Then
                     InsertDHT g_m_Ptr, 1, %FALSE
                     InsertDHT g_m_Ptr, 1, %TRUE
                  End If
                  
                  InsertSequentialScans CompIndex(), Td(), Ta(), 0, g_Nf - 1  ' SOS - Scan Data
                  InsertMarker %EOI                                         ' EOI - End of Image
                  
                  ' Size the final byte array and write to file
                  ReDim Preserve g_m_Data(g_m_Ptr - 1)
                  FileNum = FreeFile
                  
                  Open FileName For Binary Access Write As FileNum
                  Put #FileNum, , g_m_Data()
                  Close FileNum
                  
                  Erase g_m_Data
               End If
            End If
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error24",,Error$(Err)
         End Try
      End Function
      
      
      Sub PBJPEG_Reset()
         'free up memory
         Try
            ReDim g_QLumin(1)
            ReDim g_QChrom(1)
            ReDim g_TwoP(1)
            ReDim g_TwoR(1)
            ReDim g_TwoB(1)
            ReDim g_EIDCTScale(1)
            ReDim g_DIDCTScale(1)
            ReDim g_ZigZag(1)
            g_PP       = 0    ' Sample Precision [8, 12]
            g_YY       = 0    ' Number of lines             [Image Height] after clipping
            g_XX       = 0    ' Number of samples per line  [Image Width]  after clipping
            g_Nf       = 0    ' Number of components in Frame
      
            g_HMax     = 0    ' Maximum horizontal sampling frequency
            g_VMax     = 0    ' Maximum vertical sampling frequency
      
            ReDim g_m_Data(1)
            g_m_Chr    = 0    ' Current Character in g_m_Data
            g_m_Ptr    = 0    ' Byte index in g_m_Data
            g_m_Bit    = 0    ' Bit index in g_m_Chr
      
            ReDim g_m_Block(1)
      
            ReDim g_QTable(1)
            ReDim g_HuffDC(1)
            ReDim g_HuffAC(1)
            ReDim g_Comp(1)
      
            ReDim g_CompData0(1)
            ReDim g_CompData1(1)
            ReDim g_CompData2(1)
      
            g_m_Quality   = 0
            g_m_Comment   = ""
      
            '      Dim g_QLumin(63)       As Global Byte
            '      Dim g_QChrom(63)       As Global Byte
            '      Dim g_TwoP(31)         As Global Long
            '      Dim g_TwoR(31)         As Global Long
            '      Dim g_TwoB(255)        As Global Byte
            '      Dim g_EIDCTScale(7, 7) As Global Long
            '      Dim g_DIDCTScale(7, 7) As Global Long
            '      Dim g_ZigZag(7, 7)     As Global Long
            '      Dim g_m_Block(7, 7)    As Global Long
            '      Dim g_QTable(3)        As Global QUANTIZATIONTABLE
            '      Dim g_HuffDC(3)        As Global HUFFMANTABLE
            '      Dim g_HuffAC(3)        As Global HUFFMANTABLE
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error25a",,Error$(Err)
         End Try
      End Sub
      
      
      '------------------------------------------------------------------------------------
      ' Initialization
      '------------------------------------------------------------------------------------
      Function PBJPEG_Initialize() As Long
         Try
            Local i  As Long
            Local j  As Long
            Local dx As Long
            Local zz As Long
      
            ' Dimension global arrays
            Dim g_QLumin(63)       As Global Byte
            Dim g_QChrom(63)       As Global Byte
            Dim g_TwoP(31)         As Global Long
            Dim g_TwoR(31)         As Global Long
            Dim g_TwoB(255)        As Global Byte
            Dim g_EIDCTScale(7, 7) As Global Long
            Dim g_DIDCTScale(7, 7) As Global Long
            Dim g_ZigZag(7, 7)     As Global Long
            Dim g_m_Block(7, 7)    As Global Long
            Dim g_QTable(3)        As Global QUANTIZATIONTABLE
            Dim g_HuffDC(3)        As Global HUFFMANTABLE
            Dim g_HuffAC(3)        As Global HUFFMANTABLE
            
            i = 0            ' Initialize the g_ZigZag() array, which maps out the
            j = 0            ' zig-zag sequence of quantized DCT coefficients
            dx = 1           ' in approximately low to high spatial frequencies
            
            For zz = 0 To 63
               g_ZigZag(i, j) = zz
               i = i + dx
               j = j - dx
               
               If i > 7 Then          '  0   1   5   6  14  15  27  28
                  i = 7              '  2   4   7  13  16  26  29  42
                  j = j + 2          '  3   8  12  17  25  30  41  43
                  dx = -1            '  9  11  18  24  31  40  44  53
               ElseIf j > 7 Then      ' 10  19  23  32  39  45  52  54
                  j = 7              ' 20  22  33  38  46  51  55  60
                  i = i + 2          ' 21  34  37  47  50  56  59  61
                  dx = 1             ' 35  36  48  49  57  58  62  63
               ElseIf i < 0 Then
                  i = 0              ' Check (j>7) first
                  dx = 1
               ElseIf j < 0 Then
                  j = 0
                  dx = -1
               End If
            Next zz
            
            ' Luminance Quantization table for Quality = 50
            g_QLumin(0) = 16:   g_QLumin(1) = 11:   g_QLumin(2) = 12:   g_QLumin(3) = 14
            g_QLumin(4) = 12:   g_QLumin(5) = 10:   g_QLumin(6) = 16:   g_QLumin(7) = 14
            g_QLumin(8) = 13:   g_QLumin(9) = 14:   g_QLumin(10) = 18:  g_QLumin(11) = 17
            g_QLumin(12) = 16:  g_QLumin(13) = 19:  g_QLumin(14) = 24:  g_QLumin(15) = 40
            g_QLumin(16) = 26:  g_QLumin(17) = 24:  g_QLumin(18) = 22:  g_QLumin(19) = 22
            g_QLumin(20) = 24:  g_QLumin(21) = 49:  g_QLumin(22) = 35:  g_QLumin(23) = 37
            g_QLumin(24) = 29:  g_QLumin(25) = 40:  g_QLumin(26) = 58:  g_QLumin(27) = 51
            g_QLumin(28) = 61:  g_QLumin(29) = 60:  g_QLumin(30) = 57:  g_QLumin(31) = 51
            g_QLumin(32) = 56:  g_QLumin(33) = 55:  g_QLumin(34) = 64:  g_QLumin(35) = 72
            g_QLumin(36) = 92:  g_QLumin(37) = 78:  g_QLumin(38) = 64:  g_QLumin(39) = 68
            g_QLumin(40) = 87:  g_QLumin(41) = 69:  g_QLumin(42) = 55:  g_QLumin(43) = 56
            g_QLumin(44) = 80:  g_QLumin(45) = 109: g_QLumin(46) = 81:  g_QLumin(47) = 87
            g_QLumin(48) = 95:  g_QLumin(49) = 98:  g_QLumin(50) = 103: g_QLumin(51) = 104
            g_QLumin(52) = 103: g_QLumin(53) = 62:  g_QLumin(54) = 77:  g_QLumin(55) = 113
            g_QLumin(56) = 121: g_QLumin(57) = 112: g_QLumin(58) = 100: g_QLumin(59) = 120
            g_QLumin(60) = 92:  g_QLumin(61) = 101: g_QLumin(62) = 103: g_QLumin(63) = 99
            
            ' Chrominance Quantization table for Quality = 50
            g_QChrom(0) = 17:   g_QChrom(1) = 18:   g_QChrom(2) = 18:   g_QChrom(3) = 24
            g_QChrom(4) = 21:   g_QChrom(5) = 24:   g_QChrom(6) = 47:   g_QChrom(7) = 26
            g_QChrom(8) = 26:   g_QChrom(9) = 47:   g_QChrom(10) = 99:  g_QChrom(11) = 66
            g_QChrom(12) = 56:  g_QChrom(13) = 66:  g_QChrom(14) = 99:  g_QChrom(15) = 99
            g_QChrom(16) = 99:  g_QChrom(17) = 99:  g_QChrom(18) = 99:  g_QChrom(19) = 99
            g_QChrom(20) = 99:  g_QChrom(21) = 99:  g_QChrom(22) = 99:  g_QChrom(23) = 99
            g_QChrom(24) = 99:  g_QChrom(25) = 99:  g_QChrom(26) = 99:  g_QChrom(27) = 99
            g_QChrom(28) = 99:  g_QChrom(29) = 99:  g_QChrom(30) = 99:  g_QChrom(31) = 99
            g_QChrom(32) = 99:  g_QChrom(33) = 99:  g_QChrom(34) = 99:  g_QChrom(35) = 99
            g_QChrom(36) = 99:  g_QChrom(37) = 99:  g_QChrom(38) = 99:  g_QChrom(39) = 99
            g_QChrom(40) = 99:  g_QChrom(41) = 99:  g_QChrom(42) = 99:  g_QChrom(43) = 99
            g_QChrom(44) = 99:  g_QChrom(45) = 99:  g_QChrom(46) = 99:  g_QChrom(47) = 99
            g_QChrom(48) = 99:  g_QChrom(49) = 99:  g_QChrom(50) = 99:  g_QChrom(51) = 99
            g_QChrom(52) = 99:  g_QChrom(53) = 99:  g_QChrom(54) = 99:  g_QChrom(55) = 99
            g_QChrom(56) = 99:  g_QChrom(57) = 99:  g_QChrom(58) = 99:  g_QChrom(59) = 99
            g_QChrom(60) = 99:  g_QChrom(61) = 99:  g_QChrom(62) = 99:  g_QChrom(63) = 99
            
            ' Encoding Quantization Scalars  (values are 0.. 0.5 scaled by 131072)
            ' Call GenEIDCT
            g_EIDCTScale(0, 0) = 16384: g_EIDCTScale(0, 1) = 16384: g_EIDCTScale(0, 2) = 25080: g_EIDCTScale(0, 3) = 23170
            g_EIDCTScale(0, 4) = 32768: g_EIDCTScale(0, 5) = 23170: g_EIDCTScale(0, 6) = 21407: g_EIDCTScale(0, 7) = 32768
            g_EIDCTScale(1, 0) = 16384: g_EIDCTScale(1, 1) = 16384: g_EIDCTScale(1, 2) = 25080: g_EIDCTScale(1, 3) = 23170
            g_EIDCTScale(1, 4) = 32768: g_EIDCTScale(1, 5) = 23170: g_EIDCTScale(1, 6) = 21407: g_EIDCTScale(1, 7) = 32768
            g_EIDCTScale(2, 0) = 25080: g_EIDCTScale(2, 1) = 25080: g_EIDCTScale(2, 2) = 38390: g_EIDCTScale(2, 3) = 35468
            g_EIDCTScale(2, 4) = 50159: g_EIDCTScale(2, 5) = 35468: g_EIDCTScale(2, 6) = 32768: g_EIDCTScale(2, 7) = 50159
            g_EIDCTScale(3, 0) = 23170: g_EIDCTScale(3, 1) = 23170: g_EIDCTScale(3, 2) = 35468: g_EIDCTScale(3, 3) = 32768
            g_EIDCTScale(3, 4) = 46341: g_EIDCTScale(3, 5) = 32768: g_EIDCTScale(3, 6) = 30274: g_EIDCTScale(3, 7) = 46341
            g_EIDCTScale(4, 0) = 32768: g_EIDCTScale(4, 1) = 32768: g_EIDCTScale(4, 2) = 50159: g_EIDCTScale(4, 3) = 46341
            g_EIDCTScale(4, 4) = 65536: g_EIDCTScale(4, 5) = 46341: g_EIDCTScale(4, 6) = 42813: g_EIDCTScale(4, 7) = 65536
            g_EIDCTScale(5, 0) = 23170: g_EIDCTScale(5, 1) = 23170: g_EIDCTScale(5, 2) = 35468: g_EIDCTScale(5, 3) = 32768
            g_EIDCTScale(5, 4) = 46341: g_EIDCTScale(5, 5) = 32768: g_EIDCTScale(5, 6) = 30274: g_EIDCTScale(5, 7) = 46341
            g_EIDCTScale(6, 0) = 21407: g_EIDCTScale(6, 1) = 21407: g_EIDCTScale(6, 2) = 32768: g_EIDCTScale(6, 3) = 30274
            g_EIDCTScale(6, 4) = 42813: g_EIDCTScale(6, 5) = 30274: g_EIDCTScale(6, 6) = 27969: g_EIDCTScale(6, 7) = 42813
            g_EIDCTScale(7, 0) = 32768: g_EIDCTScale(7, 1) = 32768: g_EIDCTScale(7, 2) = 50159: g_EIDCTScale(7, 3) = 46341
            g_EIDCTScale(7, 4) = 65536: g_EIDCTScale(7, 5) = 46341: g_EIDCTScale(7, 6) = 42813: g_EIDCTScale(7, 7) = 65536
            
            ' Powers of 2
            Call Init_BitMasks
            
            ' The number of bits in value
            g_TwoB(0) = 0: g_TwoB(1) = 1: g_TwoB(2) = 2: g_TwoB(3) = 2
            
            For i = 4 To 7
               g_TwoB(i) = 3
            Next i
            For i = 8 To 15
               g_TwoB(i) = 4
            Next i
            For i = 16 To 31
               g_TwoB(i) = 5
            Next i
            For i = 32 To 63
               g_TwoB(i) = 6
            Next i
            For i = 64 To 127
               g_TwoB(i) = 7
            Next i
            For i = 128 To 255
               g_TwoB(i) = 8
            Next i
            
            PBJPEG_SetSamplingFrequencies 2, 2, 1, 1, 1, 1
            PBJPEG_SetQuality 75
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error25",,Error$(Err)
         End Try
      End Function
      
      '------------------------------------------------------------------------------------
      
      Sub Init_BitMasks()
         Try
            Local i      As Long
            Dim   sb(31) As Long
            
            '    Requires PB 8
            '    ARRAY ASSIGN sb() = &H1&, &H2&, &H4&, &H8&, _
            '                        &H10&, &H20&, &H40&, &H80&, _
            '                        &H100&, &H200&, &H400&, &H800&, _
            '                        &H1000&, &H2000&, &H4000, &H8000&, _
            '                        &H10000, &H20000, &H40000, &H80000, _
            '                        &H100000, &H200000, &H400000, &H800000, _
            '                        &H1000000, &H2000000, &H4000000, &H8000000, _
            '                        &H10000000, &H20000000, &H40000000, &H80000000
            sb(0)  = &H1&
            sb(1)  = &H2&
            sb(2)  = &H4&
            sb(3)  = &H8&
            sb(4)  = &H10&
            sb(5)  = &H20&
            sb(6)  = &H40&
            sb(7)  = &H80&
            sb(8)  = &H100&
            sb(9)  = &H200&
            sb(10)  = &H400&
            sb(11)  = &H800&
            sb(12)  = &H1000&
            sb(13)  = &H2000&
            sb(14)  = &H4000
            sb(15)  = &H8000&
            sb(16)  = &H10000
            sb(17)  = &H20000
            sb(18)  = &H40000
            sb(19)  = &H80000
            sb(20)  = &H100000
            sb(21)  = &H200000
            sb(22)  = &H400000
            sb(23)  = &H800000
            sb(24)  = &H1000000
            sb(25)  = &H2000000
            sb(26)  = &H4000000
            sb(27)  = &H8000000
            sb(28)  = &H10000000
            sb(29)  = &H20000000
            sb(30)  = &H40000000
            sb(31)  = &H80000000
            
            For i = 0 To 30
               g_TwoP(i) = sb(i)
               g_TwoR(i + 1) = sb(i)
            Next i
            
            g_TwoP(31) = sb(31)
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error27",,Error$(Err)
         End Try
      End Sub
      
      '------------------------------------------------------------------------------------
      
      ' Uncomment this to generate the table above
      Sub GenEIDCT()
         '    DIM   t(7) AS DOUBLE
         '    LOCAL i    AS LONG, j AS LONG
         '
         '    %PI = 3.14159265358979
         '
         '    t(0) = SIN(%PI / 4) / 2
         '    t(1) = 1 / SQR(8)
         '    t(2) = 1 / (2 * SIN(3 * %PI / 8))
         '    t(3) = 0.5
         '    t(4) = SIN(%PI / 4)
         '    t(5) = 0.5
         '    t(6) = SIN(3 * %PI / 8) / 2
         '    t(7) = 1 / SQR(2)
         '
         '    OPEN "EIDCT.txt" FOR OUTPUT AS #1
         '
         '    FOR i = 0 TO 7
         '        FOR j = 0 TO 7
         '            g_EIDCTScale(i, j) = 131072 * t(i) * t(j)
         '            PRINT #1, "g_EIDCTScale(" & i & "," & j & ")=" & g_EIDCTScale(i, j)
         '        NEXT j
         '    NEXT i
         '
         '    CLOSE #1
      End Sub
      
      '------------------------------------------------------------------------------------
      
      ' The routine below is functionally equivalent to that below but entirely in integers only
      ' nBits  = Int((Log(Abs(v)) * 1.442695040889))+1   '1/log(2) v<>0, 0 if v=0
      Function nBits(ByVal v As Long) As Long    ' Effectively binary search for Log2 -32768<v<32767
         Try
            
            If v < 0 Then v = -v
            
            If v < %TWOE08 Then                          ' Use linear table lookup for values <256
               nBits = g_TwoB(v)
            Else                                         ' Use binary search
               '            IF v < %TWOE08 THEN                 ' 0..255 bits 7..0
               '                IF v < %TWOE04 THEN             ' 0.. 15 bits 3..0
               '                    IF v < %TWOE02 THEN         ' 0..  1 bits 1..0
               '                        IF v < %TWOE01 THEN
               '                            nBits = 1
               '                        ELSE
               '                            nBits = 2
               '                        END IF
               '                    ELSEIF v < %TWOE03 THEN     ' 4..  7 bits 3..2
               '                        nBits = 3
               '                    ELSE
               '                        nBits = 4
               '                    END IF
               '                ELSE                            ' 16..255  bits 7..4
               '
               '                IF v < %TWOE06 THEN             ' 16.. 63  bits 5..4
               '                    IF v < %TWOE05 THEN
               '                        nBits = 5
               '                    ELSE
               '                        nBits = 6
               '                    END IF
               '                ELSEIF v < %TWOE07 THEN         ' 64..127 bits 7..6
               '                    nBits = 7
               '                ELSE
               '                    nBits = 8
               '                END IF
               '            END IF
               '        ELSE                                    ' 256..32768 bits 15..8
               If v < %TWOE12 Then                      ' Bits 11..8
                  If v < %TWOE10 Then                  ' Bits  9..8
                     If v < %TWOE09 Then
                        nBits = 9
                     Else
                        nBits = 10
                     End If
                  ElseIf v < %TWOE11 Then
                     nBits = 11
                  Else                                 ' Bits 11..10
                     nBits = 12
                  End If
               Else                                     ' Bits 15..12
                  If v < %TWOE14 Then                  ' Bits 13..12
                     If v < %TWOE13 Then
                        nBits = 13
                     Else
                        nBits = 14
                     End If
                  ElseIf v < %TWOE15 Then              ' Bits 15..14
                     nBits = 15
                  Else
                     nBits = 16
                  End If
               End If
            End If
            '    END IF
         Catch
            If %NOMSG = 0 Then MsgBox "JPG Error28",,Error$(Err)
         End Try
      End Function
      and here is an example of how to use it. It is a simple program that saves a picture from the clipboard. (press PrintScreen key just before running it so it will have a bitmap to save)

      Code:
      '===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!
      #Compile Exe
      #Include "WIN32API.INC"
      
      #Include "jpg.inc"
      
      
      '===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!
      Function SaveClipboardPic(ByVal hWnd As Long,sFilename As String, iQuality As Long) As Long
         Local iRet              As Long
         Local hBitmap           As Dword
         Local dcBitmap          As Dword
         Local hDesktop          As Dword
         Local bm                As Bitmap
      
         hWnd = GetDesktopWindow()
         hDesktop = GetDC(hWnd)
         Call OpenClipboard(hWnd)
         hBitmap = GetClipboardData(%CF_BITMAP)
         If (hBitmap= 0) Then
            MsgBox "No image found in clipboard.  Press Prt Screen first.",,"SaveClipboardPic Error"
         Else
            If GetObject(hBitmap,Len(bm),bm) Then
               dcBitmap = CreateCompatibleDC(hDesktop)
               If dcBitMap = 0 Then
                  MsgBox "Failed to get DC",,"SaveClipboardPic Error"
               Else
                  iRet = SelectObject(dcBitmap, hBitmap)
                  If iRet = 0 Or iRet = %GDI_ERROR Then MsgBox "SelectObject Error ",,"SaveClipboardPic Error" + Str$(iRet)
                  Try	'see if we need to remove existing file
                     Kill sFilename
                  Catch
                  End Try
                  'JPEG routines
                  PBJPEG_SetSamplingFrequencies 2, 2, 1, 1, 1, 1
                  PBJPEG_SetQuality iQuality
                  ' Save to JFIF (JPEG File Interchange Format) file
                  PBJPEG_SampleHDC dcBitmap, bm.bmwidth, bm.bmheight, 0, 0
                  PBJPEG_SaveFile sFilename
                  'PBJPEG_Reset()
                  DeleteDC dcBitmap
      				Function = %TRUE
               End If
            Else
               MsgBox "Error Getting BM Structure",,"SaveClipboardPic Error"
            End If
      
            'Call EmptyClipboard()
         End If
         Call CloseClipboard()
         If hDesktop Then ReleaseDC hWnd, hDesktop
      
      End Function
      '===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!===!
      
      Function PBMain()
          PBJPEG_Initialize  'must run first to setup JPG routines
          if SaveClipboardPic(GetDesktopWindow(), "SavedPic.jpg", 90) then		'note 90 is the quality of compression (smaller file or better quality)
      		msgbox "Clipboard saved to SavedPic.jpg",,"Worked"
      	end if
      End Function
      Hope that helps.
      Last edited by William Burns; 4 Jan 2009, 12:34 AM. Reason: Updated globals to use g_ names
      "I haven't lost my mind... its backed up on tape... I think??" :D

      Comment


      • #4
        Perfect! Thats exactly what i was needing!

        Thank you very much William.

        Comment


        • #5
          No thread on this subject is complete without a reference to José Roca's GDIPlus resources here and forums here or hereabouts

          Comment


          • #6
            Posting errors

            NEXT g 'line 1663 SUB InsertSOSInterleaved removed "ced" was "ced NEXT g"

            EmSSL scalefactor = 200 - g_m_Quality * 2 'line 493 FUNCTION PBJPEG_SetQuality
            scalefactor = 200 - g_m_Quality * 2 'removed EmSSL ?

            &l¶sÛ>> &lef="> line 1075 added remark sign iŽd¯÷ont of line below
            minance OF the pixels. This IS "how bright" a PIXEL is. The Cb AND Cr

            REM g_m_Data(g_m_4203 = Asc(Mid$(TheComment, i, 1)) 'line 1411
            g_m_Data(g_m_4203) = ASC(MID$(TheComment, i, 1)) 'changed to this??

            Tried using Vista and noticed file may be too big to read.

            I am having lots of problems reading postings.
            This may be some problem with cache?
            Last edited by Mike Doty; 15 Jul 2009, 08:16 AM.

            Comment


            • #7
              (word of caution, the include file uses several globals that would probably be better changed to statics. I did rename them to use g_ names so they would stand out more and cause fewer conflicts.)
              OR....

              EXPORT the actual "user" functions (those which start with "PBJPEG?") and #COMPILE DLL. Then global symbols cease to be a concern.

              OR...
              Maybe someone wants to package this code with a COM interface, using METHODs as 'wrappers' to the user functions.



              MCM
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                or please .ZIP it up.

                Comment


                • #9
                  William, you don't happen to have a pb jpg decoder too by chance?

                  Comment


                  • #10
                    Originally posted by John Gleason View Post
                    William, you don't happen to have a pb jpg decoder too by chance?
                    No unfortunately I do not have a decoder. In fact, as I mentioned above, I am not even the writer of this encoding functions, I just cleaned them up some and fixed a few small issues I found. If you are looking for ways to convert from JPG to a bitmap, I am pretty sure there is code on the forums that would let you do that.

                    Mike, I have no idea why we are seeing some of the posting issues. But here is the zipped file if it helps.

                    It has both the include file and the sample program to save from the clipboard.
                    Attached Files
                    "I haven't lost my mind... its backed up on tape... I think??" :D

                    Comment

                    Working...
                    X