evbfileformatjp2.pas

很好的源代码

unit EvBFileFormatJP2;
{ File format filter for reading and writing JPEG-2000 (JP2) files }

interface

uses
  EvBGraphics, Classes, LibJasper;

type
  TEvBJP2FileFormat = class(TEvBBitmapFileFormat)
  { File format filter for reading and writing JPEG-2000 (JP2) files
    Uses version 1.701.0 of the JasPer JPEG-2000 library }
  private
    FBuffer: Pointer;
    procedure InitJP2Stream(out JP2Stream: jas_stream_t);
  public
    destructor Destroy; override;
    procedure ReadStream(const Stream: TStream); override;
    procedure WriteStream(const Stream: TStream); override;
  end;

implementation

uses
  Windows, Graphics, SysUtils;

const
  JP2Magic = 'jP  ';
  BufferSize = 8192;

function JP2Read(obj: pjas_stream_obj_t; buf: pchar; cnt: int): int; cdecl;
begin
  Result := TStream(obj).Read(buf^,cnt);
end;

function JP2Write(obj: pjas_stream_obj_t; buf: pchar; cnt: int): int; cdecl;
begin
  Result := TStream(obj).Write(buf^,cnt);
end;

function JP2Seek(obj: pjas_stream_obj_t; offset: long; origin: int): long; cdecl;
begin
  Result := TStream(obj).Seek(offset,origin);
end;

function JP2Close(obj: pjas_stream_obj_t): int; cdecl;
begin
  Result := 0;
end;

{ TEvBJP2FileFormat }

destructor TEvBJP2FileFormat.Destroy;
begin
  FreeMem(FBuffer);
  inherited;
end;

procedure TEvBJP2FileFormat.InitJP2Stream(out JP2Stream: jas_stream_t);
const
  StreamOperators: jas_stream_ops_t = (
    read_: JP2Read;
    write_: JP2Write;
    seek_: JP2Seek;
    close_: JP2Close);
begin
  FillChar(JP2Stream,SizeOf(JP2Stream),0);
  if FBuffer = nil then
    GetMem(FBuffer,BufferSize + JAS_STREAM_MAXPUTBACK);
  JP2Stream.rwlimit_ := -1;
  JP2Stream.obj_ := Stream;
  JP2Stream.ops_ := @StreamOperators;
  JP2Stream.openmode_ := JAS_STREAM_READ or JAS_STREAM_WRITE or JAS_STREAM_BINARY;
  JP2Stream.bufbase_ := FBuffer;
  JP2Stream.bufsize_ := BufferSize;
  JP2Stream.bufstart_ := FBuffer;
  Inc(JP2Stream.bufstart_,JAS_STREAM_MAXPUTBACK);
  JP2Stream.ptr_ := JP2Stream.bufstart_;
  JP2Stream.bufmode_ := JAS_STREAM_FULLBUF and JAS_STREAM_BUFMODEMASK;
end;

procedure TEvBJP2FileFormat.ReadStream(const Stream: TStream);
var
  JP2Stream: jas_stream_t;
  JP2Image: pjas_image_t;
  Channels: array [0..2] of pjas_matrix_t;
  I, W, H, X, Y: Integer;
  S0, S1, S2: pjas_seqent_t;
  D: PByte;
begin
  inherited;

  for I := 0 to 2 do
    Channels[I] := nil;
  JP2Image := nil;

  jas_init;
  InitJP2Stream(JP2Stream);
  try
    JP2Image := jas_image_decode(JP2Stream,-1,nil);
    if JP2Image = nil then
      InternalError('Unable to decode image');
    if JP2Image.numcmpts_ = 1 then begin
      Bitmap.PixelFormat := pf8Bit;
      Bitmap.Palette := CreateGreyscalePalette;
    end else if JP2Image.numcmpts_ = 3 then
      Bitmap.PixelFormat := pf24Bit
    else
      InternalError('Only RGB and grayscale output color spaces supported');

    W := JP2Image.brx_ - JP2Image.tlx_;
    H := JP2Image.bry_ - JP2Image.tly_;
    Bitmap.Width := W;
    Bitmap.Height := H;

    for I := 0 to JP2Image.numcmpts_ - 1 do begin
      Channels[I] := jas_matrix_create(1,W);
      if Channels[I] = nil then
        InternalError('Unable to allocate image data');
    end;

    if JP2Image.numcmpts_ = 1 then
      for Y := 0 to H - 1 do begin
        jas_image_readcmpt(JP2Image,0,0,Y,W,1,Channels[0]);
        S0 := Channels[0].rows_^;
        D := Bitmap.ScanLine[Y];
        for X := 0 to W - 1 do begin
          D^ := S0^;
          Inc(D);
          Inc(S0);
        end;
      end
    else
      for Y := 0 to H - 1 do begin
        for I := 0 to 2 do
          jas_image_readcmpt(JP2Image,I,0,Y,W,1,Channels[I]);
        S0 := Channels[0].rows_^;
        S1 := Channels[1].rows_^;
        S2 := Channels[2].rows_^;
        D := Bitmap.ScanLine[Y];
        for X := 0 to W - 1 do begin
          D^ := S2^;
          Inc(D);
          D^ := S1^;
          Inc(D);
          D^ := S0^;
          Inc(D);
          Inc(S0);
          Inc(S1);
          Inc(S2);
        end;
      end;
  finally
    jas_stream_close(JP2Stream);
    for I := 0 to JP2Image.numcmpts_ - 1 do
      jas_matrix_destroy(Channels[I]);
    jas_image_destroy(JP2Image);
  end;
end;

procedure TEvBJP2FileFormat.WriteStream(const Stream: TStream);
var
  JP2Stream: jas_stream_t;
  JP2Image: pjas_image_t;
  ComponentInfo: array [0..2] of jas_image_cmptparm_t;
  I, W, H, X, Y, ComponentCount, Fmt: Integer;
  Channels: array [0..2] of pjas_matrix_t;
  D0, D1, D2: pjas_seqent_t;
  B: TBitmap;
  S: PByte;
  Options: String;
  Cmpt: ppjas_image_cmpt_t;
  FS: TFormatSettings;
begin
  inherited;

  for I := 0 to 2 do
    Channels[I] := nil;
  JP2Image := nil;

  if (Bitmap.PixelFormat = pf8Bit) and IsGreyscalePalette(Bitmap.Palette) then
    B := Bitmap
  else if Bitmap.PixelFormat = pf24Bit then
    B := Bitmap
  else
    B := CreateTrueColorBitmapCopy;

  jas_init;
  InitJP2Stream(JP2Stream);
  try
    if B.PixelFormat = pf8Bit then
      ComponentCount := 1
    else if B.PixelFormat = pf24Bit then
      ComponentCount := 3
    else begin
      ComponentCount := 0;
      Assert(False);
    end;

    W := B.Width;
    H := B.Height;
    for I := 0 to ComponentCount - 1 do begin
      FillChar(ComponentInfo[I],SizeOf(jas_image_cmptparm_t),0);
      ComponentInfo[I].hstep := 1;
      ComponentInfo[I].vstep := 1;
      ComponentInfo[I].width := W;
      ComponentInfo[I].height := H;
      ComponentInfo[I].prec := 8;
    end;

    if ComponentCount = 1 then
      JP2Image := jas_image_create(1,@ComponentInfo[0],JAS_IMAGE_CS_GRAY)
    else
      JP2Image := jas_image_create(3,@ComponentInfo[0],JAS_IMAGE_CS_RGB);
    if JP2Image = nil then
      InternalError('Unable to create image');

    Cmpt := JP2Image.cmpts_;
    if ComponentCount = 1 then
      Cmpt^^.type_ := JAS_CLRSPC_CHANIND_GRAY_Y
    else begin
      Cmpt^^.type_ := JAS_CLRSPC_CHANIND_RGB_R;
      Inc(Cmpt);
      Cmpt^^.type_ := JAS_CLRSPC_CHANIND_RGB_G;
      Inc(Cmpt);
      Cmpt^^.type_ := JAS_CLRSPC_CHANIND_RGB_B;
    end;

    for I := 0 to ComponentCount - 1 do begin
      Channels[I] := jas_matrix_create(1,W);
      if Channels[I] = nil then
        InternalError('Unable to allocate image data');
    end;

    if ComponentCount = 1 then
      for Y := 0 to H - 1 do begin
        D0 := Channels[0].rows_^;
        S := B.ScanLine[Y];
        for X := 0 to W - 1 do begin
          D0^ := S^;
          Inc(D0);
          Inc(S);
        end;
        jas_image_writecmpt(JP2Image,0,0,Y,W,1,Channels[0]);
      end
    else
      for Y := 0 to H - 1 do begin
        D0 := Channels[0].rows_^;
        D1 := Channels[1].rows_^;
        D2 := Channels[2].rows_^;
        S := B.ScanLine[Y];
        for X := 0 to W - 1 do begin
          D2^ := S^;
          Inc(S);
          D1^ := S^;
          Inc(S);
          D0^ := S^;
          Inc(S);
          Inc(D0);
          Inc(D1);
          Inc(D2);
        end;
        for I := 0 to 2 do
          jas_image_writecmpt(JP2Image,I,0,Y,W,1,Channels[I]);
      end;

    Fmt := jas_image_strtofmt('jp2');
    GetLocaleFormatSettings(GetSystemDefaultLCID,FS);
    FS.DecimalSeparator := '.';
    Options := Format('rate=%f',[Quality / 100],FS);
    if jas_image_encode(JP2Image,JP2Stream,Fmt,PChar(Options)) <> 0 then
      InternalError('Unable to encode image');
  finally
    for I := 0 to JP2Image.numcmpts_ - 1 do
      jas_matrix_destroy(Channels[I]);
    jas_stream_close(JP2Stream);
    jas_image_destroy(JP2Image);
  end;
end;

initialization
  TEvBBitmap.RegisterFileFormat('JPEG 2000','.jp2',JP2Magic,TEvBJP2FileFormat,True,4);

end.