cjpeg.pas

用pascal寫的jpeg codec, 測試過的

            cinfo^.optimize_coding := TRUE;
      {$else}
            WriteLn(output, progname, ': sorry, entropy optimization was not compiled');
            exit(EXIT_FAILURE);
      {$endif}

          end
          else
            if (keymatch(arg, '-outfile', 5)) then
            begin
              { Set output file name. }
              Inc(argn);
              if (argn >= argc) then	{ advance to next argument }
	        usage;
              outfilename := ParamStr(argn);	{ save it away for later use }

            end
            else
              if (keymatch(arg, '-progressive', 2)) then
              begin
                { Select simple progressive mode. }
          {$ifdef C_PROGRESSIVE_SUPPORTED}
                simple_progressive := TRUE;
                { We must postpone execution until num_components is known. }
          {$else}
                WriteLn(output, progname, ': sorry, progressive output was not compiled');
                Halt(EXIT_FAILURE);
          {$endif}

              end
              else
                if (keymatch(arg, '-quality', 2)) then
                begin
                  { Quality factor (quantization table scaling factor). }
                  Inc(argn);
                  if (argn >= argc) then	{ advance to next argument }
	            usage;
                  Val(ParamStr(argn), quality, code);
                  if code <> 0 then
	            usage;

                  { Change scale factor in case -qtables is present. }
                  q_scale_factor := jpeg_quality_scaling(quality);

                end
                else
                  if (keymatch(arg, '-qslots', 3)) then
                  begin
                    { Quantization table slot numbers. }
                    Inc(argn);
                    if (argn >= argc) then	{ advance to next argument }
	              usage;
                    qslotsarg := ParamStr(argn);
                    { Must delay setting qslots until after we have processed any
                      colorspace-determining switches, since jpeg_set_colorspace sets
                      default quant table numbers. }

                  end
                  else
                    if (keymatch(arg, '-qtables', 3)) then
                    begin
                      { Quantization tables fetched from file. }
                      Inc(argn);
                      if (argn >= argc) then	{ advance to next argument }
	                usage;
                      qtablefile := ParamStr(argn);
                      { We postpone actually reading the file in case -quality comes later. }

                    end
                    else
                      if (keymatch(arg, '-restart', 2)) then
                      begin
                        { Restart interval in MCU rows (or in MCUs with 'b'). }
                        ch := 'x';

                        Inc(argn);
                        if (argn >= argc) then	{ advance to next argument }
	                  usage;

                        WriteLn(output, 'Restart intervall is not translated yet.');
                        usage;
                        {if (sscanf(ParamStr(argn), '%ld%c', @lval, @ch) < 1) then
	                  usage;
                        if (lval < 0) or (lval > long(65535)) then
	                  usage;
                        }

                        if (ch = 'b') or (ch = 'B') then
                        begin
	                  cinfo^.restart_interval := uInt (lval);
	                  cinfo^.restart_in_rows := 0; { else prior '-restart n' overrides me }
                        end
                        else
                        begin
	                  cinfo^.restart_in_rows := int (lval);
	                  { restart_interval will be computed during startup }
                        end;

                      end
                      else
                        if (keymatch(arg, '-sample', 3)) then
                        begin
                          { Set sampling factors. }
                          Inc(argn);
                          if (argn >= argc) then	{ advance to next argument }
	                    usage;
                          samplearg := ParamStr(argn);
                          { Must delay setting sample factors until after we have processed any
                            colorspace-determining switches, since jpeg_set_colorspace sets
                            default sampling factors. }

                        end
                        else
                          if (keymatch(arg, 'scans', 2)) then
                          begin
                            { Set scan script. }
                      {$ifdef C_MULTISCAN_FILES_SUPPORTED}
                            Inc(argn);
                            if (argn >= argc) then	{ advance to next argument }
	                      usage;
                            scansarg := ParamStr(argn);
                            { We must postpone reading the file in case -progressive appears. }
                      {$else}
                            WriteLn(output, progname, ': sorry, multi-scan output was not compiled');
                            exit(EXIT_FAILURE);
                      {$endif}

                          end
                          else
                            if (keymatch(arg, '-smooth', 3)) then
                            begin
                              { Set input smoothing factor. }

                              Inc(argn);
                              if (argn >= argc) then	{ advance to next argument }
	                        usage;
                              Val(ParamStr(argn), value, code);
                              if (value < 0) or (value > 100)
                                 or (code <> 0) then
	                        usage;
                              cinfo^.smoothing_factor := value;

                            end
                            else
                              if (keymatch(arg, '-targa', 2)) then
                              begin
                                { Input file is Targa format. }
                                is_targa := TRUE;

                              end
                              else
                              begin
                                usage;			{ bogus switch }
                              end;
  end;

  { Post-switch-scanning cleanup }

  if (for_real) then
  begin

    { Set quantization tables for selected quality. }
    { Some or all may be overridden if -qtables is present. }
    jpeg_set_quality(cinfo, quality, force_baseline);

{$IFDEF EXT_SWITCH}
    if (qtablefile <> '') then	{ process -qtables if it was present }
      if (not read_quant_tables(cinfo, qtablefile,
			      q_scale_factor, force_baseline)) then
	usage;

    if (qslotsarg <> '') then	{ process -qslots if it was present }
      if (not set_quant_slots(cinfo, qslotsarg)) then
	usage;

    if (samplearg <> '') then	{ process -sample if it was present }
      if (not set_sample_factors(cinfo, samplearg)) then
	usage;
{$ENDIF}

{$ifdef C_PROGRESSIVE_SUPPORTED}
    if (simple_progressive) then	{ process -progressive; -scans can override }
      jpeg_simple_progression(cinfo);
{$endif}

{$IFDEF EXT_SWITCH}
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
    if (scansarg <> '') then	{ process -scans if it was present }
      if (not read_scan_script(cinfo, scansarg)) then
	usage;
{$endif}
{$ENDIF}
  end;

  parse_switches := argn;	{ return index of next arg (file name) }
end;


{ The main program. }

var
  cinfo : jpeg_compress_struct;
  jerr : jpeg_error_mgr;
{$ifdef PROGRESS_REPORT}
  progress : cdjpeg_progress_mgr;
{$endif}
  file_index : int;
  src_mgr : cjpeg_source_ptr;
  input_file : FILE;
  output_file : FILE;
  num_scanlines : JDIMENSION;
var
  argc : int;
begin
  argc := ParamCount;

  progname := ParamStr(0);

  { Initialize the JPEG compression object with default error handling. }
  cinfo.err := jpeg_std_error(jerr);
  jpeg_create_compress(@cinfo);
  { Add some application-specific error messages (from cderror.h) }
  {jerr.addon_message_table := cdjpeg_message_table;}
  jerr.first_addon_message := JMSG_FIRSTADDONCODE;
  jerr.last_addon_message := JMSG_LASTADDONCODE;

  { Now safe to enable signal catcher. }
{$ifdef NEED_SIGNAL_CATCHER}
  enable_signal_catcher(j_common_ptr ( @cinfo);
{$endif}

  { Initialize JPEG parameters.
    Much of this may be overridden later.
    In particular, we don't yet know the input file's color space,
    but we need to provide some value for jpeg_set_defaults() to work. }


  cinfo.in_color_space := JCS_RGB; { arbitrary guess }
  jpeg_set_defaults(@cinfo);

  { Scan command line to find file names.
    It is convenient to use just one switch-parsing routine, but the switch
    values read here are ignored; we will rescan the switches after opening
    the input file. }


  file_index := parse_switches(@cinfo, 0, FALSE);

{$ifdef TWO_FILE_COMMANDLINE}
  { Must have either -outfile switch or explicit output file name }
  if (outfilename = '') then
  begin
    if (file_index <> argc-2+1) then
    begin
      WriteLn(output, progname, ': must name one input and one output file');
      usage;
    end;
    outfilename := ParamStr(file_index+1);
  end
  else
  begin
    if (file_index <> argc-1) then
    begin
      WriteLn(output, progname, ': must name one input and one output file');
      usage;
    end;
  end;
{$else}
  { Unix style: expect zero or one file name }
  if (file_index < argc-1) then
  begin
    WriteLn(output, progname, ': only one input file');
    usage;
  end;
{$endif} { TWO_FILE_COMMANDLINE }

  { Open the input file. }
  if (file_index < argc) then
  begin
    Assign(input_file, ParamStr(file_index));
    {$I-}
    Reset(input_file, 1);
    {$ifdef IOcheck} {$I+} {$endif}
    if (IOresult <> 0) then
    begin
      WriteLn(output, progname, ': can''t open ', ParamStr(file_index));
      Halt(EXIT_FAILURE);
    end;
  end
  else
  begin
    WriteLn(output, progname, ': no input file');
    Halt(EXIT_FAILURE);
  end;

  { Open the output file. }
  if (outfilename <> '') then
  begin
    Assign(output_file, outfilename);
    {$I-}
    Reset(output_file, 1);
    {$ifdef IOcheck} {$I+} {$endif}
    if (IOresult = 0) then
    begin
      WriteLn(output, outfilename, ':  already exists.');
      close(output_file);
      Halt(EXIT_FAILURE);
    end;

    {$I-}
    ReWrite(output_file, 1);
    {$ifdef IOcheck} {$I+} {$endif}
    if (IOresult <> 0) then
    begin
      WriteLn(output, progname, ': can''t create ', outfilename);
      Halt(EXIT_FAILURE);
    end;
  end
  else
  begin
    WriteLn(output, progname, ': no output file');
    Halt(EXIT_FAILURE);
  end;

{$ifdef PROGRESS_REPORT}
  start_progress_monitor(j_common_ptr ( @cinfo, @progress);
{$endif}

  { Figure out the input file format, and set up to read it. }
  src_mgr := select_file_type(@cinfo, input_file);
  src_mgr^.input_file := @input_file;

  { Read the input file header to obtain file size & colorspace. }
  src_mgr^.start_input (@cinfo, src_mgr);

  { Now that we know input colorspace, fix colorspace-dependent defaults }
  jpeg_default_colorspace(@cinfo);

  { Adjust default compression parameters by re-parsing the options }
  file_index := parse_switches(@cinfo, 0, TRUE);

  { Specify data destination for compression }
  jpeg_stdio_dest(@cinfo, output_file);

  { Start compressor }
  jpeg_start_compress(@cinfo, TRUE);

  { Process data }
  while (cinfo.next_scanline < cinfo.image_height) do
  begin
    num_scanlines := src_mgr^.get_pixel_rows (@cinfo, src_mgr);
    {void} jpeg_write_scanlines(@cinfo, src_mgr^.buffer, num_scanlines);
  end;

  { Finish compression and release memory }
  src_mgr^.finish_input (@cinfo, src_mgr);
  jpeg_finish_compress(@cinfo);
  jpeg_destroy_compress(@cinfo);

  { Close files, if we opened them }
  close(input_file);
  close(output_file);

{$ifdef PROGRESS_REPORT}
  end_progress_monitor(j_common_ptr (@cinfo));
{$endif}

  { All done. }
  if jerr.num_warnings <> 0 then
    Halt(EXIT_WARNING)
  else
    Halt(EXIT_SUCCESS);
end.