pngimage.pas

iocopm3.04源码,一套很好的工控开发工具

  function TFileStream.Read(var Buffer; Count: Longint): Cardinal;
  begin
    if not ReadFile(fHandle, Buffer, Count, Result, nil) then
      Result := 0;
  end;

  {Seeks the file position}
  function TFileStream.Seek(Offset: Integer; Origin: Word): Longint;
  begin
    Result := SetFilePointer(fHandle, Offset, nil, Origin);
  end;

  {Sets the size of the file}
  procedure TFileStream.SetSize(const Value: Longint);
  begin
    Seek(Value, soFromBeginning);
    SetEndOfFile(fHandle);
  end;

  {TResourceStream implementation}

  {Creates the resource stream}
  constructor TResourceStream.Create(Instance: HInst; const ResName: String;
    ResType: PChar);
  var
    ResID: HRSRC;
    ResGlobal: HGlobal;
  begin
    {Obtains the resource ID}
    ResID := FindResource(hInstance, PChar(ResName), RT_RCDATA);
    if ResID = 0 then raise EPNGError.Create('');
    {Obtains memory and size}
    ResGlobal := LoadResource(hInstance, ResID);
    Size := SizeOfResource(hInstance, ResID);
    Memory := LockResource(ResGlobal);
    if (ResGlobal = 0) or (Memory = nil) then EPNGError.Create('');
  end;


  {Setting resource stream size is not supported}
  procedure TResourceStream.SetSize(const Value: Integer);
  begin
  end;

  {Writing into a resource stream is not supported}
  function TResourceStream.Write(const Buffer; Count: Integer): Cardinal;
  begin
    Result := 0;
  end;

  {Reads data from the stream}
  function TResourceStream.Read(var Buffer; Count: Integer): Cardinal;
  begin
    //Returns data
    CopyMemory(@Buffer, Ptr(Longint(Memory) + Position), Count);
    //Update position
    inc(Position, Count);
    //Returns
    Result := Count;
  end;

  {Seeks data}
  function TResourceStream.Seek(Offset: Integer; Origin: Word): Longint;
  begin
    {Move depending on the origin}
    case Origin of
      soFromBeginning: Position := Offset;
      soFromCurrent: inc(Position, Offset);
      soFromEnd: Position := Size + Offset;
    end;

    {Returns the current position}
    Result := Position;
  end;

{$ENDIF}

{TChunk implementation}

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

{Returns index from list}
function TChunk.GetIndex: Integer;
var
  i: Integer;
begin
  Result := -1; {Avoiding warnings}
  {Searches in the list}
  FOR i := 0 TO Owner.Chunks.Count - 1 DO
    if Owner.Chunks.Item[i] = Self then
    begin
      {Found match}
      Result := i;
      exit;
    end {for i}
end;

{Returns pointer to the TChunkIHDR}
function TChunk.GetHeader: TChunkIHDR;
begin
  Result := Owner.Chunks.Item[0] as TChunkIHDR;
end;

{Assigns from another TChunk}
procedure TChunk.Assign(Source: TChunk);
begin
  {Copy properties}
  fName := Source.fName;
  {Set data size and realloc}
  ResizeData(Source.fDataSize);

  {Copy data (if there's any)}
  if fDataSize > 0 then CopyMemory(fData, Source.fData, fDataSize);
end;

{Chunk being created}
constructor TChunk.Create(Owner: TPngObject);
var
  ChunkName: String;
begin
  {Ancestor create}
  inherited Create;

  {If it's a registered class, set the chunk name based on the class}
  {name. For instance, if the class name is TChunkgAMA, the GAMA part}
  {will become the chunk name}
  ChunkName := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
  if Length(ChunkName) = 4 then CopyMemory(@fName[0], @ChunkName[1], 4);

  {Initialize data holder}
  GetMem(fData, 1);
  fDataSize := 0;
  {Record owner}
  fOwner := Owner;
end;

{Chunk being destroyed}
destructor TChunk.Destroy;
begin
  {Free data holder}
  FreeMem(fData, fDataSize + 1);
  {Let ancestor destroy}
  inherited Destroy;
end;

{Returns the chunk name 1}
function TChunk.GetChunkName: String;
begin
  Result := fName
end;

{Returns the chunk name 2}
class function TChunk.GetName: String;
begin
  {For avoid writing GetName for each TChunk descendent, by default for}
  {classes which don't declare GetName, it will look for the class name}
  {to extract the chunk kind. Example, if the class name is TChunkIEND }
  {this method extracts and returns IEND}
  Result := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
end;

{Saves the data to the stream}
function TChunk.SaveData(Stream: TStream): Boolean;
var
  ChunkSize, ChunkCRC: Cardinal;
begin
  {First, write the size for the following data in the chunk}
  ChunkSize := ByteSwap(DataSize);
  Stream.Write(ChunkSize, 4);
  {The chunk name}
  Stream.Write(fName, 4);
  {If there is data for the chunk, write it}
  if DataSize > 0 then Stream.Write(Data^, DataSize);
  {Calculates and write CRC}
  ChunkCRC := update_crc($ffffffff, @fName[0], 4);
  ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff);
  Stream.Write(ChunkCRC, 4);

  {Returns that everything went ok}
  Result := TRUE;
end;

{Saves the chunk to the stream}
function TChunk.SaveToStream(Stream: TStream): Boolean;
begin
  Result := SaveData(Stream)
end;


{Loads the chunk from a stream}
function TChunk.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  Size: Integer): Boolean;
var
  CheckCRC: Cardinal;
  {$IFDEF CheckCRC}RightCRC: Cardinal;{$ENDIF}
begin
  {Copies data from source}
  ResizeData(Size);
  if Size > 0 then Stream.Read(fData^, Size);
  {Reads CRC}
  Stream.Read(CheckCRC, 4);
  CheckCrc := ByteSwap(CheckCRC);

  {Check if crc readed is valid}
  {$IFDEF CheckCRC}
    RightCRC := update_crc($ffffffff, @ChunkName[0], 4);
    RightCRC := update_crc(RightCRC, fData, Size) xor $ffffffff;
    Result := RightCRC = CheckCrc;

    {Handle CRC error}
    if not Result then
    begin
      {In case it coult not load chunk}
      Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
      exit;
    end
  {$ELSE}Result := TRUE; {$ENDIF}

end;

{TChunktIME implementation}

{Chunk being loaded from a stream}
function TChunktIME.LoadFromStream(Stream: TStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
begin
  {Let ancestor load the data}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size <> 7) then exit; {Size must be 7}

  {Reads data}
  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;

{Saving the chunk to a stream}
function TChunktIME.SaveToStream(Stream: TStream): Boolean;
begin
  {Update data}
  ResizeData(7);  {Make sure the size is 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;

  {Let inherited save data}
  Result := inherited SaveToStream(Stream);
end;

{TChunkztXt implementation}

{Loading the chunk from a stream}
function TChunkzTXt.LoadFromStream(Stream: TStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
var
  ErrorOutput: String;
  CompressionMethod: Byte;
  Output: Pointer;
  OutputSize: Integer;
begin
  {Load data from stream and validate}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size < 4) then exit;
  fKeyword := PChar(Data);  {Get keyword and compression method bellow}
  CompressionMethod := pByte(Longint(fKeyword) + Length(fKeyword))^;
  fText := '';

  {In case the compression is 0 (only one accepted by specs), reads it}
  if CompressionMethod = 0 then
  begin
    Output := nil;
    if DecompressZLIB(PChar(Longint(Data) + Length(fKeyword) + 2),
      Size - Length(fKeyword) - 2, Output, OutputSize, ErrorOutput) then
    begin
      SetLength(fText, OutputSize);
      CopyMemory(@fText[1], Output, OutputSize);
    end {if DecompressZLIB(...};
    FreeMem(Output);
  end {if CompressionMethod = 0}

end;

{Saving the chunk to a stream}
function TChunkztXt.SaveToStream(Stream: TStream): Boolean;
var
  Output: Pointer;
  OutputSize: Integer;
  ErrorOutput: String;
begin
  Output := nil; {Initializes output}
  if fText = '' then fText := ' ';

  {Compresses the data}
  if CompressZLIB(@fText[1], Length(fText), Owner.CompressionLevel, Output,
    OutputSize, ErrorOutput) then
  begin
    {Size is length from keyword, plus a null character to divide}
    {plus the compression method, plus the length of the text (zlib compressed)}
    ResizeData(Length(fKeyword) + 2 + OutputSize);

    Fillchar(Data^, DataSize, #0);
    {Copies the keyword data}
    if Keyword <> '' then
      CopyMemory(Data, @fKeyword[1], Length(Keyword));
    {Compression method 0 (inflate/deflate)}
    pByte(Ptr(Longint(Data) + Length(Keyword) + 1))^ := 0;
    if OutputSize > 0 then
      CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 2), Output, OutputSize);

    {Let ancestor calculate crc and save}
    Result := SaveData(Stream);
  end {if CompressZLIB(...} else Result := False;

  {Frees output}
  if Output <> nil then FreeMem(Output)
end;

{TChunktEXt implementation}

{Assigns from another text chunk}
procedure TChunktEXt.Assign(Source: TChunk);
begin
  fKeyword := TChunktEXt(Source).fKeyword;
  fText := TChunktEXt(Source).fText;
end;

{Loading the chunk from a stream}
function TChunktEXt.LoadFromStream(Stream: TStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
begin
  {Load data from stream and validate}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size < 3) then exit;
  {Get text}
  fKeyword := PChar(Data);
  SetLength(fText, Size - Length(fKeyword) - 1);
  CopyMemory(@fText[1], Ptr(Longint(Data) + Length(fKeyword) + 1),
    Length(fText));
end;

{Saving the chunk to a stream}
function TChunktEXt.SaveToStream(Stream: TStream): Boolean;
begin
  {Size is length from keyword, plus a null character to divide}
  {plus the length of the text}
  ResizeData(Length(fKeyword) + 1 + Length(fText));
  Fillchar(Data^, DataSize, #0);
  {Copy data}
  if Keyword <> '' then
    CopyMemory(Data, @fKeyword[1], Length(Keyword));
  if Text <> '' then
    CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 1), @fText[1],
      Length(Text));
  {Let ancestor calculate crc and save}
  Result := inherited SaveToStream(Stream);
end;


{TChunkIHDR implementation}

{Chunk being created}
constructor TChunkIHDR.Create(Owner: TPngObject);
begin
  {Call inherited}
  inherited Create(Owner);
  {Prepare pointers}
  ImageHandle := 0;
  ImageDC := 0;
end;

{Chunk being destroyed}
destructor TChunkIHDR.Destroy;
begin
  {Free memory}
  FreeImageData();

  {Calls TChunk destroy}
  inherited Destroy;
end;

{Assigns from another IHDR chunk}
procedure TChunkIHDR.Assign(Source: TChunk);
begin
  {Copy the IHDR data}
  if Source is TChunkIHDR then
  begin
    {Copy IHDR values}
    IHDRData := TChunkIHDR(Source).IHDRData;

    {Prepare to hold data by filling BitmapInfo structure and}
    {res