source: trunk/Packages/bgrabitmap/bgrareadpng.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 39.2 KB
Line 
1{
2 The original file before tweaking is:
3
4 $Id: fpreadpng.pp,v 1.10 2003/10/19 21:09:51 luk Exp $
5 This file is part of the Free Pascal run time library.
6 Copyright (c) 2003 by the Free Pascal development team
7
8 PNG reader implementation
9
10 See the file COPYING.FPC, included in this distribution,
11 for details about the copyright.
12
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16
17 **********************************************************************
18
19 Optimisations applied:
20 - using "const" parameter for TColorData
21 - direct pixel access with TBGRABitmap when possible
22 - some fixes of hints and of initializations
23 - vertical shrink option with MinifyHeight, OriginalHeight and VerticalShrinkFactor (useful for thumbnails)
24 }
25{$mode objfpc}{$h+}
26unit BGRAReadPng;
27
28interface
29
30uses
31 SysUtils,Classes, FPImage, FPImgCmn, PNGComn, ZStream, BGRABitmapTypes;
32
33Type
34
35 TSetPixelProc = procedure (x,y:integer; const CD : TColordata) of object;
36 TConvertColorProc = function (const CD:TColorData) : TFPColor of object;
37 TBGRAConvertColorProc = function (const CD:TColorData) : TBGRAPixel of object;
38 THandleScanLineProc = procedure (const y : integer; const ScanLine : PByteArray) of object;
39
40 { TBGRAReaderPNG }
41
42 TBGRAReaderPNG = class (TBGRAImageReader)
43 private
44
45 FHeader : THeaderChunk;
46 ZData : TMemoryStream; // holds compressed data until all blocks are read
47 Decompress : TDeCompressionStream; // decompresses the data
48 FPltte : boolean; // if palette is used
49 FCountScanlines : EightLong; //Number of scanlines to process for each pass
50 FScanLineLength : EightLong; //Length of scanline for each pass
51 FCurrentPass : byte;
52 ByteWidth : byte; // number of bytes to read for pixel information
53 BitsUsed : EightLong; // bitmasks to use to split a byte into smaller parts
54 BitShift : byte; // shift right to do of the bits extracted with BitsUsed for 1 element
55 CountBitsUsed : byte; // number of bit groups (1 pixel) per byte (when bytewidth = 1)
56 //CFmt : TColorFormat; // format of the colors to convert from
57 StartX,StartY, DeltaX,DeltaY, StartPass,EndPass : integer; // number and format of passes
58 FPalette : TFPPalette;
59 FSetPixel : TSetPixelProc;
60 FConvertColor : TConvertColorProc;
61 FBGRAConvertColor : TBGRAConvertColorProc;
62 FHandleScanLine: THandleScanLineProc;
63 FVerticalShrinkMask: DWord;
64 FVerticalShrinkShr: Integer;
65 function GetOriginalHeight: integer;
66 function GetOriginalWidth: integer;
67 function GetVerticalShrinkFactor: integer;
68 procedure ReadChunk;
69 procedure HandleData;
70 procedure HandleUnknown;
71 function ColorGray1 (const CD:TColorData) : TFPColor;
72 function ColorGray2 (const CD:TColorData) : TFPColor;
73 function ColorGray4 (const CD:TColorData) : TFPColor;
74 function ColorGray8 (const CD:TColorData) : TFPColor;
75 function ColorGray16 (const CD:TColorData) : TFPColor;
76 function ColorGrayAlpha8 (const CD:TColorData) : TFPColor;
77 function ColorGrayAlpha16 (const CD:TColorData) : TFPColor;
78 function ColorColor8 (const CD:TColorData) : TFPColor;
79 function ColorColor16 (const CD:TColorData) : TFPColor;
80 function ColorColorAlpha8 (const CD:TColorData) : TFPColor;
81 function ColorColorAlpha16 (const CD:TColorData) : TFPColor;
82
83 function BGRAColorGray1 (const CD:TColorData) : TBGRAPixel;
84 function BGRAColorGray2 (const CD:TColorData) : TBGRAPixel;
85 function BGRAColorGray4 (const CD:TColorData) : TBGRAPixel;
86 function BGRAColorGray8 (const CD:TColorData) : TBGRAPixel;
87 function BGRAColorGray16 (const CD:TColorData) : TBGRAPixel;
88 function BGRAColorGrayAlpha8 (const CD:TColorData) : TBGRAPixel;
89 function BGRAColorGrayAlpha16 (const CD:TColorData) : TBGRAPixel;
90 function BGRAColorColor8 (const CD:TColorData) : TBGRAPixel;
91 function BGRAColorColor16 (const CD:TColorData) : TBGRAPixel;
92 function BGRAColorColorAlpha8 (const CD:TColorData) : TBGRAPixel;
93 function BGRAColorColorAlpha16 (const CD:TColorData) : TBGRAPixel;
94 protected
95 Chunk : TChunk;
96 UseTransparent, EndOfFile : boolean;
97 TransparentDataValue : TColorData;
98 UsingBitGroup : byte;
99 DataIndex : longword;
100 DataBytes : TColorData;
101 procedure HandleChunk; virtual;
102 procedure HandlePalette; virtual;
103 procedure HandleAlpha; virtual;
104 function CalcX (relX:integer) : integer;
105 function CalcY (relY:integer) : integer;
106 function CalcColor(const ScanLine : PByteArray): TColorData;
107 procedure HandleScanLine (const y : integer; const ScanLine : PByteArray); virtual;
108 procedure BGRAHandleScanLine(const y: integer; const ScanLine: PByteArray);
109 procedure BGRAHandleScanLineTr(const y: integer; const ScanLine: PByteArray);
110 procedure DoDecompress; virtual;
111 procedure SetPalettePixel (x,y:integer; const CD : TColordata);
112 procedure SetPalColPixel (x,y:integer; const CD : TColordata);
113 procedure SetColorPixel (x,y:integer; const CD : TColordata);
114 procedure SetColorTrPixel (x,y:integer; const CD : TColordata);
115 procedure SetBGRAColorPixel (x,y:integer; const CD : TColordata);
116 procedure SetBGRAColorTrPixel (x,y:integer; const CD : TColordata);
117 function DecideSetPixel : TSetPixelProc; virtual;
118 procedure InternalRead ({%H-}Str:TStream; Img:TFPCustomImage); override;
119 function InternalCheck (Str:TStream) : boolean; override;
120 //property ColorFormat : TColorformat read CFmt;
121 property ConvertColor : TConvertColorProc read FConvertColor;
122 property CurrentPass : byte read FCurrentPass;
123 property Pltte : boolean read FPltte;
124 property ThePalette : TFPPalette read FPalette;
125 property Header : THeaderChunk read FHeader;
126 property CountScanlines : EightLong read FCountScanlines;
127 property ScanLineLength : EightLong read FScanLineLength;
128 public
129 MinifyHeight: integer;
130 constructor create; override;
131 destructor destroy; override;
132 property VerticalShrinkFactor: integer read GetVerticalShrinkFactor;
133 property OriginalWidth: integer read GetOriginalWidth;
134 property OriginalHeight: integer read GetOriginalHeight;
135 function GetQuickInfo(AStream: TStream): TQuickImageInfo; override;
136 function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override;
137 end;
138
139implementation
140
141uses math;
142
143const StartPoints : array[0..7, 0..1] of word =
144 ((0,0),(0,0),(4,0),(0,4),(2,0),(0,2),(1,0),(0,1));
145 Delta : array[0..7,0..1] of word =
146 ((1,1),(8,8),(8,8),(4,8),(4,4),(2,4),(2,2),(1,2));
147 BitsUsed1Depth : EightLong = ($80,$40,$20,$10,$08,$04,$02,$01);
148 BitsUsed2Depth : EightLong = ($C0,$30,$0C,$03,0,0,0,0);
149 BitsUsed4Depth : EightLong = ($F0,$0F,0,0,0,0,0,0);
150
151constructor TBGRAReaderPNG.create;
152begin
153 inherited;
154 chunk.acapacity := 0;
155 chunk.data := nil;
156 UseTransparent := False;
157end;
158
159destructor TBGRAReaderPNG.destroy;
160begin
161 with chunk do
162 if acapacity > 0 then
163 freemem (data);
164 inherited;
165end;
166
167function TBGRAReaderPNG.GetQuickInfo(AStream: TStream): TQuickImageInfo;
168const headerChunkSize = 13;
169var
170 {%H-}FileHeader : packed array[0..7] of byte;
171 {%H-}ChunkHeader : TChunkHeader;
172 {%H-}HeaderChunk : THeaderChunk;
173begin
174 fillchar({%H-}result, sizeof(result), 0);
175 if AStream.Read({%H-}FileHeader, sizeof(FileHeader))<> sizeof(FileHeader) then exit;
176 if QWord(FileHeader) <> QWord(PNGComn.Signature) then exit;
177 if AStream.Read({%H-}ChunkHeader, sizeof(ChunkHeader))<> sizeof(ChunkHeader) then exit;
178 if ChunkHeader.CType <> ChunkTypes[ctIHDR] then exit;
179 if BEtoN(ChunkHeader.CLength) < headerChunkSize then exit;
180 if AStream.Read({%H-}HeaderChunk, headerChunkSize) <> headerChunkSize then exit;
181 result.width:= BEtoN(HeaderChunk.Width);
182 result.height:= BEtoN(HeaderChunk.height);
183 case HeaderChunk.ColorType and 3 of
184 0,3: {grayscale, palette}
185 if HeaderChunk.BitDepth > 8 then
186 result.colorDepth := 8
187 else
188 result.colorDepth := HeaderChunk.BitDepth;
189
190 2: {color} result.colorDepth := HeaderChunk.BitDepth*3;
191 end;
192 if (HeaderChunk.ColorType and 4) = 4 then
193 result.alphaDepth := HeaderChunk.BitDepth
194 else
195 result.alphaDepth := 0;
196end;
197
198function TBGRAReaderPNG.GetBitmapDraft(AStream: TStream; AMaxWidth,
199 AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap;
200var
201 png: TBGRAReaderPNG;
202begin
203 png:= TBGRAReaderPNG.Create;
204 result := BGRABitmapFactory.Create;
205 try
206 png.MinifyHeight := AMaxHeight;
207 result.LoadFromStream(AStream, png);
208 AOriginalWidth:= result.Width;
209 AOriginalHeight:= png.OriginalHeight;
210 finally
211 png.Free;
212 end;
213end;
214
215procedure TBGRAReaderPNG.ReadChunk;
216var {%H-}ChunkHeader : TChunkHeader;
217 readCRC : longword;
218 l : longword;
219begin
220 TheStream.Read ({%H-}ChunkHeader,sizeof(ChunkHeader));
221 with chunk do
222 begin
223 // chunk header
224 with ChunkHeader do
225 begin
226 {$IFDEF ENDIAN_LITTLE}
227 alength := swap(CLength);
228 {$ELSE}
229 alength := CLength;
230 {$ENDIF}
231 ReadType := CType;
232 end;
233 aType := low(TChunkTypes);
234 while (aType < high(TChunkTypes)) and (ChunkTypes[aType] <> ReadType) do
235 inc (aType);
236 if alength > MaxChunkLength then
237 raise PNGImageException.Create ('Invalid chunklength');
238 if alength > acapacity then
239 begin
240 if acapacity > 0 then
241 freemem (data);
242 GetMem (data, alength);
243 acapacity := alength;
244 end;
245 l := TheStream.read (data^, alength);
246 if l <> alength then
247 raise PNGImageException.Create ('Chunk length exceeds stream length');
248 readCRC := 0;
249 TheStream.Read (readCRC, sizeof(ReadCRC));
250 l := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType));
251 l := CalculateCRC (l, data^, alength);
252 {$IFDEF ENDIAN_LITTLE}
253 l := swap(l xor All1Bits);
254 {$ELSE}
255 l := l xor All1Bits;
256 {$ENDIF}
257 if ReadCRC <> l then
258 raise PNGImageException.Create ('CRC check failed');
259 end;
260end;
261
262function TBGRAReaderPNG.GetVerticalShrinkFactor: integer;
263begin
264 result := 1 shl FVerticalShrinkShr;
265end;
266
267function TBGRAReaderPNG.GetOriginalHeight: integer;
268begin
269 result := Header.height;
270end;
271
272function TBGRAReaderPNG.GetOriginalWidth: integer;
273begin
274 result := header.Width;
275end;
276
277procedure TBGRAReaderPNG.HandleData;
278var OldSize : longword;
279begin
280 OldSize := ZData.size;
281 ZData.Size := OldSize;
282 ZData.Size := ZData.Size + Chunk.aLength;
283 ZData.Write (chunk.Data^, chunk.aLength);
284end;
285
286procedure TBGRAReaderPNG.HandleAlpha;
287 procedure PaletteAlpha;
288 var r : integer;
289 a : word;
290 c : TFPColor;
291 begin
292 with chunk do
293 begin
294 if alength > longword(ThePalette.count) then
295 raise PNGImageException.create ('To much alpha values for palette');
296 for r := 0 to alength-1 do
297 begin
298 c := ThePalette[r];
299 a := data^[r];
300 c.alpha := (a shl 8) + a;
301 ThePalette[r] := c;
302 end;
303 end;
304 end;
305 procedure TransparentGray;
306 var {%H-}a : word;
307 begin
308 move (chunk.data^[0], {%H-}a, 2);
309 {$IFDEF ENDIAN_LITTLE}
310 a := swap (a);
311 {$ENDIF}
312 TransparentDataValue := a;
313 UseTransparent := True;
314 end;
315 procedure TransparentColor;
316 var d : byte;
317 {%H-}r,{%H-}g,{%H-}b : word;
318 a : TColorData;
319 begin
320 with chunk do
321 begin
322 move (data^[0], {%H-}r, 2);
323 move (data^[2], {%H-}g, 2);
324 move (data^[4], {%H-}b, 2);
325 end;
326 {$IFDEF ENDIAN_LITTLE}
327 r := swap (r);
328 g := swap (g);
329 b := swap (b);
330 {$ENDIF}
331 d := header.bitdepth;
332 a := (TColorData(b) shl d) shl d;
333 a := a + (TColorData(g) shl d) + r;
334 TransparentDataValue := a;
335 UseTransparent := True;
336 end;
337begin
338 case header.ColorType of
339 3 : PaletteAlpha;
340 0 : TransparentGray;
341 2 : TransparentColor;
342 end;
343end;
344
345procedure TBGRAReaderPNG.HandlePalette;
346var r : longword;
347 c : TFPColor;
348 t : word;
349begin
350 if header.colortype = 3 then
351 with chunk do
352 begin
353 if TheImage.UsePalette then
354 FPalette := TheImage.Palette
355 else
356 FPalette := TFPPalette.Create(0);
357 c.Alpha := AlphaOpaque;
358 if (aLength mod 3) > 0 then
359 raise PNGImageException.Create ('Impossible length for PLTE-chunk');
360 r := 0;
361 ThePalette.count := 0;
362 while r < alength do
363 begin
364 t := data^[r];
365 c.red := t + (t shl 8);
366 inc (r);
367 t := data^[r];
368 c.green := t + (t shl 8);
369 inc (r);
370 t := data^[r];
371 c.blue := t + (t shl 8);
372 inc (r);
373 ThePalette.Add (c);
374 end;
375 end;
376end;
377
378procedure TBGRAReaderPNG.SetPalettePixel (x,y:integer; const CD : TColordata);
379begin // both PNG and palette have palette
380 TheImage.Pixels[x,y] := CD;
381end;
382
383procedure TBGRAReaderPNG.SetPalColPixel (x,y:integer; const CD : TColordata);
384begin // PNG with palette, Img without
385 TheImage.Colors[x,y] := ThePalette[CD];
386end;
387
388procedure TBGRAReaderPNG.SetColorPixel (x,y:integer; const CD : TColordata);
389var c : TFPColor;
390begin // both PNG and Img work without palette, and no transparency colordata
391 // c := ConvertColor (CD,CFmt);
392 c := ConvertColor (CD);
393 TheImage.Colors[x,y] := c;
394end;
395
396procedure TBGRAReaderPNG.SetColorTrPixel (x,y:integer; const CD : TColordata);
397var c : TFPColor;
398begin // both PNG and Img work without palette, and there is a transparency colordata
399 //c := ConvertColor (CD,CFmt);
400 c := ConvertColor (CD);
401 if TransparentDataValue = CD then
402 c.alpha := alphaTransparent;
403 TheImage.Colors[x,y] := c;
404end;
405
406procedure TBGRAReaderPNG.SetBGRAColorPixel(x, y: integer; const CD: TColordata);
407var c: TBGRAPixel;
408begin
409 c := FBGRAConvertColor(CD);
410 if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent)
411 else TBGRACustomBitmap(TheImage).SetPixel(x,y,c);
412end;
413
414procedure TBGRAReaderPNG.SetBGRAColorTrPixel(x, y: integer; const CD: TColordata);
415var c: TBGRAPixel;
416begin
417 if TransparentDataValue = CD then
418 TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) else
419 begin
420 c := FBGRAConvertColor(CD);
421 if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent)
422 else TBGRACustomBitmap(TheImage).SetPixel(x,y,c);
423 end;
424end;
425
426function TBGRAReaderPNG.DecideSetPixel : TSetPixelProc;
427begin
428 if Pltte then
429 if TheImage.UsePalette then
430 result := @SetPalettePixel
431 else
432 result := @SetPalColPixel
433 else
434 if UseTransparent then
435 begin
436 if TheImage is TBGRACustomBitmap then
437 result := @SetBGRAColorTrPixel
438 else
439 result := @SetColorTrPixel
440 end
441 else
442 begin
443 if TheImage is TBGRACustomBitmap then
444 result := @SetBGRAColorPixel
445 else
446 result := @SetColorPixel
447 end;
448end;
449
450function TBGRAReaderPNG.CalcX (relX:integer) : integer;
451begin
452 result := StartX + (relX * deltaX);
453end;
454
455function TBGRAReaderPNG.CalcY (relY:integer) : integer;
456begin
457 result := StartY + (relY * deltaY);
458end;
459
460function TBGRAReaderPNG.CalcColor(const ScanLine : PByteArray): TColorData;
461var cd : longword;
462 r : word;
463 p : pbyte;
464begin
465 if UsingBitGroup = 0 then
466 begin
467 Databytes := 0;
468 if Header.BitDepth = 16 then
469 begin
470 p := @Databytes;
471 for r:=0 to bytewidth shr 1 - 1 do
472 begin
473 p^ := ScanLine^[Dataindex+(r shl 1)+1];
474 (p+1)^ := ScanLine^[Dataindex+(r shl 1)];
475 inc(p,2);
476 end;
477 end
478 else move (ScanLine^[DataIndex], Databytes, bytewidth);
479 {$IFDEF ENDIAN_BIG}
480 Databytes:=swap(Databytes);
481 {$ENDIF}
482 inc (DataIndex,bytewidth);
483 end;
484 if bytewidth = 1 then
485 begin
486 cd := (Databytes and BitsUsed[UsingBitGroup]);
487 result := cd shr ((CountBitsUsed-UsingBitGroup-1) * BitShift);
488 inc (UsingBitgroup);
489 if UsingBitGroup >= CountBitsUsed then
490 UsingBitGroup := 0;
491 end
492 else
493 result := Databytes;
494end;
495
496procedure TBGRAReaderPNG.HandleScanLine (const y : integer; const ScanLine : PByteArray);
497var x, rx : integer;
498 c : TColorData;
499begin
500 UsingBitGroup := 0;
501 DataIndex := 0;
502 X := StartX;
503 if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then
504 case ByteWidth of
505 1: if BitsUsed[0] = $ff then
506 begin
507 for rx := 0 to ScanlineLength[CurrentPass]-1 do
508 begin
509 FSetPixel (x,y,ScanLine^[DataIndex]);
510 Inc(X, deltaX);
511 inc(DataIndex);
512 end;
513 exit;
514 end;
515 2: begin
516 for rx := 0 to ScanlineLength[CurrentPass]-1 do
517 begin
518 {$IFDEF ENDIAN_BIG}
519 FSetPixel (x,y,swap(PWord(@ScanLine^[DataIndex])^));
520 {$ELSE}
521 FSetPixel (x,y,PWord(@ScanLine^[DataIndex])^);
522 {$ENDIF}
523 Inc(X, deltaX);
524 inc(DataIndex,2);
525 end;
526 exit;
527 end;
528 4: begin
529 for rx := 0 to ScanlineLength[CurrentPass]-1 do
530 begin
531 {$IFDEF ENDIAN_BIG}
532 FSetPixel (x,y,swap(PDWord(@ScanLine^[DataIndex])^));
533 {$ELSE}
534 FSetPixel (x,y,PDWord(@ScanLine^[DataIndex])^);
535 {$ENDIF}
536 Inc(X, deltaX);
537 inc(DataIndex,4);
538 end;
539 exit;
540 end;
541 8: begin
542 for rx := 0 to ScanlineLength[CurrentPass]-1 do
543 begin
544 {$IFDEF ENDIAN_BIG}
545 FSetPixel (x,y,swap(PQWord(@ScanLine^[DataIndex])^));
546 {$ELSE}
547 FSetPixel (x,y,PQWord(@ScanLine^[DataIndex])^);
548 {$ENDIF}
549 Inc(X, deltaX);
550 inc(DataIndex,8);
551 end;
552 exit;
553 end;
554 end;
555
556 for rx := 0 to ScanlineLength[CurrentPass]-1 do
557 begin
558 c := CalcColor(ScanLine);
559 FSetPixel (x,y,c);
560 Inc(X, deltaX);
561 end
562end;
563
564procedure TBGRAReaderPNG.BGRAHandleScanLine (const y : integer; const ScanLine : PByteArray);
565var x, rx : integer;
566 c : TColorData;
567 pdest: PBGRAPixel;
568begin
569 UsingBitGroup := 0;
570 DataIndex := 0;
571 {$PUSH}{$RANGECHECKS OFF} //because PByteArray is limited to 32767
572 if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then
573 case ByteWidth of
574 1: if BitsUsed[0] = $ff then
575 begin
576 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
577 for rx := 0 to ScanlineLength[CurrentPass]-1 do
578 begin
579 pdest^ := FBGRAConvertColor(ScanLine^[DataIndex]);
580 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
581 Inc(pdest, deltaX);
582 inc(DataIndex);
583 end;
584 exit;
585 end;
586 2: begin
587 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
588 for rx := 0 to ScanlineLength[CurrentPass]-1 do
589 begin
590 pdest^ := FBGRAConvertColor(
591 {$IFDEF ENDIAN_BIG}
592 swap(PWord(@ScanLine^[DataIndex])^)
593 {$ELSE}
594 PWord(@ScanLine^[DataIndex])^
595 {$ENDIF} );
596 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
597 Inc(pdest, deltaX);
598 inc(DataIndex,2);
599 end;
600 exit;
601 end;
602 4: begin
603 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
604 for rx := 0 to ScanlineLength[CurrentPass]-1 do
605 begin
606 pdest^ := FBGRAConvertColor(
607 {$IFDEF ENDIAN_BIG}
608 swap(PDWord(@ScanLine^[DataIndex])^)
609 {$ELSE}
610 PDWord(@ScanLine^[DataIndex])^
611 {$ENDIF} );
612 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
613 Inc(pdest, deltaX);
614 inc(DataIndex,4);
615 end;
616 exit;
617 end;
618 8: begin
619 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
620 for rx := 0 to ScanlineLength[CurrentPass]-1 do
621 begin
622 pdest^ := FBGRAConvertColor(
623 {$IFDEF ENDIAN_BIG}
624 swap(PQWord(@ScanLine^[DataIndex])^)
625 {$ELSE}
626 PQWord(@ScanLine^[DataIndex])^
627 {$ENDIF} );
628 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
629 Inc(pdest, deltaX);
630 inc(DataIndex,8);
631 end;
632 exit;
633 end;
634 end;
635 {$POP}
636
637 X := StartX;
638 for rx := 0 to ScanlineLength[CurrentPass]-1 do
639 begin
640 c := CalcColor(ScanLine);
641 FSetPixel (x,y,c);
642 Inc(X, deltaX);
643 end
644end;
645
646procedure TBGRAReaderPNG.BGRAHandleScanLineTr(const y: integer;
647 const ScanLine: PByteArray);
648var x, rx : integer;
649 c : TColorData;
650 pdest: PBGRAPixel;
651begin
652 UsingBitGroup := 0;
653 DataIndex := 0;
654 if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then
655 case ByteWidth of
656 1: if BitsUsed[0] = $ff then
657 begin
658 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
659 for rx := 0 to ScanlineLength[CurrentPass]-1 do
660 begin
661 c := ScanLine^[DataIndex];
662 if c = TransparentDataValue then
663 pdest^ := BGRAPixelTransparent else
664 begin
665 pdest^ := FBGRAConvertColor(c);
666 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
667 end;
668 Inc(pdest, deltaX);
669 inc(DataIndex);
670 end;
671 exit;
672 end;
673 2: begin
674 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
675 for rx := 0 to ScanlineLength[CurrentPass]-1 do
676 begin
677 c :=
678 {$IFDEF ENDIAN_BIG}
679 swap(PWord(@ScanLine^[DataIndex])^)
680 {$ELSE}
681 PWord(@ScanLine^[DataIndex])^
682 {$ENDIF} ;
683 if c = TransparentDataValue then
684 pdest^ := BGRAPixelTransparent else
685 begin
686 pdest^ := FBGRAConvertColor(c);
687 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
688 end;
689 Inc(pdest, deltaX);
690 inc(DataIndex,2);
691 end;
692 exit;
693 end;
694 4: begin
695 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
696 for rx := 0 to ScanlineLength[CurrentPass]-1 do
697 begin
698 c :=
699 {$IFDEF ENDIAN_BIG}
700 swap(PDWord(@ScanLine^[DataIndex])^)
701 {$ELSE}
702 PDWord(@ScanLine^[DataIndex])^
703 {$ENDIF} ;
704 if c = TransparentDataValue then
705 pdest^ := BGRAPixelTransparent else
706 begin
707 pdest^ := FBGRAConvertColor(c);
708 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
709 end;
710 Inc(pdest, deltaX);
711 inc(DataIndex,4);
712 end;
713 exit;
714 end;
715 8: begin
716 pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX;
717 for rx := 0 to ScanlineLength[CurrentPass]-1 do
718 begin
719 c :=
720 {$IFDEF ENDIAN_BIG}
721 swap(PQWord(@ScanLine^[DataIndex])^)
722 {$ELSE}
723 PQWord(@ScanLine^[DataIndex])^
724 {$ENDIF} ;
725 if c = TransparentDataValue then
726 pdest^ := BGRAPixelTransparent else
727 begin
728 pdest^ := FBGRAConvertColor(c);
729 if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent;
730 end;
731 Inc(pdest, deltaX);
732 inc(DataIndex,8);
733 end;
734 exit;
735 end;
736 end;
737
738 X := StartX;
739 for rx := 0 to ScanlineLength[CurrentPass]-1 do
740 begin
741 c := CalcColor(ScanLine);
742 FSetPixel (x,y,c);
743 Inc(X, deltaX);
744 end
745end;
746
747function TBGRAReaderPNG.ColorGray1(const CD: TColorData): TFPColor;
748begin
749 if CD = 0 then
750 result := colBlack
751 else
752 result := colWhite;
753end;
754
755function TBGRAReaderPNG.ColorGray2(const CD: TColorData): TFPColor;
756var c : NativeUint;
757begin
758 c := CD and 3;
759 c := c + (c shl 2);
760 c := c + (c shl 4);
761 c := c + (c shl 8);
762 with result do
763 begin
764 red := c;
765 green := c;
766 blue := c;
767 alpha := alphaOpaque;
768 end;
769end;
770
771function TBGRAReaderPNG.ColorGray4(const CD: TColorData): TFPColor;
772var c : NativeUint;
773begin
774 c := CD and $F;
775 c := c + (c shl 4);
776 c := c + (c shl 8);
777 with result do
778 begin
779 red := c;
780 green := c;
781 blue := c;
782 alpha := alphaOpaque;
783 end;
784end;
785
786function TBGRAReaderPNG.ColorGray8(const CD: TColorData): TFPColor;
787var c : NativeUint;
788begin
789 c := CD and $FF;
790 c := c + (c shl 8);
791 with result do
792 begin
793 red := c;
794 green := c;
795 blue := c;
796 alpha := alphaOpaque;
797 end;
798end;
799
800function TBGRAReaderPNG.ColorGray16(const CD: TColorData): TFPColor;
801var c : NativeUint;
802begin
803 c := CD and $FFFF;
804 with result do
805 begin
806 red := c;
807 green := c;
808 blue := c;
809 alpha := alphaOpaque;
810 end;
811end;
812
813function TBGRAReaderPNG.ColorGrayAlpha8 (const CD:TColorData) : TFPColor;
814var c : NativeUint;
815begin
816 c := CD and $00FF;
817 c := c + (c shl 8);
818 with result do
819 begin
820 red := c;
821 green := c;
822 blue := c;
823 c := CD and $FF00;
824 alpha := c + (c shr 8);
825 end;
826end;
827
828function TBGRAReaderPNG.ColorGrayAlpha16 (const CD:TColorData) : TFPColor;
829var c : NativeUint;
830begin
831 c := CD and $FFFF;
832 with result do
833 begin
834 red := c;
835 green := c;
836 blue := c;
837 alpha := (CD shr 16) and $FFFF;
838 end;
839end;
840
841function TBGRAReaderPNG.ColorColor8 (const CD:TColorData) : TFPColor;
842var c : NativeUint;
843begin
844 with result do
845 begin
846 c := CD and $FF;
847 red := c + (c shl 8);
848 c := (CD shr 8) and $FF;
849 green := c + (c shl 8);
850 c := (CD shr 16) and $FF;
851 blue := c + (c shl 8);
852 alpha := alphaOpaque;
853 end;
854end;
855
856function TBGRAReaderPNG.ColorColor16 (const CD:TColorData) : TFPColor;
857begin
858 with result do
859 begin
860 red := CD and $FFFF;
861 green := (CD shr 16) and $FFFF;
862 blue := (CD shr 32) and $FFFF;
863 alpha := alphaOpaque;
864 end;
865end;
866
867function TBGRAReaderPNG.ColorColorAlpha8 (const CD:TColorData) : TFPColor;
868var c : NativeUint;
869begin
870 with result do
871 begin
872 c := CD and $FF;
873 red := c + (c shl 8);
874 c := (CD shr 8) and $FF;
875 green := c + (c shl 8);
876 c := (CD shr 16) and $FF;
877 blue := c + (c shl 8);
878 c := (CD shr 24) and $FF;
879 alpha := c + (c shl 8);
880 end;
881end;
882
883function TBGRAReaderPNG.ColorColorAlpha16 (const CD:TColorData) : TFPColor;
884begin
885 with result do
886 begin
887 red := CD and $FFFF;
888 green := (CD shr 16) and $FFFF;
889 blue := (CD shr 32) and $FFFF;
890 alpha := (CD shr 48) and $FFFF;
891 end;
892end;
893
894function TBGRAReaderPNG.BGRAColorGray1(const CD: TColorData): TBGRAPixel;
895begin
896 if CD = 0 then
897 result := BGRABlack
898 else
899 result := BGRAWhite;
900end;
901
902function TBGRAReaderPNG.BGRAColorGray2(const CD: TColorData): TBGRAPixel;
903var c : NativeUint;
904begin
905 c := CD and 3;
906 c := c + (c shl 2);
907 c := c + (c shl 4);
908 result := BGRA(c,c,c);
909end;
910
911function TBGRAReaderPNG.BGRAColorGray4(const CD: TColorData): TBGRAPixel;
912var c : NativeUint;
913begin
914 c := CD and $F;
915 c := c + (c shl 4);
916 result := BGRA(c,c,c);
917end;
918
919function TBGRAReaderPNG.BGRAColorGray8(const CD: TColorData): TBGRAPixel;
920var c : NativeUint;
921begin
922 c := CD and $FF;
923 result := BGRA(c,c,c);
924end;
925
926function TBGRAReaderPNG.BGRAColorGray16(const CD: TColorData): TBGRAPixel;
927var c : NativeUint;
928begin
929 c := (CD shr 8) and $FF;
930 result := BGRA(c,c,c);
931end;
932
933function TBGRAReaderPNG.BGRAColorGrayAlpha8(const CD: TColorData): TBGRAPixel;
934var c : NativeUint;
935begin
936 c := CD and $00FF;
937 result := BGRA(c,c,c,(CD shr 8) and $FF);
938end;
939
940function TBGRAReaderPNG.BGRAColorGrayAlpha16(const CD: TColorData): TBGRAPixel;
941var c : NativeUint;
942begin
943 c := (CD shr 8) and $FF;
944 result := BGRA(c,c,c,(CD shr 24) and $FF);
945end;
946
947function TBGRAReaderPNG.BGRAColorColor8(const CD: TColorData): TBGRAPixel;
948var temp: DWord;
949begin
950 temp := CD;
951 result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff);
952end;
953
954function TBGRAReaderPNG.BGRAColorColor16(const CD: TColorData): TBGRAPixel;
955begin
956 result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF);
957end;
958
959function TBGRAReaderPNG.BGRAColorColorAlpha8(const CD: TColorData): TBGRAPixel;
960var temp: DWord;
961begin
962 temp := CD;
963 result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff, temp shr 24);
964end;
965
966function TBGRAReaderPNG.BGRAColorColorAlpha16(const CD: TColorData): TBGRAPixel;
967begin
968 result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF, CD shr 56);
969end;
970
971procedure TBGRAReaderPNG.DoDecompress;
972
973 procedure initVars;
974 var r,d : integer;
975 begin
976 with Header do
977 begin
978 if interlace=0 then
979 begin
980 StartPass := 0;
981 EndPass := 0;
982 FCountScanlines[0] := Height;
983 FScanLineLength[0] := Width;
984 end
985 else
986 begin
987 StartPass := 1;
988 EndPass := 7;
989 for r := 1 to 7 do
990 begin
991 d := Height div delta[r,1];
992 if (height mod delta[r,1]) > startpoints[r,1] then
993 inc (d);
994 FCountScanlines[r] := d;
995 d := width div delta[r,0];
996 if (width mod delta[r,0]) > startpoints[r,0] then
997 inc (d);
998 FScanLineLength[r] := d;
999 end;
1000 end;
1001 Fpltte := (ColorType = 3);
1002 case colortype of
1003 0 : case Bitdepth of
1004 1 : begin
1005 FConvertColor := @ColorGray1; //CFmt := cfMono;
1006 FBGRAConvertColor := @BGRAColorGray1; //CFmt := cfMono;
1007 ByteWidth := 1;
1008 end;
1009 2 : begin
1010 FConvertColor := @ColorGray2; //CFmt := cfGray2;
1011 FBGRAConvertColor := @BGRAColorGray2; //CFmt := cfGray2;
1012 ByteWidth := 1;
1013 end;
1014 4 : begin
1015 FConvertColor := @ColorGray4; //CFmt := cfGray4;
1016 FBGRAConvertColor := @BGRAColorGray4; //CFmt := cfGray4;
1017 ByteWidth := 1;
1018 end;
1019 8 : begin
1020 FConvertColor := @ColorGray8; //CFmt := cfGray8;
1021 FBGRAConvertColor := @BGRAColorGray8; //CFmt := cfGray8;
1022 ByteWidth := 1;
1023 end;
1024 16 : begin
1025 FConvertColor := @ColorGray16; //CFmt := cfGray16;
1026 FBGRAConvertColor := @BGRAColorGray16; //CFmt := cfGray16;
1027 ByteWidth := 2;
1028 end;
1029 end;
1030 2 : if BitDepth = 8 then
1031 begin
1032 FConvertColor := @ColorColor8; //CFmt := cfBGR24
1033 FBGRAConvertColor := @BGRAColorColor8; //CFmt := cfBGR24
1034 ByteWidth := 3;
1035 end
1036 else
1037 begin
1038 FConvertColor := @ColorColor16; //CFmt := cfBGR48;
1039 FBGRAConvertColor := @BGRAColorColor16; //CFmt := cfBGR48;
1040 ByteWidth := 6;
1041 end;
1042 3 : if BitDepth = 16 then
1043 ByteWidth := 2
1044 else
1045 ByteWidth := 1;
1046 4 : if BitDepth = 8 then
1047 begin
1048 FConvertColor := @ColorGrayAlpha8; //CFmt := cfGrayA16
1049 FBGRAConvertColor := @BGRAColorGrayAlpha8; //CFmt := cfGrayA16
1050 ByteWidth := 2;
1051 end
1052 else
1053 begin
1054 FConvertColor := @ColorGrayAlpha16; //CFmt := cfGrayA32;
1055 FBGRAConvertColor := @BGRAColorGrayAlpha16; //CFmt := cfGrayA32;
1056 ByteWidth := 4;
1057 end;
1058 6 : if BitDepth = 8 then
1059 begin
1060 FConvertColor := @ColorColorAlpha8; //CFmt := cfABGR32
1061 FBGRAConvertColor := @BGRAColorColorAlpha8; //CFmt := cfABGR32
1062 ByteWidth := 4;
1063 end
1064 else
1065 begin
1066 FConvertColor := @ColorColorAlpha16; //CFmt := cfABGR64;
1067 FBGRAConvertColor := @BGRAColorColorAlpha16; //CFmt := cfABGR64;
1068 ByteWidth := 8;
1069 end;
1070 end;
1071 //ByteWidth := BytesNeeded[CFmt];
1072 case BitDepth of
1073 1 : begin
1074 CountBitsUsed := 8;
1075 BitShift := 1;
1076 BitsUsed := BitsUsed1Depth;
1077 end;
1078 2 : begin
1079 CountBitsUsed := 4;
1080 BitShift := 2;
1081 BitsUsed := BitsUsed2Depth;
1082 end;
1083 4 : begin
1084 CountBitsUsed := 2;
1085 BitShift := 4;
1086 BitsUsed := BitsUsed4Depth;
1087 end;
1088 8 : begin
1089 CountBitsUsed := 1;
1090 BitShift := 0;
1091 BitsUsed[0] := $FF;
1092 end;
1093 end;
1094 end;
1095 end;
1096
1097 procedure FilterSub(p: PByte; Count: NativeInt; bw: NativeInt);
1098 begin
1099 inc(p,bw);
1100 dec(Count,bw);
1101 while Count > 0 do
1102 begin
1103 {$push}{$r-}
1104 p^ += (p-bw)^;
1105 {$pop}
1106 inc(p);
1107 dec(Count);
1108 end;
1109 end;
1110
1111 procedure FilterUp(p,pPrev: PByte; Count: NativeUInt);
1112 var Count4: NativeInt;
1113 begin
1114 Count4 := Count shr 2;
1115 dec(Count, Count4 shl 2);
1116 while Count4 > 0 do
1117 begin
1118 {$push}{$r-}{$q-}
1119 PDWord(p)^ := (((PDWord(pPrev)^ and $00FF00FF) + (PDWord(p)^ and $00FF00FF)) and $00FF00FF)
1120 or (((PDWord(pPrev)^ and $FF00FF00) + (PDWord(p)^ and $FF00FF00)) and $FF00FF00);
1121 {$pop}
1122 inc(p,4);
1123 inc(pPrev,4);
1124 dec(Count4);
1125 end;
1126 while Count > 0 do
1127 begin
1128 {$push}{$r-}
1129 p^ += pPrev^;
1130 {$pop}
1131
1132 inc(p);
1133 inc(pPrev);
1134 dec(Count);
1135 end;
1136 end;
1137
1138 procedure FilterAverage(p,pPrev: PByte; Count: NativeUInt; bw: NativeInt);
1139 var CountBW: NativeInt;
1140 begin
1141 CountBW := bw;
1142 dec(Count,CountBW);
1143 while CountBW > 0 do
1144 begin
1145 {$push}{$r-}
1146 p^ += pPrev^ shr 1;
1147 {$pop}
1148 inc(p);
1149 inc(pPrev);
1150 dec(CountBW);
1151 end;
1152
1153 while Count > 0 do
1154 begin
1155 {$push}{$r-}
1156 p^ += (pPrev^+(p-bw)^) shr 1;
1157 {$pop}
1158 inc(p);
1159 inc(pPrev);
1160 dec(Count);
1161 end;
1162 end;
1163
1164 procedure FilterPaeth(p,pPrev: PByte; Count: NativeUInt; bw: NativeInt);
1165 var
1166 rx, dl, dp, dlp : NativeInt;
1167 diag,left: NativeUInt;
1168 begin
1169 for rx := 0 to bw-1 do
1170 begin
1171 {$push}{$r-}
1172 p^ += pPrev^;
1173 {$pop}
1174 inc(p);
1175 inc(pPrev);
1176 end;
1177 dec(Count,bw);
1178 while Count > 0 do
1179 begin
1180 diag := (pPrev-bw)^;
1181 left := (p - bw)^;
1182 dl := pPrev^ - NativeInt(diag);
1183 dp := NativeInt(left) - NativeInt(diag);
1184 dlp := abs(dl+dp);
1185 if dl < 0 then dl := -dl;
1186 if dp < 0 then dp := -dp;
1187 {$push}{$r-}
1188 if dp <= dlp then
1189 begin
1190 if dl <= dp then
1191 p^ += left
1192 else
1193 p^ += pPrev^
1194 end
1195 else
1196 if dl <= dlp then
1197 p^ += left
1198 else
1199 p^ += diag;
1200 {$pop}
1201 inc(p);
1202 inc(pPrev);
1203 dec(Count);
1204 end;
1205 end;
1206
1207 procedure Decode;
1208 var y, rp, ry, l : NativeInt;
1209 lf : byte;
1210 switchLine, currentLine, previousLine : pByteArray;
1211 begin
1212 FSetPixel := DecideSetPixel;
1213 if not Pltte and (TheImage is TBGRACustomBitmap) then
1214 begin
1215 if UseTransparent then
1216 FHandleScanLine := @BGRAHandleScanLineTr
1217 else
1218 FHandleScanLine := @BGRAHandleScanLine;
1219 end else
1220 FHandleScanLine := @HandleScanLine;
1221 for rp := StartPass to EndPass do
1222 begin
1223 FCurrentPass := rp;
1224 StartX := StartPoints[rp,0];
1225 StartY := StartPoints[rp,1];
1226 DeltaX := Delta[rp,0];
1227 DeltaY := Delta[rp,1];
1228 if bytewidth = 1 then
1229 begin
1230 l := (ScanLineLength[rp] div CountBitsUsed);
1231 if (ScanLineLength[rp] mod CountBitsUsed) > 0 then
1232 inc (l);
1233 end
1234 else
1235 l := ScanLineLength[rp]*ByteWidth;
1236 if (l>0) then
1237 begin
1238 GetMem (previousLine, l);
1239 GetMem (currentLine, l);
1240 fillchar (currentLine^,l,0);
1241 try
1242 for ry := 0 to CountScanlines[rp]-1 do
1243 begin
1244 switchLine := currentLine;
1245 currentLine := previousLine;
1246 previousLine := switchLine;
1247 Y := StartY + (ry * deltaY);
1248 lf := 0;
1249 Decompress.Read (lf, sizeof(lf));
1250 Decompress.Read (currentLine^, l);
1251
1252 case lf of
1253 1: FilterSub(PByte(currentLine), l, ByteWidth);
1254 2: FilterUp(PByte(currentLine), PByte(previousLine), l);
1255 3: FilterAverage(PByte(currentLine), PByte(previousLine), l, ByteWidth);
1256 4: FilterPaeth(PByte(currentLine), PByte(previousLine), l, ByteWidth);
1257 end;
1258
1259 if FVerticalShrinkShr <> 0 then
1260 begin
1261 if (y and FVerticalShrinkMask) = 0 then
1262 FHandleScanLine (y shr FVerticalShrinkShr, currentLine);
1263 end else
1264 FHandleScanLine (y, currentLine);
1265 end;
1266 finally
1267 freemem (previousLine);
1268 freemem (currentLine);
1269 end;
1270 end;
1271 end;
1272 end;
1273
1274begin
1275 InitVars;
1276 DeCode;
1277end;
1278
1279procedure TBGRAReaderPNG.HandleChunk;
1280begin
1281 case chunk.AType of
1282 ctIHDR : raise PNGImageException.Create ('Second IHDR chunk found');
1283 ctPLTE : HandlePalette;
1284 ctIDAT : HandleData;
1285 ctIEND : EndOfFile := True;
1286 cttRNS : HandleAlpha;
1287 else HandleUnknown;
1288 end;
1289end;
1290
1291procedure TBGRAReaderPNG.HandleUnknown;
1292begin
1293 if (chunk.readtype[0] in ['A'..'Z']) then
1294 raise PNGImageException.Create('Critical chunk '+chunk.readtype+' not recognized');
1295end;
1296
1297procedure TBGRAReaderPNG.InternalRead (Str:TStream; Img:TFPCustomImage);
1298var outputHeight: integer;
1299begin
1300 {$ifdef FPC_Debug_Image}
1301 if Str<>TheStream then
1302 writeln('WARNING: TBGRAReaderPNG.InternalRead Str<>TheStream');
1303 {$endif}
1304 with Header do
1305 begin
1306 FVerticalShrinkShr := 0;
1307 FVerticalShrinkMask := 0;
1308 outputHeight := Height;
1309 if MinifyHeight <> 0 then
1310 begin
1311 while (outputHeight shr 1 >= MinifyHeight) and (FVerticalShrinkShr < 8) do
1312 begin
1313 outputHeight:= outputHeight shr 1;
1314 Inc(FVerticalShrinkShr);
1315 end;
1316 FVerticalShrinkMask:= (1 shl FVerticalShrinkShr)-1;
1317 outputHeight := (Height+FVerticalShrinkMask) shr FVerticalShrinkShr;
1318 end;
1319 Img.SetSize (Width, outputHeight);
1320 end;
1321 ZData := TMemoryStream.Create;
1322 try
1323 EndOfFile := false;
1324 while not EndOfFile do
1325 begin
1326 ReadChunk;
1327 HandleChunk;
1328 end;
1329 ZData.position:=0;
1330 Decompress := TDecompressionStream.Create (ZData);
1331 try
1332 DoDecompress;
1333 finally
1334 Decompress.Free;
1335 end;
1336 finally
1337 ZData.Free;
1338 if not img.UsePalette and assigned(FPalette) then
1339 begin
1340 FPalette.Free;
1341 end;
1342 end;
1343end;
1344
1345function TBGRAReaderPNG.InternalCheck (Str:TStream) : boolean;
1346var {%H-}SigCheck : array[0..7] of byte;
1347 r : integer;
1348begin
1349 try
1350 // Check Signature
1351 if Str.Read({%H-}SigCheck, SizeOf(SigCheck)) <> SizeOf(SigCheck) then
1352 raise PNGImageException.Create('This is not PNG-data');
1353 for r := 0 to 7 do
1354 begin
1355 If SigCheck[r] <> Signature[r] then
1356 raise PNGImageException.Create('This is not PNG-data');
1357 end;
1358 // Check IHDR
1359 ReadChunk;
1360 fillchar(FHeader, sizeof(FHeader), 0);
1361 move (chunk.data^, FHeader, min(sizeof(Header), chunk.alength));
1362 with header do
1363 begin
1364 {$IFDEF ENDIAN_LITTLE}
1365 Width := swap(width);
1366 height := swap (height);
1367 {$ENDIF}
1368 result := (width > 0) and (height > 0) and (compression = 0)
1369 and (filter = 0) and (Interlace in [0,1]);
1370 end;
1371 except
1372 result := false;
1373 end;
1374end;
1375
1376initialization
1377
1378 DefaultBGRAImageReader[ifPng] := TBGRAReaderPNG;
1379
1380end.
1381
Note: See TracBrowser for help on using the repository browser.