sxpngutils.pas

skin components for design of your applicastions

  if Assigned(ChunkClasses) then
    for i:=0 to ChunkClasses.Count-1 do
    begin
      if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName=Name then
      begin
        NewChunk:=pChunkClassInfo(ChunkClasses.Item[i])^.ClassName;
        break;
      end;
    end;
  Result:=NewChunk.Create(Owner);
  Result.fName:=Name;
end;

const ZLIBAllocate=High(Word);

function ZLIBInitInflate(Stream:TStream):TZStreamRec2;
begin
 FillChar(Result,sizeof(TZStreamRec2),#0);
 with Result do
  begin
    GetMem(Data,ZLIBAllocate);
    fStream:=Stream;
  end;
 InflateInit_(Result.zlib,zlib_version,sizeof(TZStreamRec));
end;

function ZLIBInitDeflate(Stream:TStream;
  Level:TCompressionlevel;Size:Cardinal):TZStreamRec2;
begin
  FillChar(Result,sizeof(TZStreamRec2),#0);
  with Result,ZLIB do
  begin
    GetMem(Data,Size);
    fStream:=Stream;
    next_out:=Data;
    avail_out:=Size;
  end;
  deflateInit_(Result.zlib,Level,zlib_version,sizeof(TZStreamRec));
end;

procedure ZLIBTerminateDeflate(var ZLIBStream:TZStreamRec2);
begin
  DeflateEnd(ZLIBStream.zlib);
  FreeMem(ZLIBStream.Data,ZLIBAllocate);
end;

procedure ZLIBTerminateInflate(var ZLIBStream:TZStreamRec2);
begin
  InflateEnd(ZLIBStream.zlib);
  FreeMem(ZLIBStream.Data,ZLIBAllocate);
end;

function DecompressZLIB(const Input:Pointer;InputSize:Integer;
  var Output:Pointer;var OutputSize:Integer;
  var ErrorOutput:String):Boolean;
var
  StreamRec:TZStreamRec;
  Buffer:array[Byte]of Byte;
  InflateRet:Integer;
begin
  with StreamRec do
  begin
    Result:=True;
    OutputSize:=0;
    FillChar(StreamRec,sizeof(TZStreamRec),#0);
    InflateInit_(StreamRec,zlib_version,sizeof(TZStreamRec));
    next_in:=Input;
    avail_in:=InputSize;
    repeat
      if (avail_out=0) then
      begin
        next_out:=@Buffer;
        avail_out:=sizeof(Buffer);
      end;
      InflateRet:=inflate(StreamRec,0);
      if (InflateRet=Z_STREAM_END) or (InflateRet=0) then
      begin
        Inc(OutputSize,total_out);
        if Output=nil then
          GetMem(Output,OutputSize) else ReallocMem(Output,OutputSize);
        CopyMemory(Ptr(Longint(Output)+OutputSize-total_out),
          @Buffer,total_out);
      end
      else if InflateRet<0 then
      begin
        Result:=False;
        ErrorOutput:=StreamRec.msg;
        InflateEnd(StreamRec);
        exit;
      end;
    until InflateRet=Z_STREAM_END;
    InflateEnd(StreamRec);
  end;
end;

function CompressZLIB(Input:Pointer;InputSize,CompressionLevel:Integer;
  var Output:Pointer;var OutputSize:Integer;
  var ErrorOutput:String):Boolean;
var
  StreamRec:TZStreamRec;
  Buffer:array[Byte]of Byte;
  DeflateRet:Integer;
begin
  with StreamRec do
  begin
    Result:=True;
    OutputSize:=0;
    FillChar(StreamRec,sizeof(TZStreamRec),#0);
    DeflateInit_(StreamRec,CompressionLevel,zlib_version,sizeof(TZStreamRec));
    next_in:=Input;
    avail_in:=InputSize;
    while avail_in>0 do
    begin
      if avail_out=0 then
      begin
        next_out:=@Buffer;
        avail_out:=sizeof(Buffer);
      end;
      DeflateRet:=deflate(StreamRec,Z_FINISH);
      if (DeflateRet=Z_STREAM_END) or (DeflateRet=0) then
      begin
        Inc(OutputSize,total_out);
        if Output=nil then
          GetMem(Output,OutputSize) else ReallocMem(Output,OutputSize);
        CopyMemory(Ptr(Longint(Output)+OutputSize-total_out),
          @Buffer,total_out);
      end
      else if DeflateRet<0 then
      begin
        Result:=False;
        ErrorOutput:=StreamRec.msg;
        DeflateEnd(StreamRec);
        exit;
      end;
    end;
    DeflateEnd(StreamRec);
  end;
end;

constructor TPNGPointerList.Create(AOwner:TPNGObject);
begin
 inherited Create;
 fOwner:=AOwner;
end;

function TPNGPointerList.Remove(Value:Pointer):Pointer;
var
  I,Position:Integer;
begin
  Position:=-1;
  for I:=0 to Count-1 do
    if Value=Item[I] then Position:=I;
  if Position>=0 then
  begin
    Result:=Item[Position];
    Dec(fCount);
    if Position<Integer(FCount) then
      System.Move(fMemory^[Position+1],fMemory^[Position],
      (Integer(fCount)-Position)*sizeof(Pointer));
  end else Result:=nil
end;

procedure TPNGPointerList.Add(Value:Pointer);
begin
  Count:=Count+1;
  Item[Count-1]:=Value;
end;

destructor TPNGPointerList.Destroy;
begin
 if fMemory<>nil then
  FreeMem(fMemory,fCount*sizeof(Pointer));
 inherited Destroy;
end;

function TPNGPointerList.GetItem(Index:Cardinal):Pointer;
begin
  if (Index<=Count-1) then
    Result:=fMemory[Index]
  else
    Result:=nil;
end;

procedure TPNGPointerList.Insert(Value:Pointer;Position:Cardinal);
begin
  if (Position<Count) then
  begin
    SetSize(Count+1);
    if Position<Count then
      System.Move(fMemory^[Position],fMemory^[Position+1],
        (Count-Position-1)*sizeof(Pointer));
    Item[Position]:=Value;
  end;
end;

procedure TPNGPointerList.SetItem(Index:Cardinal;const Value:Pointer);
begin
  if (Index<=Count-1) then
    fMemory[Index]:=Value
end;

procedure TPNGPointerList.SetSize(const Size:Cardinal);
begin
  if (fMemory=nil) and (Size>0) then
    GetMem(fMemory,Size*sizeof(Pointer))
  else
    if Size>0 then
      ReallocMem(fMemory,Size*sizeof(Pointer))
    else
    begin
      FreeMem(fMemory);
      fMemory:=nil;
    end;
  fCount:=Size;
end;

procedure TPNGList.RemoveChunk(Chunk:TChunk);
begin
  Remove(Chunk);
  Chunk.Free
end;

function TPNGList.Add(ChunkClass:TChunkClass):TChunk;
var
  IHDR:TChunkIHDR;
  IEND:TChunkIEND;

  IDAT:TChunkIDAT;
  PLTE:TChunkPLTE;
begin
  Result:=nil;
  if (ChunkClass=TChunkIHDR) or (ChunkClass=TChunkIDAT) or
    (ChunkClass=TChunkPLTE) or (ChunkClass=TChunkIEND) then
    fOwner.RaiseError(EPNGError,EPNGCannotAddChunkText)
  else if ((ChunkClass=TChunkgAMA) and (ItemFromClass(TChunkgAMA)<>nil)) or
     ((ChunkClass=TChunktRNS) and (ItemFromClass(TChunktRNS)<>nil)) then
    fOwner.RaiseError(EPNGError,EPNGCannotAddChunkText)
  else if (ItemFromClass(TChunkIEND)=nil) or
    (ItemFromClass(TChunkIHDR)=nil) then
    fOwner.RaiseError(EPNGError,EPNGCannotAddInvalidImageText)
  else
  begin
    IHDR:=ItemFromClass(TChunkIHDR) as TChunkIHDR;
    IEND:=ItemFromClass(TChunkIEND) as TChunkIEND;
    Result:=ChunkClass.Create(Owner);
    if (ChunkClass=TChunkgAMA) then
      Insert(Result,IHDR.Index+1)
    else if (ChunkClass=TChunktRNS) then
    begin
      IDAT:=ItemFromClass(TChunkIDAT) as TChunkIDAT;
      PLTE:=ItemFromClass(TChunkPLTE) as TChunkPLTE;
      if Assigned(PLTE) then
        Insert(Result,PLTE.Index+1)
      else if Assigned(IDAT) then
        Insert(Result,IDAT.Index)
      else
        Insert(Result,IHDR.Index+1)
    end
    else
      Insert(Result,IEND.Index);
  end;
end;

function TPNGList.GetItem(Index:Cardinal):TChunk;
begin
  Result:=inherited GetItem(Index);
end;

function TPNGList.ItemFromClass(ChunkClass:TChunkClass):TChunk;
var
  i:Integer;
begin
  Result:=nil;
  for i:=0 to Count-1 do
    if Item[i] is ChunkClass then
    begin
      Result:=Item[i];
      break;
    end;
end;

procedure TChunk.ResizeData(const NewSize:Cardinal);
begin
  fDataSize:=NewSize;
  ReallocMem(fData,NewSize+1);
end;

function TChunk.GetIndex:Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=0 to Owner.Chunks.Count-1 do
    if Owner.Chunks.Item[i]=Self then
    begin
      Result:=i;
      exit;
    end;
end;

function TChunk.GetHeader:TChunkIHDR;
begin
  Result:=Owner.Chunks.Item[0] as TChunkIHDR;
end;

procedure TChunk.Assign(Source:TChunk);
begin
  fName:=Source.fName;
  ResizeData(Source.fDataSize);
  if fDataSize>0 then CopyMemory(fData,Source.fData,fDataSize);
end;

constructor TChunk.Create(Owner:TPNGObject);
var
  ChunkName:String;
begin
  inherited Create;
  ChunkName:=Copy(ClassName,Length('TChunk')+1,Length(ClassName));
  if Length(ChunkName)=4 then CopyMemory(@fName[0],@ChunkName[1],4);
  GetMem(fData,1);
  fDataSize:=0;
  fOwner:=Owner;
end;

destructor TChunk.Destroy;
begin
 FreeMem(fData,fDataSize+1);
 inherited Destroy;
end;

function TChunk.GetChunkName:String;
begin
  Result:=fName
end;

class function TChunk.GetName:String;
begin
  Result:=Copy(ClassName,Length('TChunk')+1,Length(ClassName));
end;

function TChunk.SaveData(Stream:TStream):Boolean;
var ChunkSize,ChunkCRC:Cardinal;
begin
  ChunkSize:=ByteSwap(DataSize);
  Stream.Write(ChunkSize,4);
  Stream.Write(fName,4);
  if DataSize>0 then Stream.Write(Data^,DataSize);
  ChunkCRC:=update_crc($ffffffff,@fName[0],4);
  ChunkCRC:=Byteswap(update_crc(ChunkCRC,Data,DataSize) xor $ffffffff);
  Stream.Write(ChunkCRC,4);
  Result:=True;
end;

function TChunk.SaveToStream(Stream:TStream):Boolean;
begin
  Result:=SaveData(Stream)
end;

function TChunk.LoadFromStream(Stream:TStream;const ChunkName:TChunkName;
  Size:Integer):Boolean;
var
  CheckCRC:Cardinal;
  RightCRC:Cardinal;
begin
  ResizeData(Size);
  if Size>0 then Stream.Read(fData^,Size);
  Stream.Read(CheckCRC,4);
  CheckCrc:=ByteSwap(CheckCRC);
  RightCRC:=update_crc($ffffffff,@ChunkName[0],4);
  RightCRC:=update_crc(RightCRC,fData,Size) xor $ffffffff;
  Result:=RightCRC=CheckCrc;
  if not Result then
   begin
    Owner.RaiseError(EPNGInvalidCRC,EPNGInvalidCRCText);
    exit;
   end;
end;

function TChunktIME.LoadFromStream(Stream:TStream;
  const ChunkName:TChunkName;Size:Integer):Boolean;
begin
  Result:=inherited LoadFromStream(Stream,ChunkName,Size);
  if not Result or (Size<>7) then exit;
  fYear:=((PByte(Longint(Data) )^)*256)+ (PByte(Longint(Data)+1)^);
  fMonth:=PByte(Longint(Data)+2)^;
  fDay:=PByte(Longint(Data)+3)^;
  fHour:=PByte(Longint(Data)+4)^;
  fMinute:=PByte(Longint(Data)+5)^;
  fSecond:=PByte(Longint(Data)+6)^;
end;

function TChunktIME.SaveToStream(Stream:TStream):Boolean;
begin
  ResizeData(7);
  PWord(Data)^:=Year;
  PByte(Longint(Data)+2)^:=Month;
  PByte(Longint(Data)+3)^:=Day;
  PByte(Longint(Data)+4)^:=Hour;
  PByte(Longint(Data)+5)^:=Minute;
  PByte(Longint(Data)+6)^:=Second;
  Result:=inherited SaveToStream(Stream);
end;

function TChunkzTXt.LoadFromStream(Stream:TStream;