pasjpeg.pas

DELPHI版的JPEG文件解码源程序

unit PasJPeg;

{$I jconfig.inc}

interface

uses
  Classes, SysUtils;

type
  EJPEG = class(Exception);
  JPEG_ProgressMonitor = procedure(Percent: Integer);

procedure LoadJPEG(
  {streams:}
  const infile, outfile: TStream; inmemory: boolean;
  {decompression parameters:}
  numcolors: integer;
  {progress monitor}
  callback: JPEG_ProgressMonitor);

procedure StoreJPEG(
  {streams}
  const infile, outfile: TStream; inmemory: boolean;
  {compression parameters:}
  quality: integer;
  {progress monitor}
  callback: JPEG_ProgressMonitor);

implementation

uses
  WinTypes, Dialogs,
  {PASJPG10 library}
  jmorecfg,
  jpeglib,
  jerror,
  jdeferr,
  jdmarker,
  jdmaster,
  jdapimin,
  jdapistd,
  jcparam,
  jcapimin,
  jcapistd,
  jcomapi;

{ ---------------------------------------------------------------------- }
{   source manager to read compressed data                               }
{   for reference: JDATASRC.PAS in PASJPG10 library                      }
{ ---------------------------------------------------------------------- }

type
  my_src_ptr = ^my_source_mgr;
  my_source_mgr = record
    pub    : jpeg_source_mgr;	{public fields}
    infile : TStream;		{source stream}
    buffer : JOCTET_FIELD_PTR;	{start of buffer}
    start_of_file : boolean;	{have we gotten any data yet?}
  end;

const
  INPUT_BUF_SIZE = 4096;

procedure init_source(cinfo : j_decompress_ptr); far;
var
  src : my_src_ptr;
begin
  src := my_src_ptr(cinfo^.src);
  src^.start_of_file := TRUE;
end;

function fill_input_buffer(cinfo : j_decompress_ptr) : boolean; far;
var
  src : my_src_ptr;
  nbytes : size_t;
begin
  src := my_src_ptr(cinfo^.src);
  nbytes := src^.infile.Read(src^.buffer^, INPUT_BUF_SIZE);
  if (nbytes <= 0) then begin
    if (src^.start_of_file) then   {Treat empty input file as fatal error}
      ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EMPTY);
    WARNMS(j_common_ptr(cinfo), JWRN_JPEG_EOF);
    {Insert a fake EOI marker}
    src^.buffer^[0] := JOCTET ($FF);
    src^.buffer^[1] := JOCTET (JPEG_EOI);
    nbytes := 2;
  end;
  src^.pub.next_input_byte := JOCTETptr(src^.buffer);
  src^.pub.bytes_in_buffer := nbytes;
  src^.start_of_file := FALSE;
  fill_input_buffer := TRUE;
end;

procedure skip_input_data(cinfo : j_decompress_ptr;
                      num_bytes : long); far;
var
  src : my_src_ptr;
begin
  src := my_src_ptr (cinfo^.src);
  if (num_bytes > 0) then begin
    while (num_bytes > long(src^.pub.bytes_in_buffer)) do begin
      Dec(num_bytes, long(src^.pub.bytes_in_buffer));
      fill_input_buffer(cinfo);
      { note we assume that fill_input_buffer will never return FALSE,
        so suspension need not be handled. }
    end;
    Inc( src^.pub.next_input_byte, size_t(num_bytes) );
    Dec( src^.pub.bytes_in_buffer, size_t(num_bytes) );
  end;
end;

procedure term_source(cinfo : j_decompress_ptr); far;
begin
  { no work necessary here }
end;

procedure jpeg_stream_src(cinfo : j_decompress_ptr; const infile: TStream);
var
  src : my_src_ptr;
begin
  if (cinfo^.src = nil) then begin {first time for this JPEG object?}
    cinfo^.src := jpeg_source_mgr_ptr(
      cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
				  SIZEOF(my_source_mgr)) );
    src := my_src_ptr (cinfo^.src);
    src^.buffer := JOCTET_FIELD_PTR(
      cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
				  INPUT_BUF_SIZE * SIZEOF(JOCTET)) );
  end;
  src := my_src_ptr (cinfo^.src);
  {override pub's method pointers}
  src^.pub.init_source := init_source;
  src^.pub.fill_input_buffer := fill_input_buffer;
  src^.pub.skip_input_data := skip_input_data;
  src^.pub.resync_to_restart := jpeg_resync_to_restart; {use default method}
  src^.pub.term_source := term_source;
  {define our fields}
  src^.infile := infile;
  src^.pub.bytes_in_buffer := 0;   {forces fill_input_buffer on first read}
  src^.pub.next_input_byte := nil; {until buffer loaded}
end;

{ ---------------------------------------------------------------------- }
{   destination manager to write compressed data                         }
{   for reference: JDATADST.PAS in PASJPG10 library                      }
{ ---------------------------------------------------------------------- }

type
  my_dest_ptr = ^my_destination_mgr;
  my_destination_mgr = record
    pub     : jpeg_destination_mgr;  {public fields}
    outfile : TStream;	             {target stream}
    buffer  : JOCTET_FIELD_PTR;      {start of buffer}
  end;

const
  OUTPUT_BUF_SIZE = 4096;

procedure init_destination(cinfo : j_compress_ptr); far;
var
  dest : my_dest_ptr;
begin
  dest := my_dest_ptr(cinfo^.dest);
  dest^.buffer := JOCTET_FIELD_PTR(
      cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
				  OUTPUT_BUF_SIZE * SIZEOF(JOCTET)) );
  dest^.pub.next_output_byte := JOCTETptr(dest^.buffer);
  dest^.pub.free_in_buffer := OUTPUT_BUF_SIZE;
end;

function empty_output_buffer(cinfo : j_compress_ptr) : boolean; far;
var
  dest : my_dest_ptr;
begin
  dest := my_dest_ptr(cinfo^.dest);
  if (dest^.outfile.Write(dest^.buffer^, OUTPUT_BUF_SIZE)
        <> size_t(OUTPUT_BUF_SIZE))
  then
    ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);
  dest^.pub.next_output_byte := JOCTETptr(dest^.buffer);
  dest^.pub.free_in_buffer := OUTPUT_BUF_SIZE;
  empty_output_buffer := TRUE;
end;

procedure term_destination(cinfo : j_compress_ptr); far;
var
  dest : my_dest_ptr;
  datacount : size_t;
begin
  dest := my_dest_ptr (cinfo^.dest);
  datacount := OUTPUT_BUF_SIZE - dest^.pub.free_in_buffer;
  {write any data remaining in the buffer}
  if (datacount > 0) then
    if dest^.outfile.Write(dest^.buffer^, datacount) <> datacount then
      ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);
end;

procedure jpeg_stream_dest(cinfo : j_compress_ptr; const outfile: TStream);
var
  dest : my_dest_ptr;
begin
  if (cinfo^.dest = nil) then begin {first time for this JPEG object?}
    cinfo^.dest := jpeg_destination_mgr_ptr(
      cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
				  SIZEOF(my_destination_mgr)) );
  end;
  dest := my_dest_ptr (cinfo^.dest);
  {override pub's method pointers}
  dest^.pub.init_destination := init_destination;
  dest^.pub.empty_output_buffer := empty_output_buffer;
  dest^.pub.term_destination := term_destination;
  {define our fields}
  dest^.outfile := outfile;
end;

{ ------------------------------------------------------------------------ }
{   Bitmap writing routines                                                }
{   for reference: WRBMP.PAS in PASJPG10 library                           }
{ ------------------------------------------------------------------------ }
{   NOTE: we always write BMP's in Windows format, no OS/2 formats!        }
{         however, we read all bitmap flavors (see bitmap reading)         }
{ ------------------------------------------------------------------------ }

{ To support 12-bit JPEG data, we'd have to scale output down to 8 bits.
  This is not yet implemented. }

{$ifndef BITS_IN_JSAMPLE_IS_8}
  Sorry, this code only copes with 8-bit JSAMPLEs. { deliberate syntax err }
{$endif}

type
  BGRptr = ^BGRtype;
  BGRtype = packed record
    b,g,r : byte;
  end;

  RGBptr = ^RGBtype;
  RGBtype = packed record
    r,g,b : JSAMPLE;
  end;

  bmp_dest_ptr = ^bmp_dest_struct;
  bmp_dest_struct = record
    outfile : TStream;              {Stream to write to}
    inmemory : boolean;             {keep whole image in memory}
    {image info}
    data_width : JDIMENSION;	    {JSAMPLEs per row}
    row_width : JDIMENSION;         {physical width of one row in the BMP file}
    pad_bytes : INT;                {number of padding bytes needed per row}
    grayscale : boolean;            {grayscale or quantized color table ?}
    {pixelrow buffer}
    buffer : JSAMPARRAY;            {pixelrow buffer}
    buffer_height : JDIMENSION;     {normally, we'll use 1}
    {image buffer}
    image_buffer : jvirt_sarray_ptr;{needed to reverse row order BMP<>JPG}
    image_buffer_height : JDIMENSION;  {}
    cur_output_row : JDIMENSION;    {next row# to write to virtual array}
    row_offset : INT32;             {position of next row to write to BMP}
  end;

procedure write_bmp_header (cinfo : j_decompress_ptr;
                             dest : bmp_dest_ptr);
  {Write a Windows-style BMP file header, including colormap if needed}
var
  bmpfileheader : TBitmapFileHeader;
  bmpinfoheader : TBitmapInfoHeader;
  headersize    : INT32;
  bits_per_pixel, cmap_entries, num_colors, i : INT;
  output_ext_color_map : array[0..255] of record b,g,r,a: byte; end;
begin
  {colormap size and total file size}
  if (cinfo^.out_color_space = JCS_RGB) then begin
    if (cinfo^.quantize_colors) then begin {colormapped RGB}
      bits_per_pixel := 8;
      cmap_entries := 256;
    end else begin {unquantized, full color RGB}
      bits_per_pixel := 24;
      cmap_entries := 0;
    end;
  end else begin {grayscale output. We need to fake a 256-entry colormap.}
    bits_per_pixel := 8;
    cmap_entries := 256;
  end;
  headersize := SizeOf(TBitmapFileHeader)+SizeOf(TBitmapInfoHeader)+
                  cmap_entries * 4;
  {define headers}
  FillChar(bmpfileheader, SizeOf(bmpfileheader), $0);
  FillChar(bmpinfoheader, SizeOf(bmpinfoheader), $0);
  with bmpfileheader do begin
    bfType := $4D42; {BM}
    bfSize := headersize + INT32(dest^.row_width) * INT32(cinfo^.output_height);
    bfOffBits := headersize;
  end;
  with bmpinfoheader do begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := cinfo^.output_width;
    biHeight := cinfo^.output_height;
    biPlanes := 1;
    biBitCount := bits_per_pixel;
    if (cinfo^.density_unit = 2) then begin
      biXPelsPerMeter := INT32(cinfo^.X_density*100);
      biYPelsPerMeter := INT32(cinfo^.Y_density*100);
    end;
    biClrUsed := cmap_entries;
  end;
  if dest^.outfile.Write(bmpfileheader, SizeOf(bmpfileheader))
       <> size_t(SizeOf(bmpfileheader)) then
    ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);
  if dest^.outfile.Write(bmpinfoheader, SizeOf(bmpinfoheader))
       <> size_t(SizeOf(bmpinfoheader)) then
    ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);
  {colormap}
  if cmap_entries > 0 then begin
    num_colors := cinfo^.actual_number_of_colors;
    if cinfo^.colormap <> nil then begin
      if cinfo^.out_color_components = 3 then
        for i := 0 to pred(num_colors) do
          with output_ext_color_map[i] do begin
            b := GETJSAMPLE(cinfo^.colormap^[2]^[i]);
            g := GETJSAMPLE(cinfo^.colormap^[1]^[i]);
            r := GETJSAMPLE(cinfo^.colormap^[0]^[i]);
            a := 0;
          end
      else
        {grayscale colormap (only happens with grayscale quantization)}
        for i := 0 to pred(num_colors) do
          with output_ext_color_map[i] do begin
            b := GETJSAMPLE(cinfo^.colormap^[0]^[i]);
            g := GETJSAMPLE(cinfo^.colormap^[0]^[i]);
            r := GETJSAMPLE(cinfo^.colormap^[0]^[i]);
            a := 0;
          end;
      i := num_colors;
    end else begin
      {if no colormap, must be grayscale data. Generate a linear "map".}
      {Nomssi: do not use "num_colors" here, it should be 0}
      for i := 0 to pred(256) do
        with output_ext_color_map[i] do begin
          b := i;
          g := i;
          r := i;