Announcement

Collapse
No announcement yet.

Saving to JPG without 3rd party dlls?

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

  • William Burns
    replied
    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

    Leave a comment:


  • John Gleason
    replied
    William, you don't happen to have a pb jpg decoder too by chance?

    Leave a comment:


  • Mike Doty
    replied
    or please .ZIP it up.

    Leave a comment:


  • Michael Mattias
    replied
    (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

    Leave a comment:


  • Mike Doty
    replied
    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, 07:16 AM.

    Leave a comment:


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

    Leave a comment:


  • Elias Montoya
    replied
    Perfect! Thats exactly what i was needing!

    Thank you very much William.

    Leave a comment:


  • William Burns
    replied
    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; 3 Jan 2009, 11:34 PM. Reason: Updated globals to use g_ names

    Leave a comment:


  • Elias Montoya
    replied
    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.

    Leave a comment:


  • Elias Montoya
    started a topic Saving to JPG without 3rd party dlls?

    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.
Working...
X