unit PNGformat;

interface

uses IOGraphics;

type PInt = ^integer;

procedure GetPngInfo(FileName : string; var Info: TImgRec; DisplayWarnings : boolean);
procedure LoadPNGImage(var Info : TImgRec; var  Img : Pointer);
//-------------------------------------------------------------------------------------

function get_png_info(name: PChar; xres: PInt; yres: PInt; bpp: PInt; is_gray: PInt): Integer; cdecl;
function load_png_rgb16(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; cdecl;
function load_png_gray16(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; cdecl;
function load_png_rgb8(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; cdecl;
function load_png_gray8(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; cdecl;
function save_png_rgb8(mem: Pointer; xres,yres: Integer; name: PChar): integer cdecl;
function save_png_rgb16(mem: Pointer; xres,yres: Integer; name: PChar): integer cdecl;
function save_png_gray8(mem: Pointer; xres,yres: Integer; name: PChar): integer cdecl;
function save_png_gray16(mem: Pointer; xres,yres: Integer; name: PChar): integer cdecl;


implementation

uses SysUtils, Dialogs;

function get_png_info(name: PChar; xres: PInt; yres: PInt; bpp: PInt; is_gray: PInt): Integer; external 'loadpng.dll';
function load_png_rgb16(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; external 'loadpng.dll';
function load_png_gray16(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; external 'loadpng.dll';
function load_png_rgb8(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; external 'loadpng.dll';
function load_png_gray8(name: PChar; data: Pointer; xres: PInt; yres: PInt; P: Pointer): Integer; external 'loadpng.dll';
function save_png_rgb8; external 'libpng.dll';
function save_png_rgb16; external 'libpng.dll';
function save_png_gray8; external 'libpng.dll';
function save_png_gray16; external 'libpng.dll';

procedure GetPngInfo(FileName : string; var Info: TImgRec; DisplayWarnings : boolean);
var IsGray  : integer;
    ImageDx : integer;
    ImageDy : integer;
    BpP     : integer;
    Name    : pointer;
begin
  GetMem(Name,Length(FileName)+1);
  StrPCopy(Name,FileName);
  Info.OK:=true;
  Info.Error:='';
  if get_png_info(Name,@ImageDx,@ImageDy,@BpP,@IsGray)<>1 then
    begin
      Info.OK:=false;
      Info.Error:=ExtractFilename(FileName)+' is not a correct PNG file.';
      if DisplayWarnings then ShowMessage(Info.Error);
    end;
  Info.FileName:=FileName;
  Info.ImgWidth:=ImageDx;
  Info.ImgHeight:=ImageDy;
  if IsGray=1 then Info.Channels:=1 else Info.Channels:=3;
  if BpP=8 then
    begin
      Info.DataType:='BYTE';
      Info.BytesPerPixel:=Info.Channels;
    end;
  if BpP=16 then
    begin
      Info.DataType:='WORD';
      Info.BytesPerPixel:=Info.Channels*2;
    end;
  Info.HeaderSize:=-1;
  Info.RGBsepatated:=false;
  Info.ImgSize:=Info.ImgWidth*Info.ImgHeight*Info.BytesPerPixel;
  Info.SwapBytes:=false;
  Info.VertFlip:=false;
  Info.BZero:=0;
  Info.BScale:=1;
  Info.DataMin:=1;
  Info.DataMax:=-1;
  Info.BitMap:=nil;
  FreeMem(Name);
end;

procedure LoadPNGImage(var Info : TImgRec; var  Img : Pointer);
var Name    : Pointer;
    ImageDx : integer;
    ImageDy : integer;
begin
  GetMem(Name,Length(Info.FileName)+1);
  StrPCopy(Name,Info.FileName);
  ImageDx:=Info.ImgWidth;
  ImageDy:=Info.ImgHeight;
  if (Info.Channels=1) and (Info.BytesPerPixel=1) then load_png_gray8(Name,@Img,@ImageDx,@ImageDy,nil);
  if (Info.Channels=1) and (Info.BytesPerPixel=2) then load_png_gray16(Name,@Img,@ImageDx,@ImageDy,nil);
  if (Info.Channels=3) and (Info.BytesPerPixel=3) then load_png_rgb8(Name,@Img,@ImageDx,@ImageDy,nil);
  if (Info.Channels=3) and (Info.BytesPerPixel=6) then load_png_rgb16(Name,@Img,@ImageDx,@ImageDy,nil);
  FreeMem(Name);
end;

end.




