pasjpeg.pas

DELPHI版的JPEG文件解码源程序

    Dec(source^.cur_input_row);
    row := source^.cur_input_row;
  end else begin
    Dec(source^.row_offset, source^.row_width);
    row := 0;
  end;
  if not source^.inmemory then begin
    image_ptr := cinfo^.mem^.access_virt_sarray ( j_common_ptr (cinfo),
       source^.image_buffer, row, JDIMENSION (1), TRUE);
    inptr := JSAMPLE_PTR(image_ptr^[0]);
    if source^.infile.Seek(source^.row_offset, 0) <> source^.row_offset then
      ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EOF);
    if source^.infile.Read(inptr^, source^.row_width)
         <> size_t(source^.row_width) then
      ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EOF);
  end;
  image_ptr := cinfo^.mem^.access_virt_sarray ( j_common_ptr (cinfo),
    source^.image_buffer, row, JDIMENSION (1), FALSE);
  {}
  inptr := JSAMPLE_PTR(image_ptr^[0]);
  case source^.bits_per_pixel of
     8: begin
          {expand the colormap indexes to real data}
          outptr := JSAMPLE_PTR(source^.buffer^[0]);
          for col := pred(cinfo^.image_width) downto 0 do begin
            t := GETJSAMPLE(inptr^);
            Inc(inptr);
            outptr^ := source^.colormap^[0]^[t];
            Inc(outptr);
            outptr^ := source^.colormap^[1]^[t];
            Inc(outptr);
            outptr^ := source^.colormap^[2]^[t];
            Inc(outptr);
          end;
        end;
    24: begin
          outptr24 := source^.buffer^[0];
          for col := pred(cinfo^.image_width) downto 0 do begin
            outptr24^[2] := inptr^;
            Inc(inptr);
            outptr24^[1] := inptr^;
            Inc(inptr);
            outptr24^[0] := inptr^;
            Inc(inptr);
            Inc(JSAMPLE_PTR(outptr24), 3);
          end;
        end;
  end;
  read_bmp_pixelrow := 1;
end;

procedure read_bmp_image(cinfo : j_compress_ptr;
                        source : bmp_source_ptr);
var
  row, col : JDIMENSION;
  image_ptr : JSAMPARRAY;
  inptr : JSAMPLE_PTR;
begin
  if source^.inmemory then
    for row := 0 to pred(cinfo^.image_height) do begin
      image_ptr := cinfo^.mem^.access_virt_sarray ( j_common_ptr (cinfo),
         source^.image_buffer, row, JDIMENSION (1), TRUE);
      inptr := JSAMPLE_PTR(image_ptr^[0]);
      if source^.infile.Read(inptr^, source^.row_width)
           <> size_t(source^.row_width)
      then
        ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EOF);
    end;
end;

function jinit_read_bmp (cinfo : j_compress_ptr;
                        infile : TStream;
                      inmemory : boolean) : bmp_source_ptr;
var
  source : bmp_source_ptr;
begin
  source := bmp_source_ptr (
      cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
                               SIZEOF(bmp_source_struct)) );
  source^.infile := infile;
  source^.inmemory := inmemory;
  jinit_read_bmp := source;
end;

{ ------------------------------------------------------------------------ }
{   JPEG progress monitor support                                          }
{   for reference: LIPJPEG.DOC in \JPEG\C directory                        }
{ ------------------------------------------------------------------------ }

type
  my_progress_ptr = ^my_progress_mgr;
  my_progress_mgr = record
    pub : jpeg_progress_mgr;
    proc : JPEG_ProgressMonitor;
    percent_done : INT;
    completed_extra_passes : INT;
    total_extra_passes : INT;
  end;

procedure progress_monitor(cinfo: j_common_ptr); far;
var
  progress : my_progress_ptr;
  total_passes : INT;
  percent_done : INT;
begin
  progress := my_progress_ptr(cinfo^.progress);
  total_passes :=
    progress^.pub.total_passes + progress^.total_extra_passes;
  percent_done :=
    ( ((progress^.pub.completed_passes+progress^.completed_extra_passes)*100) +
      ((progress^.pub.pass_counter*100) div progress^.pub.pass_limit)
    ) div total_passes;
  {}
  if percent_done <> progress^.percent_done then begin
    progress^.percent_done := percent_done;
    progress^.proc(percent_done);
  end;
end;

procedure jpeg_my_progress(cinfo : j_common_ptr;
                        progress : my_progress_ptr;
                        callback : JPEG_ProgressMonitor);
begin
  if @callback = nil then
    Exit;
  {set method}
  progress^.pub.progress_monitor := progress_monitor;
  {set fields}
  progress^.proc := callback;
  progress^.percent_done := -1;
  progress^.completed_extra_passes := 0;
  progress^.total_extra_passes := 0;
  {link to cinfo}
  cinfo^.progress := @progress^.pub;
end;

procedure jpeg_finish_progress(cinfo : j_common_ptr);
var
  progress : my_progress_ptr;
begin
  progress := my_progress_ptr(cinfo^.progress);
  if progress^.percent_done <> 100 then begin
    progress^.percent_done := 100;
    progress^.proc(progress^.percent_done);
  end;
end;

{ ------------------------------------------------------------------------ }
{   JPEG error handler                                                     }
{   for reference: JERROR.PAS in PASJPG10 library                          }
{                  LIPJPEG.DOC in \JPEG\C directory                        }
{   NOTE: we have replaced jpeg_std_error because it stores a static       }
{         message table (JDEFERR.PAS) in the jpeg_message_table field.     }
{ ------------------------------------------------------------------------ }

type
  my_error_ptr = ^my_error_mgr;
  my_error_mgr = record
    pub: jpeg_error_mgr;
  end;

procedure error_exit (cinfo : j_common_ptr); far;
var
  buffer : string;
begin
  cinfo^.err^.format_message(cinfo, buffer);
  raise EJPEG.Create(buffer);
end;

procedure emit_message (cinfo : j_common_ptr; msg_level : int); far;
var
  err : jpeg_error_mgr_ptr;
begin
  err := cinfo^.err;
  if (msg_level < 0) then begin
    {It's a warning message. Since corrupt files may generate many warnings,}
    {the policy implemented here is to show only the first warning,}
    {unless trace_level >= 3}
    if (err^.num_warnings = 0) or (err^.trace_level >= 3) then
      err^.output_message(cinfo);
    {Always count warnings in num_warnings}
    Inc( err^.num_warnings );
  end else
    {It's a trace message. Show it if trace_level >= msg_level}
    if (err^.trace_level >= msg_level) then
      err^.output_message (cinfo);
end;

procedure output_message (cinfo : j_common_ptr); far;
var
  buffer : string;
begin
  cinfo^.err^.format_message (cinfo, buffer);
  {message dialog}
  ShowMessage(buffer);
end;

procedure format_message (cinfo : j_common_ptr; var buffer : string); far;
begin
  buffer :=
    'JPEG ERROR -- #' + IntToStr(cinfo^.err^.msg_code);
end;

procedure reset_error_mgr (cinfo : j_common_ptr); far;
begin
  cinfo^.err^.num_warnings := 0;
  {trace_level is not reset since it is an application-supplied parameter}
  cinfo^.err^.msg_code := 0;      {may be useful as a flag for "no error"}
end;

function jpeg_my_error (var err : my_error_mgr) : jpeg_error_mgr_ptr;
begin
  {methods}
  err.pub.error_exit := error_exit;
  err.pub.emit_message := emit_message;
  err.pub.output_message := output_message;
  err.pub.format_message := format_message;
  err.pub.reset_error_mgr := reset_error_mgr;
  {fields}
  err.pub.trace_level := 0;         {default := no tracing}
  err.pub.num_warnings := 0;        {no warnings emitted yet}
  err.pub.msg_code := 0;            {may be useful as a flag for "no error"}
  {message table(s)}
  err.pub.jpeg_message_table := nil;    {we don't want to use a static table}
  err.pub.last_jpeg_message := pred(JMSG_LASTMSGCODE);
  err.pub.addon_message_table := nil;
  err.pub.first_addon_message := JMSG_NOMESSAGE;   {for safety}
  err.pub.last_addon_message := JMSG_NOMESSAGE;
  {return result}
  jpeg_my_error := @err;
end;

{ ------------------------------------------------------------------------ }
{   load JPEG stream and save as BITMAP stream                             }
{   for reference: DJPEG.PAS in PASJPG10 library                           }
{ ------------------------------------------------------------------------ }

procedure LoadJPEG(const infile, outfile: TStream; inmemory: boolean;
                   {decompression parameters:}
                   numcolors: integer;
                   {progress monitor}
                   callback: JPEG_ProgressMonitor);
var
  cinfo : jpeg_decompress_struct;
  err   : my_error_mgr;
  dest  : bmp_dest_ptr;
  progress : my_progress_mgr;
  num_scanlines : JDIMENSION;
begin
  {initialize the JPEG decompression object with default error handling.}
  cinfo.err := jpeg_my_error(err);
  jpeg_create_decompress(@cinfo);
  try
    {specify the source of the compressed data}
      jpeg_stream_src(@cinfo, infile);
    {progress monitor}
      jpeg_my_progress(@cinfo, @progress, callback);
    {obtain image info from header, set default decompression parameters}
      jpeg_read_header(@cinfo, TRUE);
    {set parameters for decompression}
      if numcolors <> 0 then begin
        cinfo.desired_number_of_colors := numcolors;
        cinfo.quantize_colors := True;
      end;
      {...}
    {prepare for decompression, initialize internal state}
      dest := jinit_write_bmp(@cinfo, outfile, inmemory);
      jpeg_start_decompress(@cinfo);
    {process data}
      write_bmp_header(@cinfo, dest);
      while (cinfo.output_scanline < cinfo.output_height) do begin
        num_scanlines :=
          jpeg_read_scanlines(@cinfo, dest^.buffer, dest^.buffer_height);
        write_bmp_pixelrow(@cinfo, dest, num_scanlines);
      end;
      write_bmp_image(@cinfo, dest);
    {finish}
      jpeg_finish_decompress(@cinfo);
      jpeg_finish_progress(@cinfo);
  finally
    {destroy}
    jpeg_destroy_decompress(@cinfo);
  end;
end;

{ ------------------------------------------------------------------------ }
{   read BITMAP stream and save as JPEG                                    }
{   for reference: CJPEG.PAS in PASJPG10 library                           }
{ ------------------------------------------------------------------------ }

procedure StoreJPEG(const infile, outfile: TStream; inmemory: boolean;
                    {compression parameters:}
                    quality: INT;
                    {progress monitor}
                    callback: JPEG_ProgressMonitor);
var
  cinfo  : jpeg_compress_struct;
  err    : my_error_mgr;
  source : bmp_source_ptr;
  progress : my_progress_mgr;
  num_scanlines : JDIMENSION;
begin
  {initialize the JPEG compression object with default error handling.}
  cinfo.err := jpeg_my_error(err);
  jpeg_create_compress(@cinfo);
  try
    {specify the destination for the compressed data}
      jpeg_stream_dest(@cinfo, outfile);
    {set jpeg defaults}
      cinfo.in_color_space := JCS_RGB; {arbitrary guess}
      jpeg_set_defaults(@cinfo);
    {progress monitor}
      jpeg_my_progress(@cinfo, @progress, callback);
    {obtain image info from bitmap header, set default compression parameters}
      source := jinit_read_bmp(@cinfo, infile, inmemory);
      read_bmp_header(@cinfo, source);
    {now we know input colorspace, fix colorspace-dependent defaults}
      jpeg_default_colorspace(@cinfo);
    {set parameters for compression (most likely only quality)}
      jpeg_set_quality(@cinfo, quality, TRUE);
      {...}
    {prepare for compression, initialize internal state}
      jpeg_start_compress(@cinfo, TRUE);
    {process data}
      read_bmp_image(@cinfo, source);
      while (cinfo.next_scanline < cinfo.image_height) do begin
        num_scanlines := read_bmp_pixelrow(@cinfo, source);
        jpeg_write_scanlines(@cinfo, source^.buffer, num_scanlines);
      end;
    {finish}
      jpeg_finish_compress(@cinfo);
      jpeg_finish_progress(@cinfo);
  finally
    {destroy}
    jpeg_destroy_compress(@cinfo);
  end;
end;

end.