wrbmp.pas

用pascal寫的jpeg codec, 測試過的

Unit wrbmp;

{ Copyright (C) 1994-1996, Thomas G. Lane.
  This code contributed by James Arthur Boucher.

  This file contains routines to write output images in Microsoft "BMP"
  format (MS Windows 3.x and OS/2 1.x flavors).
  Either 8-bit colormapped or 24-bit full-color format can be written.
  No compression is supported. }

interface

{$I jconfig.inc}

uses
  jmorecfg,
  jpeglib,
  jinclude,
  jdeferr,
  jerror,
  jdmaster,
  cdjpeg;		{ Common decls for cjpeg/djpeg applications }

{ The module selection routine for BMP format output. }

{GLOBAL}
function jinit_write_bmp (cinfo : j_decompress_ptr;
                          is_os2 : boolean) : djpeg_dest_ptr;

implementation

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

{$ifdef BITS_IN_JSAMPLE <> 8}
  Sorry, this code only copes with 8-bit JSAMPLEs. { deliberate syntax err }
{$endif}

{ Since BMP stores scanlines bottom-to-top, we have to invert the image
  from JPEG's top-to-bottom order.  To do this, we save the outgoing data
  in a virtual array during put_pixel_row calls, then actually emit the
  BMP file during finish_output.  The virtual array contains one JSAMPLE per
  pixel if the output is grayscale or colormapped, three if it is full color.}

{ Private version of data destination object }

type
  bmp_dest_ptr = ^bmp_dest_struct;
  bmp_dest_struct = record
    pub : djpeg_dest_struct;	{ public fields }

    is_os2 : boolean;           { saves the OS2 format request flag }

    whole_image : jvirt_sarray_ptr; { needed to reverse row order }
    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 }
    cur_output_row : JDIMENSION;    { next row# to write to virtual array }
  end;

{ Forward declarations }
{LOCAL}
procedure write_colormap(cinfo : j_decompress_ptr;
                         dest : bmp_dest_ptr;
                         map_colors : int;
                         map_entry_size : int); forward;

{ Write some pixel data.
  In this module rows_supplied will always be 1. }

{METHODDEF}
procedure put_pixel_rows (cinfo : j_decompress_ptr;
                          dinfo : djpeg_dest_ptr;
                          rows_supplied : JDIMENSION); far;
{ This version is for writing 24-bit pixels }
var
  dest : bmp_dest_ptr;
  image_ptr : JSAMPARRAY;
  {register} inptr : JSAMPLE_PTR;
             outptr : BGRptr;
  {register} col : JDIMENSION;
  pad : int;
begin
  dest := bmp_dest_ptr (dinfo);

  { Access next row in virtual array }
  image_ptr := cinfo^.mem^.access_virt_sarray
    (j_common_ptr(cinfo), dest^.whole_image,
     dest^.cur_output_row, JDIMENSION (1), TRUE);
  Inc(dest^.cur_output_row);


  { Transfer data.  Note destination values must be in BGR order
    (even though Microsoft's own documents say the opposite). }

  inptr := JSAMPLE_PTR(dest^.pub.buffer^[0]);
  outptr := BGRptr(image_ptr^[0]);
  for col := pred(cinfo^.output_width) downto 0 do
  begin
    outptr^.r := inptr^;	{ can omit GETJSAMPLE() safely }
    Inc(inptr);
    outptr^.g := inptr^;
    Inc(inptr);
    outptr^.b := inptr^;
    Inc(inptr);
    Inc(outptr);
  end;

  { Zero out the pad bytes. }
  pad := dest^.pad_bytes;
  while (pad > 0) do
  begin
    Dec(pad);
    JSAMPLE_PTR(outptr)^ := 0;
    Inc(JSAMPLE_PTR(outptr));
  end;
end;

{METHODDEF}
procedure put_gray_rows (cinfo : j_decompress_ptr;
                         dinfo : djpeg_dest_ptr;
	                 rows_supplied : JDIMENSION); far;
{ This version is for grayscale OR quantized color output }
var
  dest : bmp_dest_ptr;
  image_ptr : JSAMPARRAY;
  {register} inptr, outptr : JSAMPLE_PTR;
  {register} col : JDIMENSION;
  pad : int;
begin
  dest := bmp_dest_ptr (dinfo);

  { Access next row in virtual array }
  image_ptr := cinfo^.mem^.access_virt_sarray
    (j_common_ptr(cinfo), dest^.whole_image,
     dest^.cur_output_row, JDIMENSION (1), TRUE);
  Inc(dest^.cur_output_row);

  { Transfer data. }
  inptr := JSAMPLE_PTR(dest^.pub.buffer^[0]);
  outptr := JSAMPLE_PTR(image_ptr^[0]);
  for col := pred(cinfo^.output_width) downto 0 do
  begin
    outptr^ := inptr^;	{ can omit GETJSAMPLE() safely }
    Inc(outptr);
    Inc(inptr);
  end;

  { Zero out the pad bytes. }
  pad := dest^.pad_bytes;
  while (pad > 0) do
  begin
    Dec(pad);
    outptr^ := 0;
    Inc(outptr);
  end;
end;


{ Startup: normally writes the file header.
  In this module we may as well postpone everything until finish_output. }

{METHODDEF}
procedure start_output_bmp (cinfo : j_decompress_ptr;
                            dinfo : djpeg_dest_ptr); far;
begin
  { no work here }
end;


{ Finish up at the end of the file.

  Here is where we really output the BMP file.

  First, routines to write the Windows and OS/2 variants of the file header. }


{LOCAL}
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 : packed array[0..14-1] of byte;
  bmpinfoheader : packed array[0..40-1] of byte;
var
  headersize, bfSize : INT32 ;
  bits_per_pixel, cmap_entries : int;
begin
  { Compute 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;
  { File size }
  headersize := 14 + 40 + cmap_entries * 4; { Header and colormap }
  bfSize := headersize + INT32 (dest^.row_width) * INT32 (cinfo^.output_height);

  { Set unused fields of header to 0 }
  MEMZERO(@bmpfileheader, SIZEOF(bmpfileheader));
  MEMZERO(@bmpinfoheader, SIZEOF(bmpinfoheader));

  { Fill the file header }
  bmpfileheader[0] := $42;	{ first 2 bytes are ASCII 'B', 'M' }
  bmpfileheader[1] := $4D;
  {PUT_4B(bmpfileheader, 2, bfSize);} { bfSize }
	 bmpfileheader[2] := byte ((bfSize) and $FF);
	 bmpfileheader[2+1] := byte (((bfSize) shr 8) and $FF);
	 bmpfileheader[2+2] := byte (((bfSize) shr 16) and $FF);
	 bmpfileheader[2+3] := byte (((bfSize) shr 24) and $FF);
  { we leave bfReserved1 & bfReserved2 = 0 }
  {PUT_4B(bmpfileheader, 10, headersize);} { bfOffBits }
	 bmpfileheader[10] := byte (headersize and $FF);
	 bmpfileheader[10+1] := byte ((headersize shr 8) and $FF);
	 bmpfileheader[10+2] := byte ((headersize shr 16) and $FF);
	 bmpfileheader[10+3] := byte ((headersize shr 24) and $FF);

  { Fill the info header (Microsoft calls this a BITMAPINFOHEADER) }
  {PUT_2B(bmpinfoheader, 0, 40);}   { biSize }
	 bmpinfoheader[0] := byte ((40) and $FF);
	 bmpinfoheader[0+1] := byte (((40) shr 8) and $FF);

  {PUT_4B(bmpinfoheader, 4, cinfo^.output_width);} { biWidth }
         bmpinfoheader[4] := byte ((cinfo^.output_width) and $FF);
         bmpinfoheader[4+1] := byte ((cinfo^.output_width shr 8) and $FF);
         bmpinfoheader[4+2] := byte ((cinfo^.output_width shr 16) and $FF);
         bmpinfoheader[4+3] := byte ((cinfo^.output_width shr 24) and $FF);
  {PUT_4B(bmpinfoheader, 8, cinfo^.output_height);} { biHeight }
         bmpinfoheader[8] := byte (cinfo^.output_height and $FF);
         bmpinfoheader[8+1] := byte ((cinfo^.output_height shr 8) and $FF);
         bmpinfoheader[8+2] := byte ((cinfo^.output_height shr 16) and $FF);
         bmpinfoheader[8+3] := byte ((cinfo^.output_height shr 24) and $FF);
  {PUT_2B(bmpinfoheader, 12, 1);}	{ biPlanes - must be 1 }
         bmpinfoheader[12] := byte (1 and $FF);
         bmpinfoheader[12+1] := byte ((1 shr 8) and $FF);

  {PUT_2B(bmpinfoheader, 14, bits_per_pixel);} { biBitCount }
         bmpinfoheader[14] := byte (bits_per_pixel and $FF);
         bmpinfoheader[14+1] := byte ((bits_per_pixel shr 8) and $FF);
  { we leave biCompression = 0, for none }
  { we leave biSizeImage = 0; this is correct for uncompressed data }
  if (cinfo^.density_unit = 2) then
  begin { if have density in dots/cm, then }
    {PUT_4B(bmpinfoheader, 24, INT32 (cinfo^.X_density*100));} { XPels/M }
         bmpinfoheader[24] := byte (INT32 (cinfo^.X_density*100) and $FF);
         bmpinfoheader[24+1] := byte ((INT32 (cinfo^.X_density*100) shr 8) and $FF);
         bmpinfoheader[24+2] := byte ((INT32 (cinfo^.X_density*100) shr 16) and $FF);
         bmpinfoheader[24+3] := byte ((INT32 (cinfo^.X_density*100) shr 24) and $FF);
    {PUT_4B(bmpinfoheader, 28, INT32 (cinfo^.Y_density*100));} { XPels/M }
         bmpinfoheader[28] := byte (INT32 (cinfo^.Y_density*100) and $FF);
         bmpinfoheader[28+1] := byte ((INT32 (cinfo^.Y_density*100) shr 8) and $FF);
         bmpinfoheader[28+2] := byte ((INT32 (cinfo^.Y_density*100) shr 16) and $FF);
         bmpinfoheader[28+3] := byte ((INT32 (cinfo^.Y_density*100) shr 24) and $FF);
  end;
  {PUT_2B(bmpinfoheader, 32, cmap_entries);} { biClrUsed }
         bmpinfoheader[32] := byte (cmap_entries and $FF);
         bmpinfoheader[32+1] := byte ((cmap_entries shr 8) and $FF);
  { we leave biClrImportant := 0 }

  if (JFWRITE(dest^.pub.output_file^, @bmpfileheader, 14) <> size_t (14)) then
    ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);
  if (JFWRITE(dest^.pub.output_file^, @bmpinfoheader, 40) <> size_t (40)) then
    ERREXIT(j_common_ptr(cinfo), JERR_FILE_WRITE);

  if (cmap_entries > 0) then
    write_colormap(cinfo, dest, cmap_entries, 4);
end;


{LOCAL}
procedure write_os2_header (cinfo : j_decompress_ptr;
                            dest : bmp_dest_ptr);
{ Write an OS2-style BMP file header, including colormap if needed }
var
  bmpfileheader : array[0..14-1] of byte;
  bmpcoreheader : array[0..12-1] of byte;
  headersize, bfSize : INT32;
  bits_per_pixel, cmap_entries : int;
begin
  { Compute 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