unit jpegdecoder;
//
// Copyright (c) 1999, 2001 Colosseum Builders, Inc.
// All rights reserved.
//
// Colosseum Builders, Inc. makes no warranty, expressed or implied
// with regards to this software. It is provided as is.
//
// See the README.TXT file that came with this software for restrictions
// on the use and redistribution of this file or send E-mail to
// info@colosseumbuilders.com
//

//
// Descripton:
//
//   TJpegDecoder class. This class decodes JPEG (JFIF) files using
//   Baseline, Sequential and Progressive formats.
//
interface

Uses sysutils, bitmapimage, jpeginputstream, jpegdecodercomponent,
     jpgpvt, jpegdecoderdataunit, jpeghuffmandecoder ;

Type
  EJpegBadStream = Class (Exception) ;
  EJpegError = Class (Exception) ;

  TJpegDecoder = Class (TBitmapImageDecoder)
    private
      // Frame (image) dimensions
      frame_height, frame_width : Cardinal ;
      // The image dimensions in MCUs
      mcu_rows, mcu_cols : Cardinal ;
      // Set to true when processing a progressive frame.
      is_progressive : Boolean ;

      // Flags set determine if markers have been found.
      eoi_found, sof_found : Boolean ;

      // Flag to enable debug outpt.
      verbose_flag : Boolean ;
      // The current restart interval.
      restart_interval : Cardinal ;

      // Maximum sampling frequencies among all components.
      max_horizontal_frequency, max_vertical_frequency : Cardinal ;

      progressive_frame : Boolean ;
      use_filters : Boolean ;

      component_count : Cardinal ;
      components : Array [1..JPEGMAXCOMPONENTSPERFRAME] of TJpegDecoderComponent ;
      component_indices : Array [1..JPEGMAXCOMPONENTSPERFRAME] of Cardinal ;

      // Quantization tables defined.
      quantization_tables : Array [JPEGQUANTIZATIONTABLEID] of TJpegDecoderQuantizationTable ;

      // Hufman tables defined.
      ac_tables : Array [JPEGHUFFMANTABLEID] of TJpegHuffmanDecoder ;
      dc_tables : Array [JPEGHUFFMANTABLEID] of TJpegHuffmanDecoder ;


      // Address of the image that is currently being processed.
      current_image : TBitmapImage ;

      // Progress Counters
      current_scan, scan_count : Cardinal ;

      // MCU dimensions in pixels.
      mcu_height, mcu_width : Cardinal ;

      // Number components in the current scan and the components in the scan.
      scan_component_count : Cardinal ;
      scan_components : Array [1..JPEGMAXCOMPONENTSPERFRAME] of ^TJpegDecoderComponent ;

      // The next expected restart marker. Used to ensure restarts are in order.
      expected_restart : Cardinal ;

      // Flag to determine if strict JFIF is to be enforced.
      strict_jfif : Boolean ;

      // This flag is available to setXYZ functions to prevent the changing
      // of parameters during decompression that could screw things up.
      processing_image : Boolean ;

      Procedure callProgressFunction (progress : Cardinal) ;
      Procedure resetDcDifferences ;
      Procedure processRestartMarker (inputstream : TJpegInputStream) ;
      Function scanIsInterleaved : Boolean ;
      Procedure freeAllocatedResources ;

    public

      Constructor Create ;
      Destructor Destroy ; Override ;
      property frameHeight : Cardinal read frame_height ;
      property frameWidth : Cardinal read frame_height ;
      property mcuRows : Cardinal read mcu_rows ;
      property mcuCols : Cardinal read mcu_cols ;
      property isProgressive : Boolean read is_progressive ;

      Procedure readImageFile (filename : String ; image : TBitmapImage) ; Override ;
      Procedure readImage (inputstream : TJpegInputStream ; image : TBitmapImage) ; Virtual ;

      Property Verbose : Boolean read verbose_flag write verbose_flag ;
      Property UseFilters : Boolean read use_filters write use_filters ;

      Procedure updateImage ; Override ;
    End ;

implementation

uses
  Jfif, jpeginputfile, inputbytestream, systemspecific ;

Const
  CHAR_BIT = 8 ;
  BUFFERSIZE = 2048 ;


//
//  Description:
//
//    Class Default Constructor
//
Constructor TJpegDecoder.Create ;
  Begin
  verbose_flag := false ;
  strict_jfif := false ;
  processing_image := false ;
  use_filters := false ;
  End ;



Destructor TJpegDecoder.Destroy ;
  Begin
  freeAllocatedResources ;
  Inherited Destroy ;
  End ;






//
//  Dimensions:
//
//    This function calls the progress function if it has
//    been supplied by the user.
//
//  Parameters:
//    progress: The progress percentage.
//
Procedure TJpegDecoder.callProgressFunction (progress : Cardinal) ;
  Var
    abort : Boolean ;
    percent : Cardinal ;
  Begin
  if (Not Assigned (progress_function)) Then
    Exit ;

  abort := false ;
  if (progress > 100) Then
    percent := 100
  else
    percent := progress ;

  progress_function (Self,
                     progress_data,
                     current_scan,
                     scan_count,
                     percent,
                     abort) ;

  if (abort) Then
    Raise EGraphicsAbort.Create ('');
  End ;

      
        
        
        
        



//
//  Description:
//
//    This function resets the DC difference values for all components
//    for the current scan.
//
//    This function gets called before each scan is processed and
//    whenever a restart marker is read.
//

Procedure TJpegDecoder.resetDcDifferences ;
  Var
    ii : Integer ;
  Begin
  for ii := 1 To scan_component_count Do
    scan_components [ii].resetDcDifference ;
  End ;

//
//  Description:
//
//    This function reads a restart marker from the input stream.
//    It gets called byte functions that read scan data whenever
//    a restart marker is expected. An exception is raise if the
//    correct restart marker is not next in the input stream.
//
Procedure TJpegDecoder.processRestartMarker (inputstream : TJpegInputStream) ;
  var
    data : byte ;
  Begin
  inputstream.exitBitMode ;
  data := inputstream.getByte ;
  if (data <> $FF) Then
    raise EJpegBadStream.Create ('Missing Restart Marker') ;
  // According to E.1.2 0xFF can be used as a fill character
  // before the marker.
  while (data = $FF) Do
    data := inputstream.getByte () ;
  if (data < RST0) Or (data > RST7) Then
    raise EJpegBadStream.Create ('Missing Restart Marker') ;

  // Restart markers RST0..RST7 should come in sequence.
  if (($0F And data) <> expected_restart) Then
    raise EJpegBadStream.Create ('Incorrect Restart Marker') ;

  // Move the counter to the next restart marker
  Inc (expected_restart) ;
  expected_restart := expected_restart Mod 8 ;

  // Reset the DC coefficent differences to zero.
  resetDcDifferences () ;
  inputstream.enterBitMode (CHAR_BIT) ;
  End ;


Function TJpegDecoder.scanIsInterleaved : Boolean ;
  Begin
  If scan_component_count = 1 Then
    Result := false
  Else
    Result := true ;
  End ;

//
//  Description:
//
//    This function reads an image from a JPEG stream. The
//    stream needs to have been opened in binary mode.
//
//  Parameters:
//    istrm: Input stream
//    image: The output image
//
Procedure TJpegDecoder.readImage (inputstream : TJpegInputStream ; image : TBitmapImage) ;
  Const
    CR = 13 ;
    LF = 10 ;
  Var
    data : byte ;
  //
  //  Description:
  //
  //    This function reads the Start of Image Marker and the JFIF APP0
  //    marker that begin a JPEG file.
  //
  //    The JFIF standard states "The JPEG FIF APP0 marker is mandatory
  //     right after the SOI marker."
  //
  //    I have come across some JPEG files that have a COM marker between
  //    the SOI marker and APP0. This code will reject these non-conforming
  //    files.
  //

  Procedure readStreamHeader (inputstream : TJpegInputStream) ;
    Var
      header : JfifHeader ;
      ii : Cardinal ;
      count : Integer ;
    begin
    if (inputstream.getByte <> SOB) Then
      raise EJpegBadStream.Create ('Missing SOI Marker') ;
    if (inputstream.getByte () <> SOI) Then
      raise EJpegBadStream.Create ('Missing SOI Marker') ;
    if (inputstream.getByte () <> SOB) Then
      raise EJpegBadStream.Create ('Missing JFIF APP0 Marker') ;
    if (inputstream.getByte () <> APP0) Then
      raise EJpegBadStream.Create ('Missing JFIF APP0 Marker') ;

    count := inputstream.read (header, sizeof (header)) ;
    if count <> Sizeof (Header) Then
      raise EJpegBadStream.Create ('Premature end of file in JFIF header') ;

    if (header.identifier [1] <> 'J')
        Or (header.identifier [2] <> 'F')
        Or (header.identifier [3] <> 'I')
        Or (header.identifier [4] <> 'F') Then
      raise EJpegBadStream.Create ('Not a JFIF file') ;

    if (verbose_flag) Then
      Begin
      WriteLn ('{ Start Of Image }') ;
      WriteLn ('{ JFIF APP0 Marker') ;
      WriteLn ('  Length: ', BigEndianWordToSystem (header.length)) ;
      WriteLn ('  Version: ', header.version [1], '.', header.version [2]) ;
      // density unit = 0 => Only the aspect ratio is specified.
      // density unit = 1 => Density in pixels per inch.
      // density unit = 2 => Density in pixels per centimeter.
      Case header.units of
        0: WriteLn ('  Density Unit:  (aspect ratio)') ;
        1: WriteLn ('  Density Unit:  (pixels per inch)') ;
        2: WriteLn ('  Density Unit:  (pixels/cm)') ;
        else
          WriteLn ('   Density Unit: Unknown (', header.units, ')') ;
        End ;
      WriteLn ('  X Density: ', BigEndianWordToSystem (header.xdensity)); ;
      WriteLn ('  Y Density: ', BigEndianWordToSystem (header.xdensity)) ;
      WriteLn ('  Thumbnail Width: ', header.xthumbnail) ;
      WriteLn ('  Thumbnail Height: ', header.xthumbnail) ;
      WriteLn ('}') ;
      End ;

    // Skip over any thumbnail data.
    for ii := sizeof (header) + 1 To BigEndianWordToSystem (header.length) Do
      inputstream.getByte ;
    End ;

  //
  //  Description:
  //
  //    This function reads the next marker in the input
  //    stream. If the marker is followed by a data block
  //    this function dispatches a routine to read the
  //    data.
  //
  Procedure readMarker (inputstream : TJpegInputStream) ;
    var
      marker : byte ;
    //
    //  Description:
    //
    //    This method reads an application or comment marker
    //    from the input stream.
    //
    //  Parameters:
    //    type:  The marker type
    //
    Procedure readApplication (marker : Byte ; inputstream : TJpegInputStream) ;
      Const
        hex: Array [0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7',
                                      '8', '9', 'A', 'B', 'C', 'D', 'E', 'F') ;

      var
        length : cardinal ;
        id : String ;
      Begin
      length := inputstream.getBigEndianWord () ;
      SetLength (id, length) ;
      inputstream.read (id [1], length- Sizeof (WORD)) ;

      if (verbose_flag) then
        begin
        if (marker = COM) then
          Begin
          WriteLn ('{ Comment Marker ') ;
          WriteLn ('  ', id) ;
          WriteLn ('}') ;
          End
        else
          Begin
          WriteLn ('{ APP', hex [marker And $0F], ' Marker') ;
          WriteLn ('Length: ', length) ;
          WriteLn ('ID: ', id) ;
          WriteLn ('}') ;
          End ;
        End ;
      End ;

    //
    //  Description:
    //
    //    The function reads a Define Huffman Table marker from the input
    //    stream.
    //
    Procedure readHuffmanTable (inputstream : TJpegInputStream) ;
      var
        length : Cardinal ;
        remaining : Cardinal ;
        data : Byte;
        tableclass, id : Cardinal ;
        table : TJpegHuffmanDecoder ;
      Begin
      // Section B.2.4.2

      if (verbose_flag) Then
        WriteLn ('{ Define Huffman Table') ;

      length := inputstream.getBigEndianWord ;
      if (verbose_flag) Then
        WriteLn ('  Length: ', length) ;
      remaining := length - sizeof (WORD) ;
      while (remaining > 0) Do
        Begin
        data := inputstream.getByte ;
        Dec (remaining) ;

        // Tc in standard 0=>DC, 1=>AC
        tableclass := data Shr 4 ;
        id := data And $F ; // Th in standard
        if (id > 3) Then
          raise EJpegBadStream.Create ('Huffman Table Index outside range [0..3]') ;
        if (verbose_flag) Then
          Begin
          WriteLn ('   Table Index ', id) ; ;
          if (tableclass = 0) Then
            WriteLn ('   Table Class: DC')
          else
            WriteLn ('   Table Class: AC') ;
          End ;

        if (tableclass <> 0) Then
          Begin
          if Not Assigned (ac_tables [id]) Then
            ac_tables [id] := TJpegHuffmanDecoder.Create ;
          table := ac_tables [id] ;
          End
        else
          Begin
          if Not Assigned (dc_tables [id]) Then
            dc_tables [id] := TJpegHuffmanDecoder.Create ;
          table := dc_tables [id] ;
          End ;

        // Read the table data into the table object
        Dec (remaining, table.readTable (inputstream)) ;

       if (verbose_flag) Then
          table.print ;
        End ;
      if (verbose_flag) Then
        Writeln ('}') ;
      End ;

    //
    //  Description:
    //
    //    This function reads a DQT marker from the input stream.
    //
    Procedure readQuantization (inputstream : TJpegInputStream) ;
      Var
        length : Word ;
        data : Byte ;
        remaining : Integer ;
        precision : cardinal ;
        index : Cardinal ;
      Begin
      // Defined in Section B.2.4.1

      length := inputstream.getBigEndianWord ;

      // Maintain a counter for the number of bytes remaining to be read in
      // the quantization table.
      remaining := length - sizeof (length) ;

      if (verbose_flag) Then
        Begin
        WriteLn ('{ Define Quantization Table') ;
        WriteLn ('  Length: ', length) ;
        End ;
      while (remaining > 0) Do
        Begin
        data := inputstream.getByte ;
        Dec (remaining) ;
        precision := data Shr 4 ;    // Pq in standard
        index := data And $F ;      // Tq in standard

        if (index >= JPEGMAXQUANTIZATIONTABLES) Then
          raise EJpegBadStream.Create ('Quantization Table Index Too Large') ;

        if (verbose_flag) Then
          Begin
          WriteLn ('  Table Index: ', index) ;
          WriteLn ('  Table Precision: ', precision) ;
          End ;

        Case precision Of
          1:
            Dec (remaining, sizeof(Word) * JPEGSAMPLESIZE) ;
          0:
            Dec (remaining, sizeof (Byte) * JPEGSAMPLESIZE) ;
          Else
            Raise EJpegBadStream.Create ('Invalid TableSize') ;
          End ;

        // Read the table data into the table object
        if Not Assigned (quantization_tables [index]) Then
          quantization_tables [index] := TJpegDecoderQuantizationTable.Create ;
        quantization_tables [index].readTable (inputstream, precision) ;

        if (verbose_flag) Then
          Begin
          WriteLn ('  Table Values: ') ;
          quantization_tables [index].print ;
          WriteLn ('}') ;
          End ;
        End ;
      End ;

    //
    //  Description:
    //
    //    This function reads a define restart interval marker
    //    from the input stream.
    //
    Procedure readRestartInterval (inputstream : TJpegInputStream) ;
      Var
        length : Cardinal ;
      Begin
      // Section B.2.4.4

      length := inputstream.getBigEndianWord ;
      if (length <> 4) Then
        raise EJpegBadStream.Create ('Invalid length for restart marker') ;

      restart_interval := inputstream.getBigEndianWord ;
      if (verbose_flag) Then
        Begin
        WriteLn ('{ Define Restart Interval') ;
        WriteLn ('  Length:  ', length) ; // Should be 4
        WriteLn ('  Interval: ', restart_interval) ;
        WriteLn ('}') ;
        End ;
      End ;

    //
    //  Description:
    //
    //    The function reads a start of frame marker from the input stream.
    //
    //  Parameters:
    //    type:  The marker type for the frame
    //
    Procedure readStartOfFrame (inputstream : TJpegInputStream ; marker : Cardinal) ;
      Var
        length : Cardinal ;
        dataprecision : Cardinal ;
        ii : cardinal ;
        id, qtable : Cardinal ;
        data : Byte ;
      //
      //  Description:
      //
      //    This function determines for non-interlaced scans:
      //
      //     o The dimensions in pixels for an MCU
      //     o The number of MCU rows and columns needed to encode the scan.
      //
      Procedure calculateMcuDimensions ;
        Begin
        mcu_height := max_vertical_frequency * JPEGSAMPLEWIDTH ;
        mcu_width := max_horizontal_frequency * JPEGSAMPLEWIDTH ;
        mcu_rows := (frame_height + mcu_height - 1) Div mcu_height ;
        mcu_cols := (frame_width + mcu_width - 1) Div mcu_width ;
        End ;

      Begin
      if (marker = SOF2) Then
        progressive_frame := true
      else
        progressive_frame := false ;

      // Section B.2.2
      // Read in the image dimensions
      length := inputstream.getBigEndianWord ;
      dataprecision := inputstream.getByte ;  // P in standard
      if (dataprecision <> 8) Then
        raise EJpegBadStream.Create ('Only 8-bit data supported') ;

      frame_height := inputstream.getBigEndianWord ;            // Y in standard
      frame_width := inputstream.getBigEndianWord ;             // X in standard
      component_count := inputstream.getByte ;   // Nf in standard

      // JFIF only allows 1 or 3 components.
      if (component_count <> 1) And (component_count <> 3) Then
        raise EJpegBadStream.Create ('JFIF only supports 1 and 3 component streams') ;

      if (verbose_flag) Then
        Begin
        WriteLn ('{ Start Of Frame ') ;
        Case marker of
          SOF0:  WriteLn ('  Baseline') ;
          SOF1:  WriteLn ('  Sequential') ;
          SOF2:  WriteLn ('  Progressive') ;
          Else   WriteLn ('  Unknown Frame Type') ;
          End ;


        WriteLn ('  Length: ', length) ;
        WriteLn ('  Precision: ', dataprecision) ;
        WriteLn ('  Height: ', frame_height) ;
        WriteLn ('  Width: ', frame_width) ;
        WriteLn ('  Component Count: ', component_count) ;
        End ;

      if (length <> (component_count * 3 + 8)) Then
        raise EJpegBadStream.Create ('Invalid Frame Size') ;

      // Rread the component descriptions
      max_horizontal_frequency := 0 ;
      max_vertical_frequency := 0 ;
      for ii := 1 To component_count Do
        Begin
        ID := inputstream.getByte ;  // Ci in standard

        // While JPEG does not put these restrictions on component IDs
        // the JFIF standard does.
        if (strict_jfif) Then
          Begin
          if (component_count = 1) And (ID <> 1) Then
            raise EJpegBadStream.Create ('Component ID not 1')
          else if (ID <> ii) Then
            raise EJpegBadStream.Create ('Invalid Component ID or ID out of order') ;
          End ;

        component_indices [ii] := ID ;

        data := inputstream.getByte ;
        if Not Assigned (components [ID]) Then
          components [ID] := TJpegDecoderComponent.Create ;
        components [ID].horizontalFrequency := data Shr 4 ; // Hi in standard
        components [ID].verticalFrequency := data And $F ;  // Vi in standard
        qtable := inputstream.getByte ;  // Tqi in standard
        if (qtable >= JPEGMAXQUANTIZATIONTABLES) Then
          raise EJpegBadStream.Create ('Bad Quantization Table Index') ;
        if Not Assigned (quantization_tables [qtable]) Then
          quantization_tables [qtable] := TJpegDecoderQuantizationTable.Create ;
        components [ID].setQuantizationTable (quantization_tables [qtable]) ;

        // Keep track of the largest values for horizontal and vertical
        // frequency.
        if (components [ID].horizontalFrequency > max_horizontal_frequency) Then
          max_horizontal_frequency := components [ID].horizontalFrequency ;

        if (components [ID].verticalFrequency > max_vertical_frequency) Then
          max_vertical_frequency := components [ID].verticalFrequency ;

        if (verbose_flag) Then
          Begin
          WriteLn ('   Component ', ID) ;
          WriteLn ('   Horizontal Frequency: ', components [ID].horizontalFrequency) ;
          WriteLn ('   Vertical Frequency: ', components [ID].verticalFrequency) ;
          WriteLn ('   Quantization Table: ', qtable) ;
          End ;
        End ;

      calculateMcuDimensions ;

      // Allocate storage for the image.
      current_image.setSize (frame_width, frame_height) ;

      if (verbose_flag) Then
        WriteLn ('}') ;

      sof_found := true ;
      End ;

    //
    //  Description:
    //
    //    This function reads a start of scan marker and the scan data
    //    following the marker.
    //
    Procedure readStartOfScan (inputstream : TJpegInputStream) ;
      Var
        ii : Cardinal ;
        length : Cardinal ;
        componentID : Cardinal ;
        rb : Cardinal ;
        ssa : Cardinal ;
        actable, dctable : Cardinal ;
        spectralselectionstart, spectralselectionend : COEFFICIENTINDEX ;
        successiveapproximationhigh, successiveapproximationlow : SUCCESSIVEAPPROXIMATION ;
      //
      //  Description:
      //
      //    This function reads the scan data for progressive scans.
      //
      //    All we do here is determine if we are processing a DC
      //    scan (sss==sse==0) or AC scan and if we are processing
      //    the first scan for the spectral selection (sah==0) or
      //    subsequent scan.
      //
      //  Parameters:
      //    sss: Spectral Selection Start (0..63)
      //    sse: Spectral Selection End (sse..63)
      //    sah: Successive Approximation High
      //    sal: Successive Approximation Low
      //
      Procedure readProgressiveScanData (inputstream : TJpegInputStream ;
                                         sss, sse : COEFFICIENTINDEX ;
                                         sah, sal : SUCCESSIVEAPPROXIMATION) ;
        //
        //  Description:
        //
        //    This funtion reads the scan data for the first DC scan for
        //    one or more components.
        //
        //  Parameters:
        //
        //    ssa:  Successive Approximation
        //
        Procedure readDcFirst (inputstream : TJpegInputStream ;
                               ssa : SUCCESSIVEAPPROXIMATION) ;
          Var
            restartcount : Cardinal ;
            mcurow, mcucol : Cardinal ;
            cc, cx, cy : Cardinal ;
            durow, ducol : Cardinal ;
            row, col : Cardinal ;
          Begin
          resetDcDifferences ;
          restartcount := 0 ;

          if (scanIsInterleaved) Then
            Begin
            for mcurow := 0 To mcu_rows - 1 Do
              Begin
              callProgressFunction (mcurow * 100 Div mcu_rows) ;
              for mcucol := 0 To mcu_cols - 1 Do
                Begin
                if (restart_interval <> 0) And (restart_interval = restartcount) Then
                  begin
                  resetDcDifferences  ;
                  processRestartMarker (inputstream) ;
                  restartcount := 0 ;
                  End ;
                for cc := 1 To scan_component_count Do
                  Begin
                  for cy := 0 To scan_components [cc].verticalFrequency - 1 Do
                    Begin
                    durow := scan_components [cc].verticalFrequency * mcurow + cy ;
                    for cx := 0 To scan_components [cc].horizontalFrequency - 1 Do
                      Begin
                      ducol := scan_components [cc].horizontalFrequency * mcucol + cx ;
                      scan_components [cc].decodeDcFirst (inputstream, durow, ducol, ssa) ;
                      End ;
                    End ;
                  End ;
                Inc (restartcount) ;
                End ;
              End ;
             End
          else
            begin
            for row := 0 To scan_components [1].noninterleavedRows - 1 Do
              Begin
              callProgressFunction (row * 100 Div scan_components [1].noninterleavedRows) ;
              for col := 0 To scan_components [1].noninterleavedCols - 1 Do
                Begin
                if (restart_interval <> 0) And (restart_interval = restartcount) Then
                  Begin
                  resetDcDifferences ;
                  processRestartMarker (inputstream) ;
                  restartcount := 0 ;
                  End ;
                scan_components [1].decodeDcFirst (inputstream, row, col, ssa) ;
                Inc (restartcount) ;
                End ;
              End ;
            End ;
          End ;

        //
        //  Description:
        //
        //    This function reads the scan data for a refining DC scan.
        //
        //  Parameters:
        //    ssa:  The successive approximation value for this scan.
        //
        Procedure readDcRefine (inputstream : TJpegInputStream ;
                                ssa : SUCCESSIVEAPPROXIMATION) ;
          Var
            restartcount : Cardinal ;
            mcurow, mcucol : Cardinal ;
            cc, cx, cy : Cardinal ;
            durow, ducol : Cardinal ;
            row, col : Cardinal ;
          Begin
          resetDcDifferences ;
          restartcount := 0 ;

          if (scanIsInterleaved) Then
            Begin
            for mcurow := 0 To mcu_rows - 1 Do
              Begin
              callProgressFunction (mcurow * 100 Div mcu_rows) ;
              for mcucol := 0 To mcu_cols - 1 Do
                Begin
                if (restart_interval <> 0) And (restart_interval = restartcount) Then
                  Begin
                  resetDcDifferences ;
                  processRestartMarker (inputstream) ;
                  restartcount := 0 ;
                  End ;
                for cc := 1 To scan_component_count Do
                  Begin
                  for cy := 0 To scan_components [cc].verticalFrequency - 1 Do
                    Begin
                    durow := scan_components [cc].verticalFrequency * mcurow + cy ;
                    for cx := 0 To scan_components [cc].horizontalFrequency - 1 Do
                      Begin
                      ducol := scan_components [cc].horizontalFrequency * mcucol + cx ;

                      scan_components [cc].decodeDcRefine (inputstream, durow, ducol, ssa) ;
                      End ;
                    End ;
                  End ;
                Inc (restartcount)
                End ;
              End ;
            End
          else
            Begin
            for row := 0 To scan_components [1].noninterleavedRows - 1 Do
              Begin
              callProgressFunction (row * 100 Div scan_components [1].noninterleavedRows) ;
              for col := 0 To scan_components [1].noninterleavedCols - 1 Do
                Begin
                if (restart_interval <> 0) And (restart_interval = restartcount) Then
                  Begin
                  resetDcDifferences ;
                  processRestartMarker (inputstream) ;
                  restartcount := 0 ;
                  End ;
                scan_components [1].decodeDcRefine (inputstream, row, col, ssa) ;
                Inc (restartcount)
                End ;
              End ;
            End ;
          End ;

        //
        //  Description:
        //
        //    This function reads the scan data for the first AC scan for a
        //    component. Progressive scans that read AC data cannot be
        //    interleaved.
        //
        //  Parameters:
        //    sss:  Spectral Selection Start
        //    sse:  Spectral Selection End
        //    ssa:  Spectral Selection
        //

        Procedure readAcFirst (inputstream : TJpegInputStream ;
                               sss, sse : COEFFICIENTINDEX ;
                               ssa : SUCCESSIVEAPPROXIMATION) ;
          Var
            restartcount : Cardinal ;
            row, col : Cardinal ;
          Begin
          resetDcDifferences ;

          restartcount := 0 ;
          for row := 0 To scan_components [1].noninterleavedRows - 1 Do
            Begin
            callProgressFunction (row * 100 Div scan_components [1].noninterleavedRows) ;
            for col := 0 To scan_components [1].noninterleavedCols - 1 Do
              Begin
              if (restart_interval <> 0) And (restart_interval = restartcount) Then
                Begin
                resetDcDifferences ;
                processRestartMarker (inputstream) ;
                restartcount := 0 ;
                End ;
              scan_components [1].decodeAcFirst (inputstream,
                                                 row, col,
                                                 sss, sse,
                                                 ssa) ;
              Inc (restartcount) ;
              End ;
            End ;
          End ;

        //
        //  Description:
        //
        //    This function reads the scan data for a refining AC scan for a
        //    component. Progressive scans that read AC data cannot be
        //    interleaved.
        //
        //  Parameters:
        //    sss:  Spectral Selection Start
        //    sse:  Spectral Selection End
        //    ssa:  Spectral Selection
        //

        Procedure readAcRefine (inputstream : TJpegInputStream ;
                                sss, sse : COEFFICIENTINDEX ;
                                ssa : SUCCESSIVEAPPROXIMATION) ;
          Var
            restartcount : Cardinal ;
            row, col : Cardinal ;
          Begin
          resetDcDifferences ;

          restartcount := 0 ;
          for row := 0 To scan_components [1].noninterleavedRows - 1 Do
            Begin
            callProgressFunction (row * 100 Div scan_components [1].noninterleavedRows) ;
            for col := 0 To scan_components [1].noninterleavedCols - 1 Do
              Begin
              if (restart_interval <> 0) And (restart_interval = restartcount) Then
                Begin
                resetDcDifferences ;
                processRestartMarker (inputstream) ;
                restartcount := 0 ;
                End ;
              scan_components [1].decodeAcRefine (inputstream,
                                                  row, col,
                                                  sss, sse,
                                                  ssa) ;
              Inc (restartcount) ;
              End ;
            End ;
          End ;

        Begin

        if sss = 0 Then
          Begin
          if sse <> 0 Then
            raise EJpegBadStream.Create ('Progressive scan contains DC and AC data') ;

          if sah = 0 Then
            readDcFirst (inputstream, sal)
          else
            readDcRefine (inputstream, sal) ;
          End
        else
          Begin
          if sah = 0 Then
            readAcFirst (inputstream, sss, sse, sal)
          else
            readAcRefine (inputstream, sss, sse, sal) ;
          End ;
        End ;

      //
      //  Parameters:
      //
      //    The function reads the scan data for a sequential scan. All
      //    we do here is determine whether or not we have an interleaved
      //    or non-interleaved scan then call a function that handles
      //    the scan type.

      Procedure readSequentialScanData (inputstream : TJpegInputStream) ;
        //
        //  Description:
        //
        //    This function reads the scan data for an interleaved scan.
        //

        Procedure readSequentialInterleavedScan (inputstream : TJpegInputStream) ;
          var
            restartcount : Cardinal ;
            mcurow, mcucol : Cardinal ;
            cc, cx, cy : Cardinal ;
            durow, ducol : Cardinal ;
          Begin
          resetDcDifferences ;

          restartcount := 0 ;
          for mcurow := 0 To mcu_rows - 1 Do
            Begin
            callProgressFunction (mcurow * 100 Div mcu_rows) ;
            for mcucol := 0 To mcu_cols - 1 Do
              Begin
              if (restart_interval <> 0) And (restart_interval = restartcount) Then
                Begin
                processRestartMarker (inputstream) ;
                restartcount := 0 ;
                End ;
              for cc := 1 To scan_component_count Do
                Begin
                for cy := 0 To scan_components [cc].verticalFrequency - 1 Do
                  Begin
                  durow := scan_components [cc].verticalFrequency * mcurow + cy ;
                  for cx := 0 To scan_components [cc].horizontalFrequency - 1 Do
                    Begin
                    ducol := scan_components [cc].horizontalFrequency * mcucol + cx ;

                    scan_components [cc].decodeSequential (
                                              inputstream,
                                              durow,
                                              ducol) ;
                    End ;
                  End ;
                End ;
              Inc (restartcount)
              End ;
            End ;
          End ;

        //
        //  Description:
        //
        //    This function reads the scan data for a non-interleaved scan.
        //

        Procedure readSequentialNonInterleavedScan (inputstream : TJpegInputStream ) ;
          Var
            restartcount : Cardinal ;
            row, col : Cardinal ;
          Begin
          restartcount := 0 ;
          resetDcDifferences ;
          for row := 0 To scan_components [1].noninterleavedRows - 1 Do
            Begin
            callProgressFunction (row * 100 Div scan_components [1].noninterleavedRows) ;
            for col := 0 To scan_components [1].noninterleavedCols - 1 Do
              Begin
              if (restart_interval <> 0) And (restart_interval = restartcount) Then
                begin
                processRestartMarker (inputstream) ;
                restartcount := 0 ;
                End ;
              scan_components [1].decodeSequential (inputstream, row, col) ;
              Inc (restartcount) ;
              End ;
            End ;
          End ;

        begin
        expected_restart := 0 ;
        If (scanIsInterleaved) Then
          readSequentialInterleavedScan (inputstream)
        Else
          readSequentialNonInterleavedScan (inputstream) ;
        End ;

      Begin
      if (Not sof_found) Then
        raise EJpegBadStream.Create ('Scan found before frame defined') ;

      // Section B.2.3

      length := inputstream.getBigEndianWord ;
      if (verbose_flag) Then
        Begin
        WriteLn ('{ Start Of Scan ') ;
        WriteLn ('  Length:  ', length) ;
        End ;

      scan_component_count := inputstream.getByte ;  // Ns in standard
      // Right now we can only handle up to three components.
      if (scan_component_count > 3) Or (scan_component_count < 1) Then
        raise EJpegBadStream.Create ('Invalid component count in scan') ;

      for ii := 1 To scan_component_count Do
        Begin
        componentID := inputstream.getByte ;  // Csi in standard

        scan_components [ii] := @components [componentID] ;
        // If the horizontal frequency is zero then the component was not
        // defined in the SOFx marker.
        if (scan_components [ii].horizontalFrequency = 0) Then
          raise EJpegBadStream.Create ('Component Not Defined') ;

        rb := inputstream.getByte () ;
        actable := rb And $0F ;
        dctable := rb Shr 4 ;

        scan_components [ii].setHuffmanTables (
                                  dc_tables [dctable],
                                  ac_tables [actable]) ;
        if (verbose_flag) Then
          Begin
          WriteLn ('  Component ID: ', componentID) ;
          WriteLn ('  DC Entropy Table: ', dctable)  ;
          WriteLn ('  AC Entropy Table: ', actable) ;
          End ;
        End ;

      spectralselectionstart := inputstream.getByte () ; // Ss in standard
      spectralselectionend := inputstream.getByte ()  ;  // Se in standard

      ssa := inputstream.getByte ;
      successiveapproximationhigh := ssa Shr 4 ;  // Ah in standard
      successiveapproximationlow := ssa And $0F ; // Al in standard

      if (verbose_flag) Then
        Begin
        WriteLn (' Spectral Selection Start: ', spectralselectionstart) ;
        WriteLn (' Spectral Selection End: ', spectralselectionend) ;
        WriteLn (' Successive Approximation High: ', successiveapproximationhigh) ;
        WriteLn (' Successive Approximation Low: ', successiveapproximationlow)  ;
        WriteLn ('}') ;
        End ;


      for ii := 1 To scan_component_count Do
        Begin
        if (progressive_frame) Then
          Begin
          scan_components [ii].checkQuantizationTable ;
          if (spectralselectionstart = 0) Then
            scan_components [ii].checkDcTable
          else
            scan_components [ii].checkAcTable ;
          End
        else
          Begin
          scan_components [ii].checkQuantizationTable ;
          scan_components [ii].checkDcTable ;
          scan_components [ii].checkAcTable ;
          End ;

        scan_components [ii].allocateComponentBuffers (frame_width,
                                                       frame_height,
                                                       max_horizontal_frequency,
                                                       max_vertical_frequency,
                                                       progressive_frame) ;
        End ;

      Inc (current_scan) ;
      inputstream.enterBitMode (CHAR_BIT) ;
      if (progressive_frame) Then
        Begin
        readProgressiveScanData (inputstream,
                                 spectralselectionstart,
                                 spectralselectionend,
                                 successiveapproximationhigh,
                                 successiveapproximationlow) ;
        End
      else
        Begin
        readSequentialScanData (inputstream) ;
        End ;
      inputstream.exitBitMode ;

      callProgressFunction (100) ;
      End ;

    Begin
    while (inputstream.moreData) Do
      Begin
      marker := inputstream.getByte () ;
      case marker Of
        SOB:
        // According to E.1.2, 0xFF is allowed as fill when a
        // marker is expected.
        ;
        SOI:

          if (verbose_flag) then
            Begin
            Writeln ('{ Start Of Image }') ;
            exit ; // SOI has no data.
            End ;
        DQT:
          Begin
          readQuantization (inputstream) ;
          Exit ;
          End ;
        DHP:
          raise EJpegBadStream.Create ('DHP marker not supported') ;

        // The only difference between a Sequential DCT Frame
        // (SOF0) and an extended Sequential DCT Frame (SOF1)
        // is that a baseline frame may only have 2 DC and 2 AC
        // Huffman tables per scan (F.1.2) and and extended
        // Sequential Frame may have up to 4 DC and 4 AC Huffman
        // tables per scan (F.1.3). Both are decoded identically
        // for 8-bit precision. Extended Sequential frames may
        // use 12-bit precision (F, Table B.2) which we do not
        // support.
        SOF0, SOF1, SOF2:
          Begin
          readStartOfFrame (inputstream, marker) ;
          Exit ;
          End ;
        SOF3:
          raise EJpegBadStream.Create ('Lossless Huffman Coding Not Supported') ;
        SOF5:
          raise EJpegBadStream.Create ('Differential Sequential Huffman Coding Not Supported') ;
        SOF6:
          raise EJpegBadStream.Create ('Differential Progressive Huffman Coding Not Supported') ;
        SOF7:
          raise EJpegBadStream.Create ('Differential Lossless Huffman Coding Not Supported') ;

          // These are markers for frames using arithmetic coding.
          // Arithmetic coding is covered by patents so we ignore
          // this type.
        SOF9, SOFA, SOFB, SOFD, SOFE, SOFF:
          raise EJpegBadStream.Create ('Cannot read image - Arithmetic Coding covered by patents') ;
        DHT:
          Begin
          readHuffmanTable (inputstream) ;
          Exit ;
          End ;
        SOS:
          Begin
          readStartOfScan (inputstream) ;
          Exit ;
          End ;
        DRI:
          Begin
          readRestartInterval (inputstream) ;
          Exit ;
          End ;
        EOI:
          Begin
          eoi_found := true ;
          if (verbose_flag) Then
            WriteLn ('{ End Of Image }') ;
          Exit ;
          End ;
        APP0, APP1, APP2, APP3,
        APP4, APP5, APP6, APP7,
        APP8, APP9, APPA, APPB,
        APPC, APPD, APPE, APPF, COM:
          Begin
          readApplication (marker, inputstream) ;
          Exit;
          End ;
        Else
          Begin
          // We call ReadByte to make sure the problem
          // is not a premature EOF.
          inputstream.getByte ;
          raise EJpegBadStream.Create ('Unknown, unsupported, or reserved marker encountered') ;
          End ;
        End
      End ;
    raise EJpegBadStream.Create ('Premature end of file') ;
    End ;

  //
  //  Description:
  //
  //    This function scans a stream and counts the number of scans.  This
  //    allows an exact count for a progress function.
  //
  Procedure getScanCount (inputstream : TJpegInputStream) ;
    Var
      startpos : Integer ;
      data : Byte ;
      endfound : boolean ;
    Begin
    // Save the stream position so we can go back
    // when we are finished.
    startpos := inputstream.tellg ;

    // Count the number of SOS markers.
    scan_count := 0 ;
    endfound := false ;
    while inputstream.moreData And Not endfound Do
      Begin
      data := inputstream.getByte ;
      if (data = SOB) Then
        Begin
        while data = SOB Do
          data := inputstream.getByte ;
        if (data = SOS) Then
          Inc (scan_count)
        else if (data = EOI) Then
          endfound := True ;
        End ;
      End ;
    // Go back to where we were in the stream.
    inputstream.seekg (startpos) ;
    End ;

  Begin
  current_scan := 0 ;
  scan_count := 0 ;
  current_image := image ;

  if Assigned (progress_function) Then
    getScanCount (inputstream) ;

  restart_interval := 0 ;  // Clear the restart interval ;
  try
    Begin
    processing_image := true ;
    current_image.clearImage ;
    eoi_found := false ;
    sof_found := false ;

    // Read the required SOI and APP0 markers at the start of the image.
    readStreamHeader (inputstream) ;

    data := inputstream.getByte ;
    while (inputstream.moreData And Not eoi_found) Do
      Begin
      if (data = SOB) Then
        Begin
        readMarker (inputstream) ;
        if Not eoi_found Then
          Begin
          data := inputstream.getByte ;
          if (Not inputstream.moreData ) Then
            raise EJpegBadStream.Create ('Premature end of file') ;
          End ;
        End ;
      End ;
    End
  Except
    On EGraphicsAbort Do
      Begin
      freeAllocatedResources ;
      current_image := Nil ;
      End
    Else
      Begin
      updateImage ;
      freeAllocatedResources ;
      current_image := Nil ;
      processing_image := false ;
      Raise ;
      End ;
    End ;

  updateImage ;
  processing_image := false ;

  // Some people say we should not have this check here. If it bothers you
  // remove it.
  if (Not eoi_found) Then
    raise EJpegBadStream.Create('End of Image Marker Not Found') ;

  // We do no want an exception so do not call ReadByte ()
  // Sometimes there can be trailing end of record markers.
  inputstream.read (data, sizeof (data)) ;
  while ((data = CR) Or (data = LF)) And inputstream.moreData Do
    data := inputstream.getByte ;

  if (inputstream.moreData) Then
    raise EJpegBadStream.Create ('Extra Data After End of Image Marker') ;

  freeAllocatedResources ;
  current_image := Nil ;
  End ;


//
//  Description:
//

//    This function writes the image data that has been read so
//    far to the image. This function gets called after reading
//    the entire image stream.  The user can also call this function
//    from a progress function to display progressive images,
//    multi-scan sequential images, or just to display the image
//    as it is being read (slow).
//
Procedure TJpegDecoder.updateImage ;
  Var
    ii : Cardinal ;
  Begin
  if Not Assigned (current_image) Then
    Raise EJpegError.Create ('Not reading an image') ;

  if (current_scan > 0) Then
    Begin
    if (progressive_frame) Then
      Begin
      for ii := 1 To component_count Do
        Begin
        components [component_indices [ii]].progressiveInverseDct ;
        components [component_indices [ii]].upsampleImage (use_filters) ;
        End ;
      End
    else
      Begin
      for ii := 1 To component_count Do
        Begin
        components [component_indices [ii]].upsampleImage (use_filters) ;
        End ;
      End ;

    Case (component_count) Of
      3:
        TJpegDecoderComponent.convertRgb (components [component_indices [1]],
                                          components [component_indices [2]],
                                          components [component_indices [3]],
                                          current_image) ;
      1:
        TJpegDecoderComponent.convertGrayscale (
                               components [component_indices [1]],
                               current_image) ;
      End ;
    End;
  End ;

//
//  Description:
//
//    This function frees all the memory dynamically allocated
//    during the image decoding process.
//
Procedure TJpegDecoder.freeAllocatedResources ;
  Var
    ii : Integer ;
  Begin
  If (current_scan > 0) Then
    Begin
    for ii := 1 To component_count Do
      Begin
      if components [component_indices [ii]] <> Nil Then
        components [component_indices [ii]].Destroy ;
      components [component_indices [ii]] := Nil ;
      End ;
    End ;

  For ii := Low (JPEGHUFFMANTABLEID) To High (JPEGHUFFMANTABLEID) Do
    Begin
    If Assigned (ac_tables [ii]) Then
      Begin
      ac_tables [ii].Destroy ; ac_tables [ii] := Nil ;
      End ;
    If Assigned (dc_tables [ii]) Then
      Begin
      dc_tables [ii].Destroy ; dc_tables [ii] := Nil ;
      End ;
    End ;
  For ii := Low (JPEGQUANTIZATIONTABLEID) To High (JPEGQUANTIZATIONTABLEID) Do
    Begin
    If Assigned (quantization_tables [ii]) Then
      Begin
      quantization_tables [ii].Destroy ;
      quantization_tables [ii] := Nil ;
      End ;
    End ;
  End ;



Procedure TJpegDecoder.readImageFile (filename : String ;
                                      image :  TBitmapImage) ;
  Var
    inputstream : JpegInputFileStream ;
//    JpegInputMapStream inputstream ;
  Begin
  inputstream := JpegInputFileStream.Create (BUFFERSIZE) ;
  try
    try
      inputstream.open (filename) ;
      readImage (inputstream, image) ;
    Except On error : EStreamError Do
      // Convert input stream errors to JPEG errors.
      Raise EJpegError.Create (error.Message) ;
      End ;
  Finally
    inputstream.Destroy ;
    End ;
  End ;
End.
