pngimage1.pas

查看html文件的控件

    GRAYSCALEALPHA:
    {Test for bit depth}
    CASE IHDR.BitDepth of
      8:   {1 byte per gray and alpha}
      repeat
        pByteArray(ImageData)^[I] := Data^[J];
        inc(J, 2);
        inc(I, ColIncrement);
      until J >= RowBytes;
     16:   {2 bytes per gray and alpha}
      repeat
        pByteArray(ImageData)^[I] := Data^[J];
        inc(J, 4);
        inc(I, ColIncrement);
      until J >= RowBytes;
    END;

  end;
end;


{:Copy non interlaced data into the current image}
procedure TChunkIDAT.DecodeNonInterlacedRow(ImageData: Pointer; Data: pByteArray;
  RowBytes: Integer; GamaChunk: TChunkGama);
var
  Col: Integer;
begin

  {Test for color type}
  case IHDR.ColorType of
    Palette, Grayscale:
    {Test for bit depth}
    CASE IHDR.BitDepth of
      1, 4, 8:  {Simple memory copy}
        CopyMemory(ImageData, Data, RowBytes);
      2: {Pixelformat pf2bits ? not supported (pf4bits being used) }
        ConvertBits([@Data[0]], ImageData, Bitmap.Width, $FF, 2, 4);
     16: {Grayscale with 2 pixels}
      FOR Col := 0 to Bitmap.Width - 1  DO
        pByteArray(ImageData)^[Col] := Data^[Col * 2];
    END;
    RGB:
    {Test for bit depth}
    CASE IHDR.BitDepth of
      8: {1 byte for each R, G AND B values}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        with PRGBLine(ImageData)^[Col] do
        begin
          rgbtRed := Data^[Col * 3];
          rgbtGreen := Data^[1 + Col * 3];
          rgbtBlue := Data^[2 + Col * 3];

          {Gamma correction}
          if Assigned(GamaChunk) then
          begin
            rgbtRed := GamaChunk.GammaTable[rgbtRed];
            rgbtGreen := GamaChunk.GammaTable[rgbtGreen];
            rgbtBlue := GamaChunk.GammaTable[rgbtBlue];
          end;
        end;
     16: {2 bytes for each R, G AND B values}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        with PRGBLine(ImageData)^[Col] do
        begin
          rgbtRed := Data^[Col * 6];
          rgbtGreen := Data^[2 + Col * 6];
          rgbtBlue := Data^[4 + Col * 6];

          {Gamma correction}
          if Assigned(GamaChunk) then
          begin
            rgbtRed := GamaChunk.GammaTable[rgbtRed];
            rgbtGreen := GamaChunk.GammaTable[rgbtGreen];
            rgbtBlue := GamaChunk.GammaTable[rgbtBlue];
          end;

        end;
     end;
    RGBALPHA:
    {Test for bit depth}
    CASE IHDR.BitDepth of
      8: {1 byte for each R, G, B AND ALPHA values}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        with PRGBLine(ImageData)^[Col] do
        begin
          rgbtRed := Data^[Col * 4];
          rgbtGreen := Data^[1 + Col * 4];
          rgbtBlue := Data^[2 + Col * 4];

          {Gamma correction}
          if Assigned(GamaChunk) then
          begin
            rgbtRed := GamaChunk.GammaTable[rgbtRed];
            rgbtGreen := GamaChunk.GammaTable[rgbtGreen];
            rgbtBlue := GamaChunk.GammaTable[rgbtBlue];
          end;
        end;
     16: {2 bytes for each R, G AND B values and 1 for ALPHA}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        with PRGBLine(ImageData)^[Col] do
        begin
          rgbtRed := Data^[Col * 8];
          rgbtGreen := Data^[2 + Col * 8];
          rgbtBlue := Data^[4 + Col * 8];

          {Gamma correction}
          if Assigned(GamaChunk) then
          begin
            rgbtRed := GamaChunk.GammaTable[rgbtRed];
            rgbtGreen := GamaChunk.GammaTable[rgbtGreen];
            rgbtBlue := GamaChunk.GammaTable[rgbtBlue];
          end;
        end;
    end;
    GRAYSCALEALPHA:
    {Test for bit depth}
    CASE IHDR.BitDepth of
      8: {1 byte for grayscale and 1 for alpha}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        pByteArray(ImageData)^[Col] := Data^[Col * 2];
     16: {2 bytes for grayscale and 1 for alpha}
      FOR Col := 0 to (Bitmap.Width - 1)  DO
        pByteArray(ImageData)^[Col] := Data^[Col * 4];
    end;

  end;
end;

{:Decode the readed image to the bitmap}
procedure TChunkIDAT.DoAction;
const
  CHAR_BIT = 8;
var
  RowBuffer        : array[Boolean] of pbytearray;
  Row_Buffer_Width : Integer;
  OddLine          : Boolean;
  Offset           : Integer;
  UseProgress      : Boolean;
  j                : Integer;
  Pass             : Integer;
  Decode           : TZDecompressionStream;
  Row              : Integer;
  PixelsThisRow    : Integer;
  RowBytes         : Integer;
  GamaChunk        : TChunkGama;
begin
  GamaChunk := Gama;

  {Create the decompression object}
  Decode := TZDecompressionStream.Create(fStream);
  Decode.Position := 0;

  rowbytes := 0;

  {Filtering is done on corresponding items within a record. Determine}
  {the number of bytes between corresponding items.                   }
  OffSet := GetOffSet;

  {Define if uses OnProgress}
  UseProgress := Assigned(Bitmap.Onprogress);

  {Retrieve the number of bytes per line}
  row_buffer_width := GetBufferWidth;

  {Allocate memory for the row buffers and fill them with zeros}
  OddLine := TRUE;
  GetMem(RowBuffer[True], row_buffer_width + 1);
  GetMem(RowBuffer[False], row_buffer_width + 1);
  ZeroMemory(RowBuffer[False], row_buffer_width + 1);

  {Set the bitmap properties}
  with Bitmap do
  begin
    {Setup pixel formats and palette}
    SetupPixelFormat;

    {Set width and height}
    Width := IHDR.Width;
    Height := IHDR.Height;
  end;

  {Interlace decode}
  if IHDR.Interlaced = 1 then
  begin
    {Each of the interlacing passes}
    FOR Pass := 0 TO 6 DO
    begin
      {Number of pixels in this row}
      pixelsthisrow := (Bitmap.width - ColumnStart[Pass] +
        + ColumnIncrement[Pass] - 1) div ColumnIncrement[Pass] ;

      {Number of bytes}
      case (IHDR.ColorType) of
      Grayscale, Palette:
        rowbytes := (pixelsthisrow * IHDR.BitDepth + CHAR_BIT - 1) div CHAR_BIT ;
      RGB:
        rowbytes := pixelsthisrow * 3 * IHDR.BitDepth div CHAR_BIT ;
      RGBAlpha:
        rowbytes := pixelsthisrow * 4 * IHDR.BitDepth div CHAR_BIT ;
      GrayscaleAlpha:
        rowbytes := pixelsthisrow * 2 * IHDR.BitDepth div CHAR_BIT ;
      end;

      Row := RowStart[Pass];
      while Row < Bitmap.Height do
      begin
        {Read line from the stream}
        Decode.Read(rowBuffer[OddLine][0], rowbytes + 1);
        {Filter the row}
        FilterRow(RowBuffer[OddLine][0], @RowBuffer[OddLine][1],
          @RowBuffer[not OddLine][1], offset, rowbytes);

        {Translate data into the image}
        DecodeInterlacedRow(Bitmap.ScanLine[Row], @RowBuffer[OddLine][1],
          ColumnStart[Pass], ColumnIncrement[Pass], RowBytes, Pass, Gamachunk);

        {Jump to the next line}
        Inc(Row, RowIncrement[Pass]);
        {Change the line}
        OddLine := not OddLine;
      end;

      {Call progress event}
      If UseProgress then
        Bitmap.OnProgress(Bitmap, psRunning, MulDiv(100, Pass, 6),
          True, Rect(0, 0, Bitmap.Width, Bitmap.Height), 'Drawing...');

    end;
  end
  {Non interlace decode}
  else if IHDR.Interlaced = 0 then
  begin
    {Pass each row}
    for j := 0 to Bitmap.Height - 1 DO
    begin
      {Decompress}
      Decode.Read(RowBuffer[OddLine][0], row_buffer_width + 1);

      {Filter the current row}
      FilterRow(RowBuffer[OddLine][0], @RowBuffer[OddLine][1],
        @RowBuffer[not OddLine][1], OffSet, row_buffer_width);

      {Translate the data into the image}
      DecodeNonInterlacedRow(Bitmap.Scanline[j], @RowBuffer[OddLine][1],
        row_buffer_width, GamaChunk);

      {Change the line}
      OddLine := not OddLine;


      {Call progress event}
      If UseProgress then
          Bitmap.OnProgress(Bitmap, psRunning, MulDiv(j, 100, Bitmap.Height),
            True, Rect(0, j - 1, Bitmap.Width, j), 'Drawing...');
    end;
  end
  else
  {Unknown interlace method}
    CallError(PNG_ERROR_INVALID_INTERLACE);

  {Free memory for the row buffers}
  FreeMem(RowBuffer[True], row_buffer_width + 1);
  FreeMem(RowBuffer[False], row_buffer_width + 1);

  {Free the decompression object}
  Decode.Free;

  {$IFDEF _SHAREWARE} Shareware {$ENDIF};
end;

{:Returns the buffer width}
function TChunkIDAT.GetBufferWidth: Integer;
const
  CHAR_BIT = 8;
var
  RowBits         : Integer;
begin
  Result := 0;

  case IHDR.ColorType of
  Grayscale, Palette:
  begin
    rowbits := IHDR.Width * IHDR.BitDepth;
    Result := (rowbits + CHAR_BIT - 1) div CHAR_BIT;
  end;
  GrayscaleAlpha:
    Result := 2 * IHDR.width * IHDR.BitDepth div CHAR_BIT ;
  RGB:
    Result := IHDR.width * 3 * IHDR.BitDepth div CHAR_BIT ;
  RGBAlpha:
    Result := IHDR.width * 4 * IHDR.BitDepth div CHAR_BIT ;
  else
    {In case we have an undetermined color type}
    CallError(PNG_ERROR_INVALID_COLOR_TYPE);
  end;

end;

{:Returns the offset for filtering}
function TChunkIDAT.GetOffset: Integer;
const
  CHAR_BIT = 8;
begin
  case IHDR.ColorType of
    Grayscale, Palette:      result := 1;
    RGB:                     result := 3 * IHDR.BitDepth div CHAR_BIT ;
    GrayscaleAlpha:          result := 2 * IHDR.BitDepth div CHAR_BIT ;
    RGBAlpha:                result := 4 * IHDR.BitDepth div CHAR_BIT ;
    else
      result := 0;
  end;
end;

{:Filter the row for encoding}
function TChunkIDAT.EncodeFilterRow(row_buffer: pbytearray;
  Filter_buffers: TFilterRow; row_width, filter_width: Cardinal): Integer;
const
  FTest: Array[0..4] of TEncodeFilter = (efNone, efSub, efUp,
    efAverage, efPaeth);
var
  ii, run, jj: Cardinal;
  longestrun : Cardinal;
 last,
 above,
 lastabove   : byte;

begin

  // Filter for each type in the filter_mask.
  if efSub in Bitmap.Filter then
  begin

    for ii := 0 to row_width - 1 do
    begin
      if (ii >= filter_width) then
        last := row_buffer^[ii-filter_width]
      else
        last := 0 ;

      filter_buffers [FILTERSUB]^[ii] := row_buffer^[ii] - last ;
    end;
  end;

  if efUp in Bitmap.Filter then
    for ii := 0 to row_width - 1 do
      filter_buffers[FILTERUP]^[ii] := row_buffer^[ii] -
        filter_buffers[FILTERNONE]^[ii] ;

  if efAverage in Bitmap.Filter then
  begin
    for ii := 0 to row_width - 1 do
    begin
      if (ii >= filter_width) then
        last := row_buffer^[ii - filter_width]
      else
        last := 0 ;
      above := filter_buffers [FILTERNONE]^[ii] ;

      filter_buffers [FILTERAVERAGE]^[ii]
        := row_buffer^[ii] - (above + last) div 2 ;
    end;
  end;

  if efPaeth in Bitmap.Filter then
  begin
    for ii := 0 to row_width - 1 do
    begin
      if (ii >= filter_width) then
      begin
        last := row_buffer^[ii-filter_width] ;
        lastabove := filter_buffers [FILTERNONE]^[ii - filter_width] ;
      end
      else
      begin
        last := 0 ;
        lastabove := 0 ;
      end;

      above := filter_buffers [FILTERNONE]^[ii] ;
      filter_buffers [FILTERPAETH]^[ii]
        := row_buffer^[ii] - PaethPredictor (last, above, lastabove) ;
    end;
  end;


  // Filter None
  // THIS MUST BE THE LAST FILTER!!!!!!!!!! We save the value
  // here to be used in the next call with the filters that require data from the
  // previous row.
  for ii := 0 to row_width - 1 do
    filter_buffers[FILTERNONE]^[ii] := row_buffer^[ii] ;

  // If we only performed FilterNone then we do not need to proceed
  // any further.
  Result := FILTERNONE ;
  if Bitmap.Filter = [efNone] then
    exit;

  // Find the best filter. We do a simple test for the
  // longest runs of the same value.

  LongestRun := 0;
  for ii := 0 to FILTERBUFFERCOUNT - 1 DO
  begin
    if FTest[ii] in Bitmap.Filter then
    begin
      run := 0;
      for jj := 4 to row_width - 1 do
      begin
        if (filter_buffers[ii]^[jj] = filter_buffers [ii]^[jj-1]) and
            (filter_buffers[ii]^[jj] = filter_buffers [ii]^[jj-2]) and
            (filter_buffers[ii]^[jj] = filter_buffers [ii]^[jj-3]) and
            (filter_buffers[ii]^[jj] = filter_buffers [ii]^[jj-4]) then
          inc(Run);
      end;

      if (run > longestrun) then
      begin
        result := ii ;
        longestrun := run ;
      end;
    end;
  end;

end;

{:Encode the actual image from the bitmap}
procedure TChunkIDAT.EncodeImage;
var
  Encode          : TZCompressionStream;
  j, offset, i    : Integer;
  row_buffer_width: Integer;
  filter_buffers  : TFilterRow;
  Filter          : byte;
  row_buffer      : pByteArray;
  Line            : Pointer;
  GamaChunk       : TChunkGama;

  function AdjustValue(Value: Byte): Byte;
  begin
    if Assigned(GamaChunk) then
      Result := GamaChunk.InverseTable[Value]
    else
      Result := Value;
  end;
begin
  GamaChunk := Gama;

  {Clear the previous IDAT memory since we will use bitmap}
  {data to write all over again}
  fStream.Clear;

  {Create a stream to handle the compression}
  Encode := TZCompressionStream.Create(fStream, zcDefault);

  {Number of bytes in each row}
  row_buffer_width := GetBufferWidth;
  offset := GetOffset;

  {Allocate memory for filtering}