jcparam.pas

用pascal寫的jpeg codec, 測試過的

  { Set up two quantization tables using default quality of 75 }
  jpeg_set_quality(cinfo, 75, TRUE);
  { Set up two Huffman tables }
  std_huff_tables(cinfo);

  { Initialize default arithmetic coding conditioning }
  for i := 0 to pred(NUM_ARITH_TBLS) do
  begin
    cinfo^.arith_dc_L[i] := 0;
    cinfo^.arith_dc_U[i] := 1;
    cinfo^.arith_ac_K[i] := 5;
  end;

  { Default is no multiple-scan output }
  cinfo^.scan_info := NIL;
  cinfo^.num_scans := 0;

  { Expect normal source image, not raw downsampled data }
  cinfo^.raw_data_in := FALSE;

  { Use Huffman coding, not arithmetic coding, by default }
  cinfo^.arith_code := FALSE;

  { By default, don't do extra passes to optimize entropy coding }
  cinfo^.optimize_coding := FALSE;
  { The standard Huffman tables are only valid for 8-bit data precision.
    If the precision is higher, force optimization on so that usable
    tables will be computed.  This test can be removed if default tables
    are supplied that are valid for the desired precision. }

  if (cinfo^.data_precision > 8) then
    cinfo^.optimize_coding := TRUE;

  { By default, use the simpler non-cosited sampling alignment }
  cinfo^.CCIR601_sampling := FALSE;

  { No input smoothing }
  cinfo^.smoothing_factor := 0;

  { DCT algorithm preference }
  cinfo^.dct_method := JDCT_DEFAULT;

  { No restart markers }
  cinfo^.restart_interval := 0;
  cinfo^.restart_in_rows := 0;

  { Fill in default JFIF marker parameters.  Note that whether the marker
    will actually be written is determined by jpeg_set_colorspace. }

  cinfo^.density_unit := 0;	{ Pixel size is unknown by default }
  cinfo^.X_density := 1;		{ Pixel aspect ratio is square by default }
  cinfo^.Y_density := 1;

  { Choose JPEG colorspace based on input space, set defaults accordingly }

  jpeg_default_colorspace(cinfo);
end;


{ Select an appropriate JPEG colorspace for in_color_space. }

{GLOBAL}
procedure jpeg_default_colorspace (cinfo : j_compress_ptr);
begin
  case (cinfo^.in_color_space) of
  JCS_GRAYSCALE:
    jpeg_set_colorspace(cinfo, JCS_GRAYSCALE);
  JCS_RGB:
    jpeg_set_colorspace(cinfo, JCS_YCbCr);
  JCS_YCbCr:
    jpeg_set_colorspace(cinfo, JCS_YCbCr);
  JCS_CMYK:
    jpeg_set_colorspace(cinfo, JCS_CMYK); { By default, no translation }
  JCS_YCCK:
    jpeg_set_colorspace(cinfo, JCS_YCCK);
  JCS_UNKNOWN:
    jpeg_set_colorspace(cinfo, JCS_UNKNOWN);
  else
    ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
  end;
end;


{ Set the JPEG colorspace, and choose colorspace-dependent default values. }

{GLOBAL}
procedure jpeg_set_colorspace (cinfo : j_compress_ptr;
                               colorspace : J_COLOR_SPACE);
  { macro }
  procedure SET_COMP(index,id,hsamp,vsamp,quant,dctbl,actbl : int);
  begin
    with jpeg_component_info_list_ptr(cinfo^.comp_info)^[index] do
    begin
      component_id := (id);
      h_samp_factor := (hsamp);
      v_samp_factor := (vsamp);
      quant_tbl_no := (quant);
      dc_tbl_no := (dctbl);
      ac_tbl_no := (actbl);
    end;
  end;

var
  ci : int;
begin
  { Safety check to ensure start_compress not called yet. }
  if (cinfo^.global_state <> CSTATE_START) then
    ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);

  { For all colorspaces, we use Q and Huff tables 0 for luminance components,
    tables 1 for chrominance components. }

  cinfo^.jpeg_color_space := colorspace;

  cinfo^.write_JFIF_header := FALSE; { No marker for non-JFIF colorspaces }
  cinfo^.write_Adobe_marker := FALSE; { write no Adobe marker by default }

  case (colorspace) of
  JCS_GRAYSCALE:
    begin
      cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker }
      cinfo^.num_components := 1;
      { JFIF specifies component ID 1 }
      SET_COMP(0, 1, 1,1, 0, 0,0);
    end;
  JCS_RGB:
    begin
      cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag RGB }
      cinfo^.num_components := 3;
      SET_COMP(0, $52 { 'R' }, 1,1, 0, 0,0);
      SET_COMP(1, $47 { 'G' }, 1,1, 0, 0,0);
      SET_COMP(2, $42 { 'B' }, 1,1, 0, 0,0);
    end;
  JCS_YCbCr:
    begin
      cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker }
      cinfo^.num_components := 3;
      { JFIF specifies component IDs 1,2,3 }
      { We default to 2x2 subsamples of chrominance }
      SET_COMP(0, 1, 2,2, 0, 0,0);
      SET_COMP(1, 2, 1,1, 1, 1,1);
      SET_COMP(2, 3, 1,1, 1, 1,1);
    end;
  JCS_CMYK:
    begin
      cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag CMYK }
      cinfo^.num_components := 4;
      SET_COMP(0, $43 { 'C' }, 1,1, 0, 0,0);
      SET_COMP(1, $4D { 'M' }, 1,1, 0, 0,0);
      SET_COMP(2, $59 { 'Y' }, 1,1, 0, 0,0);
      SET_COMP(3, $4B { 'K' }, 1,1, 0, 0,0);
    end;
  JCS_YCCK:
    begin
      cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag YCCK }
      cinfo^.num_components := 4;
      SET_COMP(0, 1, 2,2, 0, 0,0);
      SET_COMP(1, 2, 1,1, 1, 1,1);
      SET_COMP(2, 3, 1,1, 1, 1,1);
      SET_COMP(3, 4, 2,2, 0, 0,0);
    end;
  JCS_UNKNOWN:
    begin
      cinfo^.num_components := cinfo^.input_components;
      if (cinfo^.num_components < 1)
      or (cinfo^.num_components > MAX_COMPONENTS) then
        ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT,
                 cinfo^.num_components, MAX_COMPONENTS);
      for ci := 0 to pred(cinfo^.num_components) do
      begin
        SET_COMP(ci, ci, 1,1, 0, 0,0);
      end;
    end;
  else
    ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
  end;
end;


{$ifdef C_PROGRESSIVE_SUPPORTED}

{LOCAL}
function fill_a_scan (scanptr : jpeg_scan_info_ptr;
                      ci : int; Ss : int;
                      Se : int; Ah : int;
                      Al : int) : jpeg_scan_info_ptr;
{ Support routine: generate one scan for specified component }
begin
  scanptr^.comps_in_scan := 1;
  scanptr^.component_index[0] := ci;
  scanptr^.Ss := Ss;
  scanptr^.Se := Se;
  scanptr^.Ah := Ah;
  scanptr^.Al := Al;
  Inc(scanptr);
  fill_a_scan := scanptr;
end;

{LOCAL}
function fill_scans (scanptr : jpeg_scan_info_ptr;
                     ncomps : int;
	             Ss : int; Se : int;
                     Ah : int; Al : int) : jpeg_scan_info_ptr;
{ Support routine: generate one scan for each component }
var
  ci : int;
begin

  for ci := 0 to pred(ncomps) do
  begin
    scanptr^.comps_in_scan := 1;
    scanptr^.component_index[0] := ci;
    scanptr^.Ss := Ss;
    scanptr^.Se := Se;
    scanptr^.Ah := Ah;
    scanptr^.Al := Al;
    Inc(scanptr);
  end;
  fill_scans := scanptr;
end;

{LOCAL}
function fill_dc_scans (scanptr : jpeg_scan_info_ptr;
                        ncomps : int;
                        Ah : int; Al : int) : jpeg_scan_info_ptr;
{ Support routine: generate interleaved DC scan if possible, else N scans }
var
  ci : int;
begin

  if (ncomps <= MAX_COMPS_IN_SCAN) then
  begin
    { Single interleaved DC scan }
    scanptr^.comps_in_scan := ncomps;
    for ci := 0 to pred(ncomps) do
      scanptr^.component_index[ci] := ci;
    scanptr^.Ss := 0;
    scanptr^.Se := 0;
    scanptr^.Ah := Ah;
    scanptr^.Al := Al;
    Inc(scanptr);
  end
  else
  begin
    { Noninterleaved DC scan for each component }
    scanptr := fill_scans(scanptr, ncomps, 0, 0, Ah, Al);
  end;
  fill_dc_scans := scanptr;
end;


{ Create a recommended progressive-JPEG script.
  cinfo^.num_components and cinfo^.jpeg_color_space must be correct. }

{GLOBAL}
procedure jpeg_simple_progression (cinfo : j_compress_ptr);
var
  ncomps : int;
  nscans : int;
  scanptr : jpeg_scan_info_ptr;
begin
  ncomps := cinfo^.num_components;

  { Safety check to ensure start_compress not called yet. }
  if (cinfo^.global_state <> CSTATE_START) then
    ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);

  { Figure space needed for script.  Calculation must match code below! }
  if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then
  begin
    { Custom script for YCbCr color images. }
    nscans := 10;
  end
  else
  begin
    { All-purpose script for other color spaces. }
    if (ncomps > MAX_COMPS_IN_SCAN) then
      nscans := 6 * ncomps	{ 2 DC + 4 AC scans per component }
    else
      nscans := 2 + 4 * ncomps;	{ 2 DC scans; 4 AC scans per component }
  end;

  { Allocate space for script. }
  { We use permanent pool just in case application re-uses script. }
  scanptr := jpeg_scan_info_ptr(
    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
				nscans * SIZEOF(jpeg_scan_info)) );
  cinfo^.scan_info := scanptr;
  cinfo^.num_scans := nscans;

  if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then
  begin
    { Custom script for YCbCr color images. }
    { Initial DC scan }
    scanptr := fill_dc_scans(scanptr, ncomps, 0, 1);
    { Initial AC scan: get some luma data out in a hurry }
    scanptr := fill_a_scan(scanptr, 0, 1, 5, 0, 2);
    { Chroma data is too small to be worth expending many scans on }
    scanptr := fill_a_scan(scanptr, 2, 1, 63, 0, 1);
    scanptr := fill_a_scan(scanptr, 1, 1, 63, 0, 1);
    { Complete spectral selection for luma AC }
    scanptr := fill_a_scan(scanptr, 0, 6, 63, 0, 2);
    { Refine next bit of luma AC }
    scanptr := fill_a_scan(scanptr, 0, 1, 63, 2, 1);
    { Finish DC successive approximation }
    scanptr := fill_dc_scans(scanptr, ncomps, 1, 0);
    { Finish AC successive approximation }
    scanptr := fill_a_scan(scanptr, 2, 1, 63, 1, 0);
    scanptr := fill_a_scan(scanptr, 1, 1, 63, 1, 0);
    { Luma bottom bit comes last since it's usually largest scan }
    scanptr := fill_a_scan(scanptr, 0, 1, 63, 1, 0);
  end
  else
  begin
    { All-purpose script for other color spaces. }
    { Successive approximation first pass }
    scanptr := fill_dc_scans(scanptr, ncomps, 0, 1);
    scanptr := fill_scans(scanptr, ncomps, 1, 5, 0, 2);
    scanptr := fill_scans(scanptr, ncomps, 6, 63, 0, 2);
    { Successive approximation second pass }
    scanptr := fill_scans(scanptr, ncomps, 1, 63, 2, 1);
    { Successive approximation final pass }
    scanptr := fill_dc_scans(scanptr, ncomps, 1, 0);
    scanptr := fill_scans(scanptr, ncomps, 1, 63, 1, 0);
  end;
end;

{$endif}
end.