BeRoPNG.pas

unit BeRoPNG;
(*************************************
** 2-clause simplified BSD license ***
**************************************
**
** Copyright 2010-2011 Benjamin Rosseaux. All rights reserved.
**
** Redistribution and use in source and binary forms, with or without modification, are
** permitted provided that the following conditions are met:
**
**    1. Redistributions of source code must retain the above copyright notice, this list of
**       conditions and the following disclaimer.
**
**    2. Redistributions in binary form must reproduce the above copyright notice, this list
**       of conditions and the following disclaimer in the documentation and/or other materials
**       provided with the distribution.
**
** THIS SOFTWARE IS PROVIDED BY BENJAMIN ROSSEAUX ``AS IS'' AND ANY EXPRESS OR IMPLIED
** WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
** FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BENJAMIN ROSSEAUX OR
** CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
** CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
** SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
** ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
** NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
** ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
**
** The views and conclusions contained in the software and documentation are those of the
** authors and should not be interpreted as representing official policies, either expressed
** or implied, of Benjamin Rosseaux.
*)
{$ifdef fpc}
 {$mode delphi}
 {$warnings off}
 {$hints off}
 {$ifdef cpui386}
  {$define cpu386}
  {$asmmode intel}
 {$endif}
 {$ifdef fpc_little_endian}
  {$define little_endian}
 {$else}
  {$ifdef fpc_big_endian}
   {$define big_endian}
  {$endif}
 {$endif}
 {$ifdef fpc_has_internal_sar}
  {$define HasSAR}
 {$endif}
{$else}
 {$define little_endian}
 {$ifndef cpu64}
  {$define cpu32}
 {$endif}
 {$optimization on}
 {$undef HasSAR}
 {$define UseDIV}
{$endif}
{$overflowchecks off}
{$rangechecks off}
{$modeswitch advancedrecords}

interface

type PPNGPixel=^TPNGPixel;
     TPNGPixelType = {$ifdef PNGHighDepth}word{$else}byte{$endif};
     TPNGPixel=packed record
      r,g,b,a: TPNGPixelType;
      constructor Create(_r,_g,_b,_a: TPNGPixelType);
      function ToString: string;
      class operator = (left: TPNGPixel; right: TPNGPixel): boolean;
      class operator := (right: TPNGPixel): string;
     end;

function LoadPNG(DataPointer:pointer;DataSize:longword;var ImageData:pointer;var ImageWidth,ImageHeight:longint;HeaderOnly:boolean):boolean;

implementation
uses
  SysUtils;

function TPNGPixel.ToString: string;
begin
  result := '{'+r.ToString+','+g.ToString+','+b.ToString+','+a.ToString+'}';
end;

class operator TPNGPixel.:= (right: TPNGPixel): string;
begin
  result := right.ToString;
end;

constructor TPNGPixel.Create(_r,_g,_b,_a: TPNGPixelType);
begin
  r:=_r;
  g:=_g;
  b:=_b;
  a:=_a;
end;

class operator TPNGPixel.= (left: TPNGPixel; right: TPNGPixel): boolean;
begin
  result := (left.r = right.r) and (left.g = right.g) and (left.b = right.b) and (left.a = right.a);
end;

type TPNGHeader=array[0..7] of byte;

{$ifdef fpc}
 {$undef OldDelphi}
{$else}
 {$ifdef conditionalexpressions}
  {$if CompilerVersion>=23.0}
   {$undef OldDelphi}
type qword=uint64;
     ptruint=NativeUInt;
     ptrint=NativeInt;
  {$else}
   {$define OldDelphi}
  {$ifend}
 {$else}
  {$define OldDelphi}
 {$endif}
{$endif}
{$ifdef OldDelphi}
type qword=int64;
{$ifdef cpu64}
     ptruint=qword;
     ptrint=int64;
{$else}
     ptruint=longword;
     ptrint=longint;
{$endif}
{$endif}

//const PNGHeader:TPNGHeader=($89,$50,$4e,$47,$0d,$0a,$1a,$0a);

function CRC32(data:pointer;length:longword):longword;
const CRC32Table:array[0..15] of longword=($00000000,$1db71064,$3b6e20c8,$26d930ac,$76dc4190,
                                           $6b6b51f4,$4db26158,$5005713c,$edb88320,$f00f9344,
                                           $d6d6a3e8,$cb61b38c,$9b64c2b0,$86d3d2d4,$a00ae278,
                                           $bdbdf21c);

var buf:pansichar;
    i:longword;
begin
 if length=0 then begin
  result:=0;
 end else begin
  buf:=data;
  result:=$ffffffff;
  for i:=1 to length do begin
   result:=result xor byte(buf^);
   result:=CRC32Table[result and $f] xor (result shr 4);
   result:=CRC32Table[result and $f] xor (result shr 4);
   inc(buf);
  end;
  result:=result xor $ffffffff;
 end;
end;

function Swap16(x:word):word;
begin
 result:=((x and $ff) shl 8) or ((x and $ff00) shr 8);
end;

function Swap32(x:longword):longword;
begin
 result:=(Swap16(x and $ffff) shl 16) or Swap16((x and $ffff0000) shr 16);
end;

function Swap64(x:int64):int64;
begin
 result:=(Swap32(x and $ffffffff) shl 32) or Swap32((x and $ffffffff00000000) shr 32);
end;

function DoInflate(InData:pointer;InLen:longword;var DestData:pointer;var DestLen:longword;ParseHeader:boolean):boolean;
const CLCIndex:array[0..18] of byte=(16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15);
type pword=^word;
     PTree=^TTree;
     TTree=packed record
      Table:array[0..15] of word;
      Translation:array[0..287] of word;
     end;
     PBuffer=^TBuffer;
     TBuffer=array[0..65535] of byte;
     PLengths=^TLengths;
     TLengths=array[0..288+32-1] of byte;
     POffsets=^TOffsets;
     TOffsets=array[0..15] of word;
     PBits=^TBits;
     TBits=array[0..29] of byte;
     PBase=^TBase;
     TBase=array[0..29] of word;
var Tag,BitCount,DestSize:longword;
    SymbolLengthTree,DistanceTree,FixedSymbolLengthTree,FixedDistanceTree:PTree;
    LengthBits,DistanceBits:PBits;
    LengthBase,DistanceBase:PBase;
    Source,SourceEnd:pansichar;
    Dest:pansichar;
 procedure IncSize(length:longword);
 var j:longword;
 begin
  if (DestLen+length)>=DestSize then begin
   if DestSize=0 then begin
    DestSize:=1;
   end;
   while (DestLen+length)>=DestSize do begin
    inc(DestSize,DestSize);
   end;
   j:=ptruint(Dest)-ptruint(DestData);
   ReAllocMem(DestData,DestSize);
   ptruint(Dest):=ptruint(DestData)+j;
  end;
 end;           
 function adler32(data:pointer;length:longword):longword;
 const BASE=65521;
       NMAX=5552;
 var buf:pansichar;
     s1,s2,k,i:longword;
 begin
  s1:=1;
  s2:=0;
  buf:=data;
  while length>0 do begin
   if length<NMAX then begin
    k:=length;
   end else begin
    k:=NMAX;
   end;
   dec(length,k);
   for i:=1 to k do begin
    inc(s1,byte(buf^));
    inc(s2,s1);
    inc(buf);
   end;
   s1:=s1 mod BASE;
   s2:=s2 mod BASE;
  end;
  result:=(s2 shl 16) or s1;
 end;
 procedure BuildBitsBase(Bits:pansichar;Base:pword;Delta,First:longint);
 var i,Sum:longint;
 begin
  for i:=0 to Delta-1 do begin
   Bits[i]:=ansichar(#0);
  end;
  for i:=0 to (30-Delta)-1 do begin
   Bits[i+Delta]:=ansichar(byte(i div Delta));
  end;
  Sum:=First;
  for i:=0 to 29 do begin
   Base^:=Sum;
   inc(Base);
   inc(Sum,1 shl byte(Bits[i]));
  end;
 end;
 procedure BuildFixedTrees(var lt,dt:TTree);
 var i:longint;
 begin
  for i:=0 to 6 do begin
   lt.Table[i]:=0;
  end;
  lt.Table[7]:=24;
  lt.Table[8]:=152;
  lt.Table[9]:=112;
  for i:=0 to 23 do begin
   lt.Translation[i]:=256+i;
  end;
  for i:=0 to 143 do begin
   lt.Translation[24+i]:=i;
  end;
  for i:=0 to 7 do begin
   lt.Translation[168+i]:=280+i;
  end;
  for i:=0 to 111 do begin
   lt.Translation[176+i]:=144+i;
  end;
  for i:=0 to 4 do begin
   dt.Table[i]:=0;
  end;
  dt.Table[5]:=32;
  for i:=0 to 31 do begin
   dt.Translation[i]:=i;
  end;
 end;
 procedure BuildTree(var t:TTree;Lengths:pansichar;Num:longint);
 var Offsets:POffsets;
     i:longint;
     Sum:longword;
 begin
  New(Offsets);
  try
   for i:=0 to 15 do begin
    t.Table[i]:=0;
   end;
   for i:=0 to Num-1 do begin
    inc(t.Table[byte(Lengths[i])]);
   end;
   t.Table[0]:=0;
   Sum:=0;
   for i:=0 to 15 do begin
    Offsets^[i]:=Sum;
    inc(Sum,t.Table[i]);
   end;
   for i:=0 to Num-1 do begin
    if lengths[i]<>ansichar(#0) then begin
     t.Translation[Offsets^[byte(lengths[i])]]:=i;
     inc(Offsets^[byte(lengths[i])]);
    end;
   end;
  finally
   Dispose(Offsets);
  end;
 end;
 function GetBit:longword;
 begin
  if BitCount=0 then begin
   Tag:=byte(Source^);
   inc(Source);
   BitCount:=7;
  end else begin
   dec(BitCount);
  end;
  result:=Tag and 1;
  Tag:=Tag shr 1;
 end;
 function ReadBits(Num,Base:longword):longword;
 var Limit,Mask:longword;
 begin
  result:=0;
  if Num<>0 then begin
   Limit:=1 shl Num;
   Mask:=1;
   while Mask<Limit do begin
    if GetBit<>0 then begin
     inc(result,Mask);
    end;
    Mask:=Mask shl 1;
   end;
  end;
  inc(result,Base);
 end;
 function DecodeSymbol(var t:TTree):longword;
 var Sum,c,l:longint;
 begin
  Sum:=0;
  c:=0;
  l:=0;
  repeat
   c:=(c*2)+longint(GetBit);
   inc(l);
   inc(Sum,t.Table[l]);
   dec(c,t.Table[l]);
  until not (c>=0);
  result:=t.Translation[Sum+c];
 end;
 procedure DecodeTrees(var lt,dt:TTree);
 var CodeTree:PTree;
     Lengths:PLengths;
     hlit,hdist,hclen,i,num,length,clen,Symbol,Prev:longword;
 begin
  New(CodeTree);
  New(Lengths);
  try
   FillChar(CodeTree^,sizeof(TTree),ansichar(#0));
   FillChar(Lengths^,sizeof(TLengths),ansichar(#0));
   hlit:=ReadBits(5,257);
   hdist:=ReadBits(5,1);
   hclen:=ReadBits(4,4);
   for i:=0 to 18 do begin
    lengths^[i]:=0;
   end;
   for i:=1 to hclen do begin
    clen:=ReadBits(3,0);
    lengths^[CLCIndex[i-1]]:=clen;
   end;
   BuildTree(CodeTree^,pansichar(pointer(@lengths^[0])),19);
   num:=0;
   while num<(hlit+hdist) do begin
    Symbol:=DecodeSymbol(CodeTree^);
    case Symbol of
     16:begin
      prev:=lengths^[num-1];
      length:=ReadBits(2,3);
      while length>0 do begin
       lengths^[num]:=prev;
       inc(num);
       dec(length);
      end;
     end;
     17:begin
      length:=ReadBits(3,3);
      while length>0 do begin
       lengths^[num]:=0;
       inc(num);
       dec(length);
      end;
     end;
     18:begin
      length:=ReadBits(7,11);
      while length>0 do begin
       lengths^[num]:=0;
       inc(num);
       dec(length);
      end;
     end;
     else begin
      lengths^[num]:=Symbol;
      inc(num);
     end;
    end;
   end;
   BuildTree(lt,pansichar(pointer(@lengths^[0])),hlit);
   BuildTree(dt,pansichar(pointer(@lengths^[hlit])),hdist);
  finally
   Dispose(CodeTree);
   Dispose(Lengths);
  end;
 end;
 function InflateBlockData(var lt,dt:TTree):boolean;
 var Symbol:longword;
     Length,Distance,Offset,i:longint;
 begin
  result:=false;
  while (Source<SourceEnd) or (BitCount>0) do begin
   Symbol:=DecodeSymbol(lt);
   if Symbol=256 then begin
    result:=true;
    break;
   end;
   if Symbol<256 then begin
    IncSize(1);
    Dest^:=ansichar(byte(Symbol));
    inc(Dest);
    inc(DestLen);
   end else begin
    dec(Symbol,257);
    Length:=ReadBits(LengthBits^[Symbol],LengthBase^[Symbol]);
    Distance:=DecodeSymbol(dt);
    Offset:=ReadBits(DistanceBits^[Distance],DistanceBase^[Distance]);
    IncSize(length);
    for i:=0 to length-1 do begin
     Dest[i]:=Dest[i-Offset];
    end;
    inc(Dest,Length);
    inc(DestLen,Length);
   end;
  end;
 end;
 function InflateUncompressedBlock:boolean;
 var length,invlength:longword;
 begin
  result:=false;
  length:=(byte(source[1]) shl 8) or byte(source[0]);
  invlength:=(byte(source[3]) shl 8) or byte(source[2]);
  if length<>((not invlength) and $ffff) then begin
   exit;
  end;
  IncSize(length);
  inc(Source,4);
  if Length>0 then begin
   Move(Source^,Dest^,Length);
   inc(Source,Length);
   inc(Dest,Length);
  end;
  BitCount:=0;
  inc(DestLen,Length);
  result:=true;
 end;
 function InflateFixedBlock:boolean;
 begin
  result:=InflateBlockData(FixedSymbolLengthTree^,FixedDistanceTree^);
 end;
 function InflateDynamicBlock:boolean;
 begin
  DecodeTrees(SymbolLengthTree^,DistanceTree^);
  result:=InflateBlockData(SymbolLengthTree^,DistanceTree^);
 end;
 function Uncompress:boolean;
 var Final,r:boolean;
     BlockType:longword;
 begin
  result:=false;
  BitCount:=0;
  Final:=false;
  while not Final do begin
   Final:=GetBit<>0;
   BlockType:=ReadBits(2,0);
   case BlockType of
    0:begin
     r:=InflateUncompressedBlock;
    end;
    1:begin
     r:=InflateFixedBlock;
    end;
    2:begin
     r:=InflateDynamicBlock;
    end;
    else begin
     r:=false;
    end;
   end;
   if not r then begin
    exit;
   end;
  end;
  result:=true;
 end;
 function UncompressZLIB:boolean;
 var cmf,flg:byte;
     a32:longword;
 begin
  result:=false;
  Source:=InData;
  cmf:=byte(Source[0]);
  flg:=byte(Source[1]);
  if ((((cmf shl 8)+flg) mod 31)<>0) or ((cmf and $f)<>8) or ((cmf shr 4)>7) or ((flg and $20)<>0) then begin
   exit;
  end;
  a32:=(byte(Source[InLen-4]) shl 24) or (byte(Source[InLen-3]) shl 16) or (byte(Source[InLen-2]) shl 8) or (byte(Source[InLen-1]) shl 0);
  inc(Source,2);
  dec(InLen,6);
  SourceEnd:=@Source[InLen];
  result:=Uncompress;
  if not result then begin
   exit;
  end;
  result:=adler32(DestData,DestLen)=a32;
 end;
 function UncompressDirect:boolean;
 begin
  Source:=InData;
  SourceEnd:=@Source[InLen];
  result:=Uncompress;
 end;
begin
 DestData:=nil;
 LengthBits:=nil;
 DistanceBits:=nil;
 LengthBase:=nil;
 DistanceBase:=nil;
 SymbolLengthTree:=nil;
 DistanceTree:=nil;
 FixedSymbolLengthTree:=nil;
 FixedDistanceTree:=nil;
 try
  New(LengthBits);
  New(DistanceBits);
  New(LengthBase);
  New(DistanceBase);
  New(SymbolLengthTree);
  New(DistanceTree);
  New(FixedSymbolLengthTree);
  New(FixedDistanceTree);
  try
   begin
    FillChar(LengthBits^,sizeof(TBits),ansichar(#0));
    FillChar(DistanceBits^,sizeof(TBits),ansichar(#0));
    FillChar(LengthBase^,sizeof(TBase),ansichar(#0));
    FillChar(DistanceBase^,sizeof(TBase),ansichar(#0));
    FillChar(SymbolLengthTree^,sizeof(TTree),ansichar(#0));
    FillChar(DistanceTree^,sizeof(TTree),ansichar(#0));
    FillChar(FixedSymbolLengthTree^,sizeof(TTree),ansichar(#0));
    FillChar(FixedDistanceTree^,sizeof(TTree),ansichar(#0));
   end;
   begin
    BuildFixedTrees(FixedSymbolLengthTree^,FixedDistanceTree^);
    BuildBitsBase(pansichar(pointer(@LengthBits^[0])),pword(pointer(@LengthBase^[0])),4,3);
    BuildBitsBase(pansichar(pointer(@DistanceBits^[0])),pword(pointer(@DistanceBase^[0])),2,1);
    LengthBits^[28]:=0;
    LengthBase^[28]:=258;
   end;
   begin
    GetMem(DestData,4096);
    DestSize:=4096;
    Dest:=DestData;
    DestLen:=0;
    if ParseHeader then begin
     result:=UncompressZLIB;
    end else begin
     result:=UncompressDirect;
    end;
    if result then begin
     ReAllocMem(DestData,DestLen);
    end else if assigned(DestData) then begin
     FreeMem(DestData);
     DestData:=nil;
    end;
   end;
  finally
   if assigned(LengthBits) then begin
    Dispose(LengthBits);
   end;
   if assigned(DistanceBits) then begin
    Dispose(DistanceBits);
   end;
   if assigned(LengthBase) then begin
    Dispose(LengthBase);
   end;
   if assigned(DistanceBase) then begin
    Dispose(DistanceBase);
   end;
   if assigned(SymbolLengthTree) then begin
    Dispose(SymbolLengthTree);
   end;
   if assigned(DistanceTree) then begin
    Dispose(DistanceTree);
   end;
   if assigned(FixedSymbolLengthTree) then begin
    Dispose(FixedSymbolLengthTree);
   end;
   if assigned(FixedDistanceTree) then begin
    Dispose(FixedDistanceTree);
   end;
  end;
 except
  result:=false;
 end;
end;

type PPNGPixelEx=^TPNGPixelEx;
     TPNGPixelEx=packed record
      r,g,b,a:word;
     end;

     TPNGColorFunc=function(x:int64):TPNGPixelEx;

function ColorGray1(x:int64):TPNGPixelEx;
begin
 result.r:=(0-(x and 1)) and $ffff;
 result.g:=(0-(x and 1)) and $ffff;
 result.b:=(0-(x and 1)) and $ffff;
 result.a:=$ffff;
end;

function ColorGray2(x:int64):TPNGPixelEx;
begin
 result.r:=(x and 3) or ((x and 3) shl 2) or ((x and 3) shl 4) or ((x and 3) shl 6) or ((x and 3) shl 8) or ((x and 3) shl 10) or ((x and 3) shl 12) or ((x and 3) shl 14);
 result.g:=(x and 3) or ((x and 3) shl 2) or ((x and 3) shl 4) or ((x and 3) shl 6) or ((x and 3) shl 8) or ((x and 3) shl 10) or ((x and 3) shl 12) or ((x and 3) shl 14);
 result.b:=(x and 3) or ((x and 3) shl 2) or ((x and 3) shl 4) or ((x and 3) shl 6) or ((x and 3) shl 8) or ((x and 3) shl 10) or ((x and 3) shl 12) or ((x and 3) shl 14);
 result.a:=$ffff;
end;

function ColorGray4(x:int64):TPNGPixelEx;
begin
 result.r:=(x and $f) or ((x and $f) shl 4) or ((x and $f) shl 8) or ((x and $f) shl 12);
 result.g:=(x and $f) or ((x and $f) shl 4) or ((x and $f) shl 8) or ((x and $f) shl 12);
 result.b:=(x and $f) or ((x and $f) shl 4) or ((x and $f) shl 8) or ((x and $f) shl 12);
 result.a:=$ffff;
end;

function ColorGray8(x:int64):TPNGPixelEx;
begin
 result.r:=(x and $ff) or ((x and $ff) shl 8);
 result.g:=(x and $ff) or ((x and $ff) shl 8);
 result.b:=(x and $ff) or ((x and $ff) shl 8);
 result.a:=$ffff;
end;

function ColorGray16(x:int64):TPNGPixelEx;
begin
 result.r:=x and $ffff;
 result.g:=x and $ffff;
 result.b:=x and $ffff;
 result.a:=$ffff;
end;

function ColorGrayAlpha8(x:int64):TPNGPixelEx;
begin
 result.r:=(x and $00ff) or ((x and $00ff) shl 8);
 result.g:=(x and $00ff) or ((x and $00ff) shl 8);
 result.b:=(x and $00ff) or ((x and $00ff) shl 8);
 result.a:=(x and $ff00) or ((x and $ff00) shr 8);
end;

function ColorGrayAlpha16(x:int64):TPNGPixelEx;
begin
 result.r:=(x shr 16) and $ffff;
 result.g:=(x shr 16) and $ffff;
 result.b:=(x shr 16) and $ffff;
 result.a:=x and $ffff;
end;

function ColorColor8(x:int64):TPNGPixelEx;
begin
 result.r:=(x and $ff) or ((x and $ff) shl 8);
 result.g:=((x shr 8) and $ff) or (((x shr 8) and $ff) shl 8);
 result.b:=((x shr 16) and $ff) or (((x shr 16) and $ff) shl 8);
 result.a:=$ffff;
end;

function ColorColor16(x:int64):TPNGPixelEx;
begin
 result.r:=x and $ffff;
 result.g:=(x shr 16) and $ffff;
 result.b:=(x shr 32) and $ffff;
 result.a:=$ffff;
end;

function ColorColorAlpha8(x:int64):TPNGPixelEx;
begin
 result.r:=(x and $ff) or ((x and $ff) shl 8);
 result.g:=((x shr 8) and $ff) or (((x shr 8) and $ff) shl 8);
 result.b:=((x shr 16) and $ff) or (((x shr 16) and $ff) shl 8);
 result.a:=((x shr 24) and $ff) or (((x shr 24) and $ff) shl 8);
end;

function ColorColorAlpha16(x:int64):TPNGPixelEx;
begin
 result.r:=x and $ffff;
 result.g:=(x shr 16) and $ffff;
 result.b:=(x shr 32) and $ffff;
 result.a:=(x shr 48) and $ffff;
end;

function Paeth(a,b,c:longint):longint;
var p,pa,pb,pc:longint;
begin
 p:=(a+b)-c;
 pa:=abs(p-a);
 pb:=abs(p-b);
 pc:=abs(p-c);
 if (pa<=pb) and (pa<=pc) then begin
  result:=a;
 end else if pb<=pc then begin
  result:=b;
 end else begin
  result:=c;
 end;
end;

function LoadPNG(DataPointer:pointer;DataSize:longword;var ImageData:pointer;var ImageWidth,ImageHeight:longint;HeaderOnly:boolean):boolean;
type TBitsUsed=array[0..7] of longword;
     PByteArray=^TByteArray;
     TByteArray=array[0..65535] of byte;
     TColorData=int64;
const StartPoints:array[0..7,0..1] of word=((0,0),(0,0),(4,0),(0,4),(2,0),(0,2),(1,0),(0,1));
      Delta:array[0..7,0..1] of word=((1,1),(8,8),(8,8),(4,8),(4,4),(2,4),(2,2),(1,2));
      BitsUsed1Depth:TBitsUsed=($80,$40,$20,$10,$08,$04,$02,$01);
      BitsUsed2Depth:TBitsUsed=($c0,$30,$0c,$03,0,0,0,0);
      BitsUsed4Depth:TBitsUsed=($f0,$0f,0,0,0,0,0,0);
var DataEnd,DataPtr,DataNextChunk,DataPtrEx:pointer;
    ConvertColor:TPNGColorFunc;
    ByteWidth:longint;
    CountBitsUsed,BitShift,UsingBitGroup,DataIndex:longword;
    DataBytes:TColorData;
    DataBytes32:longword;
    BitDepth,StartX,StartY,DeltaX,DeltaY,{ImageBytesPerPixel,}WidthHeight:longint;
    BitsUsed:TBitsUsed;
    SwitchLine,CurrentLine,PreviousLine:PByteArray;
    CountScanlines,ScanLineLength:array[0..7] of longword;
    ChunkLength,ChunkType,Width,Height,ColorType,Comp,Filter,Interlace,CRC,
    PalImgBytes,ImgBytes,PaletteSize,l,ml:longword;
    First,HasTransparent,CgBI:boolean;
    Palette:array of array[0..3] of byte;
    TransparentColor:array of word;
    i,rx,ry,y{,BitsPerPixel,ImageLineWidth,ImageSize},StartPass,EndPass,d:longint;
    idata,DecompressPtr:pointer;
    idatasize,idatacapacity,idataexpandedsize,LineFilter:longword;
    idataexpanded:pointer;
 function GetU8(var p:pointer):byte;
 begin
  result:=byte(p^);
  inc(pansichar(p),sizeof(byte));
 end;
 function GetU16(var p:pointer):word;
 begin
  result:=GetU8(p) shl 8;
  result:=result or GetU8(p);
 end;
 function GetU32(var p:pointer):longword;
 begin
  result:=GetU16(p) shl 16;
  result:=result or GetU16(p);
 end;
 function CalcColor:TColorData;
 var r:word;
     b:byte;
 begin
  if UsingBitGroup=0 then begin
   DataBytes:=0;
   if BitDepth=16 then begin
    r:=1;
    while r<ByteWidth do begin
     b:=CurrentLine^[DataIndex+r];
     CurrentLine^[DataIndex+r]:=CurrentLine^[DataIndex+longword(r-1)];
     CurrentLine^[DataIndex+longword(r-1)]:=b;
     inc(r,2);
    end;
   end;
   Move(CurrentLine^[DataIndex],DataBytes,ByteWidth);
{$ifdef big_endian}
   DataBytes:=Swap64(DataBytes);
{$endif}
   inc(DataIndex,ByteWidth);
  end;
  if ByteWidth=1 then begin
   result:=(longword(DataBytes and BitsUsed[UsingBitGroup]) and $ffffffff) shr (((CountBitsUsed-UsingBitGroup)-1)*BitShift);
   inc(UsingBitgroup);
   if UsingBitGroup>=CountBitsUsed then begin
    UsingBitGroup:=0;
   end;
  end else begin
   result:=DataBytes;
  end;
 end;
 procedure HandleScanLine(const y,CurrentPass:longint;const ScanLine:PByteArray);
 var x,l:longint;
     c:TColorData;
     pe:TPNGPixelEx;
     p:PPNGPixel;
 begin
  UsingBitGroup:=0;
  DataIndex:=0;
  if length(Palette)<>0 then begin
   l:=length(Palette);
   for x:=0 to ScanlineLength[CurrentPass]-1 do begin
    c:=CalcColor;
    if c<l then begin
     p:=PPNGPixel(pointer(@pansichar(ImageData)[((y*longint(Width))+(StartX+(x*DeltaX)))*sizeof(TPNGPixel)]));
{$ifdef PNGHighDepth}
     p^.r:=Palette[c,0] or (Palette[c,0] shl 8);
     p^.g:=Palette[c,1] or (Palette[c,1] shl 8);
     p^.b:=Palette[c,2] or (Palette[c,2] shl 8);
     p^.a:=Palette[c,3] or (Palette[c,3] shl 8);
{$else}
     p^.r:=Palette[c,0];
     p^.g:=Palette[c,1];
     p^.b:=Palette[c,2];
     p^.a:=Palette[c,3];
{$endif}
    end;
   end;
  end else begin
   if addr(ConvertColor)=@ColorColorAlpha8 then begin
    l:=length(TransparentColor);
    for x:=0 to ScanlineLength[CurrentPass]-1 do begin
     DataBytes32:=longword(pointer(@CurrentLine^[DataIndex])^);
{$ifdef big_endian}
     DataBytes32:=Swap32(DataBytes32);
{$endif}
     inc(DataIndex,4);
     pe.r:=(DataBytes32 and $ff) or ((DataBytes32 and $ff) shl 8);
     pe.g:=((DataBytes32 shr 8) and $ff) or (((DataBytes32 shr 8) and $ff) shl 8);
     pe.b:=((DataBytes32 shr 16) and $ff) or (((DataBytes32 shr 16) and $ff) shl 8);
     pe.a:=((DataBytes32 shr 24) and $ff) or (((DataBytes32 shr 24) and $ff) shl 8);
     p:=PPNGPixel(pointer(@pansichar(ImageData)[((y*longint(Width))+(StartX+(x*DeltaX)))*sizeof(TPNGPixel)]));
     if (((l=1) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[0]) and (pe.b=TransparentColor[0])))) or
        (((l=3) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[1]) and (pe.b=TransparentColor[2])))) then begin
      pe.a:=0;
     end;
{$ifdef PNGHighDepth}
     p^.r:=pe.r;
     p^.g:=pe.g;
     p^.b:=pe.b;
     p^.a:=pe.a;
{$else}
     p^.r:=pe.r shr 8;
     p^.g:=pe.g shr 8;
     p^.b:=pe.b shr 8;
     p^.a:=pe.a shr 8;
{$endif}
    end;
   end else if addr(ConvertColor)=@ColorColor8 then begin
    l:=length(TransparentColor);
    for x:=0 to ScanlineLength[CurrentPass]-1 do begin
     DataBytes32:=longword(pointer(@CurrentLine^[DataIndex])^) and $00ffffff;
{$ifdef big_endian}
     DataBytes32:=Swap32(DataBytes32);
{$endif}
     inc(DataIndex,3);
     pe.r:=(DataBytes32 and $ff) or ((DataBytes32 and $ff) shl 8);
     pe.g:=((DataBytes32 shr 8) and $ff) or (((DataBytes32 shr 8) and $ff) shl 8);
     pe.b:=((DataBytes32 shr 16) and $ff) or (((DataBytes32 shr 16) and $ff) shl 8);
     pe.a:=$ffff;
     p:=PPNGPixel(pointer(@pansichar(ImageData)[((y*longint(Width))+(StartX+(x*DeltaX)))*sizeof(TPNGPixel)]));
     if (((l=1) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[0]) and (pe.b=TransparentColor[0])))) or
        (((l=3) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[1]) and (pe.b=TransparentColor[2])))) then begin
      pe.a:=0;
     end;
{$ifdef PNGHighDepth}
     p^.r:=pe.r;
     p^.g:=pe.g;
     p^.b:=pe.b;
     p^.a:=pe.a;
{$else}
     p^.r:=pe.r shr 8;
     p^.g:=pe.g shr 8;
     p^.b:=pe.b shr 8;
     p^.a:=pe.a shr 8;
{$endif}
    end;
   end else if assigned(ConvertColor) then begin
    l:=length(TransparentColor);
    for x:=0 to ScanlineLength[CurrentPass]-1 do begin
     pe:=ConvertColor(CalcColor);
     p:=PPNGPixel(pointer(@pansichar(ImageData)[((y*longint(Width))+(StartX+(x*DeltaX)))*sizeof(TPNGPixel)]));
     if (((l=1) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[0]) and (pe.b=TransparentColor[0])))) or
        (((l=3) and ((pe.r=TransparentColor[0]) and (pe.r=TransparentColor[1]) and (pe.b=TransparentColor[2])))) then begin
      pe.a:=0;
     end;
{$ifdef PNGHighDepth}
     p^.r:=pe.r;
     p^.g:=pe.g;
     p^.b:=pe.b;
     p^.a:=pe.a;
{$else}
     p^.r:=pe.r shr 8;
     p^.g:=pe.g shr 8;
     p^.b:=pe.b shr 8;
     p^.a:=pe.a shr 8;
{$endif}
    end;
   end;
  end;
 end;
 procedure CgBISwapBGR2RGBandUnpremultiply;
 const UnpremultiplyFactor={$ifdef PNGHighDepth}65535{$else}255{$endif};
       FullAlpha={$ifdef PNGHighDepth}65535{$else}255{$endif};
 var i,b,a:longint;
     p:PPNGPixel;
 begin
  a:=FullAlpha;
  p:=PPNGPixel(pointer(@pansichar(ImageData)[0]));
  for i:=0 to WidthHeight-1 do begin
   a:=a and p^.a;
   inc(p);
  end;
  if ((ColorType and 4)<>0) or (a<>FullAlpha) or HasTransparent then begin
   p:=PPNGPixel(pointer(@pansichar(ImageData)[0]));
   for i:=0 to WidthHeight-1 do begin
    a:=p^.a;
    if a<>0 then begin
     b:=p^.b;
     p^.b:=(p^.r*UnpremultiplyFactor) div a;
     p^.r:=(b*UnpremultiplyFactor) div a;
     p^.g:=(p^.g*UnpremultiplyFactor) div a;
    end else begin
     b:=p^.b;
     p^.b:=p^.r;
     p^.r:=b;
    end;
    inc(p);
   end;
  end else begin
   p:=PPNGPixel(pointer(@pansichar(ImageData)[0]));
   for i:=0 to WidthHeight-1 do begin
    b:=p^.b;
    p^.b:=p^.r;
    p^.r:=b;
    inc(p);
   end;
  end;
 end;
begin
 result:=false;
 ImageData:=nil;
 try
  Palette:=nil;
  TransparentColor:=nil;
  idataexpanded:=nil;
  idata:=nil;
  idataexpanded:=nil;
  try
   if (assigned(DataPointer) and (DataSize>8)) and
      ((pansichar(DataPointer)[0]=#$89) and (pansichar(DataPointer)[1]=#$50) and (pansichar(DataPointer)[2]=#$4e) and (pansichar(DataPointer)[3]=#$47) and
       (pansichar(DataPointer)[4]=#$0d) and (pansichar(DataPointer)[5]=#$0a) and (pansichar(DataPointer)[6]=#$1a) and (pansichar(DataPointer)[7]=#$0a)) then begin
    DataEnd:=@pansichar(DataPointer)[DataSize];
    First:=true;
    PalImgBytes:=0;
    ImgBytes:=0;
    DataPtr:=@pansichar(DataPointer)[8];
    Width:=0;
    Height:=0;
    idatasize:=0;
    idatacapacity:=0;
    PaletteSize:=0;
    idataexpandedsize:=0;
    BitDepth:=0;
    ColorType:=0;
    Interlace:=0;
    WidthHeight:=0;
    DataBytes:=0;
    CgBI:=false;
    HasTransparent:=false;
    while (pansichar(DataPtr)+11)<pansichar(DataEnd) do begin
     ChunkLength:=GetU32(DataPtr);
     if (pansichar(DataPtr)+(4+ChunkLength))>pansichar(DataEnd) then begin
      result:=false;
      break;
     end;
     DataPtrEx:=DataPtr;
     ChunkType:=GetU32(DataPtr);
     DataNextChunk:=@pansichar(DataPtr)[ChunkLength];
     CRC:=GetU32(DataNextChunk);
     if CRC32(DataPtrEx,ChunkLength+4)<>CRC then begin
      result:=false;
      break;
     end;
     case ChunkType of
      longword((ord('C') shl 24) or (ord('g') shl 16) or (ord('B') shl 8) or ord('I')):begin // CgBI
       CgBI:=true;
      end;
      longword((ord('I') shl 24) or (ord('H') shl 16) or (ord('D') shl 8) or ord('R')):begin // IHDR
       if ChunkLength=13 then begin
        if not First then begin
         result:=false;
         break;
        end;
        First:=false;
        Width:=GetU32(DataPtr);
        Height:=GetU32(DataPtr);
        if ((Width>(1 shl 24)) or (Height>(1 shl 24))) or ((Width=0) or (Height=0)) then begin
         result:=false;
         break;
        end;
        if HeaderOnly then begin
         result:=true;
         break;
        end;
        BitDepth:=GetU8(DataPtr);
        if not (BitDepth in [1,2,4,8]) then begin
         result:=false;
         break;
        end;
        ColorType:=GetU8(DataPtr);
        if (ColorType>6) or ((ColorType<>3) and ((ColorType and 1)<>0)) then begin
         result:=false;
         exit;
        end else if ColorType=3 then begin
         PalImgBytes:=3;
        end;
        Comp:=GetU8(DataPtr);
        if Comp<>0 then begin
         result:=false;
         break;
        end;
        Filter:=GetU8(DataPtr);
        if Filter<>0 then begin
         result:=false;
         break;
        end;
        Interlace:=GetU8(DataPtr);
        if Interlace>1 then begin
         result:=false;
         break;
        end;
        if PalImgBytes=0 then begin
         if (ColorType and 2)<>0 then begin
          ImgBytes:=3;
         end else begin
          ImgBytes:=1;
         end;
         if (ColorType and 4)<>0 then begin
          inc(ImgBytes);
         end;
         if (((1 shl 30) div Width) div ImgBytes)<Height then begin
          result:=false;
          break;
         end;
        end else begin
         ImgBytes:=1;
         if (((1 shl 30) div Width) div 4)<Height then begin
          result:=false;
          break;
         end;
        end;
       end else begin
        result:=false;
        break;
       end;
      end;
      longword((ord('P') shl 24) or (ord('L') shl 16) or (ord('T') shl 8) or ord('E')):begin // PLTE
       if First then begin
        result:=false;
        break;
       end;
       case PalImgBytes of
        3:begin
         PaletteSize:=ChunkLength div 3;
         if (PaletteSize*3)<>ChunkLength then begin
          result:=false;
          break;
         end;
         SetLength(Palette,PaletteSize);
         for i:=0 to PaletteSize-1 do begin
          Palette[i,0]:=GetU8(DataPtr);
          Palette[i,1]:=GetU8(DataPtr);
          Palette[i,2]:=GetU8(DataPtr);
          Palette[i,3]:=$ff;
         end;
        end;
        4:begin
         PaletteSize:=ChunkLength div 4;
         if (PaletteSize*4)<>ChunkLength then begin
          result:=false;
          exit;
         end;
         SetLength(Palette,PaletteSize);
         for i:=0 to PaletteSize-1 do begin
          Palette[i,0]:=GetU8(DataPtr);
          Palette[i,1]:=GetU8(DataPtr);
          Palette[i,2]:=GetU8(DataPtr);
          Palette[i,3]:=GetU8(DataPtr);
         end;
        end;
        else begin
         result:=false;
         break;
        end;
       end;
      end;
      longword((ord('t') shl 24) or (ord('R') shl 16) or (ord('N') shl 8) or ord('S')):begin // tRNS
       if First or assigned(idata) then begin
        result:=false;
        break;
       end;
       if PalImgBytes<>0 then begin
        if (length(Palette)=0) or (longint(ChunkLength)>length(Palette)) then begin
         result:=false;
         break;
        end;
        PalImgBytes:=4;
        for i:=0 to PaletteSize-1 do begin
         Palette[i,3]:=GetU8(DataPtr);
        end;
       end else begin
        if ChunkLength=ImgBytes then begin
         SetLength(TransparentColor,longint(ImgBytes));
         for i:=0 to longint(ImgBytes)-1 do begin
          d:=GetU8(DataPtr);
          TransparentColor[i]:=d or (d shl 8);
         end;
        end else begin
         if ((ImgBytes and 1)=0) or (ChunkLength<>(ImgBytes*2)) then begin
          result:=false;
          break;
         end;
         HasTransparent:=true;
         SetLength(TransparentColor,longint(ImgBytes));
         for i:=0 to longint(ImgBytes)-1 do begin
          TransparentColor[i]:=GetU16(DataPtr);
         end;
        end;
       end;
      end;
      longword((ord('I') shl 24) or (ord('D') shl 16) or (ord('A') shl 8) or ord('T')):begin // IDAT
       if First or ((PalImgBytes<>0) and (length(Palette)=0)) then begin
        result:=false;
        break;
       end;
       if (idatasize=0) or (idatacapacity=0) or not assigned(idata) then begin
        idatasize:=ChunkLength;
        idatacapacity:=ChunkLength;
        GetMem(idata,idatacapacity);
        Move(DataPtr^,idata^,ChunkLength);
       end else begin
        if (idatasize+ChunkLength)>=idatacapacity then begin
         if idatacapacity=0 then begin
          idatacapacity:=1;
         end;
         while (idatasize+ChunkLength)>=idatacapacity do begin
          inc(idatacapacity,idatacapacity);
         end;
         ReallocMem(idata,idatacapacity);
        end;
        Move(DataPtr^,pansichar(idata)[idatasize],ChunkLength);
        inc(idatasize,ChunkLength);
       end;
      end;
      longword((ord('I') shl 24) or (ord('E') shl 16) or (ord('N') shl 8) or ord('D')):begin // IEND
       if First or ((PalImgBytes<>0) and (length(Palette)=0)) or not assigned(idata) then begin
        result:=false;
        break;
       end;
       if not DoInflate(idata,idatasize,idataexpanded,idataexpandedsize,not CgBI) then begin
        result:=false;
        break;
       end;
//     BitsPerPixel:=longint(ImgBytes)*BitDepth;
       ImageWidth:=Width;
       ImageHeight:=Height;
       WidthHeight:=Width*Height;
//     ImageBytesPerPixel:=((longint(ImgBytes)*longint(BitDepth))+7) shr 3;
//     ImageLineWidth:=((ImageWidth*BitsPerPixel)+7) shr 3;
//     ImageSize:=(((ImageWidth*ImageHeight)*BitsPerPixel)+7) shr 3;
       GetMem(ImageData,(ImageWidth*ImageHeight)*sizeof(TPNGPixel));
       try
        CountBitsUsed:=0;
        case Interlace of
         0:begin
          StartPass:=0;
          EndPass:=0;
          CountScanlines[0]:=Height;
          ScanLineLength[0]:=Width;
         end;
         1:begin
          StartPass:=1;
          EndPass:=7;
          for i:=1 to 7 do begin
           d:=Height div Delta[i,1];
           if (Height mod Delta[i,1])>StartPoints[i,1] then begin
            inc(d);
           end;
           CountScanLines[i]:=d;
           d:=Width div Delta[i,0];
           if (Width mod Delta[i,0])>StartPoints[i,0] then begin
            inc(d);
           end;
           ScanLineLength[i]:=d;
          end;
         end;
         else begin
          if assigned(ImageData) then begin
           FreeMem(ImageData);
           ImageData:=nil;
          end;
          result:=false;
          break;
         end;
        end;
        ByteWidth:=0;
        ConvertColor:=nil;
        case ColorType of
         0:begin
          case BitDepth of
           1:begin
            ConvertColor:=@ColorGray1;
            ByteWidth:=1;
           end;
           2:begin
            ConvertColor:=@ColorGray2;
            ByteWidth:=1;
           end;
           4:begin
            ConvertColor:=@ColorGray4;
            ByteWidth:=1;
           end;
           8:begin
            ConvertColor:=@ColorGray8;
            ByteWidth:=1;
           end;
           16:begin
            ConvertColor:=@ColorGray16;
            ByteWidth:=2;
           end;
          end;
         end;
         2:begin
          if BitDepth=8 then begin
           ConvertColor:=@ColorColor8;
           ByteWidth:=3;
          end else begin
           ConvertColor:=@ColorColor16;
           ByteWidth:=6;
          end;
         end;
         3:begin
          if BitDepth=16 then begin
           ByteWidth:=2;
          end else begin
           ByteWidth:=1;
          end;
         end;
         4:begin
          if BitDepth=8 then begin
           ConvertColor:=@ColorGrayAlpha8;
           ByteWidth:=2;
          end else begin
           ConvertColor:=@ColorGrayAlpha16;
           ByteWidth:=4;
          end;
         end;
         6:begin
          if BitDepth=8 then begin
           ConvertColor:=@ColorColorAlpha8;
           ByteWidth:=4;
          end else begin
           ConvertColor:=@ColorColorAlpha16;
           ByteWidth:=8;
          end;
         end;
        end;
        case BitDepth of
         1:begin
          CountBitsUsed:=8;
          BitShift:=1;
          BitsUsed:=BitsUsed1Depth;
         end;
         2:begin
          CountBitsUsed:=4;
          BitShift:=2;
          BitsUsed:=BitsUsed2Depth;
         end;
         4:begin
          CountBitsUsed:=2;
          BitShift:=4;
          BitsUsed:=BitsUsed4Depth;
         end;
         8:begin
          CountBitsUsed:=1;
          BitShift:=0;
          BitsUsed[0]:=$ff;
         end;
        end;
        DecompressPtr:=idataexpanded;
        ml:=16;
        try
         GetMem(PreviousLine,16);
         GetMem(CurrentLine,16);
         for i:=StartPass to EndPass do begin
          StartX:=StartPoints[i,0];
          StartY:=StartPoints[i,1];
          DeltaX:=Delta[i,0];
          DeltaY:=Delta[i,1];
          if ByteWidth=1 then begin
           l:=ScanLineLength[i] div CountBitsUsed;
           if (ScanLineLength[i] mod CountBitsUsed)>0 then begin
            inc(l);
           end;
          end else begin
           l:=ScanLineLength[i]*longword(ByteWidth);
          end;
          if ml=0 then begin
           GetMem(PreviousLine,l);
           GetMem(CurrentLine,l);
          end else if ml<l then begin
           ReallocMem(PreviousLine,l);
           ReallocMem(CurrentLine,l);
          end;
          ml:=l;
          FillChar(CurrentLine^,l,ansichar(#0));
          for ry:=0 to CountScanlines[i]-1 do begin
           SwitchLine:=CurrentLine;
           CurrentLine:=PreviousLine;
           PreviousLine:=SwitchLine;
           y:=StartY+(ry*DeltaY);
           LineFilter:=GetU8(DecompressPtr);
           Move(DecompressPtr^,CurrentLine^,l);
           inc(pansichar(DecompressPtr),l);
           case LineFilter of
            1:begin // Sub
             for rx:=0 to l-1 do begin
              if rx<ByteWidth then begin
               CurrentLine^[rx]:=CurrentLine^[rx] and $ff;
              end else begin
               CurrentLine^[rx]:=(CurrentLine^[rx]+CurrentLine^[rx-ByteWidth]) and $ff;
              end;
             end;
            end;
            2:begin // Up
             for rx:=0 to l-1 do begin
              CurrentLine^[rx]:=(CurrentLine^[rx]+PreviousLine^[rx]) and $ff;
             end;
            end;
            3:begin // Average
             for rx:=0 to l-1 do begin
              if rx<ByteWidth then begin
               CurrentLine^[rx]:=(CurrentLine^[rx]+(PreviousLine^[rx] div 2)) and $ff;
              end else begin
               CurrentLine^[rx]:=(CurrentLine^[rx]+((CurrentLine^[rx-ByteWidth]+PreviousLine^[rx]) div 2)) and $ff;
              end;
             end;
            end;
            4:begin // Paeth
             for rx:=0 to l-1 do begin
              if rx<ByteWidth then begin             
               CurrentLine^[rx]:=(CurrentLine^[rx]+Paeth(0,PreviousLine^[rx],0)) and $ff;
              end else begin
               CurrentLine^[rx]:=(CurrentLine^[rx]+Paeth(CurrentLine^[rx-ByteWidth],PreviousLine^[rx],PreviousLine^[rx-ByteWidth])) and $ff;
              end;
             end;
            end;
           end;
           HandleScanLine(y,i,CurrentLine);
          end;
         end;
        finally
         FreeMem(PreviousLine);
         FreeMem(CurrentLine);
        end;
        if CgBI then begin
         CgBISwapBGR2RGBandUnpremultiply;
        end;
       finally
       end;
       result:=true;
       break;
      end;
      else begin
      end;
     end;
     DataPtr:=DataNextChunk;
    end;
   end;
  finally
   SetLength(Palette,0);
   SetLength(TransparentColor,0);
   if assigned(idata) then begin
    FreeMem(idata);
    idata:=nil;
   end;
   if assigned(idataexpanded) then begin
    FreeMem(idataexpanded);
    idataexpanded:=nil;
   end;
  end;
 except
  if assigned(ImageData) then begin
   FreeMem(ImageData);
   ImageData:=nil;
  end;
  result:=false;
 end;
end;

initialization
finalization
end.