pngfilt.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

  cdecl; external;
procedure png_set_IHDR(png_ptr: png_structp; info_ptr: png_infop;
  width, height: png_uint_32; bit_depth, color_type,
  interlace_type, compression_type, filter_type: int);
  cdecl; external;
procedure png_set_PLTE(png_ptr: png_structp; info_ptr: png_infop;
  palette: png_colorp; num_palette: int);
  cdecl; external;
procedure png_set_gAMA(png_ptr: png_structp; info_ptr: png_infop;
  file_gamma: double);
  cdecl; external;
procedure png_set_sBIT(png_ptr: png_structp; info_ptr: png_infop;
  sig_bits: png_color_8p);
  cdecl; external;
procedure png_set_cHRM(png_ptr: png_structp; info_ptr: png_infop;
  white_x, white_y, red_x, red_y, green_x, green_y,
  blue_x, blue_y: double);
  cdecl; external;
procedure png_set_sRGB_gAMA_and_cHRM(png_ptr: png_structp;
  info_ptr: png_infop; intent: int);
  cdecl; external;
procedure png_set_tRNS(png_ptr: png_structp; info_ptr: png_infop;
  trans: png_bytep; num_trans: int;
  trans_values: png_color_16p);
  cdecl; external;
procedure png_set_bKGD(png_ptr: png_structp; info_ptr: png_infop;
  background: png_color_16p);
  cdecl; external;
procedure png_set_hIST(png_ptr: png_structp; info_ptr: png_infop;
  hist: png_uint_16p);
  cdecl; external;
procedure png_set_pHYs(png_ptr: png_structp; info_ptr: png_infop;
  res_x, res_y: png_uint_32; unit_type: int);
  cdecl; external;
procedure png_set_oFFs(png_ptr: png_structp; info_ptr: png_infop;
  offset_x, offset_y: png_uint_32; unit_type: int);
  cdecl; external;
procedure png_set_pCAL(png_ptr: png_structp; info_ptr: png_infop;
  purpose: png_charp; X0, X1: png_int_32;
  typ, nparams: int; units: png_charp;
  params: png_charpp);
  cdecl; external;
procedure png_set_tIME(png_ptr: png_structp; info_ptr: png_infop;
  mod_time: png_timep);
  cdecl; external;
procedure png_set_text(png_ptr: png_structp; info_ptr: png_infop;
  text_ptr: png_textp; num_text: int);
  cdecl; external;
function png_get_text(png_ptr: png_structp; info_ptr:png_infop; text_ptr:png_textpp; num_text:pinteger):png_uint_32; cdecl;  external;
function png_create_info_struct(png_ptr: png_structp): png_infop;
  cdecl; external;
procedure png_destroy_read_struct(png_ptr_ptr: png_structpp;
  info_ptr_ptr, end_info_ptr_ptr: png_infopp);
  cdecl; external;
procedure png_set_read_fn(png_ptr: png_structp;
  io_ptr: png_voidp; read_data_fn: png_rw_ptr);
  cdecl; external;
procedure png_read_info(png_ptr: png_structp; info_ptr: png_infop);
  cdecl; external;
function png_get_IHDR(png_ptr: png_structp; info_ptr: png_infop;
  var width, height: png_uint_32; var bit_depth,
  color_type, interlace_type, compression_type,
  filter_type: int): png_uint_32;
  cdecl; external;
procedure png_set_expand(png_ptr: png_structp);
  cdecl; external;
procedure png_set_bgr(png_ptr: png_structp);
  cdecl; external;
procedure png_set_swap(png_ptr: png_structp);
  cdecl; external;
procedure png_set_strip_16(png_ptr: png_structp);
  cdecl; external;
procedure png_set_packing(png_ptr: png_structp);
  cdecl; external;
procedure png_set_gray_to_rgb(png_ptr: png_structp);
  cdecl; external;
procedure png_read_update_info(png_ptr: png_structp; info_ptr: png_infop);
  cdecl; external;
function png_set_interlace_handling(png_ptr: png_structp): int;
  cdecl; external;
procedure png_read_rows(png_ptr: png_structp; row, display_row:
  png_bytepp; num_rows: png_uint_32);
  cdecl; external;
procedure png_read_end(png_ptr: png_structp; info_ptr: png_infop);
  cdecl; external;
function png_get_io_ptr(png_ptr: png_structp): png_voidp;
  cdecl; external;
function png_get_rowbytes(png_ptr: png_structp; info_ptr: png_infop):
  png_uint_32;
  cdecl; external;
function png_get_bKGD(png_ptr: png_structp; info_ptr: png_infop;
  var background: png_color_16p): png_uint_32;
  cdecl; external;
procedure png_set_background(png_ptr: png_structp;
  background_color: png_color_16p;
  background_gamma_code, need_expand: int;
  background_gamma: double);
  cdecl; external;
function png_get_x_pixels_per_meter(png_ptr: png_structp;
  info_ptr: png_infop): png_uint_32;
  cdecl; external;
function png_get_y_pixels_per_meter(png_ptr: png_structp;
  info_ptr: png_infop): png_uint_32;
  cdecl; external;
function png_get_interlace_type(png_ptr: png_structp;
  info_ptr: png_infop): png_byte;
  cdecl; external;
procedure png_set_gamma(png_ptr: png_structp; screen_gamma,
  default_file_gamma: double);
  cdecl; external;
function png_get_gAMA(png_ptr: png_structp; info_ptr: png_infop;
  var file_gamma: double): png_uint_32;
  cdecl; external;
function png_get_PLTE(png_ptr: png_structp; info_ptr: png_infop;
  var palette: png_colorp; var num_palette: int):
  png_uint_32;
  cdecl; external;
function png_sig_cmp(sig: png_bytep; start, num_to_check: png_size_t):
  int;
  cdecl; external;
function png_get_channels(png_ptr: png_structp; info_ptr: png_infop): png_byte;
  cdecl; external;

procedure PNG_MEMSET_CHECK; external;
procedure PNG_DO_STRIP_FILLER; external;
procedure PNG_DO_INVERT; external;
procedure PNG_DO_BGR; external;
procedure PNG_DO_PACKSWAP; external;
procedure PNG_DO_SWAP; external;
procedure PNG_INIT_READ_TRANSFORMATIONS; external;
procedure PNG_SET_GAMA_FIXED; external;
procedure PNG_SET_CHRM_FIXED; external;
procedure PNG_SET_ICCP; external;
procedure PNG_SET_SPLT; external;
procedure PNG_SET_SCAL; external;
procedure PNG_SET_UNKNOWN_CHUNKS; external;
procedure png_set_text_2; external;


procedure ErrorFunc(png_ptr: Pointer; msg: Pointer); cdecl;
begin
  pboolean(png_ptr)^ := true;
  Abort;
end;

procedure WarnFunc(png_ptr: Pointer; msg: Pointer); cdecl;
begin
end;

procedure ReadFunc(png_ptr: png_structp; data: Pointer; length: png_size_t); cdecl;
var
  Stream: TStream;
begin
  Stream := png_get_io_ptr(png_ptr);
  if png_size_t(Stream.Read(pchar(data)^, length)) < length then
    Abort;
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure ReadPNGStream(Stream: TStream; Bitmap: TIEBitmap; var IOParams: TIOParamsVals; var xProgress: TProgressRec; Preview: boolean);
var
  png_ptr: png_structp;
  info_ptr: png_infop;
  width, height: png_uint_32;
  compression_type: integer;
  filter_type: integer;
  bit_depth, color_type, interlace_type: integer;
  Error_ptr: pointer;
  i, number_passes, pass, y: integer;
  px: pointer;
  bgrnd:png_color_16p;
  palette: png_colorp;
  num_palette: integer;
  channels, x: integer;
  arowbuf, apx, apx2: pbyte;
  native: boolean;
  text_ptr:png_textp;
begin
{$WARNINGS OFF}
  try
    try
      Error_ptr := xProgress.Aborting;
      png_ptr := nil;
      png_ptr := png_create_read_struct('1.2.14', Error_ptr, @ErrorFunc, @WarnFunc);
      if png_ptr = nil then
      begin
        xProgress.Aborting^ := true;
        Abort;
      end;
      info_ptr := png_create_info_struct(png_ptr);
      if info_ptr = nil then
      begin
        png_destroy_read_struct(@png_ptr, nil, nil);
        png_ptr := nil;
        xProgress.Aborting^ := true;
        Abort;
      end;
      png_set_read_fn(png_ptr, Stream, @ReadFunc);
      png_read_info(png_ptr, info_ptr);
      png_get_IHDR(png_ptr, info_ptr, width, height, bit_depth, color_type,
        interlace_type, Compression_type, filter_type);

      // get text
      x:=png_get_text(png_ptr,info_ptr,@text_ptr,nil);
      IOParams.PNG_TextKeys.Clear;
      IOParams.PNG_TextValues.Clear;
      for i:=0 to x-1 do
      begin
        IOParams.PNG_TextKeys.Add( text_ptr^.key );
        IOParams.PNG_TextValues.Add( text_ptr^.text );
        inc(text_ptr);
      end;

      // 2.2.9
      bgrnd:=nil;
      png_get_bKGD(png_ptr,info_ptr,bgrnd);
      if bgrnd<>nil then
        IOParams.PNG_Background := CreateRGB( bgrnd^.red shr 8, bgrnd^.green shr 8, bgrnd^.blue shr 8 );

      if (not IOParams.IsNativePixelFormat) or ((bit_depth <> 8) and (bit_depth<>16)) or
        ((color_type <> PNG_COLOR_TYPE_PALETTE) and (color_type <> PNG_COLOR_TYPE_GRAY)) then
      begin

        // Is paletted? (from 2 to 8 bit)
        if (color_type = PNG_COLOR_TYPE_PALETTE) and (bit_depth <= 8) and (bit_depth > 1) then
          png_set_expand(png_ptr);
        // Is grayscale? (from 2 to 7 bit)
        if (color_type = PNG_COLOR_TYPE_GRAY) and (bit_depth < 8) and (bit_depth > 1) then
          png_set_expand(png_ptr);
        // Is grayscale? (only 16 bit)
        if (bit_depth = 16) then
          png_set_strip_16(png_ptr);
        //
        if (bit_depth < 8) and (bit_depth > 1) then
          png_set_packing(png_ptr);
        // Is grayscale and not blackwhite?
        if ((color_type = PNG_COLOR_TYPE_GRAY) or (color_type = PNG_COLOR_TYPE_GRAY_ALPHA)) and (bit_depth > 1) then
          png_set_gray_to_rgb(png_ptr);

        if (bit_depth > 1) then
          png_set_bgr(png_ptr);

        native := false;

      end
      else
      begin
        if bit_depth=16 then
          png_set_swap(png_ptr);

        native := true;
      end;


      number_passes := png_set_interlace_handling(png_ptr);
      png_read_update_info(png_ptr, info_ptr);
      //
      ioparams.width := width;
      ioparams.height := height;
      ioparams.bitspersample := bit_depth;
      case color_type of
        PNG_COLOR_TYPE_GRAY: ioparams.samplesperpixel := 1;
        PNG_COLOR_TYPE_PALETTE: ioparams.samplesperpixel := 1;
        PNG_COLOR_TYPE_RGB: ioparams.samplesperpixel := 3;
        PNG_COLOR_TYPE_RGB_ALPHA: ioparams.samplesperpixel := 4;
        PNG_COLOR_TYPE_GRAY_ALPHA: ioparams.samplesperpixel := 2;
      end;
      ioparams.dpix := round(png_get_x_pixels_per_meter(png_ptr, info_ptr) / 100 * 2.54);
      if ioparams.dpix = 0 then
        ioparams.dpix := gDefaultDPIX;
      ioparams.dpiy := round(png_get_y_pixels_per_meter(png_ptr, info_ptr) / 100 * 2.54);
      if ioparams.dpiy = 0 then
        ioparams.dpiy := gDefaultDPIY;
      if IOParams.ColorMap <> nil then
      begin
        freemem(IOParams.ColorMap);
        IOParams.fColorMap := nil;
        IOParams.fColorMapCount := 0;
      end;
      if color_type = PNG_COLOR_TYPE_PALETTE then
      begin
        // copy palette
        png_get_PLTE(png_ptr, info_ptr, palette, num_palette);
        IOParams.fColorMapCount := num_palette;
        getmem(IOParams.fColorMap, 3 * num_palette);
        for y := 0 to num_palette - 1 do
        begin
          IOParams.fColorMap^[y].r := palette^.red;
          IOParams.fColorMap^[y].g := palette^.green;
          IOParams.fColorMap^[y].b := palette^.blue;
          inc(palette);
        end;
      end;
      if png_get_interlace_type(png_ptr, info_ptr) = PNG_INTERLACE_NONE then
        ioparams.PNG_Interlaced := false
      else
        ioparams.PNG_Interlaced := true;
      //
      if Preview then
      begin
        png_destroy_read_struct(@png_ptr, @info_ptr, nil);
        exit;
      end;
      //
      if (bit_depth = 1) and not (color_type = PNG_COLOR_TYPE_PALETTE) then
        Bitmap.Allocate(Width, Height, ie1g)
      else if native and (IOParams.SamplesPerPixel = 1) then
      begin
        if (IOParams.BitsPerSample <= 8) and (color_type = PNG_COLOR_TYPE_PALETTE) then
        begin
          Bitmap.Allocate(Width, Height, ie8p);
          Bitmap.PaletteUsed := 1 shl IOParams.BitsPerSample;
          for i := 0 to IOParams.ColorMapCount - 1 do
            Bitmap.Palette[i] := IOParams.ColorMap[i]
        end
        else if (IOParams.BitsPerSample = 8) and (color_type = PNG_COLOR_TYPE_GRAY) then
          Bitmap.Allocate(Width, Height, ie8g)
        else if (IOParams.BitsPerSample = 16) and (color_type = PNG_COLOR_TYPE_GRAY) then
          Bitmap.Allocate(Width, Height, ie16g);
      end
      else
        Bitmap.Allocate(Width, Height, ie24RGB);
      //
      xProgress.per1 := 100 / (height * number_passes);
      xProgress.val := 0;
      channels := png_get_channels(png_ptr, info_ptr);
      if (channels = 4) and (number_passes=1) then
        getmem(arowbuf, width * 4)
      else if (channels=4) and (number_passes>1) then
        getmem(arowbuf, width*height*4)
      else
        arowbuf := nil;
      if (channels = 4) then
        bitmap.AlphaChannel.Full := false;
      for pass := 0 to number_passes - 1 do
      begin
        for y := 0 to height - 1 do
        begin
          px := bitmap.scanline[y];
          if (channels = 4) then
          begin
            if number_passes>1 then
            begin
              apx := pointer(integer(arowbuf)+y*width*4);
              png_read_rows(png_ptr, @apx, nil, 1);
            end
            else
            begin
              png_read_rows(png_ptr, @arowbuf, nil, 1);
              apx := arowbuf;
            end;
            apx2 := bitmap.AlphaChannel.ScanLine[y];
            for x := 0 to width - 1 do
            begin
              PRGB(px)^ := PRGB(apx)^;
              inc(apx, 3);
              apx2^ := apx^;
              inc(apx2);
              inc(apx);
              inc(pbyte(px), 3);
            end;
          end
          else if (bit_depth=1) and (color_type = PNG_COLOR_TYPE_PALETTE) and (bitmap.PixelFormat=ie24RGB) then
          begin
            // 1 bit depth with color map, convert to ie24RGB
            getmem(apx,width div 8 +1);
            png_read_rows(png_ptr, @apx, nil, 1);
            for x:=0 to width-1 do
            begin
              if _GetPixelbw(apx,x)=0 then
                PRGB(px)^:=IOParams.fColorMap^[0]
              else
                PRGB(px)^:=IOParams.fColorMap^[1];
              inc(PRGB(px));
            end;
            freemem(apx);
          end
          else
            png_read_rows(png_ptr, @px, nil, 1);
          // OnProgress
          with xProgress do
          begin
            inc(val);
            if assigned(fOnProgress) then
              fOnProgress(Sender, trunc(per1 * val));
          end;
          if xProgress.Aborting^ then
            break;
        end;
        if xProgress.Aborting^ then
          break;
      end;
      if channels = 4 then
        freemem(arowbuf);
      if not xProgress.Aborting^ then
        png_read_end(png_ptr, info_ptr);
    finally
      if png_ptr <> nil then
        png_destroy_read_struct(@png_ptr, @info_ptr, nil);
    end;
  except
    on EAbort do
      ;
  end;
{$WARNINGS ON}
end;

// return true it is a PNG stream

function IsPNGStream(Stream: TStream): boolean;
var
  buf: array[0..7] of byte;
begin
  Stream.read(buf, 8);
  result := png_sig_cmp(@(buf[0]), 0, 4) = 0;
  Stream.Seek(-8, soFromCurrent);
end;

{$else} // IEINCLUDEPNG

interface

implementation

{$endif}

end.