bspngimage.pas

BusinessSkinForm的控件包与实例

const
  BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
  StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4,  0, 0, 0, 0);
var
  CurBit, Col: Integer;
  Dest2: PChar;
begin
  Col := ColumnStart[Pass];
  repeat
    CurBit := StartBit[Header.BitDepth];
    repeat
      Dest2 := pChar(Longint(Dest) + (Header.BitDepth * Col) div 8);
      Byte(Dest2^) := Byte(Dest2^) or
        ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth])
          shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8)));
      inc(Col, ColumnIncrement[Pass]);
      dec(CurBit, Header.BitDepth);
    until CurBit < 0;
    inc(Src);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest,
  Trans, Extra: pChar);
var
  CurBit, Col: Integer;
  Dest2: PChar;
begin
  Col := ColumnStart[Pass];
  repeat
    CurBit := 6;
    repeat
      Dest2 := pChar(Longint(Dest) + Col div 2);
      Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
         shl (4 - (4 * Col) mod 8));
      inc(Col, ColumnIncrement[Pass]);
      dec(CurBit, 2);
    until CurBit < 0;
    inc(Src);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedGray2(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  CurBit, Col: Integer;
  Dest2: PChar;
begin
  Col := ColumnStart[Pass];
  repeat
    CurBit := 6;
    repeat
      Dest2 := pChar(Longint(Dest) + Col div 2);
      Byte(Dest2^) := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F)
         shl (4 - (Col*4) mod 8));
      inc(Col, ColumnIncrement[Pass]);
      dec(CurBit, 2);
    until CurBit < 0;
    inc(Src);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedGrayscale16(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  Col: Integer;
begin
  Col := ColumnStart[Pass];
  Dest := pChar(Longint(Dest) + Col);
  repeat
    Dest^ := Src^; inc(Dest);
    Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
    inc(Src, 2);
    inc(Dest, ColumnIncrement[Pass] - 1);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  Col: Integer;
begin
  Col := ColumnStart[Pass];
  Dest := pChar(Longint(Dest) + Col * 3);
  Trans := pChar(Longint(Trans) + Col);
  repeat
    Trans^ := pChar(Longint(Src) + 3)^;
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);

    inc(Src, 4);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  Col: Integer;
begin
  Col := ColumnStart[Pass];
  Dest := pChar(Longint(Dest) + Col * 3);
  Trans := pChar(Longint(Trans) + Col);
  repeat
    Trans^ := pChar(Longint(Src) + 6)^;
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);

    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);

    inc(Src, 8);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  Col: Integer;
begin
  Col := ColumnStart[Pass];
  Dest := pChar(Longint(Dest) + Col);
  Trans := pChar(Longint(Trans) + Col);
  repeat
    Dest^ := Src^;  inc(Src);
    Trans^ := Src^; inc(Src);
    inc(Dest, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
  Src, Dest, Trans, Extra: pChar);
var
  Col: Integer;
begin
  Col := ColumnStart[Pass];
  Dest := pChar(Longint(Dest) + Col);
  Trans := pChar(Longint(Trans) + Col);
  repeat
    Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
    Dest^ := Src^;  inc(Src, 2);
    Trans^ := Src^; inc(Src, 2);
    inc(Dest, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

procedure TbsPngLayerIDAT.DecodeInterlacedAdam7(Stream: TStream;
  var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
var
  CurrentPass: Byte;
  PixelsThisRow: Integer;
  CurrentRow: Integer;
  Trans, Data, Extra: pChar;
  CopyProc: procedure(const Pass: Byte; Src, Dest,
    Trans, Extra: pChar) of object;
begin
  CopyProc := nil;
  case Header.ColorType of
    COLOR_RGB:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedRGB8;
       16:  CopyProc := CopyInterlacedRGB16;
      end;
    COLOR_PALETTE, COLOR_GRAYSCALE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := CopyInterlacedPalette148;
        2      : if Header.ColorType = COLOR_PALETTE then
                   CopyProc := CopyInterlacedPalette2
                 else
                   CopyProc := CopyInterlacedGray2;
        16     : CopyProc := CopyInterlacedGrayscale16;
      end;
    COLOR_RGBALPHA:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedRGBAlpha8;
       16:  CopyProc := CopyInterlacedRGBAlpha16;
      end;
     COLOR_GRAYSCALEALPHA:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedGrayscaleAlpha8;
       16:  CopyProc := CopyInterlacedGrayscaleAlpha16;
      end;
  end;

  FOR CurrentPass := 0 TO 6 DO
  begin
    PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
      ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
    Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
      Header.BitDepth);
    ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes);
    CurrentRow := RowStart[CurrentPass];
    Data := Ptr(Longint(Header.ImageData) + Header.BytesPerRow *
      (ImageHeight - 1 - CurrentRow));
    Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
    Extra := Ptr(Longint(Header.ExtraImageData) + Header.BytesPerRow *
      (ImageHeight - 1 - CurrentRow));
    if Row_Bytes > 0 then {There must have bytes for this interlaced pass}
      while CurrentRow < ImageHeight do
      begin
        if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1,
          EndPos, CRCFile) = 0 then break;
        FilterRow;

        CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Data, Trans,  Extra);
        RowUsed := not RowUsed;
        inc(CurrentRow, RowIncrement[CurrentPass]);
        dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
        inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
        dec(Extra, RowIncrement[CurrentPass] * Header.BytesPerRow);
      end;
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedRGB8(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);
    inc(Src, 3);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedRGB16(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
    inc(Src, 6);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedPalette148(
  Src, Dest, Trans, Extra: pChar);
begin
  CopyMemory(Dest, Src, Row_Bytes);
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedGray2(
  Src, Dest, Trans, Extra: pChar);
var
  i: Integer;
begin
  FOR i := 1 TO Row_Bytes do
  begin
    Byte(Dest^) := ((Byte(Src^) shr 2) and $F) or ((Byte(Src^)) and $F0);
      inc(Dest);
    Byte(Dest^) := ((Byte(Src^) shl 2) and $F) or ((Byte(Src^) shl 4) and $F0);
      inc(Dest);
    inc(Src);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedPalette2(
  Src, Dest, Trans, Extra: pChar);
var
  i: Integer;
begin
  FOR i := 1 TO Row_Bytes do
  begin
    Byte(Dest^) := ((Byte(Src^) shr 4) and $3) or ((Byte(Src^) shr 2) and $30);
      inc(Dest);
    Byte(Dest^) := (Byte(Src^) and $3) or ((Byte(Src^) shl 2) and $30);
      inc(Dest);
    inc(Src);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedGrayscale16(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Dest^ := Src^; inc(Dest);
    Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
    inc(Src, 2);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedRGBAlpha8(
  Src, Dest, Trans, Extra: pChar);
var
  i: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Trans^ := pChar(Longint(Src) + 3)^;
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);
    inc(Src, 4); inc(Trans);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedRGBAlpha16(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Trans^ := pChar(Longint(Src) + 6)^;
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
    Byte(Dest^)  := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);

    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
    Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);

    inc(Src, 8); inc(Trans);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedGrayscaleAlpha8(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Dest^  := Src^;  inc(Src);
    Trans^ := Src^;  inc(Src);
    inc(Dest); inc(Trans);
  end;
end;

procedure TbsPngLayerIDAT.CopyNonInterlacedGrayscaleAlpha16(
  Src, Dest, Trans, Extra: pChar);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
    Dest^  := Src^;  inc(Src, 2);
    Trans^ := Src^;  inc(Src, 2);
    inc(Dest); inc(Trans);
  end;
end;


procedure TbsPngLayerIDAT.DecodeNonInterlaced(Stream: TStream;
  var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
var
  j: Cardinal;
  Trans, Data, Extra: pChar;
  CopyProc: procedure(
    Src, Dest, Trans, Extra: pChar) of object;
begin
  CopyProc := nil; 

  case Header.ColorType of
    COLOR_RGB:
      case Header.BitDepth of
        8: CopyProc := CopyNonInterlacedRGB8;
       16: CopyProc := CopyNonInterlacedRGB16;
      end;
    COLOR_PALETTE, COLOR_GRAYSCALE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := CopyNonInterlacedPalette148;
        2      : if Header.ColorType = COLOR_PALETTE then
                   CopyProc := CopyNonInterlacedPalette2
                 else
                   CopyProc := CopyNonInterlacedGray2;
        16     : CopyProc := CopyNonInterlacedGrayscale16;
      end;
    COLOR_RGBALPHA:
      case Header.BitDepth of
        8  : CopyProc := CopyNonInterlacedRGBAlpha8;
       16  : CopyProc := CopyNonInterlacedRGBAlpha16;
      end;
    COLOR_GRAYSCALEALPHA:
      case Header.BitDepth of
        8  : CopyProc := CopyNonInterlacedGrayscaleAlpha8;
       16  : CopyProc := CopyNonInterlacedGrayscaleAlpha16;
      end;
  end;

  Longint(Data) := Longint(Header.ImageData) +
    Header.BytesPerRow * (ImageHeight - 1);
  Trans := Header.ImageAlpha;
  Longint(Extra) := Longint(Header.ExtraImageData) +
    Header.BytesPerRow * (ImageHeight - 1);
  FOR j := 0 to ImageHeig