|
@@ -121,7 +121,6 @@ begin
|
|
raise PNGImageException.create ('Doesn''t have a chunktype to write')
|
|
raise PNGImageException.create ('Doesn''t have a chunktype to write')
|
|
else
|
|
else
|
|
chead.CType := ReadType;
|
|
chead.CType := ReadType;
|
|
- writeln ('Writing chunk ',Readtype,' with length ',alength);
|
|
|
|
c := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType));
|
|
c := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType));
|
|
c := CalculateCRC (c, data^, alength);
|
|
c := CalculateCRC (c, data^, alength);
|
|
crc := swap(c xor All1Bits);
|
|
crc := swap(c xor All1Bits);
|
|
@@ -136,7 +135,6 @@ end;
|
|
|
|
|
|
procedure TFPWriterPNG.SetChunkLength(aValue : longword);
|
|
procedure TFPWriterPNG.SetChunkLength(aValue : longword);
|
|
begin
|
|
begin
|
|
- writeln ('Setting length to ',AValue);
|
|
|
|
with Fchunk do
|
|
with Fchunk do
|
|
begin
|
|
begin
|
|
alength := aValue;
|
|
alength := aValue;
|
|
@@ -342,18 +340,12 @@ begin
|
|
begin
|
|
begin
|
|
// problem: TheImage has integer width, PNG header longword width.
|
|
// problem: TheImage has integer width, PNG header longword width.
|
|
// Integer Swap can give negative value
|
|
// Integer Swap can give negative value
|
|
- writeln ('Using header, swapping width ',Theimage.Width);
|
|
|
|
Width := swap (longword(TheImage.Width));
|
|
Width := swap (longword(TheImage.Width));
|
|
- writeln ('Swapping height ',TheImage.height);
|
|
|
|
height := swap (longword(TheImage.Height));
|
|
height := swap (longword(TheImage.Height));
|
|
- writeln (' - Width ',Width, '(',TheImage.Width,')');
|
|
|
|
- writeln (' - height ', Height, '(',TheImage.Height,')');
|
|
|
|
- writeln ('- Alpha');
|
|
|
|
if FUseAlpha then
|
|
if FUseAlpha then
|
|
c := CountAlphas
|
|
c := CountAlphas
|
|
else
|
|
else
|
|
c := 0;
|
|
c := 0;
|
|
- writeln ('- Colortype');
|
|
|
|
if FIndexed then
|
|
if FIndexed then
|
|
begin
|
|
begin
|
|
if TheImage.UsePalette then
|
|
if TheImage.UsePalette then
|
|
@@ -383,9 +375,7 @@ begin
|
|
BitDepth := 8;
|
|
BitDepth := 8;
|
|
DetermineColorFormat;
|
|
DetermineColorFormat;
|
|
FByteWidth := BytesNeeded[CFmt];
|
|
FByteWidth := BytesNeeded[CFmt];
|
|
- writeln ('Color format ', ord(CFmt), ' bytes needed:',FByteWidth);
|
|
|
|
end;
|
|
end;
|
|
- writeln ('- Fixed values');
|
|
|
|
Compression := 0;
|
|
Compression := 0;
|
|
Filter := 0;
|
|
Filter := 0;
|
|
Interlace := 0;
|
|
Interlace := 0;
|
|
@@ -395,19 +385,14 @@ end;
|
|
procedure TFPWriterPNG.WriteIHDR;
|
|
procedure TFPWriterPNG.WriteIHDR;
|
|
begin
|
|
begin
|
|
// signature for PNG
|
|
// signature for PNG
|
|
- writeln ('Signature to stream');
|
|
|
|
TheStream.writeBuffer(Signature,sizeof(Signature));
|
|
TheStream.writeBuffer(Signature,sizeof(Signature));
|
|
// Determine all settings for filling the header
|
|
// Determine all settings for filling the header
|
|
- writeln ('Filling header');
|
|
|
|
DetermineHeader (FHeader);
|
|
DetermineHeader (FHeader);
|
|
// write the header chunk
|
|
// write the header chunk
|
|
- writeln ('Filling chunk');
|
|
|
|
SetChunkLength (13); // (sizeof(FHeader)); gives 14 and is wrong !!
|
|
SetChunkLength (13); // (sizeof(FHeader)); gives 14 and is wrong !!
|
|
move (FHeader, ChunkDataBuffer^, 13); // sizeof(FHeader));
|
|
move (FHeader, ChunkDataBuffer^, 13); // sizeof(FHeader));
|
|
SetChunkType (ctIHDR);
|
|
SetChunkType (ctIHDR);
|
|
- writeln ('writing chunk');
|
|
|
|
WriteChunk;
|
|
WriteChunk;
|
|
- writeln ('Finished header');
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFPWriterPNG.GetColorPixel (x,y:longword) : TColorData;
|
|
function TFPWriterPNG.GetColorPixel (x,y:longword) : TColorData;
|
|
@@ -431,16 +416,13 @@ begin
|
|
3 : if TheImage.UsePalette then
|
|
3 : if TheImage.UsePalette then
|
|
begin
|
|
begin
|
|
result := @GetPalettePixel;
|
|
result := @GetPalettePixel;
|
|
- writeln ('GetPalettePixel');
|
|
|
|
end
|
|
end
|
|
else
|
|
else
|
|
begin
|
|
begin
|
|
result := @GetColPalPixel;
|
|
result := @GetColPalPixel;
|
|
- writeln ('GetColPalPixel');
|
|
|
|
end;
|
|
end;
|
|
else begin
|
|
else begin
|
|
result := @GetColorPixel;
|
|
result := @GetColorPixel;
|
|
- writeln ('GetColorPixel');
|
|
|
|
end
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
@@ -511,7 +493,6 @@ var x,y : integer;
|
|
begin
|
|
begin
|
|
for y := 0 to pred(TheImage.height) do
|
|
for y := 0 to pred(TheImage.height) do
|
|
begin
|
|
begin
|
|
- write ('*');
|
|
|
|
FSwitchLine := FCurrentLine;
|
|
FSwitchLine := FCurrentLine;
|
|
FCurrentLine := FPreviousLine;
|
|
FCurrentLine := FPreviousLine;
|
|
FPreviousLine := FSwitchLine;
|
|
FPreviousLine := FSwitchLine;
|
|
@@ -522,14 +503,12 @@ begin
|
|
Compressor.Write (lf, sizeof(lf));
|
|
Compressor.Write (lf, sizeof(lf));
|
|
Compressor.Write (FCurrentLine^, FDataLineLength);
|
|
Compressor.Write (FCurrentLine^, FDataLineLength);
|
|
end;
|
|
end;
|
|
- writeln;
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFPWriterPNG.WriteCompressedData;
|
|
procedure TFPWriterPNG.WriteCompressedData;
|
|
var l : longword;
|
|
var l : longword;
|
|
begin
|
|
begin
|
|
Compressor.Free; // Close compression and finish the writing in ZData
|
|
Compressor.Free; // Close compression and finish the writing in ZData
|
|
- writeln (' -- ZData position: ',zdata.position, ' -- size: ',zdata.size);
|
|
|
|
l := ZData.position;
|
|
l := ZData.position;
|
|
ZData.position := 0;
|
|
ZData.position := 0;
|
|
SetChunkLength(l);
|
|
SetChunkLength(l);
|
|
@@ -628,21 +607,14 @@ end;
|
|
|
|
|
|
procedure TFPWriterPNG.InternalWrite (Str:TStream; Img:TFPCustomImage);
|
|
procedure TFPWriterPNG.InternalWrite (Str:TStream; Img:TFPCustomImage);
|
|
begin
|
|
begin
|
|
- writeln ('PNG Writing');
|
|
|
|
WriteIHDR;
|
|
WriteIHDR;
|
|
- writeln ('Header finished');
|
|
|
|
if Fheader.colorType = 3 then
|
|
if Fheader.colorType = 3 then
|
|
WritePLTE;
|
|
WritePLTE;
|
|
- writeln ('Palette finished');
|
|
|
|
if FUsetRNS then
|
|
if FUsetRNS then
|
|
WritetRNS;
|
|
WritetRNS;
|
|
- writeln ('Finished transparency');
|
|
|
|
WriteIDAT;
|
|
WriteIDAT;
|
|
- writeln ('Finished data');
|
|
|
|
WriteTexts;
|
|
WriteTexts;
|
|
- writeln ('Finished Texts');
|
|
|
|
WriteIEND;
|
|
WriteIEND;
|
|
- writeln ('Finished texts');
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|
|
end.
|