evbfileformatjpg.pas

很好的源代码

unit EvBFileFormatJPG;
{ File format filter for reading and writing JPEG (JPG) files }

interface

uses
  EvBGraphics, Classes, LibJPEG;

type
  TEvBJPGFileFormat = class(TEvBBitmapFileFormat)
  { File format filter for reading and writing JPEG (JPG) files.
    Uses version 6b of the IJG JPEG library }
  private
    procedure SetSource(var CInfo: jpeg_decompress_struct; const Stream: TStream);
    procedure SetDestination(var CInfo: jpeg_compress_struct; const Stream: TStream);
  public
    procedure ReadStream(const Stream: TStream); override;
    procedure WriteStream(const Stream: TStream); override;
  end;

implementation

uses
  SysUtils, Graphics;

const
  JPGMagic = #$FF#$D8#$FF#$E0;
  BufferSize = 8192;

type
  PCustomSource = ^TCustomSource;
  TCustomSource = record
    Manager: jpeg_source_mgr;
    Buffer: Pointer;
    Stream: TStream;
    StartOfStream: Boolean;
  end;

type
  PCustomDestination = ^TCustomDestination;
  TCustomDestination = record
    Manager: jpeg_destination_mgr;
    Buffer: Pointer;
    Stream: TStream;
  end;

{ Error handling }

procedure CustomErrorExit(CInfo: j_common_ptr); cdecl;
begin
  CInfo.err.output_message(CInfo);
end;

procedure CustomOutputMessage(CInfo: j_common_ptr); cdecl;
var
  S: String;
  FF: TEvBJPGFileFormat;
begin
  FF := CInfo.client_data;
  SetLength(S,1024);
  CInfo.err.format_message(CInfo,PChar(S));
  SetLength(S,StrLen(PChar(S)));
  FF.InternalError(S);
end;

{ Custom Source (JPEG reading) }

procedure CustomInitSource(var CInfo: jpeg_decompress_struct); cdecl;
var
  Source: PCustomSource;
begin
  Source := PCustomSource(CInfo.src);
  Source.StartOfStream := True;
end;

function CustomFillInputBuffer(var CInfo: jpeg_decompress_struct): Boolean; cdecl;
var
  Source: PCustomSource;
  P: PByte;
begin
  Source := PCustomSource(CInfo.src);
  Source.Manager.bytes_in_buffer := Source.Stream.Read(Source.Buffer^,BufferSize);
  if Source.Manager.bytes_in_buffer = 0 then begin
    if Source.StartOfStream then
      ERREXIT(j_common_ptr(@CInfo),JERR_INPUT_EMPTY);
    WARNMS(j_common_ptr(@CInfo),JWRN_JPEG_EOF);
    P := Source.Buffer;
    P^ := $FF;
    Inc(P);
    P^ := JPEG_EOI;
    Source.Manager.bytes_in_buffer := 2;
  end;
  Source.Manager.next_input_byte := Source.Buffer;
  Source.StartOfStream := False;
  Result := True;
end;

procedure CustomSkipInputData(var CInfo: jpeg_decompress_struct; num_bytes: long); cdecl;
var
  Source: PCustomSource;
begin
  if num_bytes > 0 then begin
    Source := PCustomSource(CInfo.src);
    while Cardinal(num_bytes) > Source.Manager.bytes_in_buffer do begin
      Dec(num_bytes,Source.Manager.bytes_in_buffer);
      CustomFillInputBuffer(CInfo);
    end;
    Inc(Source.Manager.next_input_byte,num_bytes);
    Dec(Source.Manager.bytes_in_buffer,num_bytes);
  end;
end;

procedure CustomTermSource(var CInfo: jpeg_decompress_struct); cdecl;
begin
  // Nothing special
end;

{ Custom Destination (JPEG writing) }

procedure CustomInitDestination(var CInfo: jpeg_compress_struct); cdecl;
var
  Destination: PCustomDestination;
begin
  Destination := PCustomDestination(CInfo.dest);
  Destination.Buffer := CInfo.mem.alloc_small(@CInfo,JPOOL_IMAGE,BufferSize);
  Destination.Manager.next_output_byte := Destination.Buffer;
  Destination.Manager.free_in_buffer := BufferSize;
end;

function CustomEmptyOutputBuffer(var CInfo: jpeg_compress_struct): Boolean; cdecl;
var
  Destination: PCustomDestination;
begin
  Destination := PCustomDestination(CInfo.dest);
  Destination.Manager.free_in_buffer :=
    Destination.Stream.Write(Destination.Buffer^,BufferSize);
  if Destination.Manager.free_in_buffer <> BufferSize then
    ERREXIT(@CInfo,JERR_FILE_WRITE);
  Destination.Manager.next_output_byte := Destination.Buffer;
  Result := True;
end;

procedure CustomTermDestination(var CInfo: jpeg_compress_struct); cdecl;
var
  Destination: PCustomDestination;
  BytesLeft, BytesWritten: Cardinal;
begin
  Destination := PCustomDestination(CInfo.dest);
  BytesLeft := BufferSize - Destination.Manager.free_in_buffer;
  if BytesLeft > 0 then begin
    BytesWritten := Destination.Stream.Write(Destination.Buffer^,BytesLeft);
    if BytesWritten <> BytesLeft then
      ERREXIT(@CInfo,JERR_FILE_WRITE);
  end;
end;

{ TEvBJPGFileFormat }

procedure TEvBJPGFileFormat.ReadStream(const Stream: TStream);
var
  CInfo: jpeg_decompress_struct;
  JErr: jpeg_error_mgr;
  X, Y: Integer;
  P: PEvBXYZ;
  B: Byte;
begin
  inherited;
  CInfo.client_data := Self;
  CInfo.Err := jpeg_std_error(@JErr);
  JErr.error_exit := CustomErrorExit;
  JErr.output_message := CustomOutputMessage;
  jpeg_create_decompress(CInfo);
  try
    SetSource(CInfo,Stream);
    jpeg_read_header(CInfo,True);
    if CInfo.data_precision <> 8 then
      InternalError('Only 8-bit image samples supported');
    if CInfo.out_color_space = JCS_RGB then
      Bitmap.PixelFormat := pf24Bit
    else if CInfo.out_color_space = JCS_GRAYSCALE then begin
      Bitmap.PixelFormat := pf8Bit;
      Bitmap.Palette := CreateGreyscalePalette;
    end else
      InternalError('Only RGB and grayscale output color spaces supported');

    jpeg_start_decompress(CInfo);
    Bitmap.Width := CInfo.output_width;
    Bitmap.Height := CInfo.output_height;
    for Y := 0 to CInfo.output_height - 1 do begin
      P := Bitmap.ScanLine[Y];
      jpeg_read_scanlines(CInfo,@P,1);
      if CInfo.out_color_space = JCS_RGB then
        // Convert RGB (JPEG) to BGR (Bitmap)
        for X := 0 to CInfo.output_width - 1 do begin
          B := P.X;
          P.X := P.Z;
          P.Z := B;
          Inc(P);
        end;
    end;
    jpeg_finish_decompress(CInfo);
  finally
    jpeg_destroy_decompress(CInfo);
  end;
end;

procedure TEvBJPGFileFormat.SetDestination(var CInfo: jpeg_compress_struct;
  const Stream: TStream);
var
  Destination: PCustomDestination;
begin
  Destination := CInfo.mem.alloc_small(@CInfo,JPOOL_IMAGE,SizeOf(TCustomDestination));
  CInfo.dest := pjpeg_destination_mgr(Destination);
  Destination.Stream := Stream;
  Destination.Manager.init_destination := CustomInitDestination;
  Destination.Manager.empty_output_buffer := CustomEmptyOutputBuffer;
  Destination.Manager.term_destination := CustomTermDestination;
end;

procedure TEvBJPGFileFormat.SetSource(var CInfo: jpeg_decompress_struct;
  const Stream: TStream);
var
  Source: PCustomSource;
begin
  Source := CInfo.mem.alloc_small(@CInfo,JPOOL_IMAGE,SizeOf(TCustomSource));
  CInfo.src := pjpeg_source_mgr(Source);
  Source.Buffer := CInfo.mem.alloc_small(@CInfo,JPOOL_IMAGE,BufferSize);
  Source.Stream := Stream;
  Source.Manager.init_source := CustomInitSource;
  Source.Manager.fill_input_buffer := CustomFillInputBuffer;
  Source.Manager.skip_input_data := CustomSkipInputData;
  Source.Manager.resync_to_restart := jpeg_resync_to_restart;
  Source.Manager.term_source := CustomTermSource;
  Source.Manager.bytes_in_buffer := 0;
  Source.Manager.next_input_byte := nil;
end;

procedure TEvBJPGFileFormat.WriteStream(const Stream: TStream);
var
  CInfo: jpeg_compress_struct;
  JErr: jpeg_error_mgr;
  X, Y: Integer;
  A: array of TEvBXYZ;
  P: PEvBXYZ;
  B: TBitmap;
begin
  inherited;
  if (Bitmap.PixelFormat = pf8Bit) and IsGreyscalePalette(Bitmap.Palette) then
    B := Bitmap
  else if Bitmap.PixelFormat = pf24Bit then
    B := Bitmap
  else
    B := CreateTrueColorBitmapCopy;

  CInfo.client_data := Self;
  CInfo.Err := jpeg_std_error(@JErr);
  JErr.error_exit := CustomErrorExit;
  JErr.output_message := CustomOutputMessage;
  jpeg_create_compress(CInfo);
  try
    SetDestination(CInfo,Stream);
    CInfo.image_width := B.Width;
    CInfo.image_height := B.Height;
    if B.PixelFormat = pf8Bit then begin
      CInfo.input_components := 1;
      CInfo.in_color_space := JCS_GRAYSCALE;
    end else begin
      CInfo.input_components := 3;
      CInfo.in_color_space := JCS_RGB;
    end;
    CInfo.data_precision := 8;
    jpeg_set_defaults(CInfo);
    CInfo.density_unit := 1; // DPI
    CInfo.dct_method := JDCT_FLOAT; // Best quality, reasonable speed
    CInfo.optimize_coding := True; // Smallest filesize
    jpeg_set_quality(CInfo,Quality,True);

    jpeg_start_compress(CInfo,True);
    if CInfo.in_color_space = JCS_RGB then
      SetLength(A,CInfo.image_width)
    else
      A := nil;
    for Y := 0 to CInfo.image_height - 1 do begin
      P := B.ScanLine[Y];
      if CInfo.in_color_space = JCS_GRAYSCALE then
        jpeg_write_scanlines(CInfo,@P,1)
      else begin
        for X := 0 to CInfo.image_width - 1 do begin
          // Convert BGR (Bitmap) to RGB (JPEG)
          A[X].X := P.Z;
          A[X].Y := P.Y;
          A[X].Z := P.X;
          Inc(P);
        end;
        P := @A[0];
        jpeg_write_scanlines(CInfo,@P,1)
      end;
    end;
    jpeg_finish_compress(CInfo);
  finally
    jpeg_destroy_compress(CInfo);
  end;
end;

initialization
  TEvBBitmap.RegisterFileFormat('JPEG','.jpg',JPGMagic,TEvBJPGFileFormat,True);

end.