diff options
| author | Vadim Dashevskiy <watcherhd@gmail.com> | 2012-10-08 09:10:06 +0000 |
|---|---|---|
| committer | Vadim Dashevskiy <watcherhd@gmail.com> | 2012-10-08 09:10:06 +0000 |
| commit | 194923c172167eb3fc33807ec8009b255f86337e (patch) | |
| tree | 1effc97a1bd872cc3a5eac7a361250cf283e0efd /plugins/!NotAdopted/Chess4Net/lib/PNGImage | |
| parent | b2943645fed61d0c0cfee1225654e5ff44fd96f8 (diff) | |
Plugin is not adapted until someone can compile it and tell others how to do the same
git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/lib/PNGImage')
16 files changed, 6688 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/adler32.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/adler32.obj Binary files differnew file mode 100644 index 0000000000..84d2850efa --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/adler32.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/compress.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/compress.obj Binary files differnew file mode 100644 index 0000000000..90cf74f1e4 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/compress.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/crc32.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/crc32.obj Binary files differnew file mode 100644 index 0000000000..ea14153d31 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/crc32.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/deflate.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/deflate.obj Binary files differnew file mode 100644 index 0000000000..3ffc8bcae9 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/deflate.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/gzio.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/gzio.obj Binary files differnew file mode 100644 index 0000000000..ff94037b1e --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/gzio.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/infback.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/infback.obj Binary files differnew file mode 100644 index 0000000000..2114f10ad5 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/infback.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inffast.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inffast.obj Binary files differnew file mode 100644 index 0000000000..c8f5b1f5e5 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inffast.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inflate.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inflate.obj Binary files differnew file mode 100644 index 0000000000..4c53c01a93 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inflate.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inftrees.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inftrees.obj Binary files differnew file mode 100644 index 0000000000..c37455e249 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/inftrees.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/trees.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/trees.obj Binary files differnew file mode 100644 index 0000000000..98a6110b3f --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/trees.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/uncompr.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/uncompr.obj Binary files differnew file mode 100644 index 0000000000..12cd70b661 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/uncompr.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/zutil.obj b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/zutil.obj Binary files differnew file mode 100644 index 0000000000..9395409f01 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/obj/zutil.obj diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngextra.pas b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngextra.pas new file mode 100644 index 0000000000..c219e7e22e --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngextra.pas @@ -0,0 +1,353 @@ +unit pngextra;
+
+interface
+
+uses
+ Windows, Graphics, Messages, SysUtils, Classes, Controls, pngimage, Buttons,
+ ExtCtrls;
+
+type
+ TPNGButtonStyle = (pbsDefault, pbsFlat, pbsNoFrame);
+ TPNGButtonLayout = (pbsImageAbove, pbsImageBellow, pbsImageLeft,
+ pbsImageRight);
+ TPNGButtonState = (pbsNormal, pbsDown, pbsDisabled);
+
+ TPNGButton = class(TGraphicControl)
+ private
+ {Holds the property values}
+ fButtonStyle: TPNGButtonStyle;
+ fMouseOverControl: Boolean;
+ FCaption: String;
+ FButtonLayout: TPNGButtonLayout;
+ FButtonState: TPNGButtonState;
+ FImageDown: TPNGObject;
+ fImageNormal: TPNGObject;
+ fImageDisabled: TPNGObject;
+ fImageOver: TPNGObject;
+ fOnMouseEnter, fOnMouseExit: TNotifyEvent;
+ {Procedures for setting the property values}
+ procedure SetButtonStyle(const Value: TPNGButtonStyle);
+ procedure SetCaption(const Value: String);
+ procedure SetButtonLayout(const Value: TPNGButtonLayout);
+ procedure SetButtonState(const Value: TPNGButtonState);
+ procedure SetImageNormal(const Value: TPNGObject);
+ procedure SetImageDown(const Value: TPNGObject);
+ procedure SetImageOver(const Value: TPNGObject);
+ published
+ {Published properties}
+ property Font;
+ property Visible;
+ property ButtonLayout: TPNGButtonLayout read FButtonLayout write SetButtonLayout;
+ property Caption: String read FCaption write SetCaption;
+ property ImageNormal: TPNGObject read fImageNormal write SetImageNormal;
+ property ImageDown: TPNGObject read FImageDown write SetImageDown;
+ property ImageOver: TPNGObject read FImageOver write SetImageOver;
+ property ButtonStyle: TPNGButtonStyle read fButtonStyle
+ write SetButtonStyle;
+ property Enabled;
+ property ParentShowHint;
+ property ShowHint;
+ {Default events}
+ property OnMouseDown;
+ property OnClick;
+ property OnMouseUp;
+ property OnMouseMove;
+ property OnDblClick;
+ property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
+ property OnMouseExit: TNotifyEvent read fOnMouseExit write fOnMouseExit;
+ public
+ {Public properties}
+ property ButtonState: TPNGButtonState read FButtonState write SetButtonState;
+ protected
+ {Being painted}
+ procedure Paint; override;
+ {Clicked}
+ procedure Click; override;
+ {Mouse pressed}
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ {Mouse entering or leaving}
+ procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
+ procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
+ {Being enabled or disabled}
+ procedure CMEnabledChanged(var Message: TMessage);
+ message CM_ENABLEDCHANGED;
+ public
+ {Returns if the mouse is over the control}
+ property IsMouseOver: Boolean read fMouseOverControl;
+ {Constructor and destructor}
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+procedure Register;
+procedure MakeImageHalfTransparent(Source, Dest: TPNGObject);
+
+implementation
+
+procedure Register;
+begin
+ RegisterComponents('Samples', [TPNGButton]);
+end;
+
+procedure MakeImageHalfTransparent(Source, Dest: TPNGObject);
+var
+ i, j: Integer;
+begin
+ Dest.Assign(Source);
+ Dest.CreateAlpha;
+ if (Dest.Header.ColorType <> COLOR_PALETTE) then
+ for j := 0 to Source.Height - 1 do
+ for i := 0 to Source.Width - 1 do
+ Dest.AlphaScanline[j]^[i] := Dest.AlphaScanline[j]^[i] div 3;
+end;
+
+{TPNGButton implementation}
+
+{Being created}
+constructor TPNGButton.Create(AOwner: TComponent);
+begin
+ {Calls ancestor}
+ inherited Create(AOwner);
+ {Creates the TPNGObjects}
+ fImageNormal := TPNGObject.Create;
+ fImageDown := TPNGObject.Create;
+ fImageDisabled := TPNGObject.Create;
+ fImageOver := TPNGObject.Create;
+ {Initial properties}
+ ControlStyle := ControlStyle + [csCaptureMouse];
+ SetBounds(Left, Top, 23, 23);
+ fMouseOverControl := False;
+ fButtonLayout := pbsImageAbove;
+ fButtonState := pbsNormal
+end;
+
+destructor TPNGButton.Destroy;
+begin
+ {Frees the TPNGObject}
+ fImageNormal.Free;
+ fImageDown.Free;
+ fImageDisabled.Free;
+ fImageOver.Free;
+
+ {Calls ancestor}
+ inherited Destroy;
+end;
+
+{Being enabled or disabled}
+procedure TPNGButton.CMEnabledChanged(var Message: TMessage);
+begin
+ if not Enabled then MakeImageHalfTransparent(fImageNormal, fImageDisabled);
+ if Enabled then ButtonState := pbsNormal else ButtonState := pbsDisabled
+end;
+
+{Returns the largest number}
+function Max(A, B: Integer): Integer;
+begin
+ if A > B then Result := A else Result := B
+end;
+
+{Button being painted}
+procedure TPNGButton.Paint;
+const
+ Slide: Array[false..true] of Integer = (0, 2);
+var
+ Area: TRect;
+ TextSize, ImageSize: TSize;
+ TextPos, ImagePos: TPoint;
+ Image: TPNGObject;
+ Pushed: Boolean;
+begin
+ {Prepares the canvas}
+ Canvas.Font.Assign(Font);
+
+ {Determines if the button is pushed}
+ Pushed := (ButtonState = pbsDown) and IsMouseOver;
+
+ {Determines the image to use}
+ if (Pushed) and not fImageDown.Empty then
+ Image := fImageDown
+ else if IsMouseOver and not fImageOver.Empty and Enabled then
+ Image := fImageOver
+ else if (ButtonState = pbsDisabled) and not fImageDisabled.Empty then
+ Image := fImageDisabled
+ else
+ Image := fImageNormal;
+
+ {Get the elements size}
+ ImageSize.cx := Image.Width;
+ ImageSize.cy := Image.Height;
+ Area := ClientRect;
+ if Caption <> '' then
+ begin
+ TextSize := Canvas.TextExtent(Caption);
+ ImageSize.cy := ImageSize.Cy + 4;
+ end else FillChar(TextSize, SizeOf(TextSize), #0);
+
+ {Set the elements position}
+ ImagePos.X := (Width - ImageSize.cx) div 2 + Slide[Pushed];
+ TextPos.X := (Width - TextSize.cx) div 2 + Slide[Pushed];
+ TextPos.Y := (Height - TextSize.cy) div 2;
+ ImagePos.Y := (Height - ImageSize.cy) div 2;
+ case ButtonLayout of
+ pbsImageAbove: begin
+ ImagePos.Y := (Height - ImageSize.cy - TextSize.cy) div 2;
+ TextPos.Y := ImagePos.Y + ImageSize.cy;
+ end;
+ pbsImageBellow: begin
+ TextPos.Y := (Height - ImageSize.cy - TextSize.cy) div 2;
+ ImagePos.Y := TextPos.Y + TextSize.cy;
+ end;
+ pbsImageLeft: begin
+ ImagePos.X := (Width - ImageSize.cx - TextSize.cx) div 2;
+ TextPos.X := ImagePos.X + ImageSize.cx + 5;
+ end;
+ pbsImageRight: begin
+ TextPos.X := (Width - ImageSize.cx - TextSize.cx) div 2;;
+ ImagePos.X := TextPos.X + TextSize.cx + 5;
+ end
+ end;
+ ImagePos.Y := ImagePos.Y + Slide[Pushed];
+ TextPos.Y := TextPos.Y + Slide[Pushed];
+
+ {Draws the border}
+ if ButtonStyle = pbsFlat then
+ begin
+ if ButtonState <> pbsDisabled then
+ if (Pushed) then
+ Frame3D(Canvas, Area, clBtnShadow, clBtnHighlight, 1)
+ else if IsMouseOver or (ButtonState = pbsDown) then
+ Frame3D(Canvas, Area, clBtnHighlight, clBtnShadow, 1)
+ end
+ else if ButtonStyle = pbsDefault then
+ DrawButtonFace(Canvas, Area, 1, bsNew, TRUE, Pushed, FALSE);
+
+ {Draws the elements}
+ Canvas.Brush.Style := bsClear;
+ Canvas.Draw(ImagePos.X, ImagePos.Y, Image);
+ if ButtonState = pbsDisabled then Canvas.Font.Color := clGrayText;
+ Canvas.TextRect(Area, TextPos.X, TextPos.Y, Caption)
+end;
+
+{Changing the button Layout property}
+procedure TPNGButton.SetButtonLayout(const Value: TPNGButtonLayout);
+begin
+ FButtonLayout := Value;
+ Repaint
+end;
+
+{Changing the button state property}
+procedure TPNGButton.SetButtonState(const Value: TPNGButtonState);
+begin
+ FButtonState := Value;
+ Repaint
+end;
+
+{Changing the button style property}
+procedure TPNGButton.SetButtonStyle(const Value: TPNGButtonStyle);
+begin
+ fButtonStyle := Value;
+ Repaint
+end;
+
+{Changing the caption property}
+procedure TPNGButton.SetCaption(const Value: String);
+begin
+ FCaption := Value;
+ Repaint
+end;
+
+{Changing the image property}
+procedure TPNGButton.SetImageNormal(const Value: TPNGObject);
+begin
+ fImageNormal.Assign(Value);
+ MakeImageHalfTransparent(fImageNormal, fImageDisabled);
+ Repaint
+end;
+
+{Setting the down image}
+procedure TPNGButton.SetImageDown(const Value: TPNGObject);
+begin
+ FImageDown.Assign(Value);
+ Repaint
+end;
+
+{Setting the over image}
+procedure TPNGButton.SetImageOver(const Value: TPNGObject);
+begin
+ fImageOver.Assign(Value);
+ Repaint
+end;
+
+{Mouse pressed}
+procedure TPNGButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Integer);
+begin
+ {Changes the state and repaints}
+ if (ButtonState = pbsNormal) and (Button = mbLeft) then
+ ButtonState := pbsDown;
+ {Calls ancestor}
+ inherited
+end;
+
+{Being clicked}
+procedure TPNGButton.Click;
+begin
+ if ButtonState = pbsDown then ButtonState := pbsNormal;
+ inherited Click;
+end;
+
+{Mouse released}
+procedure TPNGButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Integer);
+begin
+ {Changes the state and repaints}
+ if ButtonState = pbsDown then ButtonState := pbsNormal;
+ {Calls ancestor}
+ inherited
+end;
+
+{Mouse moving over the control}
+procedure TPNGButton.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ {In case cursor is over the button}
+ if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) and
+ (fMouseOverControl = False) and (ButtonState <> pbsDown) then
+ begin
+ fMouseOverControl := True;
+ Repaint;
+ end;
+
+ {Calls ancestor}
+ inherited;
+
+end;
+
+{Mouse is now over the control}
+procedure TPNGButton.CMMouseEnter(var Message: TMessage);
+begin
+ if Enabled then
+ begin
+ if Assigned(fOnMouseEnter) then fOnMouseEnter(Self);
+ fMouseOverControl := True;
+ Repaint
+ end
+end;
+
+{Mouse has left the control}
+procedure TPNGButton.CMMouseLeave(var Message: TMessage);
+begin
+ if Enabled then
+ begin
+ if Assigned(fOnMouseExit) then FOnMouseExit(Self);
+ fMouseOverControl := False;
+ Repaint
+ end
+end;
+
+
+
+end.
diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngimage.pas b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngimage.pas new file mode 100644 index 0000000000..320891d4d3 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pngimage.pas @@ -0,0 +1,5824 @@ +{Portable Network Graphics Delphi 1.564 (31 July 2006) }
+
+{This is a full, open sourced implementation of png in Delphi }
+{It has native support for most of png features including the }
+{partial transparency, gamma and more. }
+{For the latest version, please be sure to check my website }
+{http://pngdelphi.sourceforge.net }
+{Gustavo Huffenbacher Daud (gustavo.daud@terra.com.br) }
+
+
+{
+ Version 1.564
+ 2006-07-25 BUG 1 - There was one GDI Palette object leak
+ when assigning from other PNG (fixed)
+ BUG 2 - Loosing color information when assigning png
+ to bmp on lower screen depth system
+ BUG 3 - There was a bug in TStream.GetSize
+ (fixed thanks to Vladimir Panteleev)
+ IMPROVE 1 - When assigning png to bmp now alpha information
+ is drawn (simulated into a white background)
+
+ Version 1.563
+ 2006-07-25 BUG 1 - There was a memory bug in the main component
+ destructor (fixed thanks to Steven L Brenner)
+ BUG 2 - The packages name contained spaces which was
+ causing some strange bugs in Delphi
+ (fixed thanks to Martijn Saly)
+ BUG 3 - Lots of fixes when handling palettes
+ (bugs implemented in the last version)
+ Fixed thanks to Gabriel Corneanu!!!
+ BUG 4 - CreateAlpha was raising an error because it did
+ not resized the palette chunk it created;
+ Fixed thanks to Miha Sokolov
+ IMPROVE 1 - Renamed the pngzlib.pas unit to zlibpas.pas
+ as a tentative to all libraries use the same
+ shared zlib implementation and to avoid including
+ two or three times the same P-Code.
+ (Gabriel Corneanu idea)
+
+
+
+ Version 1.561
+ 2006-05-17 BUG 1 - There was a bug in the method that draws semi
+ transparent images (a memory leak). fixed.
+
+ Version 1.56
+ 2006-05-09 - IMPROVE 1 - Delphi standard TCanvas support is now implemented
+ IMPROVE 2 - The PNG files may now be resized and created from
+ scratch using CreateBlank, Resize, Width and Height
+ BUG 1 - Fixed some bugs on handling tRNS transparencies
+ BUG 2 - Fixed bugs related to palette handling
+
+ Version 1.535
+ 2006-04-21 - IMPROVE 1 - Now the library uses the latest ZLIB release (1.2.3)
+ (thanks to: Roberto Della Pasqua
+ http://www.dellapasqua.com/delphizlib/)
+
+ Version 1.53
+ 2006-04-14 -
+ BUG 1 - Remove transparency was not working for
+ RGB Alpha and Grayscale alpha. fixed
+ BUG 2 - There was a bug were compressed text chunks no keyword
+ name could not be read
+ IMPROVE 1 - Add classes and methods to work with the pHYs chunk
+ (including TPNGObject.DrawUsingPixelInformation)
+ IMPROVE 3 - Included a property Version to return the library
+ version
+ IMPROVE 4 - New polish translation (thanks to Piotr Domanski)
+ IMPROVE 5 - Now packages for delphi 5, 6, 7, 2005 and 2006
+
+ Also Martijn Saly (thany) made some improvements in the library:
+ IMPROVE 1 - SetPixel now works with grayscale
+ IMPROVE 2 - Palette property now can be written using a
+ windows handle
+ Thanks !!
+
+ Version 1.5
+ 2005-06-29 - Fixed a lot of bugs using tips from mails that I´ve
+ being receiving for some time
+ BUG 1 - Loosing palette when assigning to TBitmap. fixed
+ BUG 2 - SetPixels and GetPixels worked only with
+ parameters in range 0..255. fixed
+ BUG 3 - Force type address off using directive
+ BUG 4 - TChunkzTXt contained an error
+ BUG 5 - MaxIdatSize was not working correctly (fixed thanks
+ to Gabriel Corneanu
+ BUG 6 - Corrected german translation (thanks to Mael Horz)
+ And the following improvements:
+ IMPROVE 1 - Create ImageHandleValue properties as public in
+ TChunkIHDR to get access to this handle
+ IMPROVE 2 - Using SetStretchBltMode to improve stretch quality
+ IMPROVE 3 - Scale is now working for alpha transparent images
+ IMPROVE 4 - GammaTable propery is now public to support an
+ article in the help file
+
+ Version 1.4361
+ 2003-03-04 - Fixed important bug for simple transparency when using
+ RGB, Grayscale color modes
+
+ Version 1.436
+ 2003-03-04 - * NEW * Property Pixels for direct access to pixels
+ * IMPROVED * Palette property (TPngObject) (read only)
+ Slovenian traslation for the component (Miha Petelin)
+ Help file update (scanline article/png->jpg example)
+
+ Version 1.435
+ 2003-11-03 - * NEW * New chunk implementation zTXt (method AddzTXt)
+ * NEW * New compiler flags to store the extra 8 bits
+ from 16 bits samples (when saving it is ignored), the
+ extra data may be acessed using ExtraScanline property
+ * Fixed * a bug on tIMe chunk
+ French translation included (Thanks to IBE Software)
+ Bugs fixed
+
+ Version 1.432
+ 2002-08-24 - * NEW * A new method, CreateAlpha will transform the
+ current image into partial transparency.
+ Help file updated with a new article on how to handle
+ partial transparency.
+
+ Version 1.431
+ 2002-08-14 - Fixed and tested to work on:
+ C++ Builder 3
+ C++ Builder 5
+ Delphi 3
+ There was an error when setting TransparentColor, fixed
+ New method, RemoveTransparency to remove image
+ BIT TRANSPARENCY
+
+ Version 1.43
+ 2002-08-01 - * NEW * Support for Delphi 3 and C++ Builder 3
+ Implements mostly some things that were missing,
+ a few tweaks and fixes.
+
+ Version 1.428
+ 2002-07-24 - More minor fixes (thanks to Ian Boyd)
+ Bit transparency fixes
+ * NEW * Finally support to bit transparency
+ (palette / rgb / grayscale -> all)
+
+ Version 1.427
+ 2002-07-19 - Lots of bugs and leaks fixed
+ * NEW * method to easy adding text comments, AddtEXt
+ * NEW * property for setting bit transparency,
+ TransparentColor
+
+ Version 1.426
+ 2002-07-18 - Clipboard finally fixed and working
+ Changed UseDelphi trigger to UseDelphi
+ * NEW * Support for bit transparency bitmaps
+ when assigning from/to TBitmap objects
+ Altough it does not support drawing transparent
+ parts of bit transparency pngs (only partial)
+ it is closer than ever
+
+ Version 1.425
+ 2002-07-01 - Clipboard methods implemented
+ Lots of bugs fixed
+
+ Version 1.424
+ 2002-05-16 - Scanline and AlphaScanline are now working correctly.
+ New methods for handling the clipboard
+
+ Version 1.423
+ 2002-05-16 - * NEW * Partial transparency for 1, 2, 4 and 8 bits is
+ also supported using the tRNS chunk (for palette and
+ grayscaling).
+ New bug fixes (Peter Haas).
+
+ Version 1.422
+ 2002-05-14 - Fixed some critical leaks, thanks to Peter Haas tips.
+ New translation for German (Peter Haas).
+
+ Version 1.421
+ 2002-05-06 - Now uses new ZLIB version, 1.1.4 with some security
+ fixes.
+ LoadFromResourceID and LoadFromResourceName added and
+ help file updated for that.
+ The resources strings are now located in pnglang.pas.
+ New translation for Brazilian Portuguese.
+ Bugs fixed.
+
+ IMPORTANT: As always I´m looking for bugs on the library. If
+ anyone has found one, please send me an email and
+ I will fix asap. Thanks for all the help and ideas
+ I'm receiving so far.}
+
+{My email is : gustavo.daud@terra.com.br}
+{Website link : http://pngdelphi.sourceforge.net}
+{Gustavo Huffenbacher Daud}
+
+unit pngimage;
+
+interface
+
+{Triggers avaliable (edit the fields bellow)}
+{$TYPEDADDRESS OFF}
+
+{$DEFINE UseDelphi} //Disable fat vcl units(perfect for small apps)
+{$DEFINE ErrorOnUnknownCritical} //Error when finds an unknown critical chunk
+{$DEFINE CheckCRC} //Enables CRC checking
+{$DEFINE RegisterGraphic} //Registers TPNGObject to use with TPicture
+{$DEFINE PartialTransparentDraw} //Draws partial transparent images
+{$DEFINE Store16bits} //Stores the extra 8 bits from 16bits/sample
+{$RANGECHECKS OFF} {$J+}
+
+
+
+uses
+ Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF},
+ zlibpas, pnglang;
+
+const
+ LibraryVersion = '1.564';
+
+{$IFNDEF UseDelphi}
+ const
+ soFromBeginning = 0;
+ soFromCurrent = 1;
+ soFromEnd = 2;
+{$ENDIF}
+
+const
+ {ZLIB constants}
+ ZLIBErrors: Array[-6..2] of string = ('incompatible version (-6)',
+ 'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)',
+ 'stream error (-2)', 'file error (-1)', '(0)', 'stream end (1)',
+ 'need dictionary (2)');
+ Z_NO_FLUSH = 0;
+ Z_FINISH = 4;
+ Z_STREAM_END = 1;
+
+ {Avaliable PNG filters for mode 0}
+ FILTER_NONE = 0;
+ FILTER_SUB = 1;
+ FILTER_UP = 2;
+ FILTER_AVERAGE = 3;
+ FILTER_PAETH = 4;
+
+ {Avaliable color modes for PNG}
+ COLOR_GRAYSCALE = 0;
+ COLOR_RGB = 2;
+ COLOR_PALETTE = 3;
+ COLOR_GRAYSCALEALPHA = 4;
+ COLOR_RGBALPHA = 6;
+
+
+type
+ {$IFNDEF UseDelphi}
+ {Custom exception handler}
+ Exception = class(TObject)
+ constructor Create(Msg: String);
+ end;
+ ExceptClass = class of Exception;
+ TColor = ColorRef;
+ {$ENDIF}
+
+ {Error types}
+ EPNGOutMemory = class(Exception);
+ EPngError = class(Exception);
+ EPngUnexpectedEnd = class(Exception);
+ EPngInvalidCRC = class(Exception);
+ EPngInvalidIHDR = class(Exception);
+ EPNGMissingMultipleIDAT = class(Exception);
+ EPNGZLIBError = class(Exception);
+ EPNGInvalidPalette = class(Exception);
+ EPNGInvalidFileHeader = class(Exception);
+ EPNGIHDRNotFirst = class(Exception);
+ EPNGNotExists = class(Exception);
+ EPNGSizeExceeds = class(Exception);
+ EPNGMissingPalette = class(Exception);
+ EPNGUnknownCriticalChunk = class(Exception);
+ EPNGUnknownCompression = class(Exception);
+ EPNGUnknownInterlace = class(Exception);
+ EPNGNoImageData = class(Exception);
+ EPNGCouldNotLoadResource = class(Exception);
+ EPNGCannotChangeTransparent = class(Exception);
+ EPNGHeaderNotPresent = class(Exception);
+ EPNGInvalidNewSize = class(Exception);
+ EPNGInvalidSpec = class(Exception);
+
+type
+ {Direct access to pixels using R,G,B}
+ TRGBLine = array[word] of TRGBTriple;
+ pRGBLine = ^TRGBLine;
+
+ {Same as TBitmapInfo but with allocated space for}
+ {palette entries}
+ TMAXBITMAPINFO = packed record
+ bmiHeader: TBitmapInfoHeader;
+ bmiColors: packed array[0..255] of TRGBQuad;
+ end;
+
+ {Transparency mode for pngs}
+ TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);
+ {Pointer to a cardinal type}
+ pCardinal = ^Cardinal;
+ {Access to a rgb pixel}
+ pRGBPixel = ^TRGBPixel;
+ TRGBPixel = packed record
+ B, G, R: Byte;
+ end;
+
+ {Pointer to an array of bytes type}
+ TByteArray = Array[Word] of Byte;
+ pByteArray = ^TByteArray;
+
+ {Forward}
+ TPNGObject = class;
+ pPointerArray = ^TPointerArray;
+ TPointerArray = Array[Word] of Pointer;
+
+ {Contains a list of objects}
+ TPNGPointerList = class
+ private
+ fOwner: TPNGObject;
+ fCount : Cardinal;
+ fMemory: pPointerArray;
+ function GetItem(Index: Cardinal): Pointer;
+ procedure SetItem(Index: Cardinal; const Value: Pointer);
+ protected
+ {Removes an item}
+ function Remove(Value: Pointer): Pointer; virtual;
+ {Inserts an item}
+ procedure Insert(Value: Pointer; Position: Cardinal);
+ {Add a new item}
+ procedure Add(Value: Pointer);
+ {Returns an item}
+ property Item[Index: Cardinal]: Pointer read GetItem write SetItem;
+ {Set the size of the list}
+ procedure SetSize(const Size: Cardinal);
+ {Returns owner}
+ property Owner: TPNGObject read fOwner;
+ public
+ {Returns number of items}
+ property Count: Cardinal read fCount write SetSize;
+ {Object being either created or destroyed}
+ constructor Create(AOwner: TPNGObject);
+ destructor Destroy; override;
+ end;
+
+ {Forward declaration}
+ TChunk = class;
+ TChunkClass = class of TChunk;
+
+ {Same as TPNGPointerList but providing typecasted values}
+ TPNGList = class(TPNGPointerList)
+ private
+ {Used with property Item}
+ function GetItem(Index: Cardinal): TChunk;
+ public
+ {Finds the first item with this class}
+ function FindChunk(ChunkClass: TChunkClass): TChunk;
+ {Removes an item}
+ procedure RemoveChunk(Chunk: TChunk); overload;
+ {Add a new chunk using the class from the parameter}
+ function Add(ChunkClass: TChunkClass): TChunk;
+ {Returns pointer to the first chunk of class}
+ function ItemFromClass(ChunkClass: TChunkClass): TChunk;
+ {Returns a chunk item from the list}
+ property Item[Index: Cardinal]: TChunk read GetItem;
+ end;
+
+ {$IFNDEF UseDelphi}
+ {The STREAMs bellow are only needed in case delphi provided ones is not}
+ {avaliable (UseDelphi trigger not set)}
+ {Object becomes handles}
+ TCanvas = THandle;
+ TBitmap = HBitmap;
+ {Trick to work}
+ TPersistent = TObject;
+
+ {Base class for all streams}
+ TStream = class
+ protected
+ {Returning/setting size}
+ function GetSize: Longint; virtual;
+ procedure SetSize(const Value: Longint); virtual; abstract;
+ {Returns/set position}
+ function GetPosition: Longint; virtual;
+ procedure SetPosition(const Value: Longint); virtual;
+ public
+ {Returns/sets current position}
+ property Position: Longint read GetPosition write SetPosition;
+ {Property returns/sets size}
+ property Size: Longint read GetSize write SetSize;
+ {Allows reading/writing data}
+ function Read(var Buffer; Count: Longint): Cardinal; virtual; abstract;
+ function Write(const Buffer; Count: Longint): Cardinal; virtual; abstract;
+ {Copies from another Stream}
+ function CopyFrom(Source: TStream;
+ Count: Cardinal): Cardinal; virtual;
+ {Seeks a stream position}
+ function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
+ end;
+
+ {File stream modes}
+ TFileStreamMode = (fsmRead, fsmWrite, fsmCreate);
+ TFileStreamModeSet = set of TFileStreamMode;
+
+ {File stream for reading from files}
+ TFileStream = class(TStream)
+ private
+ {Opened mode}
+ Filemode: TFileStreamModeSet;
+ {Handle}
+ fHandle: THandle;
+ protected
+ {Set the size of the file}
+ procedure SetSize(const Value: Longint); override;
+ public
+ {Seeks a file position}
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ {Reads/writes data from/to the file}
+ function Read(var Buffer; Count: Longint): Cardinal; override;
+ function Write(const Buffer; Count: Longint): Cardinal; override;
+ {Stream being created and destroy}
+ constructor Create(Filename: String; Mode: TFileStreamModeSet);
+ destructor Destroy; override;
+ end;
+
+ {Stream for reading from resources}
+ TResourceStream = class(TStream)
+ constructor Create(Instance: HInst; const ResName: String; ResType:PChar);
+ private
+ {Variables for reading}
+ Size: Integer;
+ Memory: Pointer;
+ Position: Integer;
+ protected
+ {Set the size of the file}
+ procedure SetSize(const Value: Longint); override;
+ public
+ {Stream processing}
+ function Read(var Buffer; Count: Integer): Cardinal; override;
+ function Seek(Offset: Integer; Origin: Word): Longint; override;
+ function Write(const Buffer; Count: Longint): Cardinal; override;
+ end;
+ {$ENDIF}
+
+ {Forward}
+ TChunkIHDR = class;
+ TChunkpHYs = class;
+ {Interlace method}
+ TInterlaceMethod = (imNone, imAdam7);
+ {Compression level type}
+ TCompressionLevel = 0..9;
+ {Filters type}
+ TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);
+ TFilters = set of TFilter;
+
+ {Png implementation object}
+ TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}
+ protected
+ {Inverse gamma table values}
+ InverseGamma: Array[Byte] of Byte;
+ procedure InitializeGamma;
+ private
+ {Canvas}
+ {$IFDEF UseDelphi}fCanvas: TCanvas;{$ENDIF}
+ {Filters to test to encode}
+ fFilters: TFilters;
+ {Compression level for ZLIB}
+ fCompressionLevel: TCompressionLevel;
+ {Maximum size for IDAT chunks}
+ fMaxIdatSize: Integer;
+ {Returns if image is interlaced}
+ fInterlaceMethod: TInterlaceMethod;
+ {Chunks object}
+ fChunkList: TPngList;
+ {Clear all chunks in the list}
+ procedure ClearChunks;
+ {Returns if header is present}
+ function HeaderPresent: Boolean;
+ procedure GetPixelInfo(var LineSize, Offset: Cardinal);
+ {Returns linesize and byte offset for pixels}
+ procedure SetMaxIdatSize(const Value: Integer);
+ function GetAlphaScanline(const LineIndex: Integer): pByteArray;
+ function GetScanline(const LineIndex: Integer): Pointer;
+ {$IFDEF Store16bits}
+ function GetExtraScanline(const LineIndex: Integer): Pointer;
+ {$ENDIF}
+ function GetPixelInformation: TChunkpHYs;
+ function GetTransparencyMode: TPNGTransparencyMode;
+ function GetTransparentColor: TColor;
+ procedure SetTransparentColor(const Value: TColor);
+ {Returns the version}
+ function GetLibraryVersion: String;
+ protected
+ {Being created}
+ BeingCreated: Boolean;
+ {Returns / set the image palette}
+ function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
+ procedure SetPalette(Value: HPALETTE); {$IFDEF UseDelphi}override;{$ENDIF}
+ procedure DoSetPalette(Value: HPALETTE; const UpdateColors: Boolean);
+ {Returns/sets image width and height}
+ function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF}
+ function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF}
+ procedure SetWidth(Value: Integer); {$IFDEF UseDelphi}override; {$ENDIF}
+ procedure SetHeight(Value: Integer); {$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns from another TPNGObject}
+ procedure AssignPNG(Source: TPNGObject);
+ {Returns if the image is empty}
+ function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}
+ {Used with property Header}
+ function GetHeader: TChunkIHDR;
+ {Draws using partial transparency}
+ procedure DrawPartialTrans(DC: HDC; Rect: TRect);
+ {$IFDEF UseDelphi}
+ {Returns if the image is transparent}
+ function GetTransparent: Boolean; override;
+ {$ENDIF}
+ {Returns a pixel}
+ function GetPixels(const X, Y: Integer): TColor; virtual;
+ procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;
+ public
+ {Gamma table array}
+ GammaTable: Array[Byte] of Byte;
+ {Resizes the PNG image}
+ procedure Resize(const CX, CY: Integer);
+ {Generates alpha information}
+ procedure CreateAlpha;
+ {Removes the image transparency}
+ procedure RemoveTransparency;
+ {Transparent color}
+ property TransparentColor: TColor read GetTransparentColor write
+ SetTransparentColor;
+ {Add text chunk, TChunkTEXT, TChunkzTXT}
+ procedure AddtEXt(const Keyword, Text: String);
+ procedure AddzTXt(const Keyword, Text: String);
+ {$IFDEF UseDelphi}
+ {Saves to clipboard format (thanks to Antoine Pottern)}
+ procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
+ var APalette: HPalette); override;
+ procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
+ APalette: HPalette); override;
+ {$ENDIF}
+ {Calling errors}
+ procedure RaiseError(ExceptionClass: ExceptClass; Text: String);
+ {Returns a scanline from png}
+ property Scanline[const Index: Integer]: Pointer read GetScanline;
+ {$IFDEF Store16bits}
+ property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline;
+ {$ENDIF}
+ {Used to return pixel information}
+ function HasPixelInformation: Boolean;
+ property PixelInformation: TChunkpHYs read GetPixelInformation;
+ property AlphaScanline[const Index: Integer]: pByteArray read
+ GetAlphaScanline;
+ procedure DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint);
+
+ {Canvas}
+ {$IFDEF UseDelphi}property Canvas: TCanvas read fCanvas;{$ENDIF}
+ {Returns pointer to the header}
+ property Header: TChunkIHDR read GetHeader;
+ {Returns the transparency mode used by this png}
+ property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
+ {Assigns from another object}
+ procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns to another object}
+ procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns from a windows bitmap handle}
+ procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;
+ TransparentColor: ColorRef);
+ {Draws the image into a canvas}
+ procedure Draw(ACanvas: TCanvas; const Rect: TRect);
+ {$IFDEF UseDelphi}override;{$ENDIF}
+ {Width and height properties}
+ property Width: Integer read GetWidth;
+ property Height: Integer read GetHeight;
+ {Returns if the image is interlaced}
+ property InterlaceMethod: TInterlaceMethod read fInterlaceMethod
+ write fInterlaceMethod;
+ {Filters to test to encode}
+ property Filters: TFilters read fFilters write fFilters;
+ {Maximum size for IDAT chunks, default and minimum is 65536}
+ property MaxIdatSize: Integer read fMaxIdatSize write SetMaxIdatSize;
+ {Property to return if the image is empty or not}
+ property Empty: Boolean read GetEmpty;
+ {Compression level}
+ property CompressionLevel: TCompressionLevel read fCompressionLevel
+ write fCompressionLevel;
+ {Access to the chunk list}
+ property Chunks: TPngList read fChunkList;
+ {Object being created and destroyed}
+ constructor Create; {$IFDEF UseDelphi}override;{$ENDIF}
+ constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer);
+ destructor Destroy; override;
+ {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF}
+ {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF}
+ procedure LoadFromStream(Stream: TStream);
+ {$IFDEF UseDelphi}override;{$ENDIF}
+ procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
+ {Loading the image from resources}
+ procedure LoadFromResourceName(Instance: HInst; const Name: String);
+ procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
+ {Access to the png pixels}
+ property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels;
+ {Palette property}
+ {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette write
+ SetPalette;{$ENDIF}
+ {Returns the version}
+ property Version: String read GetLibraryVersion;
+ end;
+
+ {Chunk name object}
+ TChunkName = Array[0..3] of Char;
+
+ {Global chunk object}
+ TChunk = class
+ private
+ {Contains data}
+ fData: Pointer;
+ fDataSize: Cardinal;
+ {Stores owner}
+ fOwner: TPngObject;
+ {Stores the chunk name}
+ fName: TChunkName;
+ {Returns pointer to the TChunkIHDR}
+ function GetHeader: TChunkIHDR;
+ {Used with property index}
+ function GetIndex: Integer;
+ {Should return chunk class/name}
+ class function GetName: String; virtual;
+ {Returns the chunk name}
+ function GetChunkName: String;
+ public
+ {Returns index from list}
+ property Index: Integer read GetIndex;
+ {Returns pointer to the TChunkIHDR}
+ property Header: TChunkIHDR read GetHeader;
+ {Resize the data}
+ procedure ResizeData(const NewSize: Cardinal);
+ {Returns data and size}
+ property Data: Pointer read fData;
+ property DataSize: Cardinal read fDataSize;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); virtual;
+ {Returns owner}
+ property Owner: TPngObject read fOwner;
+ {Being destroyed/created}
+ constructor Create(Owner: TPngObject); virtual;
+ destructor Destroy; override;
+ {Returns chunk class/name}
+ property Name: String read GetChunkName;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; virtual;
+ {Saves the chunk to a stream}
+ function SaveData(Stream: TStream): Boolean;
+ function SaveToStream(Stream: TStream): Boolean; virtual;
+ end;
+
+ {Chunk classes}
+ TChunkIEND = class(TChunk); {End chunk}
+
+ {IHDR data}
+ pIHDRData = ^TIHDRData;
+ TIHDRData = packed record
+ Width, Height: Cardinal;
+ BitDepth,
+ ColorType,
+ CompressionMethod,
+ FilterMethod,
+ InterlaceMethod: Byte;
+ end;
+
+ {Information header chunk}
+ TChunkIHDR = class(TChunk)
+ private
+ {Current image}
+ ImageHandle: HBitmap;
+ ImageDC: HDC;
+ ImagePalette: HPalette;
+ {Output windows bitmap}
+ HasPalette: Boolean;
+ BitmapInfo: TMaxBitmapInfo;
+ {Stores the image bytes}
+ {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
+ ImageData: pointer;
+ ImageAlpha: Pointer;
+
+ {Contains all the ihdr data}
+ IHDRData: TIHDRData;
+ protected
+ BytesPerRow: Integer;
+ {Creates a grayscale palette}
+ function CreateGrayscalePalette(Bitdepth: Integer): HPalette;
+ {Copies the palette to the Device Independent bitmap header}
+ procedure PaletteToDIB(Palette: HPalette);
+ {Resizes the image data to fill the color type, bit depth, }
+ {width and height parameters}
+ procedure PrepareImageData;
+ {Release allocated ImageData memory}
+ procedure FreeImageData;
+ public
+ {Access to ImageHandle}
+ property ImageHandleValue: HBitmap read ImageHandle;
+ {Properties}
+ property Width: Cardinal read IHDRData.Width write IHDRData.Width;
+ property Height: Cardinal read IHDRData.Height write IHDRData.Height;
+ property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth;
+ property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType;
+ property CompressionMethod: Byte read IHDRData.CompressionMethod
+ write IHDRData.CompressionMethod;
+ property FilterMethod: Byte read IHDRData.FilterMethod
+ write IHDRData.FilterMethod;
+ property InterlaceMethod: Byte read IHDRData.InterlaceMethod
+ write IHDRData.InterlaceMethod;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Destructor/constructor}
+ constructor Create(Owner: TPngObject); override;
+ destructor Destroy; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {pHYs chunk}
+ pUnitType = ^TUnitType;
+ TUnitType = (utUnknown, utMeter);
+ TChunkpHYs = class(TChunk)
+ private
+ fPPUnitX, fPPUnitY: Cardinal;
+ fUnit: TUnitType;
+ public
+ {Returns the properties}
+ property PPUnitX: Cardinal read fPPUnitX write fPPUnitX;
+ property PPUnitY: Cardinal read fPPUnitY write fPPUnitY;
+ property UnitType: TUnitType read fUnit write fUnit;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Gamma chunk}
+ TChunkgAMA = class(TChunk)
+ private
+ {Returns/sets the value for the gamma chunk}
+ function GetValue: Cardinal;
+ procedure SetValue(const Value: Cardinal);
+ public
+ {Returns/sets gamma value}
+ property Gamma: Cardinal read GetValue write SetValue;
+ {Loading the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Being created}
+ constructor Create(Owner: TPngObject); override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {ZLIB Decompression extra information}
+ TZStreamRec2 = packed record
+ {From ZLIB}
+ ZLIB: TZStreamRec;
+ {Additional info}
+ Data: Pointer;
+ fStream : TStream;
+ end;
+
+ {Palette chunk}
+ TChunkPLTE = class(TChunk)
+ protected
+ {Number of items in the palette}
+ fCount: Integer;
+ private
+ {Contains the palette handle}
+ function GetPaletteItem(Index: Byte): TRGBQuad;
+ public
+ {Returns the color for each item in the palette}
+ property Item[Index: Byte]: TRGBQuad read GetPaletteItem;
+ {Returns the number of items in the palette}
+ property Count: Integer read fCount;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Transparency information}
+ TChunktRNS = class(TChunk)
+ private
+ fBitTransparency: Boolean;
+ function GetTransparentColor: ColorRef;
+ {Returns the transparent color}
+ procedure SetTransparentColor(const Value: ColorRef);
+ public
+ {Palette values for transparency}
+ PaletteValues: Array[Byte] of Byte;
+ {Returns if it uses bit transparency}
+ property BitTransparency: Boolean read fBitTransparency;
+ {Returns the transparent color}
+ property TransparentColor: ColorRef read GetTransparentColor write
+ SetTransparentColor;
+ {Loads/saves the chunk from/to a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Actual image information}
+ TChunkIDAT = class(TChunk)
+ private
+ {Holds another pointer to the TChunkIHDR}
+ Header: TChunkIHDR;
+ {Stores temporary image width and height}
+ ImageWidth, ImageHeight: Integer;
+ {Size in bytes of each line and offset}
+ Row_Bytes, Offset : Cardinal;
+ {Contains data for the lines}
+ Encode_Buffer: Array[0..5] of pByteArray;
+ Row_Buffer: Array[Boolean] of pByteArray;
+ {Variable to invert the Row_Buffer used}
+ RowUsed: Boolean;
+ {Ending position for the current IDAT chunk}
+ EndPos: Integer;
+ {Filter the current line}
+ procedure FilterRow;
+ {Filter to encode and returns the best filter}
+ function FilterToEncode: Byte;
+ {Reads ZLIB compressed data}
+ function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
+ Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer;
+ {Compress and writes IDAT data}
+ procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
+ const Length: Cardinal);
+ procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
+ {Prepares the palette}
+ procedure PreparePalette;
+ protected
+ {Decode interlaced image}
+ procedure DecodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+ {Decode non interlaced imaged}
+ procedure DecodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer;
+ var crcfile: Cardinal);
+ protected
+ {Encode non interlaced images}
+ procedure EncodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+ {Encode interlaced images}
+ procedure EncodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+ protected
+ {Memory copy methods to decode}
+ procedure CopyNonInterlacedRGB8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGB16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedPalette148(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedPalette2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGray2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscale16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGBAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGBAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedPalette2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGray2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ protected
+ {Memory copy methods to encode}
+ procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ public
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ end;
+
+ {Image last modification chunk}
+ TChunktIME = class(TChunk)
+ private
+ {Holds the variables}
+ fYear: Word;
+ fMonth, fDay, fHour, fMinute, fSecond: Byte;
+ public
+ {Returns/sets variables}
+ property Year: Word read fYear write fYear;
+ property Month: Byte read fMonth write fMonth;
+ property Day: Byte read fDay write fDay;
+ property Hour: Byte read fHour write fHour;
+ property Minute: Byte read fMinute write fMinute;
+ property Second: Byte read fSecond write fSecond;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Textual data}
+ TChunktEXt = class(TChunk)
+ private
+ fKeyword, fText: String;
+ public
+ {Keyword and text}
+ property Keyword: String read fKeyword write fKeyword;
+ property Text: String read fText write fText;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {zTXT chunk}
+ TChunkzTXt = class(TChunktEXt)
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ end;
+
+{Here we test if it's c++ builder or delphi version 3 or less}
+{$IFDEF VER110}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER100}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER93}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER90}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER80}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+
+
+{Registers a new chunk class}
+procedure RegisterChunk(ChunkClass: TChunkClass);
+{Calculates crc}
+function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
+ {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
+{Invert bytes using assembly}
+function ByteSwap(const a: integer): integer;
+
+implementation
+
+var
+ ChunkClasses: TPngPointerList;
+ {Table of CRCs of all 8-bit messages}
+ crc_table: Array[0..255] of Cardinal;
+ {Flag: has the table been computed? Initially false}
+ crc_table_computed: Boolean;
+
+{Draw transparent image using transparent color}
+procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer;
+ var srcHeader: TBitmapInfoHeader;
+ srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);
+var
+ cColor: COLORREF;
+ bmAndBack, bmAndObject, bmAndMem: HBITMAP;
+ bmBackOld, bmObjectOld, bmMemOld: HBITMAP;
+ hdcMem, hdcBack, hdcObject, hdcTemp: HDC;
+ ptSize, orgSize: TPOINT;
+ OldBitmap, DrawBitmap: HBITMAP;
+begin
+ hdcTemp := CreateCompatibleDC(dc);
+ {Select the bitmap}
+ DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^,
+ DIB_RGB_COLORS);
+ OldBitmap := SelectObject(hdcTemp, DrawBitmap);
+
+ {Get sizes}
+ OrgSize.x := abs(srcHeader.biWidth);
+ OrgSize.y := abs(srcHeader.biHeight);
+ ptSize.x := Rect.Right - Rect.Left; // Get width of bitmap
+ ptSize.y := Rect.Bottom - Rect.Top; // Get height of bitmap
+
+ {Create some DCs to hold temporary data}
+ hdcBack := CreateCompatibleDC(dc);
+ hdcObject := CreateCompatibleDC(dc);
+ hdcMem := CreateCompatibleDC(dc);
+
+ // Create a bitmap for each DC. DCs are required for a number of
+ // GDI functions.
+
+ // Monochrome DCs
+ bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
+ bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
+
+ bmAndMem := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
+
+ // Each DC must select a bitmap object to store pixel data.
+ bmBackOld := SelectObject(hdcBack, bmAndBack);
+ bmObjectOld := SelectObject(hdcObject, bmAndObject);
+ bmMemOld := SelectObject(hdcMem, bmAndMem);
+
+ // Set the background color of the source DC to the color.
+ // contained in the parts of the bitmap that should be transparent
+ cColor := SetBkColor(hdcTemp, cTransparentColor);
+
+ // Create the object mask for the bitmap by performing a BitBlt
+ // from the source bitmap to a monochrome bitmap.
+ StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
+ orgSize.x, orgSize.y, SRCCOPY);
+
+ // Set the background color of the source DC back to the original
+ // color.
+ SetBkColor(hdcTemp, cColor);
+
+ // Create the inverse of the object mask.
+ BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0,
+ NOTSRCCOPY);
+
+ // Copy the background of the main DC to the destination.
+ BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top,
+ SRCCOPY);
+
+ // Mask out the places where the bitmap will be placed.
+ BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
+
+ // Mask out the transparent colored pixels on the bitmap.
+// BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
+ StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 0, 0,
+ PtSize.x, PtSize.y, SRCAND);
+
+ // XOR the bitmap with the background on the destination DC.
+ StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
+ OrgSize.x, OrgSize.y, SRCPAINT);
+
+ // Copy the destination to the screen.
+ BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0,
+ SRCCOPY);
+
+ // Delete the memory bitmaps.
+ DeleteObject(SelectObject(hdcBack, bmBackOld));
+ DeleteObject(SelectObject(hdcObject, bmObjectOld));
+ DeleteObject(SelectObject(hdcMem, bmMemOld));
+ DeleteObject(SelectObject(hdcTemp, OldBitmap));
+
+ // Delete the memory DCs.
+ DeleteDC(hdcMem);
+ DeleteDC(hdcBack);
+ DeleteDC(hdcObject);
+ DeleteDC(hdcTemp);
+end;
+
+{Make the table for a fast CRC.}
+procedure make_crc_table;
+var
+ c: Cardinal;
+ n, k: Integer;
+begin
+
+ {fill the crc table}
+ for n := 0 to 255 do
+ begin
+ c := Cardinal(n);
+ for k := 0 to 7 do
+ begin
+ if Boolean(c and 1) then
+ c := $edb88320 xor (c shr 1)
+ else
+ c := c shr 1;
+ end;
+ crc_table[n] := c;
+ end;
+
+ {The table has already being computated}
+ crc_table_computed := true;
+end;
+
+{Update a running CRC with the bytes buf[0..len-1]--the CRC
+ should be initialized to all 1's, and the transmitted value
+ is the 1's complement of the final running CRC (see the
+ crc() routine below)).}
+function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
+ {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
+var
+ c: Cardinal;
+ n: Integer;
+begin
+ c := crc;
+
+ {Create the crc table in case it has not being computed yet}
+ if not crc_table_computed then make_crc_table;
+
+ {Update}
+ for n := 0 to len - 1 do
+ c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);
+
+ {Returns}
+ Result := c;
+end;
+
+{$IFNDEF UseDelphi}
+ function FileExists(Filename: String): Boolean;
+ var
+ FindFile: THandle;
+ FindData: TWin32FindData;
+ begin
+ FindFile := FindFirstFile(PChar(Filename), FindData);
+ Result := FindFile <> INVALID_HANDLE_VALUE;
+ if Result then Windows.FindClose(FindFile);
+ end;
+
+
+{$ENDIF}
+
+{$IFNDEF UseDelphi}
+ {Exception implementation}
+ constructor Exception.Create(Msg: String);
+ begin
+ end;
+{$ENDIF}
+
+{Calculates the paeth predictor}
+function PaethPredictor(a, b, c: Byte): Byte;
+var
+ pa, pb, pc: Integer;
+begin
+ { a = left, b = above, c = upper left }
+ pa := abs(b - c); { distances to a, b, c }
+ pb := abs(a - c);
+ pc := abs(a + b - c * 2);
+
+ { return nearest of a, b, c, breaking ties in order a, b, c }
+ if (pa <= pb) and (pa <= pc) then
+ Result := a
+ else
+ if pb <= pc then
+ Result := b
+ else
+ Result := c;
+end;
+
+{Invert bytes using assembly}
+function ByteSwap(const a: integer): integer;
+asm
+ bswap eax
+end;
+function ByteSwap16(inp:word): word;
+asm
+ bswap eax
+ shr eax, 16
+end;
+
+{Calculates number of bytes for the number of pixels using the}
+{color mode in the paramenter}
+function BytesForPixels(const Pixels: Integer; const ColorType,
+ BitDepth: Byte): Integer;
+begin
+ case ColorType of
+ {Palette and grayscale contains a single value, for palette}
+ {an value of size 2^bitdepth pointing to the palette index}
+ {and grayscale the value from 0 to 2^bitdepth with color intesity}
+ COLOR_GRAYSCALE, COLOR_PALETTE:
+ Result := (Pixels * BitDepth + 7) div 8;
+ {RGB contains 3 values R, G, B with size 2^bitdepth each}
+ COLOR_RGB:
+ Result := (Pixels * BitDepth * 3) div 8;
+ {Contains one value followed by alpha value booth size 2^bitdepth}
+ COLOR_GRAYSCALEALPHA:
+ Result := (Pixels * BitDepth * 2) div 8;
+ {Contains four values size 2^bitdepth, Red, Green, Blue and alpha}
+ COLOR_RGBALPHA:
+ Result := (Pixels * BitDepth * 4) div 8;
+ else
+ Result := 0;
+ end {case ColorType}
+end;
+
+type
+ pChunkClassInfo = ^TChunkClassInfo;
+ TChunkClassInfo = record
+ ClassName: TChunkClass;
+ end;
+
+{Register a chunk type}
+procedure RegisterChunk(ChunkClass: TChunkClass);
+var
+ NewClass: pChunkClassInfo;
+begin
+ {In case the list object has not being created yet}
+ if ChunkClasses = nil then ChunkClasses := TPngPointerList.Create(nil);
+
+ {Add this new class}
+ new(NewClass);
+ NewClass^.ClassName := ChunkClass;
+ ChunkClasses.Add(NewClass);
+end;
+
+{Free chunk class list}
+procedure FreeChunkClassList;
+var
+ i: Integer;
+begin
+ if (ChunkClasses <> nil) then
+ begin
+ FOR i := 0 TO ChunkClasses.Count - 1 do
+ Dispose(pChunkClassInfo(ChunkClasses.Item[i]));
+ ChunkClasses.Free;
+ end;
+end;
+
+{Registering of common chunk classes}
+procedure RegisterCommonChunks;
+begin
+ {Important chunks}
+ RegisterChunk(TChunkIEND);
+ RegisterChunk(TChunkIHDR);
+ RegisterChunk(TChunkIDAT);
+ RegisterChunk(TChunkPLTE);
+ RegisterChunk(TChunkgAMA);
+ RegisterChunk(TChunktRNS);
+
+ {Not so important chunks}
+ RegisterChunk(TChunkpHYs);
+ RegisterChunk(TChunktIME);
+ RegisterChunk(TChunktEXt);
+ RegisterChunk(TChunkzTXt);
+end;
+
+{Creates a new chunk of this class}
+function CreateClassChunk(Owner: TPngObject; Name: TChunkName): TChunk;
+var
+ i : Integer;
+ NewChunk: TChunkClass;
+begin
+ {Looks for this chunk}
+ NewChunk := TChunk; {In case there is no registered class for this}
+
+ {Looks for this class in all registered chunks}
+ if Assigned(ChunkClasses) then
+ FOR i := 0 TO ChunkClasses.Count - 1 DO
+ begin
+ if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName = Name then
+ begin
+ NewChunk := pChunkClassInfo(ChunkClasses.Item[i])^.ClassName;
+ break;
+ end;
+ end;
+
+ {Returns chunk class}
+ Result := NewChunk.Create(Owner);
+ Result.fName := Name;
+end;
+
+{ZLIB support}
+
+const
+ ZLIBAllocate = High(Word);
+
+{Initializes ZLIB for decompression}
+function ZLIBInitInflate(Stream: TStream): TZStreamRec2;
+begin
+ {Fill record}
+ Fillchar(Result, SIZEOF(TZStreamRec2), #0);
+
+ {Set internal record information}
+ with Result do
+ begin
+ GetMem(Data, ZLIBAllocate);
+ fStream := Stream;
+ end;
+
+ {Init decompression}
+ InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec));
+end;
+
+{Initializes ZLIB for compression}
+function ZLIBInitDeflate(Stream: TStream;
+ Level: TCompressionlevel; Size: Cardinal): TZStreamRec2;
+begin
+ {Fill record}
+ Fillchar(Result, SIZEOF(TZStreamRec2), #0);
+
+ {Set internal record information}
+ with Result, ZLIB do
+ begin
+ GetMem(Data, Size);
+ fStream := Stream;
+ next_out := Data;
+ avail_out := Size;
+ end;
+
+ {Inits compression}
+ deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec));
+end;
+
+{Terminates ZLIB for compression}
+procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2);
+begin
+ {Terminates decompression}
+ DeflateEnd(ZLIBStream.zlib);
+ {Free internal record}
+ FreeMem(ZLIBStream.Data, ZLIBAllocate);
+end;
+
+{Terminates ZLIB for decompression}
+procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2);
+begin
+ {Terminates decompression}
+ InflateEnd(ZLIBStream.zlib);
+ {Free internal record}
+ FreeMem(ZLIBStream.Data, ZLIBAllocate);
+end;
+
+{Decompresses ZLIB into a memory address}
+function DecompressZLIB(const Input: Pointer; InputSize: Integer;
+ var Output: Pointer; var OutputSize: Integer;
+ var ErrorOutput: String): Boolean;
+var
+ StreamRec : TZStreamRec;
+ Buffer : Array[Byte] of Byte;
+ InflateRet: Integer;
+begin
+ with StreamRec do
+ begin
+ {Initializes}
+ Result := True;
+ OutputSize := 0;
+
+ {Prepares the data to decompress}
+ FillChar(StreamRec, SizeOf(TZStreamRec), #0);
+ InflateInit_(StreamRec, zlib_version, SIZEOF(TZStreamRec));
+ next_in := Input;
+ avail_in := InputSize;
+
+ {Decodes data}
+ repeat
+ {In case it needs an output buffer}
+ if (avail_out = 0) then
+ begin
+ next_out := @Buffer;
+ avail_out := SizeOf(Buffer);
+ end {if (avail_out = 0)};
+
+ {Decompress and put in output}
+ InflateRet := inflate(StreamRec, 0);
+ if (InflateRet = Z_STREAM_END) or (InflateRet = 0) then
+ begin
+ {Reallocates output buffer}
+ inc(OutputSize, total_out);
+ if Output = nil then
+ GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
+ {Copies the new data}
+ CopyMemory(Ptr(Longint(Output) + OutputSize - total_out),
+ @Buffer, total_out);
+ end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
+ {Now tests for errors}
+ else if InflateRet < 0 then
+ begin
+ Result := False;
+ ErrorOutput := StreamRec.msg;
+ InflateEnd(StreamRec);
+ Exit;
+ end {if InflateRet < 0}
+ until InflateRet = Z_STREAM_END;
+
+ {Terminates decompression}
+ InflateEnd(StreamRec);
+ end {with StreamRec}
+
+end;
+
+{Compresses ZLIB into a memory address}
+function CompressZLIB(Input: Pointer; InputSize, CompressionLevel: Integer;
+ var Output: Pointer; var OutputSize: Integer;
+ var ErrorOutput: String): Boolean;
+var
+ StreamRec : TZStreamRec;
+ Buffer : Array[Byte] of Byte;
+ DeflateRet: Integer;
+begin
+ with StreamRec do
+ begin
+ Result := True; {By default returns TRUE as everything might have gone ok}
+ OutputSize := 0; {Initialize}
+ {Prepares the data to compress}
+ FillChar(StreamRec, SizeOf(TZStreamRec), #0);
+ DeflateInit_(StreamRec, CompressionLevel,zlib_version, SIZEOF(TZStreamRec));
+
+ next_in := Input;
+ avail_in := InputSize;
+
+ while avail_in > 0 do
+ begin
+ {When it needs new buffer to stores the compressed data}
+ if avail_out = 0 then
+ begin
+ {Restore buffer}
+ next_out := @Buffer;
+ avail_out := SizeOf(Buffer);
+ end {if avail_out = 0};
+
+ {Compresses}
+ DeflateRet := deflate(StreamRec, Z_FINISH);
+
+ if (DeflateRet = Z_STREAM_END) or (DeflateRet = 0) then
+ begin
+ {Updates the output memory}
+ inc(OutputSize, total_out);
+ if Output = nil then
+ GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
+
+ {Copies the new data}
+ CopyMemory(Ptr(Longint(Output) + OutputSize - total_out),
+ @Buffer, total_out);
+ end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
+ {Now tests for errors}
+ else if DeflateRet < 0 then
+ begin
+ Result := False;
+ ErrorOutput := StreamRec.msg;
+ DeflateEnd(StreamRec);
+ Exit;
+ end {if InflateRet < 0}
+
+ end {while avail_in > 0};
+
+ {Finishes compressing}
+ DeflateEnd(StreamRec);
+ end {with StreamRec}
+
+end;
+
+{TPngPointerList implementation}
+
+{Object being created}
+constructor TPngPointerList.Create(AOwner: TPNGObject);
+begin
+ inherited Create; {Let ancestor work}
+ {Holds owner}
+ fOwner := AOwner;
+ {Memory pointer not being used yet}
+ fMemory := nil;
+ {No items yet}
+ fCount := 0;
+end;
+
+{Removes value from the list}
+function TPngPointerList.Remove(Value: Pointer): Pointer;
+var
+ I, Position: Integer;
+begin
+ {Gets item position}
+ Position := -1;
+ FOR I := 0 TO Count - 1 DO
+ if Value = Item[I] then Position := I;
+ {In case a match was found}
+ if Position >= 0 then
+ begin
+ Result := Item[Position]; {Returns pointer}
+ {Remove item and move memory}
+ Dec(fCount);
+ if Position < Integer(FCount) then
+ System.Move(fMemory^[Position + 1], fMemory^[Position],
+ (Integer(fCount) - Position) * SizeOf(Pointer));
+ end {if Position >= 0} else Result := nil
+end;
+
+{Add a new value in the list}
+procedure TPngPointerList.Add(Value: Pointer);
+begin
+ Count := Count + 1;
+ Item[Count - 1] := Value;
+end;
+
+
+{Object being destroyed}
+destructor TPngPointerList.Destroy;
+begin
+ {Release memory if needed}
+ if fMemory <> nil then
+ FreeMem(fMemory, fCount * sizeof(Pointer));
+
+ {Free things}
+ inherited Destroy;
+end;
+
+{Returns one item from the list}
+function TPngPointerList.GetItem(Index: Cardinal): Pointer;
+begin
+ if (Index <= Count - 1) then
+ Result := fMemory[Index]
+ else
+ {In case it's out of bounds}
+ Result := nil;
+end;
+
+{Inserts a new item in the list}
+procedure TPngPointerList.Insert(Value: Pointer; Position: Cardinal);
+begin
+ if (Position < Count) or (Count = 0) then
+ begin
+ {Increase item count}
+ SetSize(Count + 1);
+ {Move other pointers}
+ if Position < Count then
+ System.Move(fMemory^[Position], fMemory^[Position + 1],
+ (Count - Position - 1) * SizeOf(Pointer));
+ {Sets item}
+ Item[Position] := Value;
+ end;
+end;
+
+{Sets one item from the list}
+procedure TPngPointerList.SetItem(Index: Cardinal; const Value: Pointer);
+begin
+ {If index is in bounds, set value}
+ if (Index <= Count - 1) then
+ fMemory[Index] := Value
+end;
+
+{This method resizes the list}
+procedure TPngPointerList.SetSize(const Size: Cardinal);
+begin
+ {Sets the size}
+ if (fMemory = nil) and (Size > 0) then
+ GetMem(fMemory, Size * SIZEOF(Pointer))
+ else
+ if Size > 0 then {Only realloc if the new size is greater than 0}
+ ReallocMem(fMemory, Size * SIZEOF(Pointer))
+ else
+ {In case user is resize to 0 items}
+ begin
+ FreeMem(fMemory);
+ fMemory := nil;
+ end;
+ {Update count}
+ fCount := Size;
+end;
+
+{TPNGList implementation}
+
+{Finds the first chunk of this class}
+function TPNGList.FindChunk(ChunkClass: TChunkClass): TChunk;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if Item[i] is ChunkClass then
+ begin
+ Result := Item[i];
+ Break
+ end
+end;
+
+
+{Removes an item}
+procedure TPNGList.RemoveChunk(Chunk: TChunk);
+begin
+ Remove(Chunk);
+ Chunk.Free
+end;
+
+{Add a new item}
+function TPNGList.Add(ChunkClass: TChunkClass): TChunk;
+var
+ IHDR: TChunkIHDR;
+ IEND: TChunkIEND;
+
+ IDAT: TChunkIDAT;
+ PLTE: TChunkPLTE;
+begin
+ Result := nil; {Default result}
+ {Adding these is not allowed}
+ if ((ChunkClass = TChunkIHDR) or (ChunkClass = TChunkIDAT) or
+ (ChunkClass = TChunkPLTE) or (ChunkClass = TChunkIEND)) and not
+ (Owner.BeingCreated) then
+ fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
+ {Two of these is not allowed}
+ else if ((ChunkClass = TChunkgAMA) and (ItemFromClass(TChunkgAMA) <> nil)) or
+ ((ChunkClass = TChunktRNS) and (ItemFromClass(TChunktRNS) <> nil)) or
+ ((ChunkClass = TChunkpHYs) and (ItemFromClass(TChunkpHYs) <> nil)) then
+ fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
+ {There must have an IEND and IHDR chunk}
+ else if ((ItemFromClass(TChunkIEND) = nil) or
+ (ItemFromClass(TChunkIHDR) = nil)) and not Owner.BeingCreated then
+ fOwner.RaiseError(EPngError, EPNGCannotAddInvalidImageText)
+ else
+ begin
+ {Get common chunks}
+ IHDR := ItemFromClass(TChunkIHDR) as TChunkIHDR;
+ IEND := ItemFromClass(TChunkIEND) as TChunkIEND;
+ {Create new chunk}
+ Result := ChunkClass.Create(Owner);
+ {Add to the list}
+ if (ChunkClass = TChunkgAMA) or (ChunkClass = TChunkpHYs) or
+ (ChunkClass = TChunkPLTE) then
+ Insert(Result, IHDR.Index + 1)
+ {Header and end}
+ else if (ChunkClass = TChunkIEND) then
+ Insert(Result, Count)
+ else if (ChunkClass = TChunkIHDR) then
+ Insert(Result, 0)
+ {Transparency chunk (fix by Ian Boyd)}
+ else if (ChunkClass = TChunktRNS) then
+ begin
+ {Transparecy chunk must be after PLTE; before IDAT}
+ IDAT := ItemFromClass(TChunkIDAT) as TChunkIDAT;
+ PLTE := ItemFromClass(TChunkPLTE) as TChunkPLTE;
+
+ if Assigned(PLTE) then
+ Insert(Result, PLTE.Index + 1)
+ else if Assigned(IDAT) then
+ Insert(Result, IDAT.Index)
+ else
+ Insert(Result, IHDR.Index + 1)
+ end
+ else {All other chunks}
+ Insert(Result, IEND.Index);
+ end {if}
+end;
+
+{Returns item from the list}
+function TPNGList.GetItem(Index: Cardinal): TChunk;
+begin
+ Result := inherited GetItem(Index);
+end;
+
+{Returns first item from the list using the class from parameter}
+function TPNGList.ItemFromClass(ChunkClass: TChunkClass): TChunk;
+var
+ i: Integer;
+begin
+ Result := nil; {Initial result}
+ FOR i := 0 TO Count - 1 DO
+ {Test if this item has the same class}
+ if Item[i] is ChunkClass then
+ begin
+ {Returns this item and exit}
+ Result := Item[i];
+ break;
+ end {if}
+end;
+
+{$IFNDEF UseDelphi}
+
+ {TStream implementation}
+
+ {Copies all from another stream}
+ function TStream.CopyFrom(Source: TStream; Count: Cardinal): Cardinal;
+ const
+ MaxBytes = $f000;
+ var
+ Buffer: PChar;
+ BufSize, N: Cardinal;
+ begin
+ {If count is zero, copy everything from Source}
+ if Count = 0 then
+ begin
+ Source.Seek(0, soFromBeginning);
+ Count := Source.Size;
+ end;
+
+ Result := Count; {Returns the number of bytes readed}
+ {Allocates memory}
+ if Count > MaxBytes then BufSize := MaxBytes else BufSize := Count;
+ GetMem(Buffer, BufSize);
+
+ {Copy memory}
+ while Count > 0 do
+ begin
+ if Count > BufSize then N := BufSize else N := Count;
+ Source.Read(Buffer^, N);
+ Write(Buffer^, N);
+ dec(Count, N);
+ end;
+
+ {Deallocates memory}
+ FreeMem(Buffer, BufSize);
+ end;
+
+{Set current stream position}
+procedure TStream.SetPosition(const Value: Longint);
+begin
+ Seek(Value, soFromBeginning);
+end;
+
+{Returns position}
+function TStream.GetPosition: Longint;
+begin
+ Result := Seek(0, soFromCurrent);
+end;
+
+ {Returns stream size}
+function TStream.GetSize: Longint;
+ var
+ Pos: Cardinal;
+ begin
+ Pos := Seek(0, soFromCurrent);
+ Result := Seek(0, soFromEnd);
+ Seek(Pos, soFromBeginning);
+ end;
+
+ {TFileStream implementation}
+
+ {Filestream object being created}
+ constructor TFileStream.Create(Filename: String; Mode: TFileStreamModeSet);
+ {Makes file mode}
+ function OpenMode: DWORD;
+ begin
+ Result := 0;
+ if fsmRead in Mode then Result := GENERIC_READ;
+ if (fsmWrite in Mode) or (fsmCreate in Mode) then
+ Result := Result OR GENERIC_WRITE;
+ end;
+ const
+ IsCreate: Array[Boolean] of Integer = (OPEN_ALWAYS, CREATE_ALWAYS);
+ begin
+ {Call ancestor}
+ inherited Create;
+
+ {Create handle}
+ fHandle := CreateFile(PChar(Filename), OpenMode, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, IsCreate[fsmCreate in Mode], 0, 0);
+ {Store mode}
+ FileMode := Mode;
+ end;
+
+ {Filestream object being destroyed}
+ destructor TFileStream.Destroy;
+ begin
+ {Terminates file and close}
+ if FileMode = [fsmWrite] then
+ SetEndOfFile(fHandle);
+ CloseHandle(fHandle);
+
+ {Call ancestor}
+ inherited Destroy;
+ end;
+
+ {Writes data to the file}
+ function TFileStream.Write(const Buffer; Count: Longint): Cardinal;
+ begin
+ if not WriteFile(fHandle, Buffer, Count, Result, nil) then
+ Result := 0;
+ end;
+
+ {Reads data from the file}
+ 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;
+
+{Assigns from another TChunk}
+procedure TChunktIME.Assign(Source: TChunk);
+begin
+ fYear := TChunktIME(Source).fYear;
+ fMonth := TChunktIME(Source).fMonth;
+ fDay := TChunktIME(Source).fDay;
+ fHour := TChunktIME(Source).fHour;
+ fMinute := TChunktIME(Source).fMinute;
+ fSecond := TChunktIME(Source).fSecond;
+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)^ := ByteSwap16(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}
+ if Longint(fKeyword) = 0 then
+ CompressionMethod := pByte(Data)^
+ else
+ 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
+ {Prepare pointers}
+ ImageHandle := 0;
+ ImagePalette := 0;
+ ImageDC := 0;
+
+ {Call inherited}
+ inherited Create(Owner);
+end;
+
+{Chunk being destroyed}
+destructor TChunkIHDR.Destroy;
+begin
+ {Free memory}
+ FreeImageData();
+
+ {Calls TChunk destroy}
+ inherited Destroy;
+end;
+
+{Copies the palette}
+procedure CopyPalette(Source: HPALETTE; Destination: HPALETTE);
+var
+ PaletteSize: Integer;
+ Entries: Array[Byte] of TPaletteEntry;
+begin
+ PaletteSize := 0;
+ if GetObject(Source, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
+ if PaletteSize = 0 then Exit;
+ ResizePalette(Destination, PaletteSize);
+ GetPaletteEntries(Source, 0, PaletteSize, Entries);
+ SetPaletteEntries(Destination, 0, PaletteSize, Entries);
+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}
+ {resizing ImageData and ImageAlpha memory allocations}
+ PrepareImageData();
+
+ {Copy image data}
+ CopyMemory(ImageData, TChunkIHDR(Source).ImageData,
+ BytesPerRow * Integer(Height));
+ CopyMemory(ImageAlpha, TChunkIHDR(Source).ImageAlpha,
+ Integer(Width) * Integer(Height));
+
+ {Copy palette colors}
+ BitmapInfo.bmiColors := TChunkIHDR(Source).BitmapInfo.bmiColors;
+ {Copy palette also}
+ CopyPalette(TChunkIHDR(Source).ImagePalette, ImagePalette);
+ end
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{Release allocated image data}
+procedure TChunkIHDR.FreeImageData;
+begin
+ {Free old image data}
+ if ImageHandle <> 0 then DeleteObject(ImageHandle);
+ if ImageDC <> 0 then DeleteDC(ImageDC);
+ if ImageAlpha <> nil then FreeMem(ImageAlpha);
+ if ImagePalette <> 0 then DeleteObject(ImagePalette);
+ {$IFDEF Store16bits}
+ if ExtraImageData <> nil then FreeMem(ExtraImageData);
+ {$ENDIF}
+ ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := nil;
+ ImagePalette := 0; ExtraImageData := nil;
+end;
+
+{Chunk being loaded from a stream}
+function TChunkIHDR.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+begin
+ {Let TChunk load it}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then Exit;
+
+ {Now check values}
+ {Note: It's recommended by png specification to make sure that the size}
+ {must be 13 bytes to be valid, but some images with 14 bytes were found}
+ {which could be loaded by internet explorer and other tools}
+ if (fDataSize < SIZEOF(TIHdrData)) then
+ begin
+ {Ihdr must always have at least 13 bytes}
+ Result := False;
+ Owner.RaiseError(EPNGInvalidIHDR, EPNGInvalidIHDRText);
+ exit;
+ end;
+
+ {Everything ok, reads IHDR}
+ IHDRData := pIHDRData(fData)^;
+ IHDRData.Width := ByteSwap(IHDRData.Width);
+ IHDRData.Height := ByteSwap(IHDRData.Height);
+
+ {The width and height must not be larger than 65535 pixels}
+ if (IHDRData.Width > High(Word)) or (IHDRData.Height > High(Word)) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGSizeExceeds, EPNGSizeExceedsText);
+ exit;
+ end {if IHDRData.Width > High(Word)};
+ {Compression method must be 0 (inflate/deflate)}
+ if (IHDRData.CompressionMethod <> 0) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGUnknownCompression, EPNGUnknownCompressionText);
+ exit;
+ end;
+ {Interlace must be either 0 (none) or 7 (adam7)}
+ if (IHDRData.InterlaceMethod <> 0) and (IHDRData.InterlaceMethod <> 1) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGUnknownInterlace, EPNGUnknownInterlaceText);
+ exit;
+ end;
+
+ {Updates owner properties}
+ Owner.InterlaceMethod := TInterlaceMethod(IHDRData.InterlaceMethod);
+
+ {Prepares data to hold image}
+ PrepareImageData();
+end;
+
+{Saving the IHDR chunk to a stream}
+function TChunkIHDR.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Ignore 2 bits images}
+ if BitDepth = 2 then BitDepth := 4;
+
+ {It needs to do is update the data with the IHDR data}
+ {structure containing the write values}
+ ResizeData(SizeOf(TIHDRData));
+ pIHDRData(fData)^ := IHDRData;
+ {..byteswap 4 byte types}
+ pIHDRData(fData)^.Width := ByteSwap(pIHDRData(fData)^.Width);
+ pIHDRData(fData)^.Height := ByteSwap(pIHDRData(fData)^.Height);
+ {..update interlace method}
+ pIHDRData(fData)^.InterlaceMethod := Byte(Owner.InterlaceMethod);
+ {..and then let the ancestor SaveToStream do the hard work}
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Creates a grayscale palette}
+function TChunkIHDR.CreateGrayscalePalette(Bitdepth: Integer): HPalette;
+var
+ j: Integer;
+ palEntries: TMaxLogPalette;
+begin
+ {Prepares and fills the strucutre}
+ if Bitdepth = 16 then Bitdepth := 8;
+ fillchar(palEntries, sizeof(palEntries), 0);
+ palEntries.palVersion := $300;
+ palEntries.palNumEntries := 1 shl Bitdepth;
+ {Fill it with grayscale colors}
+ for j := 0 to palEntries.palNumEntries - 1 do
+ begin
+ palEntries.palPalEntry[j].peRed :=
+ fOwner.GammaTable[MulDiv(j, 255, palEntries.palNumEntries - 1)];
+ palEntries.palPalEntry[j].peGreen := palEntries.palPalEntry[j].peRed;
+ palEntries.palPalEntry[j].peBlue := palEntries.palPalEntry[j].peRed;
+ end;
+ {Creates and returns the palette}
+ Result := CreatePalette(pLogPalette(@palEntries)^);
+end;
+
+{Copies the palette to the Device Independent bitmap header}
+procedure TChunkIHDR.PaletteToDIB(Palette: HPalette);
+var
+ j: Integer;
+ palEntries: TMaxLogPalette;
+begin
+ {Copy colors}
+ Fillchar(palEntries, sizeof(palEntries), #0);
+ BitmapInfo.bmiHeader.biClrUsed := GetPaletteEntries(Palette, 0, 256, palEntries.palPalEntry[0]);
+ for j := 0 to BitmapInfo.bmiHeader.biClrUsed - 1 do
+ begin
+ BitmapInfo.bmiColors[j].rgbBlue := palEntries.palPalEntry[j].peBlue;
+ BitmapInfo.bmiColors[j].rgbRed := palEntries.palPalEntry[j].peRed;
+ BitmapInfo.bmiColors[j].rgbGreen := palEntries.palPalEntry[j].peGreen;
+ end;
+end;
+
+{Resizes the image data to fill the color type, bit depth, }
+{width and height parameters}
+procedure TChunkIHDR.PrepareImageData();
+ {Set the bitmap info}
+ procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean);
+ begin
+
+ {Copy if the bitmap contain palette entries}
+ HasPalette := Palette;
+ {Fill the strucutre}
+ with BitmapInfo.bmiHeader do
+ begin
+ biSize := sizeof(TBitmapInfoHeader);
+ biHeight := Height;
+ biWidth := Width;
+ biPlanes := 1;
+ biBitCount := BitDepth;
+ biCompression := BI_RGB;
+ end {with BitmapInfo.bmiHeader}
+ end;
+begin
+ {Prepare bitmap info header}
+ Fillchar(BitmapInfo, sizeof(TMaxBitmapInfo), #0);
+ {Release old image data}
+ FreeImageData();
+
+ {Obtain number of bits for each pixel}
+ case ColorType of
+ COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA:
+ case BitDepth of
+ {These are supported by windows}
+ 1, 4, 8: SetInfo(BitDepth, TRUE);
+ {2 bits for each pixel is not supported by windows bitmap}
+ 2 : SetInfo(4, TRUE);
+ {Also 16 bits (2 bytes) for each pixel is not supported}
+ {and should be transormed into a 8 bit grayscale}
+ 16 : SetInfo(8, TRUE);
+ end;
+ {Only 1 byte (8 bits) is supported}
+ COLOR_RGB, COLOR_RGBALPHA: SetInfo(24, FALSE);
+ end {case ColorType};
+ {Number of bytes for each scanline}
+ BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31)
+ and not 31) div 8;
+
+ {Build array for alpha information, if necessary}
+ if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ begin
+ GetMem(ImageAlpha, Integer(Width) * Integer(Height));
+ FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #0);
+ end;
+
+ {Build array for extra byte information}
+ {$IFDEF Store16bits}
+ if (BitDepth = 16) then
+ begin
+ GetMem(ExtraImageData, BytesPerRow * Integer(Height));
+ FillChar(ExtraImageData^, BytesPerRow * Integer(Height), #0);
+ end;
+ {$ENDIF}
+
+ {Creates the image to hold the data, CreateDIBSection does a better}
+ {work in allocating necessary memory}
+ ImageDC := CreateCompatibleDC(0);
+ {$IFDEF UseDelphi}Self.Owner.Canvas.Handle := ImageDC;{$ENDIF}
+
+ {In case it is a palette image, create the palette}
+ if HasPalette then
+ begin
+ {Create a standard palette}
+ if ColorType = COLOR_PALETTE then
+ ImagePalette := CreateHalfTonePalette(ImageDC)
+ else
+ ImagePalette := CreateGrayscalePalette(Bitdepth);
+ ResizePalette(ImagePalette, 1 shl BitmapInfo.bmiHeader.biBitCount);
+ BitmapInfo.bmiHeader.biClrUsed := 1 shl BitmapInfo.bmiHeader.biBitCount;
+ SelectPalette(ImageDC, ImagePalette, False);
+ RealizePalette(ImageDC);
+ PaletteTODIB(ImagePalette);
+ end;
+
+ {Create the device independent bitmap}
+ ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
+ DIB_RGB_COLORS, ImageData, 0, 0);
+ SelectObject(ImageDC, ImageHandle);
+
+ {Build array and allocate bytes for each row}
+ fillchar(ImageData^, BytesPerRow * Integer(Height), 0);
+end;
+
+{TChunktRNS implementation}
+
+{$IFNDEF UseDelphi}
+function CompareMem(P1, P2: pByte; const Size: Integer): Boolean;
+var i: Integer;
+begin
+ Result := True;
+ for i := 1 to Size do
+ begin
+ if P1^ <> P2^ then Result := False;
+ inc(P1); inc(P2);
+ end {for i}
+end;
+{$ENDIF}
+
+{Sets the transpararent color}
+procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
+var
+ i: Byte;
+ LookColor: TRGBQuad;
+begin
+ {Clears the palette values}
+ Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
+ {Sets that it uses bit transparency}
+ fBitTransparency := True;
+
+
+ {Depends on the color type}
+ with Header do
+ case ColorType of
+ COLOR_GRAYSCALE:
+ begin
+ Self.ResizeData(2);
+ pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
+ end;
+ COLOR_RGB:
+ begin
+ Self.ResizeData(6);
+ pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
+ pWord(@PaletteValues[2])^ := ByteSwap16(GetGValue(Value));
+ pWord(@PaletteValues[4])^ := ByteSwap16(GetBValue(Value));
+ end;
+ COLOR_PALETTE:
+ begin
+ {Creates a RGBQuad to search for the color}
+ LookColor.rgbRed := GetRValue(Value);
+ LookColor.rgbGreen := GetGValue(Value);
+ LookColor.rgbBlue := GetBValue(Value);
+ {Look in the table for the entry}
+ for i := 0 to BitmapInfo.bmiHeader.biClrUsed - 1 do
+ if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then
+ Break;
+ {Fill the transparency table}
+ Fillchar(PaletteValues, i, 255);
+ Self.ResizeData(i + 1)
+
+ end
+ end {case / with};
+
+end;
+
+{Returns the transparent color for the image}
+function TChunktRNS.GetTransparentColor: ColorRef;
+var
+ PaletteChunk: TChunkPLTE;
+ i: Integer;
+ Value: Byte;
+begin
+ Result := 0; {Default: Unknown transparent color}
+
+ {Depends on the color type}
+ with Header do
+ case ColorType of
+ COLOR_GRAYSCALE:
+ begin
+ Value := BitmapInfo.bmiColors[PaletteValues[1]].rgbRed;
+ Result := RGB(Value, Value, Value);
+ end;
+ COLOR_RGB:
+ Result := RGB(fOwner.GammaTable[PaletteValues[1]],
+ fOwner.GammaTable[PaletteValues[3]],
+ fOwner.GammaTable[PaletteValues[5]]);
+ COLOR_PALETTE:
+ begin
+ {Obtains the palette chunk}
+ PaletteChunk := Owner.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
+
+ {Looks for an entry with 0 transparency meaning that it is the}
+ {full transparent entry}
+ for i := 0 to Self.DataSize - 1 do
+ if PaletteValues[i] = 0 then
+ with PaletteChunk.GetPaletteItem(i) do
+ begin
+ Result := RGB(rgbRed, rgbGreen, rgbBlue);
+ break
+ end
+ end {COLOR_PALETTE}
+ end {case Header.ColorType};
+end;
+
+{Saving the chunk to a stream}
+function TChunktRNS.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Copy palette into data buffer}
+ if DataSize <= 256 then
+ CopyMemory(fData, @PaletteValues[0], DataSize);
+
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Assigns from another chunk}
+procedure TChunktRNS.Assign(Source: TChunk);
+begin
+ CopyMemory(@PaletteValues[0], @TChunkTrns(Source).PaletteValues[0], 256);
+ fBitTransparency := TChunkTrns(Source).fBitTransparency;
+ inherited Assign(Source);
+end;
+
+{Loads the chunk from a stream}
+function TChunktRNS.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+var
+ i, Differ255: Integer;
+begin
+ {Let inherited load}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+
+ if not Result then Exit;
+
+ {Make sure size is correct}
+ if Size > 256 then Owner.RaiseError(EPNGInvalidPalette,
+ EPNGInvalidPaletteText);
+
+ {The unset items should have value 255}
+ Fillchar(PaletteValues[0], 256, 255);
+ {Copy the other values}
+ CopyMemory(@PaletteValues[0], fData, Size);
+
+ {Create the mask if needed}
+ case Header.ColorType of
+ {Mask for grayscale and RGB}
+ COLOR_RGB, COLOR_GRAYSCALE: fBitTransparency := True;
+ COLOR_PALETTE:
+ begin
+ Differ255 := 0; {Count the entries with a value different from 255}
+ {Tests if it uses bit transparency}
+ for i := 0 to Size - 1 do
+ if PaletteValues[i] <> 255 then inc(Differ255);
+
+ {If it has one value different from 255 it is a bit transparency}
+ fBitTransparency := (Differ255 = 1);
+ end {COLOR_PALETTE}
+ end {case Header.ColorType};
+
+end;
+
+{Prepares the image palette}
+procedure TChunkIDAT.PreparePalette;
+var
+ Entries: Word;
+ j : Integer;
+ palEntries: TMaxLogPalette;
+begin
+ {In case the image uses grayscale, build a grayscale palette}
+ with Header do
+ if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ begin
+ {Calculate total number of palette entries}
+ Entries := (1 shl Byte(BitmapInfo.bmiHeader.biBitCount));
+ Fillchar(palEntries, sizeof(palEntries), #0);
+ palEntries.palVersion := $300;
+ palEntries.palNumEntries := Entries;
+
+ FOR j := 0 TO Entries - 1 DO
+ with palEntries.palPalEntry[j] do
+ begin
+
+ {Calculate each palette entry}
+ peRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
+ peGreen := peRed;
+ peBlue := peRed;
+ end {with BitmapInfo.bmiColors[j]};
+ Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^));
+ end {if ColorType = COLOR_GRAYSCALE..., with Header}
+end;
+
+{Reads from ZLIB}
+function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2;
+ Buffer: Pointer; Count: Integer; var EndPos: Integer;
+ var crcfile: Cardinal): Integer;
+var
+ ProcResult : Integer;
+ IDATHeader : Array[0..3] of char;
+ IDATCRC : Cardinal;
+begin
+ {Uses internal record pointed by ZLIBStream to gather information}
+ with ZLIBStream, ZLIBStream.zlib do
+ begin
+ {Set the buffer the zlib will read into}
+ next_out := Buffer;
+ avail_out := Count;
+
+ {Decode until it reach the Count variable}
+ while avail_out > 0 do
+ begin
+ {In case it needs more data and it's in the end of a IDAT chunk,}
+ {it means that there are more IDAT chunks}
+ if (fStream.Position = EndPos) and (avail_out > 0) and
+ (avail_in = 0) then
+ begin
+ {End this chunk by reading and testing the crc value}
+ fStream.Read(IDATCRC, 4);
+
+ {$IFDEF CheckCRC}
+ if crcfile xor $ffffffff <> Cardinal(ByteSwap(IDATCRC)) then
+ begin
+ Result := -1;
+ Owner.RaiseError(EPNGInvalidCRC, EPNGInvalidCRCText);
+ exit;
+ end;
+ {$ENDIF}
+
+ {Start reading the next chunk}
+ fStream.Read(EndPos, 4); {Reads next chunk size}
+ fStream.Read(IDATHeader[0], 4); {Next chunk header}
+ {It must be a IDAT chunk since image data is required and PNG}
+ {specification says that multiple IDAT chunks must be consecutive}
+ if IDATHeader <> 'IDAT' then
+ begin
+ Owner.RaiseError(EPNGMissingMultipleIDAT, EPNGMissingMultipleIDATText);
+ result := -1;
+ exit;
+ end;
+
+ {Calculate chunk name part of the crc}
+ {$IFDEF CheckCRC}
+ crcfile := update_crc($ffffffff, @IDATHeader[0], 4);
+ {$ENDIF}
+ EndPos := fStream.Position + ByteSwap(EndPos);
+ end;
+
+
+ {In case it needs compressed data to read from}
+ if avail_in = 0 then
+ begin
+ {In case it's trying to read more than it is avaliable}
+ if fStream.Position + ZLIBAllocate > EndPos then
+ avail_in := fStream.Read(Data^, EndPos - fStream.Position)
+ else
+ avail_in := fStream.Read(Data^, ZLIBAllocate);
+ {Update crc}
+ {$IFDEF CheckCRC}
+ crcfile := update_crc(crcfile, Data, avail_in);
+ {$ENDIF}
+
+ {In case there is no more compressed data to read from}
+ if avail_in = 0 then
+ begin
+ Result := Count - avail_out;
+ Exit;
+ end;
+
+ {Set next buffer to read and record current position}
+ next_in := Data;
+
+ end {if avail_in = 0};
+
+ ProcResult := inflate(zlib, 0);
+
+ {In case the result was not sucessfull}
+ if (ProcResult < 0) then
+ begin
+ Result := -1;
+ Owner.RaiseError(EPNGZLIBError,
+ EPNGZLIBErrorText + zliberrors[procresult]);
+ exit;
+ end;
+
+ end {while avail_out > 0};
+
+ end {with};
+
+ {If everything gone ok, it returns the count bytes}
+ Result := Count;
+end;
+
+{TChunkIDAT implementation}
+
+const
+ {Adam 7 interlacing values}
+ RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1);
+ ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0);
+ RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2);
+ ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1);
+
+{Copy interlaced images with 1 byte for R, G, B}
+procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ repeat
+ {Copy this row}
+ 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);
+
+ {Move to next column}
+ inc(Src, 3);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy interlaced images with 2 bytes for R, G, B}
+procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ 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);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 6);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using bit depths 1, 4 or 8}
+procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+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
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := StartBit[Header.BitDepth];
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + (Header.BitDepth * Col) div 8);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or
+ ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth])
+ shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8)));
+
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, Header.BitDepth);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using bit depth 2}
+procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest,
+ Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ CurBit, Col: Integer;
+ Dest2: PChar;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := 6;
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + Col div 2);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
+ shl (4 - (4 * Col) mod 8));
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, 2);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with grayscale using bit depth 2}
+procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ CurBit, Col: Integer;
+ Dest2: PChar;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := 6;
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + Col div 2);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F)
+ shl (4 - (Col*4) mod 8));
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, 2);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using 2 bytes for each pixel}
+procedure TChunkIDAT.CopyInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ repeat
+ {Copy this row}
+ Dest^ := Src^; inc(Dest);
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 2);
+ inc(Dest, ColumnIncrement[Pass] - 1);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes interlaced RGB alpha with 1 byte for each sample}
+procedure TChunkIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row and alpha value}
+ 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);
+
+ {Move to next column}
+ inc(Src, 4);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes interlaced RGB alpha with 2 bytes for each sample}
+procedure TChunkIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row and alpha value}
+ 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);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ 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);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 8);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes 8 bit grayscale image followed by an alpha sample}
+procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column, pointers to the data and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this grayscale value and alpha}
+ Dest^ := Src^; inc(Src);
+ Trans^ := Src^; inc(Src);
+
+ {Move to next column}
+ inc(Dest, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes 16 bit grayscale image followed by an alpha sample}
+procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column, pointers to the data and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+ {Copy this grayscale value and alpha, transforming 16 bits into 8}
+ Dest^ := Src^; inc(Src, 2);
+ Trans^ := Src^; inc(Src, 2);
+
+ {Move to next column}
+ inc(Dest, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes an interlaced image}
+procedure TChunkIDAT.DecodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+var
+ CurrentPass: Byte;
+ PixelsThisRow: Integer;
+ CurrentRow: Integer;
+ Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar;
+ CopyProc: procedure(const Pass: Byte; Src, Dest,
+ Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object;
+begin
+
+ CopyProc := nil; {Initialize}
+ {Determine method to copy the image data}
+ case Header.ColorType of
+ {R, G, B values for each pixel}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedRGB8;
+ 16: CopyProc := CopyInterlacedRGB16;
+ end {case Header.BitDepth};
+ {Palette}
+ 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;
+ {RGB followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedRGBAlpha8;
+ 16: CopyProc := CopyInterlacedRGBAlpha16;
+ end;
+ {Grayscale followed by alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedGrayscaleAlpha8;
+ 16: CopyProc := CopyInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Adam7 method has 7 passes to make the final image}
+ FOR CurrentPass := 0 TO 6 DO
+ begin
+ {Calculates the number of pixels and bytes for this pass row}
+ PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
+ ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
+ Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
+ Header.BitDepth);
+ {Clear buffer for this pass}
+ ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes);
+
+ {Get current row index}
+ CurrentRow := RowStart[CurrentPass];
+ {Get a pointer to the current row image data}
+ Data := Ptr(Longint(Header.ImageData) + Header.BytesPerRow *
+ (ImageHeight - 1 - CurrentRow));
+ Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
+ {$IFDEF Store16bits}
+ Extra := Ptr(Longint(Header.ExtraImageData) + Header.BytesPerRow *
+ (ImageHeight - 1 - CurrentRow));
+ {$ENDIF}
+
+ if Row_Bytes > 0 then {There must have bytes for this interlaced pass}
+ while CurrentRow < ImageHeight do
+ begin
+ {Reads this line and filter}
+ if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1,
+ EndPos, CRCFile) = 0 then break;
+
+ FilterRow;
+ {Copy image data}
+
+ CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Data, Trans
+ {$IFDEF Store16bits}, Extra{$ENDIF});
+
+ {Use the other RowBuffer item}
+ RowUsed := not RowUsed;
+
+ {Move to the next row}
+ inc(CurrentRow, RowIncrement[CurrentPass]);
+ {Move pointer to the next line}
+ dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
+ {$IFDEF Store16bits}
+ dec(Extra, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ {$ENDIF}
+ end {while CurrentRow < ImageHeight};
+
+ end {FOR CurrentPass};
+
+end;
+
+{Copy 8 bits RGB image}
+procedure TChunkIDAT.CopyNonInterlacedRGB8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values}
+ 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);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+end;
+
+{Copy 16 bits RGB image}
+procedure TChunkIDAT.CopyNonInterlacedRGB16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Since windows does not supports 2 bytes for
+ //each R, G, B value, the method will read only 1 byte from it
+ {Copy pixel values}
+ 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);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ 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);
+ {$ENDIF}
+
+ {Move to next pixel}
+ inc(Src, 6);
+ end {for I}
+end;
+
+{Copy types using palettes (1, 4 or 8 bits per pixel)}
+procedure TChunkIDAT.CopyNonInterlacedPalette148(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+begin
+ {It's simple as copying the data}
+ CopyMemory(Dest, Src, Row_Bytes);
+end;
+
+{Copy grayscale types using 2 bits for each pixel}
+procedure TChunkIDAT.CopyNonInterlacedGray2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ {2 bits is not supported, this routine will converted into 4 bits}
+ 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 {FOR i}
+end;
+
+{Copy types using palette with 2 bits for each pixel}
+procedure TChunkIDAT.CopyNonInterlacedPalette2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ {2 bits is not supported, this routine will converted into 4 bits}
+ 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 {FOR i}
+end;
+
+{Copy grayscale images with 16 bits}
+procedure TChunkIDAT.CopyNonInterlacedGrayscale16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Windows does not supports 16 bits for each pixel in grayscale}
+ {mode, so reduce to 8}
+ Dest^ := Src^; inc(Dest);
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+
+ {Move to next pixel}
+ inc(Src, 2);
+ end {for I}
+end;
+
+{Copy 8 bits per sample RGB images followed by an alpha byte}
+procedure TChunkIDAT.CopyNonInterlacedRGBAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values and transparency}
+ 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);
+ {Move to next pixel}
+ inc(Src, 4); inc(Trans);
+ end {for I}
+end;
+
+{Copy 16 bits RGB image with alpha using 2 bytes for each sample}
+procedure TChunkIDAT.CopyNonInterlacedRGBAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Copy rgb and alpha values (transforming from 16 bits to 8 bits)
+ {Copy pixel values}
+ 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);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ 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);
+ {$ENDIF}
+ {Move to next pixel}
+ inc(Src, 8); inc(Trans);
+ end {for I}
+end;
+
+{Copy 8 bits per sample grayscale followed by alpha}
+procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy alpha value and then gray value}
+ Dest^ := Src^; inc(Src);
+ Trans^ := Src^; inc(Src);
+ inc(Dest); inc(Trans);
+ end;
+end;
+
+{Copy 16 bits per sample grayscale followed by alpha}
+procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy alpha value and then gray value}
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+ Dest^ := Src^; inc(Src, 2);
+ Trans^ := Src^; inc(Src, 2);
+ inc(Dest); inc(Trans);
+ end;
+end;
+
+{Decode non interlaced image}
+procedure TChunkIDAT.DecodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+var
+ j: Cardinal;
+ Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar;
+ CopyProc: procedure(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object;
+begin
+ CopyProc := nil; {Initialize}
+ {Determines the method to copy the image data}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := CopyNonInterlacedRGB8;
+ 16: CopyProc := CopyNonInterlacedRGB16;
+ end;
+ {Types using palettes}
+ 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;
+ {R, G, B followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8 : CopyProc := CopyNonInterlacedRGBAlpha8;
+ 16 : CopyProc := CopyNonInterlacedRGBAlpha16;
+ end;
+ {Grayscale followed by alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8 : CopyProc := CopyNonInterlacedGrayscaleAlpha8;
+ 16 : CopyProc := CopyNonInterlacedGrayscaleAlpha16;
+ end;
+ end;
+
+ {Get the image data pointer}
+ Longint(Data) := Longint(Header.ImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ Trans := Header.ImageAlpha;
+ {$IFDEF Store16bits}
+ Longint(Extra) := Longint(Header.ExtraImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ {$ENDIF}
+ {Reads each line}
+ FOR j := 0 to ImageHeight - 1 do
+ begin
+ {Read this line Row_Buffer[RowUsed][0] if the filter type for this line}
+ if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, EndPos,
+ CRCFile) = 0 then break;
+
+ {Filter the current row}
+ FilterRow;
+ {Copies non interlaced row to image}
+ CopyProc(@Row_Buffer[RowUsed][1], Data, Trans{$IFDEF Store16bits}, Extra
+ {$ENDIF});
+
+ {Invert line used}
+ RowUsed := not RowUsed;
+ dec(Data, Header.BytesPerRow);
+ {$IFDEF Store16bits}dec(Extra, Header.BytesPerRow);{$ENDIF}
+ inc(Trans, ImageWidth);
+ end {for I};
+
+
+end;
+
+{Filter the current line}
+procedure TChunkIDAT.FilterRow;
+var
+ pp: Byte;
+ vv, left, above, aboveleft: Integer;
+ Col: Cardinal;
+begin
+ {Test the filter}
+ case Row_Buffer[RowUsed]^[0] of
+ {No filtering for this line}
+ FILTER_NONE: begin end;
+ {AND 255 serves only to never let the result be larger than one byte}
+ {Sub filter}
+ FILTER_SUB:
+ FOR Col := Offset + 1 to Row_Bytes DO
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ Row_Buffer[RowUsed][Col - Offset]) and 255;
+ {Up filter}
+ FILTER_UP:
+ FOR Col := 1 to Row_Bytes DO
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ Row_Buffer[not RowUsed][Col]) and 255;
+ {Average filter}
+ FILTER_AVERAGE:
+ FOR Col := 1 to Row_Bytes DO
+ begin
+ {Obtains up and left pixels}
+ above := Row_Buffer[not RowUsed][Col];
+ if col - 1 < Offset then
+ left := 0
+ else
+ Left := Row_Buffer[RowUsed][Col - Offset];
+
+ {Calculates}
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ (left + above) div 2) and 255;
+ end;
+ {Paeth filter}
+ FILTER_PAETH:
+ begin
+ {Initialize}
+ left := 0;
+ aboveleft := 0;
+ {Test each byte}
+ FOR Col := 1 to Row_Bytes DO
+ begin
+ {Obtains above pixel}
+ above := Row_Buffer[not RowUsed][Col];
+ {Obtains left and top-left pixels}
+ if (col - 1 >= offset) Then
+ begin
+ left := row_buffer[RowUsed][col - offset];
+ aboveleft := row_buffer[not RowUsed][col - offset];
+ end;
+
+ {Obtains current pixel and paeth predictor}
+ vv := row_buffer[RowUsed][Col];
+ pp := PaethPredictor(left, above, aboveleft);
+
+ {Calculates}
+ Row_Buffer[RowUsed][Col] := (pp + vv) and $FF;
+ end {for};
+ end;
+
+ end {case};
+end;
+
+{Reads the image data from the stream}
+function TChunkIDAT.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+var
+ ZLIBStream: TZStreamRec2;
+ CRCCheck,
+ CRCFile : Cardinal;
+begin
+ {Get pointer to the header chunk}
+ Header := Owner.Chunks.Item[0] as TChunkIHDR;
+ {Build palette if necessary}
+ if Header.HasPalette then PreparePalette();
+
+ {Copy image width and height}
+ ImageWidth := Header.Width;
+ ImageHeight := Header.Height;
+
+ {Initialize to calculate CRC}
+ {$IFDEF CheckCRC}
+ CRCFile := update_crc($ffffffff, @ChunkName[0], 4);
+ {$ENDIF}
+
+ Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
+ ZLIBStream := ZLIBInitInflate(Stream); {Initializes decompression}
+
+ {Calculate ending position for the current IDAT chunk}
+ EndPos := Stream.Position + Size;
+
+ {Allocate memory}
+ GetMem(Row_Buffer[false], Row_Bytes + 1);
+ GetMem(Row_Buffer[true], Row_Bytes + 1);
+ ZeroMemory(Row_Buffer[false], Row_bytes + 1);
+ {Set the variable to alternate the Row_Buffer item to use}
+ RowUsed := TRUE;
+
+ {Call special methods for the different interlace methods}
+ case Owner.InterlaceMethod of
+ imNone: DecodeNonInterlaced(stream, ZLIBStream, Size, crcfile);
+ imAdam7: DecodeInterlacedAdam7(stream, ZLIBStream, size, crcfile);
+ end;
+
+ {Free memory}
+ ZLIBTerminateInflate(ZLIBStream); {Terminates decompression}
+ FreeMem(Row_Buffer[False], Row_Bytes + 1);
+ FreeMem(Row_Buffer[True], Row_Bytes + 1);
+
+ {Now checks CRC}
+ Stream.Read(CRCCheck, 4);
+ {$IFDEF CheckCRC}
+ CRCFile := CRCFile xor $ffffffff;
+ CRCCheck := ByteSwap(CRCCheck);
+ Result := CRCCheck = CRCFile;
+
+ {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;
+
+const
+ IDATHeader: Array[0..3] of char = ('I', 'D', 'A', 'T');
+ BUFFER = 5;
+
+{Saves the IDAT chunk to a stream}
+function TChunkIDAT.SaveToStream(Stream: TStream): Boolean;
+var
+ ZLIBStream : TZStreamRec2;
+begin
+ {Get pointer to the header chunk}
+ Header := Owner.Chunks.Item[0] as TChunkIHDR;
+ {Copy image width and height}
+ ImageWidth := Header.Width;
+ ImageHeight := Header.Height;
+ Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
+
+ {Allocate memory}
+ GetMem(Encode_Buffer[BUFFER], Row_Bytes);
+ ZeroMemory(Encode_Buffer[BUFFER], Row_Bytes);
+ {Allocate buffers for the filters selected}
+ {Filter none will always be calculated to the other filters to work}
+ GetMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ if pfSub in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
+ if pfUp in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_UP], Row_Bytes);
+ if pfAverage in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
+ if pfPaeth in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);
+
+ {Initialize ZLIB}
+ ZLIBStream := ZLIBInitDeflate(Stream, Owner.fCompressionLevel,
+ Owner.MaxIdatSize);
+ {Write data depending on the interlace method}
+ case Owner.InterlaceMethod of
+ imNone: EncodeNonInterlaced(stream, ZLIBStream);
+ imAdam7: EncodeInterlacedAdam7(stream, ZLIBStream);
+ end;
+ {Terminates ZLIB}
+ ZLIBTerminateDeflate(ZLIBStream);
+
+ {Release allocated memory}
+ FreeMem(Encode_Buffer[BUFFER], Row_Bytes);
+ FreeMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ if pfSub in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
+ if pfUp in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_UP], Row_Bytes);
+ if pfAverage in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
+ if pfPaeth in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);
+
+ {Everything went ok}
+ Result := True;
+end;
+
+{Writes the IDAT using the settings}
+procedure WriteIDAT(Stream: TStream; Data: Pointer; const Length: Cardinal);
+var
+ ChunkLen, CRC: Cardinal;
+begin
+ {Writes IDAT header}
+ ChunkLen := ByteSwap(Length);
+ Stream.Write(ChunkLen, 4); {Chunk length}
+ Stream.Write(IDATHeader[0], 4); {Idat header}
+ CRC := update_crc($ffffffff, @IDATHeader[0], 4); {Crc part for header}
+
+ {Writes IDAT data and calculates CRC for data}
+ Stream.Write(Data^, Length);
+ CRC := Byteswap(update_crc(CRC, Data, Length) xor $ffffffff);
+ {Writes final CRC}
+ Stream.Write(CRC, 4);
+end;
+
+{Compress and writes IDAT chunk data}
+procedure TChunkIDAT.IDATZlibWrite(var ZLIBStream: TZStreamRec2;
+ Buffer: Pointer; const Length: Cardinal);
+begin
+ with ZLIBStream, ZLIBStream.ZLIB do
+ begin
+ {Set data to be compressed}
+ next_in := Buffer;
+ avail_in := Length;
+
+ {Compress all the data avaliable to compress}
+ while avail_in > 0 do
+ begin
+ deflate(ZLIB, Z_NO_FLUSH);
+
+ {The whole buffer was used, save data to stream and restore buffer}
+ if avail_out = 0 then
+ begin
+ {Writes this IDAT chunk}
+ WriteIDAT(fStream, Data, Owner.MaxIdatSize);
+
+ {Restore buffer}
+ next_out := Data;
+ avail_out := Owner.MaxIdatSize;
+ end {if avail_out = 0};
+
+ end {while avail_in};
+
+ end {with ZLIBStream, ZLIBStream.ZLIB}
+end;
+
+{Finishes compressing data to write IDAT chunk}
+procedure TChunkIDAT.FinishIDATZlib(var ZLIBStream: TZStreamRec2);
+begin
+ with ZLIBStream, ZLIBStream.ZLIB do
+ begin
+ {Set data to be compressed}
+ next_in := nil;
+ avail_in := 0;
+
+ while deflate(ZLIB,Z_FINISH) <> Z_STREAM_END do
+ begin
+ {Writes this IDAT chunk}
+ WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out);
+ {Re-update buffer}
+ next_out := Data;
+ avail_out := Owner.MaxIdatSize;
+ end;
+
+ if avail_out < Owner.MaxIdatSize then
+ {Writes final IDAT}
+ WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out);
+
+ end {with ZLIBStream, ZLIBStream.ZLIB};
+end;
+
+{Copy memory to encode RGB image with 1 byte for each color sample}
+procedure TChunkIDAT.EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values}
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+end;
+
+{Copy memory to encode RGB images with 16 bits for each color sample}
+procedure TChunkIDAT.EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
+ //for sample
+ {Copy pixel values}
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+
+end;
+
+{Copy memory to encode types using palettes (1, 4 or 8 bits per pixel)}
+procedure TChunkIDAT.EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
+begin
+ {It's simple as copying the data}
+ CopyMemory(Dest, Src, Row_Bytes);
+end;
+
+{Copy memory to encode grayscale images with 2 bytes for each sample}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
+ //for sample
+ pWORD(Dest)^ := pByte(Longint(Src))^; inc(Dest, 2);
+ {Move to next pixel}
+ inc(Src);
+ end {for I}
+end;
+
+{Encode images using RGB followed by an alpha value using 1 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+ inc(Src, 3); inc(Trans);
+ end {for i};
+end;
+
+{Encode images using RGB followed by an alpha value using 2 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest, 2);
+ pWord(Dest)^ := PByte(Longint(Trans) )^; inc(Dest, 2);
+ inc(Src, 3); inc(Trans);
+ end {for i};
+end;
+
+{Encode grayscale images followed by an alpha value using 1 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ Dest^ := Src^; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+ inc(Src); inc(Trans);
+ end {for i};
+end;
+
+{Encode grayscale images followed by an alpha value using 2 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+ inc(Src); inc(Trans);
+ end {for i};
+end;
+
+{Encode non interlaced images}
+procedure TChunkIDAT.EncodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+var
+ {Current line}
+ j: Cardinal;
+ {Pointers to image data}
+ Data, Trans: PChar;
+ {Filter used for this line}
+ Filter: Byte;
+ {Method which will copy the data into the buffer}
+ CopyProc: procedure(Src, Dest, Trans: pChar) of object;
+begin
+ CopyProc := nil; {Initialize to avoid warnings}
+ {Defines the method to copy the data to the buffer depending on}
+ {the image parameters}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedRGB8;
+ 16: CopyProc := EncodeNonInterlacedRGB16;
+ end;
+ {Palette and grayscale values}
+ COLOR_GRAYSCALE, COLOR_PALETTE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := EncodeNonInterlacedPalette148;
+ 16: CopyProc := EncodeNonInterlacedGrayscale16;
+ end;
+ {RGB with a following alpha value}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedRGBAlpha8;
+ 16: CopyProc := EncodeNonInterlacedRGBAlpha16;
+ end;
+ {Grayscale images followed by an alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedGrayscaleAlpha8;
+ 16: CopyProc := EncodeNonInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Get the image data pointer}
+ Longint(Data) := Longint(Header.ImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ Trans := Header.ImageAlpha;
+
+ {Writes each line}
+ FOR j := 0 to ImageHeight - 1 do
+ begin
+ {Copy data into buffer}
+ CopyProc(Data, @Encode_Buffer[BUFFER][0], Trans);
+ {Filter data}
+ Filter := FilterToEncode;
+
+ {Compress data}
+ IDATZlibWrite(ZLIBStream, @Filter, 1);
+ IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
+
+ {Adjust pointers to the actual image data}
+ dec(Data, Header.BytesPerRow);
+ inc(Trans, ImageWidth);
+ end;
+
+ {Compress and finishes copying the remaining data}
+ FinishIDATZlib(ZLIBStream);
+end;
+
+{Copy memory to encode interlaced images using RGB value with 1 byte for}
+{each color sample}
+procedure TChunkIDAT.EncodeInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy memory to encode interlaced RGB images with 2 bytes each color sample}
+procedure TChunkIDAT.EncodeInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy memory to encode interlaced images using palettes using bit depths}
+{1, 4, 8 (each pixel in the image)}
+procedure TChunkIDAT.EncodeInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+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;
+ Src2: PChar;
+begin
+ {Clean the line}
+ fillchar(Dest^, Row_Bytes, #0);
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ with Header.BitmapInfo.bmiHeader do
+ repeat
+ {Copy data}
+ CurBit := StartBit[biBitCount];
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Src2 := pChar(Longint(Src) + (biBitCount * Col) div 8);
+ {Copy data}
+ Byte(Dest^) := Byte(Dest^) or
+ (((Byte(Src2^) shr (StartBit[Header.BitDepth] - (biBitCount * Col)
+ mod 8))) and (BitTable[biBitCount])) shl CurBit;
+
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, biBitCount);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Dest);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced grayscale images using 16 bits for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := Byte(Src^); inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced rgb images followed by an alpha value, all using}
+{one byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced rgb images followed by an alpha value, all using}
+{two byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := pByte(Longint(Src) + 2)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Longint(Src) + 1)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Longint(Src) )^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode grayscale interlaced images followed by an alpha value, all}
+{using 1 byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ Dest^ := Src^; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode grayscale interlaced images followed by an alpha value, all}
+{using 2 bytes for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Encode interlaced images}
+procedure TChunkIDAT.EncodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+var
+ CurrentPass, Filter: Byte;
+ PixelsThisRow: Integer;
+ CurrentRow : Integer;
+ Trans, Data: pChar;
+ CopyProc: procedure(const Pass: Byte;
+ Src, Dest, Trans: pChar) of object;
+begin
+ CopyProc := nil; {Initialize to avoid warnings}
+ {Defines the method to copy the data to the buffer depending on}
+ {the image parameters}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedRGB8;
+ 16: CopyProc := EncodeInterlacedRGB16;
+ end;
+ {Grayscale and palette}
+ COLOR_PALETTE, COLOR_GRAYSCALE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := EncodeInterlacedPalette148;
+ 16: CopyProc := EncodeInterlacedGrayscale16;
+ end;
+ {RGB followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedRGBAlpha8;
+ 16: CopyProc := EncodeInterlacedRGBAlpha16;
+ end;
+ COLOR_GRAYSCALEALPHA:
+ {Grayscale followed by alpha}
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedGrayscaleAlpha8;
+ 16: CopyProc := EncodeInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Compress the image using the seven passes for ADAM 7}
+ FOR CurrentPass := 0 TO 6 DO
+ begin
+ {Calculates the number of pixels and bytes for this pass row}
+ PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
+ ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
+ Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
+ Header.BitDepth);
+ ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
+
+ {Get current row index}
+ CurrentRow := RowStart[CurrentPass];
+ {Get a pointer to the current row image data}
+ Data := Ptr(Longint(Header.ImageData) + Header.BytesPerRow *
+ (ImageHeight - 1 - CurrentRow));
+ Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
+
+ {Process all the image rows}
+ if Row_Bytes > 0 then
+ while CurrentRow < ImageHeight do
+ begin
+ {Copy data into buffer}
+ CopyProc(CurrentPass, Data, @Encode_Buffer[BUFFER][0], Trans);
+ {Filter data}
+ Filter := FilterToEncode;
+
+ {Compress data}
+ IDATZlibWrite(ZLIBStream, @Filter, 1);
+ IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
+
+ {Move to the next row}
+ inc(CurrentRow, RowIncrement[CurrentPass]);
+ {Move pointer to the next line}
+ dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
+ end {while CurrentRow < ImageHeight}
+
+ end {CurrentPass};
+
+ {Compress and finishes copying the remaining data}
+ FinishIDATZlib(ZLIBStream);
+end;
+
+{Filters the row to be encoded and returns the best filter}
+function TChunkIDAT.FilterToEncode: Byte;
+var
+ Run, LongestRun, ii, jj: Cardinal;
+ Last, Above, LastAbove: Byte;
+begin
+ {Selecting more filters using the Filters property from TPngObject}
+ {increases the chances to the file be much smaller, but decreases}
+ {the performace}
+
+ {This method will creates the same line data using the different}
+ {filter methods and select the best}
+
+ {Sub-filter}
+ if pfSub in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {There is no previous pixel when it's on the first pixel, so}
+ {set last as zero when in the first}
+ if (ii >= Offset) then
+ last := Encode_Buffer[BUFFER]^[ii - Offset]
+ else
+ last := 0;
+ Encode_Buffer[FILTER_SUB]^[ii] := Encode_Buffer[BUFFER]^[ii] - last;
+ end;
+
+ {Up filter}
+ if pfUp in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ Encode_Buffer[FILTER_UP]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ Encode_Buffer[FILTER_NONE]^[ii];
+
+ {Average filter}
+ if pfAverage in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {Get the previous pixel, if the current pixel is the first, the}
+ {previous is considered to be 0}
+ if (ii >= Offset) then
+ last := Encode_Buffer[BUFFER]^[ii - Offset]
+ else
+ last := 0;
+ {Get the pixel above}
+ above := Encode_Buffer[FILTER_NONE]^[ii];
+
+ {Calculates formula to the average pixel}
+ Encode_Buffer[FILTER_AVERAGE]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ (above + last) div 2 ;
+ end;
+
+ {Paeth filter (the slower)}
+ if pfPaeth in Owner.Filters then
+ begin
+ {Initialize}
+ last := 0;
+ lastabove := 0;
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {In case this pixel is not the first in the line obtains the}
+ {previous one and the one above the previous}
+ if (ii >= Offset) then
+ begin
+ last := Encode_Buffer[BUFFER]^[ii - Offset];
+ lastabove := Encode_Buffer[FILTER_NONE]^[ii - Offset];
+ end;
+ {Obtains the pixel above}
+ above := Encode_Buffer[FILTER_NONE]^[ii];
+ {Calculate paeth filter for this byte}
+ Encode_Buffer[FILTER_PAETH]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ PaethPredictor(last, above, lastabove);
+ end;
+ end;
+
+ {Now calculates the same line using no filter, which is necessary}
+ {in order to have data to the filters when the next line comes}
+ CopyMemory(@Encode_Buffer[FILTER_NONE]^[0],
+ @Encode_Buffer[BUFFER]^[0], Row_Bytes);
+
+ {If only filter none is selected in the filter list, we don't need}
+ {to proceed and further}
+ if (Owner.Filters = [pfNone]) or (Owner.Filters = []) then
+ begin
+ Result := FILTER_NONE;
+ exit;
+ end {if (Owner.Filters = [pfNone...};
+
+ {Check which filter is the best by checking which has the larger}
+ {sequence of the same byte, since they are best compressed}
+ LongestRun := 0; Result := FILTER_NONE;
+ for ii := FILTER_NONE TO FILTER_PAETH do
+ {Check if this filter was selected}
+ if TFilter(ii) in Owner.Filters then
+ begin
+ Run := 0;
+ {Check if it's the only filter}
+ if Owner.Filters = [TFilter(ii)] then
+ begin
+ Result := ii;
+ exit;
+ end;
+
+ {Check using a sequence of four bytes}
+ for jj := 2 to Row_Bytes - 1 do
+ if (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-1]) or
+ (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-2]) then
+ inc(Run); {Count the number of sequences}
+
+ {Check if this one is the best so far}
+ if (Run > LongestRun) then
+ begin
+ Result := ii;
+ LongestRun := Run;
+ end {if (Run > LongestRun)};
+
+ end {if TFilter(ii) in Owner.Filters};
+end;
+
+{TChunkPLTE implementation}
+
+{Returns an item in the palette}
+function TChunkPLTE.GetPaletteItem(Index: Byte): TRGBQuad;
+begin
+ {Test if item is valid, if not raise error}
+ if Index > Count - 1 then
+ Owner.RaiseError(EPNGError, EPNGUnknownPalEntryText)
+ else
+ {Returns the item}
+ Result := Header.BitmapInfo.bmiColors[Index];
+end;
+
+{Loads the palette chunk from a stream}
+function TChunkPLTE.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+type
+ pPalEntry = ^PalEntry;
+ PalEntry = record
+ r, g, b: Byte;
+ end;
+var
+ j : Integer; {For the FOR}
+ PalColor : pPalEntry;
+ palEntries: TMaxLogPalette;
+begin
+ {Let ancestor load data and check CRC}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then exit;
+
+ {This chunk must be divisible by 3 in order to be valid}
+ if (Size mod 3 <> 0) or (Size div 3 > 256) then
+ begin
+ {Raise error}
+ Result := FALSE;
+ Owner.RaiseError(EPNGInvalidPalette, EPNGInvalidPaletteText);
+ exit;
+ end {if Size mod 3 <> 0};
+
+ {Fill array with the palette entries}
+ fCount := Size div 3;
+ Fillchar(palEntries, sizeof(palEntries), #0);
+ palEntries.palVersion := $300;
+ palEntries.palNumEntries := fCount;
+ PalColor := Data;
+ FOR j := 0 TO fCount - 1 DO
+ with palEntries.palPalEntry[j] do
+ begin
+ peRed := Owner.GammaTable[PalColor.r];
+ peGreen := Owner.GammaTable[PalColor.g];
+ peBlue := Owner.GammaTable[PalColor.b];
+ peFlags := 0;
+ {Move to next palette entry}
+ inc(PalColor);
+ end;
+ Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^));
+end;
+
+{Saves the PLTE chunk to a stream}
+function TChunkPLTE.SaveToStream(Stream: TStream): Boolean;
+var
+ J: Integer;
+ DataPtr: pByte;
+ BitmapInfo: TMAXBITMAPINFO;
+ palEntries: TMaxLogPalette;
+begin
+ {Adjust size to hold all the palette items}
+ if fCount = 0 then fCount := Header.BitmapInfo.bmiHeader.biClrUsed;
+ ResizeData(fCount * 3);
+ {Get all the palette entries}
+ fillchar(palEntries, sizeof(palEntries), #0);
+ GetPaletteEntries(Header.ImagePalette, 0, 256, palEntries.palPalEntry[0]);
+ {Copy pointer to data}
+ DataPtr := fData;
+
+ {Copy palette items}
+ BitmapInfo := Header.BitmapInfo;
+ FOR j := 0 TO fCount - 1 DO
+ with palEntries.palPalEntry[j] do
+ begin
+ DataPtr^ := Owner.InverseGamma[peRed]; inc(DataPtr);
+ DataPtr^ := Owner.InverseGamma[peGreen]; inc(DataPtr);
+ DataPtr^ := Owner.InverseGamma[peBlue]; inc(DataPtr);
+ end {with BitmapInfo};
+
+ {Let ancestor do the rest of the work}
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Assigns from another PLTE chunk}
+procedure TChunkPLTE.Assign(Source: TChunk);
+begin
+ {Copy the number of palette items}
+ if Source is TChunkPLTE then
+ fCount := TChunkPLTE(Source).fCount
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{TChunkgAMA implementation}
+
+{Assigns from another chunk}
+procedure TChunkgAMA.Assign(Source: TChunk);
+begin
+ {Copy the gamma value}
+ if Source is TChunkgAMA then
+ Gamma := TChunkgAMA(Source).Gamma
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{Gamma chunk being created}
+constructor TChunkgAMA.Create(Owner: TPngObject);
+begin
+ {Call ancestor}
+ inherited Create(Owner);
+ Gamma := 1; {Initial value}
+end;
+
+{Returns gamma value}
+function TChunkgAMA.GetValue: Cardinal;
+begin
+ {Make sure that the size is four bytes}
+ if DataSize <> 4 then
+ begin
+ {Adjust size and returns 1}
+ ResizeData(4);
+ Result := 1;
+ end
+ {If it's right, read the value}
+ else Result := Cardinal(ByteSwap(pCardinal(Data)^))
+end;
+
+function Power(Base, Exponent: Extended): Extended;
+begin
+ if Exponent = 0.0 then
+ Result := 1.0 {Math rule}
+ else if (Base = 0) or (Exponent = 0) then Result := 0
+ else
+ Result := Exp(Exponent * Ln(Base));
+end;
+
+{Loading the chunk from a stream}
+function TChunkgAMA.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+var
+ i: Integer;
+ Value: Cardinal;
+begin
+ {Call ancestor and test if it went ok}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then exit;
+ Value := Gamma;
+ {Build gamma table and inverse table for saving}
+ if Value <> 0 then
+ with Owner do
+ FOR i := 0 TO 255 DO
+ begin
+ GammaTable[I] := Round(Power((I / 255), 1 /
+ (Value / 100000 * 2.2)) * 255);
+ InverseGamma[Round(Power((I / 255), 1 /
+ (Value / 100000 * 2.2)) * 255)] := I;
+ end
+end;
+
+{Sets the gamma value}
+procedure TChunkgAMA.SetValue(const Value: Cardinal);
+begin
+ {Make sure that the size is four bytes}
+ if DataSize <> 4 then ResizeData(4);
+ {If it's right, set the value}
+ pCardinal(Data)^ := ByteSwap(Value);
+end;
+
+{TPngObject implementation}
+
+{Assigns from another object}
+procedure TPngObject.Assign(Source: TPersistent);
+begin
+ {Being cleared}
+ if Source = nil then
+ ClearChunks
+ {Assigns contents from another TPNGObject}
+ else if Source is TPNGObject then
+ AssignPNG(Source as TPNGObject)
+ {Copy contents from a TBitmap}
+ {$IFDEF UseDelphi}else if Source is TBitmap then
+ with Source as TBitmap do
+ AssignHandle(Handle, Transparent,
+ ColorToRGB(TransparentColor)){$ENDIF}
+ {Unknown source, let ancestor deal with it}
+ else
+ inherited;
+end;
+
+{Clear all the chunks in the list}
+procedure TPngObject.ClearChunks;
+var
+ i: Integer;
+begin
+ {Initialize gamma}
+ InitializeGamma();
+ {Free all the objects and memory (0 chunks Bug fixed by Noel Sharpe)}
+ for i := 0 TO Integer(Chunks.Count) - 1 do
+ TChunk(Chunks.Item[i]).Free;
+ Chunks.Count := 0;
+end;
+
+{Portable Network Graphics object being created as a blank image}
+constructor TPNGObject.CreateBlank(ColorType, BitDepth: Cardinal;
+ cx, cy: Integer);
+var NewIHDR: TChunkIHDR;
+begin
+ {Calls creator}
+ Create;
+ {Checks if the parameters are ok}
+ if not (ColorType in [COLOR_GRAYSCALE, COLOR_RGB, COLOR_PALETTE,
+ COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA]) or not (BitDepth in
+ [1,2,4,8, 16]) or ((ColorType = COLOR_PALETTE) and (BitDepth = 16)) or
+ ((ColorType = COLOR_RGB) and (BitDepth < 8)) then
+ begin
+ RaiseError(EPNGInvalidSpec, EInvalidSpec);
+ exit;
+ end;
+ if Bitdepth = 2 then Bitdepth := 4;
+
+ {Add the basis chunks}
+ InitializeGamma;
+ BeingCreated := True;
+ Chunks.Add(TChunkIEND);
+ NewIHDR := Chunks.Add(TChunkIHDR) as TChunkIHDR;
+ NewIHDR.IHDRData.ColorType := ColorType;
+ NewIHDR.IHDRData.BitDepth := BitDepth;
+ NewIHDR.IHDRData.Width := cx;
+ NewIHDR.IHDRData.Height := cy;
+ NewIHDR.PrepareImageData;
+ if NewIHDR.HasPalette then
+ TChunkPLTE(Chunks.Add(TChunkPLTE)).fCount := 1 shl BitDepth;
+ Chunks.Add(TChunkIDAT);
+ BeingCreated := False;
+end;
+
+{Portable Network Graphics object being created}
+constructor TPngObject.Create;
+begin
+ {Let it be created}
+ inherited Create;
+
+ {Initial properties}
+ {$IFDEF UseDelphi}fCanvas := TCanvas.Create;{$ENDIF}
+ fFilters := [pfSub];
+ fCompressionLevel := 7;
+ fInterlaceMethod := imNone;
+ fMaxIdatSize := High(Word);
+ {Create chunklist object}
+ fChunkList := TPngList.Create(Self);
+
+end;
+
+{Portable Network Graphics object being destroyed}
+destructor TPngObject.Destroy;
+begin
+ {Free object list}
+ ClearChunks;
+ fChunkList.Free;
+ {$IFDEF UseDelphi}if fCanvas <> nil then
+ fCanvas.Free;{$ENDIF}
+
+ {Call ancestor destroy}
+ inherited Destroy;
+end;
+
+{Returns linesize and byte offset for pixels}
+procedure TPngObject.GetPixelInfo(var LineSize, Offset: Cardinal);
+begin
+ {There must be an Header chunk to calculate size}
+ if HeaderPresent then
+ begin
+ {Calculate number of bytes for each line}
+ LineSize := BytesForPixels(Header.Width, Header.ColorType, Header.BitDepth);
+
+ {Calculates byte offset}
+ Case Header.ColorType of
+ {Grayscale}
+ COLOR_GRAYSCALE:
+ If Header.BitDepth = 16 Then
+ Offset := 2
+ Else
+ Offset := 1 ;
+ {It always smaller or equal one byte, so it occupes one byte}
+ COLOR_PALETTE:
+ offset := 1;
+ {It might be 3 or 6 bytes}
+ COLOR_RGB:
+ offset := 3 * Header.BitDepth Div 8;
+ {It might be 2 or 4 bytes}
+ COLOR_GRAYSCALEALPHA:
+ offset := 2 * Header.BitDepth Div 8;
+ {4 or 8 bytes}
+ COLOR_RGBALPHA:
+ offset := 4 * Header.BitDepth Div 8;
+ else
+ Offset := 0;
+ End ;
+
+ end
+ else
+ begin
+ {In case if there isn't any Header chunk}
+ Offset := 0;
+ LineSize := 0;
+ end;
+
+end;
+
+{Returns image height}
+function TPngObject.GetHeight: Integer;
+begin
+ {There must be a Header chunk to get the size, otherwise returns 0}
+ if HeaderPresent then
+ Result := TChunkIHDR(Chunks.Item[0]).Height
+ else Result := 0;
+end;
+
+{Returns image width}
+function TPngObject.GetWidth: Integer;
+begin
+ {There must be a Header chunk to get the size, otherwise returns 0}
+ if HeaderPresent then
+ Result := Header.Width
+ else Result := 0;
+end;
+
+{Returns if the image is empty}
+function TPngObject.GetEmpty: Boolean;
+begin
+ Result := (Chunks.Count = 0);
+end;
+
+{Raises an error}
+procedure TPngObject.RaiseError(ExceptionClass: ExceptClass; Text: String);
+begin
+ raise ExceptionClass.Create(Text);
+end;
+
+{Set the maximum size for IDAT chunk}
+procedure TPngObject.SetMaxIdatSize(const Value: Integer);
+begin
+ {Make sure the size is at least 65535}
+ if Value < High(Word) then
+ fMaxIdatSize := High(Word) else fMaxIdatSize := Value;
+end;
+
+{Draws the image using pixel information from TChunkpHYs}
+procedure TPNGObject.DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint);
+ function Rect(Left, Top, Right, Bottom: Integer): TRect;
+ begin
+ Result.Left := Left;
+ Result.Top := Top;
+ Result.Right := Right;
+ Result.Bottom := Bottom;
+ end;
+var
+ PPMeterY, PPMeterX: Double;
+ NewSizeX, NewSizeY: Integer;
+ DC: HDC;
+begin
+ {Get system information}
+ DC := GetDC(0);
+ PPMeterY := GetDeviceCaps(DC, LOGPIXELSY) / 0.0254;
+ PPMeterX := GetDeviceCaps(DC, LOGPIXELSX) / 0.0254;
+ ReleaseDC(0, DC);
+
+ {In case it does not has pixel information}
+ if not HasPixelInformation then
+ Draw(Canvas, Rect(Point.X, Point.Y, Point.X + Width,
+ Point.Y + Height))
+ else
+ with PixelInformation do
+ begin
+ NewSizeX := Trunc(Self.Width / (PPUnitX / PPMeterX));
+ NewSizeY := Trunc(Self.Height / (PPUnitY / PPMeterY));
+ Draw(Canvas, Rect(Point.X, Point.Y, Point.X + NewSizeX,
+ Point.Y + NewSizeY));
+ end;
+end;
+
+{$IFNDEF UseDelphi}
+ {Creates a file stream reading from the filename in the parameter and load}
+ procedure TPngObject.LoadFromFile(const Filename: String);
+ var
+ FileStream: TFileStream;
+ begin
+ {Test if the file exists}
+ if not FileExists(Filename) then
+ begin
+ {In case it does not exists, raise error}
+ RaiseError(EPNGNotExists, EPNGNotExistsText);
+ exit;
+ end;
+
+ {Creates the file stream to read}
+ FileStream := TFileStream.Create(Filename, [fsmRead]);
+ LoadFromStream(FileStream); {Loads the data}
+ FileStream.Free; {Free file stream}
+ end;
+
+ {Saves the current png image to a file}
+ procedure TPngObject.SaveToFile(const Filename: String);
+ var
+ FileStream: TFileStream;
+ begin
+ {Creates the file stream to write}
+ FileStream := TFileStream.Create(Filename, [fsmWrite]);
+ SaveToStream(FileStream); {Saves the data}
+ FileStream.Free; {Free file stream}
+ end;
+
+{$ENDIF}
+
+{Returns if it has the pixel information chunk}
+function TPngObject.HasPixelInformation: Boolean;
+begin
+ Result := (Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs) <> nil;
+end;
+
+{Returns the pixel information chunk}
+function TPngObject.GetPixelInformation: TChunkpHYs;
+begin
+ Result := Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs;
+ if not Assigned(Result) then
+ begin
+ Result := Chunks.Add(tChunkpHYs) as tChunkpHYs;
+ Result.fUnit := utMeter;
+ end;
+end;
+
+{Returns pointer to the chunk TChunkIHDR which should be the first}
+function TPngObject.GetHeader: TChunkIHDR;
+begin
+ {If there is a TChunkIHDR returns it, otherwise returns nil}
+ if (Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR) then
+ Result := Chunks.Item[0] as TChunkIHDR
+ else
+ begin
+ {No header, throw error message}
+ RaiseError(EPNGHeaderNotPresent, EPNGHeaderNotPresentText);
+ Result := nil
+ end
+end;
+
+{Draws using partial transparency}
+procedure TPngObject.DrawPartialTrans(DC: HDC; Rect: TRect);
+ {Adjust the rectangle structure}
+ procedure AdjustRect(var Rect: TRect);
+ var
+ t: Integer;
+ begin
+ if Rect.Right < Rect.Left then
+ begin
+ t := Rect.Right;
+ Rect.Right := Rect.Left;
+ Rect.Left := t;
+ end;
+ if Rect.Bottom < Rect.Top then
+ begin
+ t := Rect.Bottom;
+ Rect.Bottom := Rect.Top;
+ Rect.Top := t;
+ end
+ end;
+
+type
+ {Access to pixels}
+ TPixelLine = Array[Word] of TRGBQuad;
+ pPixelLine = ^TPixelLine;
+const
+ {Structure used to create the bitmap}
+ BitmapInfoHeader: TBitmapInfoHeader =
+ (biSize: sizeof(TBitmapInfoHeader);
+ biWidth: 100;
+ biHeight: 100;
+ biPlanes: 1;
+ biBitCount: 32;
+ biCompression: BI_RGB;
+ biSizeImage: 0;
+ biXPelsPerMeter: 0;
+ biYPelsPerMeter: 0;
+ biClrUsed: 0;
+ biClrImportant: 0);
+var
+ {Buffer bitmap creation}
+ BitmapInfo : TBitmapInfo;
+ BufferDC : HDC;
+ BufferBits : Pointer;
+ OldBitmap,
+ BufferBitmap: HBitmap;
+ Header: TChunkIHDR;
+
+ {Transparency/palette chunks}
+ TransparencyChunk: TChunktRNS;
+ PaletteChunk: TChunkPLTE;
+ TransValue, PaletteIndex: Byte;
+ CurBit: Integer;
+ Data: PByte;
+
+ {Buffer bitmap modification}
+ BytesPerRowDest,
+ BytesPerRowSrc,
+ BytesPerRowAlpha: Integer;
+ ImageSource, ImageSourceOrg,
+ AlphaSource : pByteArray;
+ ImageData : pPixelLine;
+ i, j, i2, j2 : Integer;
+
+ {For bitmap stretching}
+ W, H : Cardinal;
+ Stretch : Boolean;
+ FactorX, FactorY: Double;
+begin
+ {Prepares the rectangle structure to stretch draw}
+ if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then exit;
+ AdjustRect(Rect);
+ {Gets the width and height}
+ W := Rect.Right - Rect.Left;
+ H := Rect.Bottom - Rect.Top;
+ Header := Self.Header; {Fast access to header}
+ Stretch := (W <> Header.Width) or (H <> Header.Height);
+ if Stretch then FactorX := W / Header.Width else FactorX := 1;
+ if Stretch then FactorY := H / Header.Height else FactorY := 1;
+
+ {Prepare to create the bitmap}
+ Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
+ BitmapInfoHeader.biWidth := W;
+ BitmapInfoHeader.biHeight := -Integer(H);
+ BitmapInfo.bmiHeader := BitmapInfoHeader;
+
+ {Create the bitmap which will receive the background, the applied}
+ {alpha blending and then will be painted on the background}
+ BufferDC := CreateCompatibleDC(0);
+ {In case BufferDC could not be created}
+ if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);
+ BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS,
+ BufferBits, 0, 0);
+ {In case buffer bitmap could not be created}
+ if (BufferBitmap = 0) or (BufferBits = Nil) then
+ begin
+ if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
+ DeleteDC(BufferDC);
+ RaiseError(EPNGOutMemory, EPNGOutMemoryText);
+ end;
+
+ {Selects new bitmap and release old bitmap}
+ OldBitmap := SelectObject(BufferDC, BufferBitmap);
+
+ {Draws the background on the buffer image}
+ BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY);
+
+ {Obtain number of bytes for each row}
+ BytesPerRowAlpha := Header.Width;
+ BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * W) + 31)
+ and not 31) div 8; {Number of bytes for each image row in destination}
+ BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
+ 31) and not 31) div 8; {Number of bytes for each image row in source}
+
+ {Obtains image pointers}
+ ImageData := BufferBits;
+ AlphaSource := Header.ImageAlpha;
+ Longint(ImageSource) := Longint(Header.ImageData) +
+ Header.BytesPerRow * Longint(Header.Height - 1);
+ ImageSourceOrg := ImageSource;
+
+ case Header.BitmapInfo.bmiHeader.biBitCount of
+ {R, G, B images}
+ 24:
+ FOR j := 1 TO H DO
+ begin
+ {Process all the pixels in this line}
+ FOR i := 0 TO W - 1 DO
+ begin
+ if Stretch then i2 := trunc(i / FactorX) else i2 := i;
+ {Optmize when we don´t have transparency}
+ if (AlphaSource[i2] <> 0) then
+ if (AlphaSource[i2] = 255) then
+ ImageData[i] := pRGBQuad(@ImageSource[i2 * 3])^
+ else
+ with ImageData[i] do
+ begin
+ rgbRed := (255+ImageSource[2+i2*3] * AlphaSource[i2] + rgbRed *
+ (not AlphaSource[i2])) shr 8;
+ rgbGreen := (255+ImageSource[1+i2*3] * AlphaSource[i2] +
+ rgbGreen * (not AlphaSource[i2])) shr 8;
+ rgbBlue := (255+ImageSource[i2*3] * AlphaSource[i2] + rgbBlue *
+ (not AlphaSource[i2])) shr 8;
+ end;
+ end;
+
+ {Move pointers}
+ inc(Longint(ImageData), BytesPerRowDest);
+ if Stretch then j2 := trunc(j / FactorY) else j2 := j;
+ Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
+ Longint(AlphaSource) := Longint(Header.ImageAlpha) +
+ BytesPerRowAlpha * j2;
+ end;
+ {Palette images with 1 byte for each pixel}
+ 1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
+ FOR j := 1 TO H DO
+ begin
+ {Process all the pixels in this line}
+ FOR i := 0 TO W - 1 DO
+ with ImageData[i], Header.BitmapInfo do begin
+ if Stretch then i2 := trunc(i / FactorX) else i2 := i;
+ rgbRed := (255 + ImageSource[i2] * AlphaSource[i2] +
+ rgbRed * (255 - AlphaSource[i2])) shr 8;
+ rgbGreen := (255 + ImageSource[i2] * AlphaSource[i2] +
+ rgbGreen * (255 - AlphaSource[i2])) shr 8;
+ rgbBlue := (255 + ImageSource[i2] * AlphaSource[i2] +
+ rgbBlue * (255 - AlphaSource[i2])) shr 8;
+ end;
+
+ {Move pointers}
+ Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
+ if Stretch then j2 := trunc(j / FactorY) else j2 := j;
+ Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
+ Longint(AlphaSource) := Longint(Header.ImageAlpha) +
+ BytesPerRowAlpha * j2;
+ end
+ else {Palette images}
+ begin
+ {Obtain pointer to the transparency chunk}
+ TransparencyChunk := TChunktRNS(Chunks.ItemFromClass(TChunktRNS));
+ PaletteChunk := TChunkPLTE(Chunks.ItemFromClass(TChunkPLTE));
+
+ FOR j := 1 TO H DO
+ begin
+ {Process all the pixels in this line}
+ i := 0;
+ repeat
+ CurBit := 0;
+ if Stretch then i2 := trunc(i / FactorX) else i2 := i;
+ Data := @ImageSource[i2];
+
+ repeat
+ {Obtains the palette index}
+ case Header.BitDepth of
+ 1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
+ 2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
+ else PaletteIndex := Data^;
+ end;
+
+ {Updates the image with the new pixel}
+ with ImageData[i] do
+ begin
+ TransValue := TransparencyChunk.PaletteValues[PaletteIndex];
+ rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed *
+ TransValue + rgbRed * (255 - TransValue)) shr 8;
+ rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen *
+ TransValue + rgbGreen * (255 - TransValue)) shr 8;
+ rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue *
+ TransValue + rgbBlue * (255 - TransValue)) shr 8;
+ end;
+
+ {Move to next data}
+ inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount);
+ until CurBit >= 8;
+ {Move to next source data}
+ //inc(Data);
+ until i >= Integer(W);
+
+ {Move pointers}
+ Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
+ if Stretch then j2 := trunc(j / FactorY) else j2 := j;
+ Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
+ end
+ end {Palette images}
+ end {case Header.BitmapInfo.bmiHeader.biBitCount};
+
+ {Draws the new bitmap on the foreground}
+ BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY);
+
+ {Free bitmap}
+ SelectObject(BufferDC, OldBitmap);
+ DeleteObject(BufferBitmap);
+ DeleteDC(BufferDC);
+end;
+
+{Draws the image into a canvas}
+procedure TPngObject.Draw(ACanvas: TCanvas; const Rect: TRect);
+var
+ Header: TChunkIHDR;
+begin
+ {Quit in case there is no header, otherwise obtain it}
+ if Empty then Exit;
+ Header := Chunks.GetItem(0) as TChunkIHDR;
+
+ {Copy the data to the canvas}
+ case Self.TransparencyMode of
+ {$IFDEF PartialTransparentDraw}
+ ptmPartial:
+ DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect);
+ {$ENDIF}
+ ptmBit: DrawTransparentBitmap(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF},
+ Header.ImageData, Header.BitmapInfo.bmiHeader,
+ pBitmapInfo(@Header.BitmapInfo), Rect,
+ {$IFDEF UseDelphi}ColorToRGB({$ENDIF}TransparentColor)
+ {$IFDEF UseDelphi}){$ENDIF}
+ else
+ begin
+ SetStretchBltMode(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, COLORONCOLOR);
+ StretchDiBits(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect.Left,
+ Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0,
+ Header.Width, Header.Height, Header.ImageData,
+ pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)
+ end
+ end {case}
+end;
+
+{Characters for the header}
+const
+ PngHeader: Array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10);
+
+{Loads the image from a stream of data}
+procedure TPngObject.LoadFromStream(Stream: TStream);
+var
+ Header : Array[0..7] of Char;
+ HasIDAT : Boolean;
+
+ {Chunks reading}
+ ChunkCount : Cardinal;
+ ChunkLength: Cardinal;
+ ChunkName : TChunkName;
+begin
+ {Initialize before start loading chunks}
+ ChunkCount := 0;
+ ClearChunks();
+ {Reads the header}
+ Stream.Read(Header[0], 8);
+
+ {Test if the header matches}
+ if Header <> PngHeader then
+ begin
+ RaiseError(EPNGInvalidFileHeader, EPNGInvalidFileHeaderText);
+ Exit;
+ end;
+
+
+ HasIDAT := FALSE;
+ Chunks.Count := 10;
+
+ {Load chunks}
+ repeat
+ inc(ChunkCount); {Increment number of chunks}
+ if Chunks.Count < ChunkCount then {Resize the chunks list if needed}
+ Chunks.Count := Chunks.Count + 10;
+
+ {Reads chunk length and invert since it is in network order}
+ {also checks the Read method return, if it returns 0, it}
+ {means that no bytes was readed, probably because it reached}
+ {the end of the file}
+ if Stream.Read(ChunkLength, 4) = 0 then
+ begin
+ {In case it found the end of the file here}
+ Chunks.Count := ChunkCount - 1;
+ RaiseError(EPNGUnexpectedEnd, EPNGUnexpectedEndText);
+ end;
+
+ ChunkLength := ByteSwap(ChunkLength);
+ {Reads chunk name}
+ Stream.Read(Chunkname, 4);
+
+ {Here we check if the first chunk is the Header which is necessary}
+ {to the file in order to be a valid Portable Network Graphics image}
+ if (ChunkCount = 1) and (ChunkName <> 'IHDR') then
+ begin
+ Chunks.Count := ChunkCount - 1;
+ RaiseError(EPNGIHDRNotFirst, EPNGIHDRNotFirstText);
+ exit;
+ end;
+
+ {Has a previous IDAT}
+ if (HasIDAT and (ChunkName = 'IDAT')) or (ChunkName = 'cHRM') then
+ begin
+ dec(ChunkCount);
+ Stream.Seek(ChunkLength + 4, soFromCurrent);
+ Continue;
+ end;
+ {Tell it has an IDAT chunk}
+ if ChunkName = 'IDAT' then HasIDAT := TRUE;
+
+ {Creates object for this chunk}
+ Chunks.SetItem(ChunkCount - 1, CreateClassChunk(Self, ChunkName));
+
+ {Check if the chunk is critical and unknown}
+ {$IFDEF ErrorOnUnknownCritical}
+ if (TChunk(Chunks.Item[ChunkCount - 1]).ClassType = TChunk) and
+ ((Byte(ChunkName[0]) AND $20) = 0) and (ChunkName <> '') then
+ begin
+ Chunks.Count := ChunkCount;
+ RaiseError(EPNGUnknownCriticalChunk, EPNGUnknownCriticalChunkText);
+ end;
+ {$ENDIF}
+
+ {Loads it}
+ try if not TChunk(Chunks.Item[ChunkCount - 1]).LoadFromStream(Stream,
+ ChunkName, ChunkLength) then break;
+ except
+ Chunks.Count := ChunkCount;
+ raise;
+ end;
+
+ {Terminates when it reaches the IEND chunk}
+ until (ChunkName = 'IEND');
+
+ {Resize the list to the appropriate size}
+ Chunks.Count := ChunkCount;
+
+ {Check if there is data}
+ if not HasIDAT then
+ RaiseError(EPNGNoImageData, EPNGNoImageDataText);
+end;
+
+{Changing height is not supported}
+procedure TPngObject.SetHeight(Value: Integer);
+begin
+ Resize(Width, Value)
+end;
+
+{Changing width is not supported}
+procedure TPngObject.SetWidth(Value: Integer);
+begin
+ Resize(Value, Height)
+end;
+
+{$IFDEF UseDelphi}
+{Saves to clipboard format (thanks to Antoine Pottern)}
+procedure TPNGObject.SaveToClipboardFormat(var AFormat: Word;
+ var AData: THandle; var APalette: HPalette);
+begin
+ with TBitmap.Create do
+ try
+ Width := Self.Width;
+ Height := Self.Height;
+ Self.Draw(Canvas, Rect(0, 0, Width, Height));
+ SaveToClipboardFormat(AFormat, AData, APalette);
+ finally
+ Free;
+ end {try}
+end;
+
+{Loads data from clipboard}
+procedure TPngObject.LoadFromClipboardFormat(AFormat: Word;
+ AData: THandle; APalette: HPalette);
+begin
+ with TBitmap.Create do
+ try
+ LoadFromClipboardFormat(AFormat, AData, APalette);
+ Self.AssignHandle(Handle, False, 0);
+ finally
+ Free;
+ end {try}
+end;
+
+{Returns if the image is transparent}
+function TPngObject.GetTransparent: Boolean;
+begin
+ Result := (TransparencyMode <> ptmNone);
+end;
+
+{$ENDIF}
+
+{Saving the PNG image to a stream of data}
+procedure TPngObject.SaveToStream(Stream: TStream);
+var
+ j: Integer;
+begin
+ {Reads the header}
+ Stream.Write(PNGHeader[0], 8);
+ {Write each chunk}
+ FOR j := 0 TO Chunks.Count - 1 DO
+ Chunks.Item[j].SaveToStream(Stream)
+end;
+
+{Prepares the Header chunk}
+procedure BuildHeader(Header: TChunkIHDR; Handle: HBitmap; Info: pBitmap);
+var
+ DC: HDC;
+begin
+ {Set width and height}
+ Header.Width := Info.bmWidth;
+ Header.Height := abs(Info.bmHeight);
+ {Set bit depth}
+ if Info.bmBitsPixel >= 16 then
+ Header.BitDepth := 8 else Header.BitDepth := Info.bmBitsPixel;
+ {Set color type}
+ if Info.bmBitsPixel >= 16 then
+ Header.ColorType := COLOR_RGB else Header.ColorType := COLOR_PALETTE;
+ {Set other info}
+ Header.CompressionMethod := 0; {deflate/inflate}
+ Header.InterlaceMethod := 0; {no interlace}
+
+ {Prepares bitmap headers to hold data}
+ Header.PrepareImageData();
+ {Copy image data}
+ DC := CreateCompatibleDC(0);
+ GetDIBits(DC, Handle, 0, Header.Height, Header.ImageData,
+ pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
+
+ DeleteDC(DC);
+end;
+
+{Loads the image from a resource}
+procedure TPngObject.LoadFromResourceName(Instance: HInst;
+ const Name: String);
+var
+ ResStream: TResourceStream;
+begin
+ {Creates an especial stream to load from the resource}
+ try ResStream := TResourceStream.Create(Instance, Name, RT_RCDATA);
+ except RaiseError(EPNGCouldNotLoadResource, EPNGCouldNotLoadResourceText);
+ exit; end;
+
+ {Loads the png image from the resource}
+ try
+ LoadFromStream(ResStream);
+ finally
+ ResStream.Free;
+ end;
+end;
+
+{Loads the png from a resource ID}
+procedure TPngObject.LoadFromResourceID(Instance: HInst; ResID: Integer);
+begin
+ LoadFromResourceName(Instance, String(ResID));
+end;
+
+{Assigns this tpngobject to another object}
+procedure TPngObject.AssignTo(Dest: TPersistent);
+{$IFDEF UseDelphi}
+ function DetectPixelFormat: TPixelFormat;
+ begin
+ with Header do
+ begin
+ {Always use 24bits for partial transparency}
+ if TransparencyMode = ptmPartial then
+ DetectPixelFormat := pf24bit
+ else
+ case BitDepth of
+ {Only supported by COLOR_PALETTE}
+ 1: DetectPixelFormat := pf1bit;
+ 2, 4: DetectPixelFormat := pf4bit;
+ {8 may be palette or r, g, b values}
+ 8, 16:
+ case ColorType of
+ COLOR_RGB, COLOR_GRAYSCALE: DetectPixelFormat := pf24bit;
+ COLOR_PALETTE: DetectPixelFormat := pf8bit;
+ else raise Exception.Create('');
+ end {case ColorFormat of}
+ else raise Exception.Create('');
+ end {case BitDepth of}
+ end {with Header}
+ end;
+var
+ TRNS: TChunkTRNS;
+{$ENDIF}
+begin
+ {If the destination is also a TPNGObject make it assign}
+ {this one}
+ if Dest is TPNGObject then
+ TPNGObject(Dest).AssignPNG(Self)
+ {$IFDEF UseDelphi}
+ {In case the destination is a bitmap}
+ else if (Dest is TBitmap) and HeaderPresent then
+ begin
+ {Copies the handle using CopyImage API}
+ TBitmap(Dest).PixelFormat := DetectPixelFormat;
+ TBitmap(Dest).Width := Width;
+ TBitmap(Dest).Height := Height;
+ TBitmap(Dest).Canvas.Draw(0, 0, Self);
+
+ {Copy transparency mode}
+ if (TransparencyMode = ptmBit) then
+ begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ TBitmap(Dest).TransparentColor := TRNS.TransparentColor;
+ TBitmap(Dest).Transparent := True
+ end {if (TransparencyMode = ptmBit)}
+
+ end
+ else
+ {Unknown destination kind}
+ inherited AssignTo(Dest);
+ {$ENDIF}
+end;
+
+{Assigns from a bitmap object}
+procedure TPngObject.AssignHandle(Handle: HBitmap; Transparent: Boolean;
+ TransparentColor: ColorRef);
+var
+ BitmapInfo: Windows.TBitmap;
+ {Chunks}
+ Header: TChunkIHDR;
+ PLTE: TChunkPLTE;
+ IDAT: TChunkIDAT;
+ IEND: TChunkIEND;
+ TRNS: TChunkTRNS;
+ i: Integer;
+ palEntries : TMaxLogPalette;
+begin
+ {Obtain bitmap info}
+ GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo);
+
+ {Clear old chunks and prepare}
+ ClearChunks();
+
+ {Create the chunks}
+ Header := TChunkIHDR.Create(Self);
+
+ {This method will fill the Header chunk with bitmap information}
+ {and copy the image data}
+ BuildHeader(Header, Handle, @BitmapInfo);
+
+ if Header.HasPalette then PLTE := TChunkPLTE.Create(Self) else PLTE := nil;
+ if Transparent then TRNS := TChunkTRNS.Create(Self) else TRNS := nil;
+ IDAT := TChunkIDAT.Create(Self);
+ IEND := TChunkIEND.Create(Self);
+
+ {Add chunks}
+ TPNGPointerList(Chunks).Add(Header);
+ if Header.HasPalette then TPNGPointerList(Chunks).Add(PLTE);
+ if Transparent then TPNGPointerList(Chunks).Add(TRNS);
+ TPNGPointerList(Chunks).Add(IDAT);
+ TPNGPointerList(Chunks).Add(IEND);
+
+ {In case there is a image data, set the PLTE chunk fCount variable}
+ {to the actual number of palette colors which is 2^(Bits for each pixel)}
+ if Header.HasPalette then
+ begin
+ PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
+
+ {Create and set palette}
+ fillchar(palEntries, sizeof(palEntries), 0);
+ palEntries.palVersion := $300;
+ palEntries.palNumEntries := 1 shl BitmapInfo.bmBitsPixel;
+ for i := 0 to palEntries.palNumEntries - 1 do
+ begin
+ palEntries.palPalEntry[i].peRed := Header.BitmapInfo.bmiColors[i].rgbRed;
+ palEntries.palPalEntry[i].peGreen := Header.BitmapInfo.bmiColors[i].rgbGreen;
+ palEntries.palPalEntry[i].peBlue := Header.BitmapInfo.bmiColors[i].rgbBlue;
+ end;
+ DoSetPalette(CreatePalette(pLogPalette(@palEntries)^), false);
+ end;
+
+ {In case it is a transparent bitmap, prepares it}
+ if Transparent then TRNS.TransparentColor := TransparentColor;
+end;
+
+{Assigns from another PNG}
+procedure TPngObject.AssignPNG(Source: TPNGObject);
+var
+ J: Integer;
+begin
+ {Copy properties}
+ InterlaceMethod := Source.InterlaceMethod;
+ MaxIdatSize := Source.MaxIdatSize;
+ CompressionLevel := Source.CompressionLevel;
+ Filters := Source.Filters;
+
+ {Clear old chunks and prepare}
+ ClearChunks();
+ Chunks.Count := Source.Chunks.Count;
+ {Create chunks and makes a copy from the source}
+ FOR J := 0 TO Chunks.Count - 1 DO
+ with Source.Chunks do
+ begin
+ Chunks.SetItem(J, TChunkClass(TChunk(Item[J]).ClassType).Create(Self));
+ TChunk(Chunks.Item[J]).Assign(TChunk(Item[J]));
+ end {with};
+end;
+
+{Returns a alpha data scanline}
+function TPngObject.GetAlphaScanline(const LineIndex: Integer): pByteArray;
+begin
+ with Header do
+ if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ Longint(Result) := Longint(ImageAlpha) + (LineIndex * Longint(Width))
+ else Result := nil; {In case the image does not use alpha information}
+end;
+
+{$IFDEF Store16bits}
+{Returns a png data extra scanline}
+function TPngObject.GetExtraScanline(const LineIndex: Integer): Pointer;
+begin
+ with Header do
+ Longint(Result) := (Longint(ExtraImageData) + ((Longint(Height) - 1) *
+ BytesPerRow)) - (LineIndex * BytesPerRow);
+end;
+{$ENDIF}
+
+{Returns a png data scanline}
+function TPngObject.GetScanline(const LineIndex: Integer): Pointer;
+begin
+ with Header do
+ Longint(Result) := (Longint(ImageData) + ((Longint(Height) - 1) *
+ BytesPerRow)) - (LineIndex * BytesPerRow);
+end;
+
+{Initialize gamma table}
+procedure TPngObject.InitializeGamma;
+var
+ i: Integer;
+begin
+ {Build gamma table as if there was no gamma}
+ FOR i := 0 to 255 do
+ begin
+ GammaTable[i] := i;
+ InverseGamma[i] := i;
+ end {for i}
+end;
+
+{Returns the transparency mode used by this png}
+function TPngObject.GetTransparencyMode: TPNGTransparencyMode;
+var
+ TRNS: TChunkTRNS;
+begin
+ with Header do
+ begin
+ Result := ptmNone; {Default result}
+ {Gets the TRNS chunk pointer}
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+
+ {Test depending on the color type}
+ case ColorType of
+ {This modes are always partial}
+ COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Result := ptmPartial;
+ {This modes support bit transparency}
+ COLOR_RGB, COLOR_GRAYSCALE: if TRNS <> nil then Result := ptmBit;
+ {Supports booth translucid and bit}
+ COLOR_PALETTE:
+ {A TRNS chunk must be present, otherwise it won't support transparency}
+ if TRNS <> nil then
+ if TRNS.BitTransparency then
+ Result := ptmBit else Result := ptmPartial
+ end {case}
+
+ end {with Header}
+end;
+
+{Add a text chunk}
+procedure TPngObject.AddtEXt(const Keyword, Text: String);
+var
+ TextChunk: TChunkTEXT;
+begin
+ TextChunk := Chunks.Add(TChunkText) as TChunkTEXT;
+ TextChunk.Keyword := Keyword;
+ TextChunk.Text := Text;
+end;
+
+{Add a text chunk}
+procedure TPngObject.AddzTXt(const Keyword, Text: String);
+var
+ TextChunk: TChunkzTXt;
+begin
+ TextChunk := Chunks.Add(TChunkzTXt) as TChunkzTXt;
+ TextChunk.Keyword := Keyword;
+ TextChunk.Text := Text;
+end;
+
+{Removes the image transparency}
+procedure TPngObject.RemoveTransparency;
+var
+ TRNS: TChunkTRNS;
+begin
+ {Removes depending on the color type}
+ with Header do
+ case ColorType of
+ {Palette uses the TChunktRNS to store alpha}
+ COLOR_PALETTE:
+ begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ if TRNS <> nil then Chunks.RemoveChunk(TRNS)
+ end;
+ {Png allocates different memory space to hold alpha information}
+ {for these types}
+ COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA:
+ begin
+ {Transform into the appropriate color type}
+ if ColorType = COLOR_GRAYSCALEALPHA then
+ ColorType := COLOR_GRAYSCALE
+ else ColorType := COLOR_RGB;
+ {Free the pointer data}
+ if ImageAlpha <> nil then FreeMem(ImageAlpha);
+ ImageAlpha := nil
+ end
+ end
+end;
+
+{Generates alpha information}
+procedure TPngObject.CreateAlpha;
+var
+ TRNS: TChunkTRNS;
+begin
+ {Generates depending on the color type}
+ with Header do
+ case ColorType of
+ {Png allocates different memory space to hold alpha information}
+ {for these types}
+ COLOR_GRAYSCALE, COLOR_RGB:
+ begin
+ {Transform into the appropriate color type}
+ if ColorType = COLOR_GRAYSCALE then
+ ColorType := COLOR_GRAYSCALEALPHA
+ else ColorType := COLOR_RGBALPHA;
+ {Allocates memory to hold alpha information}
+ GetMem(ImageAlpha, Integer(Width) * Integer(Height));
+ FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #255);
+ end;
+ {Palette uses the TChunktRNS to store alpha}
+ COLOR_PALETTE:
+ begin
+ {Gets/creates TRNS chunk}
+ if Chunks.ItemFromClass(TChunkTRNS) = nil then
+ TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS
+ else
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+
+ {Prepares the TRNS chunk}
+ with TRNS do
+ begin
+ ResizeData(256);
+ Fillchar(PaletteValues[0], 256, 255);
+ fDataSize := 1 shl Header.BitDepth;
+ fBitTransparency := False
+ end {with Chunks.Add};
+ end;
+ end {case Header.ColorType}
+
+end;
+
+{Returns transparent color}
+function TPngObject.GetTransparentColor: TColor;
+var
+ TRNS: TChunkTRNS;
+begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ {Reads the transparency chunk to get this info}
+ if Assigned(TRNS) then Result := TRNS.TransparentColor
+ else Result := 0
+end;
+
+{$OPTIMIZATION OFF}
+procedure TPngObject.SetTransparentColor(const Value: TColor);
+var
+ TRNS: TChunkTRNS;
+begin
+ if HeaderPresent then
+ {Tests the ColorType}
+ case Header.ColorType of
+ {Not allowed for this modes}
+ COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Self.RaiseError(
+ EPNGCannotChangeTransparent, EPNGCannotChangeTransparentText);
+ {Allowed}
+ COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE:
+ begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ if not Assigned(TRNS) then TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS;
+
+ {Sets the transparency value from TRNS chunk}
+ TRNS.TransparentColor := {$IFDEF UseDelphi}ColorToRGB({$ENDIF}Value
+ {$IFDEF UseDelphi}){$ENDIF}
+ end {COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE)}
+ end {case}
+end;
+
+{Returns if header is present}
+function TPngObject.HeaderPresent: Boolean;
+begin
+ Result := ((Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR))
+end;
+
+{Returns pixel for png using palette and grayscale}
+function GetByteArrayPixel(const png: TPngObject; const X, Y: Integer): TColor;
+var
+ ByteData: Byte;
+ DataDepth: Byte;
+begin
+ with png, Header do
+ begin
+ {Make sure the bitdepth is not greater than 8}
+ DataDepth := BitDepth;
+ if DataDepth > 8 then DataDepth := 8;
+ {Obtains the byte containing this pixel}
+ ByteData := pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
+ {Moves the bits we need to the right}
+ ByteData := (ByteData shr ((8 - DataDepth) -
+ (X mod (8 div DataDepth)) * DataDepth));
+ {Discard the unwanted pixels}
+ ByteData:= ByteData and ($FF shr (8 - DataDepth));
+
+ {For palette mode map the palette entry and for grayscale convert and
+ returns the intensity}
+ case ColorType of
+ COLOR_PALETTE:
+ with TChunkPLTE(png.Chunks.ItemFromClass(TChunkPLTE)).Item[ByteData] do
+ Result := rgb(GammaTable[rgbRed], GammaTable[rgbGreen],
+ GammaTable[rgbBlue]);
+ COLOR_GRAYSCALE:
+ begin
+ if BitDepth = 1
+ then ByteData := GammaTable[Byte(ByteData * 255)]
+ else ByteData := GammaTable[Byte(ByteData * ((1 shl DataDepth) + 1))];
+ Result := rgb(ByteData, ByteData, ByteData);
+ end;
+ else Result := 0;
+ end {case};
+ end {with}
+end;
+
+{In case vcl units are not being used}
+{$IFNDEF UseDelphi}
+function ColorToRGB(const Color: TColor): COLORREF;
+begin
+ Result := Color
+end;
+{$ENDIF}
+
+{Sets a pixel for grayscale and palette pngs}
+procedure SetByteArrayPixel(const png: TPngObject; const X, Y: Integer;
+ const Value: TColor);
+const
+ ClearFlag: Array[1..8] of Integer = (1, 3, 0, 15, 0, 0, 0, $FF);
+var
+ ByteData: pByte;
+ DataDepth: Byte;
+ ValEntry: Byte;
+begin
+ with png.Header do
+ begin
+ {Map into a palette entry}
+ ValEntry := GetNearestPaletteIndex(Png.Palette, ColorToRGB(Value));
+
+ {16 bits grayscale extra bits are discarted}
+ DataDepth := BitDepth;
+ if DataDepth > 8 then DataDepth := 8;
+ {Gets a pointer to the byte we intend to change}
+ ByteData := @pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
+ {Clears the old pixel data}
+ ByteData^ := ByteData^ and not (ClearFlag[DataDepth] shl ((8 - DataDepth) -
+ (X mod (8 div DataDepth)) * DataDepth));
+
+ {Setting the new pixel}
+ ByteData^ := ByteData^ or (ValEntry shl ((8 - DataDepth) -
+ (X mod (8 div DataDepth)) * DataDepth));
+ end {with png.Header}
+end;
+
+{Returns pixel when png uses RGB}
+function GetRGBLinePixel(const png: TPngObject;
+ const X, Y: Integer): TColor;
+begin
+ with pRGBLine(png.Scanline[Y])^[X] do
+ Result := RGB(rgbtRed, rgbtGreen, rgbtBlue)
+end;
+
+{Sets pixel when png uses RGB}
+procedure SetRGBLinePixel(const png: TPngObject;
+ const X, Y: Integer; Value: TColor);
+begin
+ with pRGBLine(png.Scanline[Y])^[X] do
+ begin
+ rgbtRed := GetRValue(Value);
+ rgbtGreen := GetGValue(Value);
+ rgbtBlue := GetBValue(Value)
+ end
+end;
+
+{Returns pixel when png uses grayscale}
+function GetGrayLinePixel(const png: TPngObject;
+ const X, Y: Integer): TColor;
+var
+ B: Byte;
+begin
+ B := PByteArray(png.Scanline[Y])^[X];
+ Result := RGB(B, B, B);
+end;
+
+{Sets pixel when png uses grayscale}
+procedure SetGrayLinePixel(const png: TPngObject;
+ const X, Y: Integer; Value: TColor);
+begin
+ PByteArray(png.Scanline[Y])^[X] := GetRValue(Value);
+end;
+
+{Resizes the PNG image}
+procedure TPngObject.Resize(const CX, CY: Integer);
+ function Min(const A, B: Integer): Integer;
+ begin
+ if A < B then Result := A else Result := B;
+ end;
+var
+ Header: TChunkIHDR;
+ Line, NewBytesPerRow: Integer;
+ NewHandle: HBitmap;
+ NewDC: HDC;
+ NewImageData: Pointer;
+ NewImageAlpha: Pointer;
+ NewImageExtra: Pointer;
+begin
+ if (CX > 0) and (CY > 0) then
+ begin
+ {Gets some actual information}
+ Header := Self.Header;
+
+ {Creates the new image}
+ NewDC := CreateCompatibleDC(Header.ImageDC);
+ Header.BitmapInfo.bmiHeader.biWidth := cx;
+ Header.BitmapInfo.bmiHeader.biHeight := cy;
+ NewHandle := CreateDIBSection(NewDC, pBitmapInfo(@Header.BitmapInfo)^,
+ DIB_RGB_COLORS, NewImageData, 0, 0);
+ SelectObject(NewDC, NewHandle);
+ {$IFDEF UseDelphi}Canvas.Handle := NewDC;{$ENDIF}
+ NewBytesPerRow := (((Header.BitmapInfo.bmiHeader.biBitCount * cx) + 31)
+ and not 31) div 8;
+
+ {Copies the image data}
+ for Line := 0 to Min(CY - 1, Height - 1) do
+ CopyMemory(Ptr(Longint(NewImageData) + (Longint(CY) - 1) *
+ NewBytesPerRow - (Line * NewBytesPerRow)), Scanline[Line],
+ Min(NewBytesPerRow, Header.BytesPerRow));
+
+ {Build array for alpha information, if necessary}
+ if (Header.ColorType = COLOR_RGBALPHA) or
+ (Header.ColorType = COLOR_GRAYSCALEALPHA) then
+ begin
+ GetMem(NewImageAlpha, CX * CY);
+ Fillchar(NewImageAlpha^, CX * CY, 255);
+ for Line := 0 to Min(CY - 1, Height - 1) do
+ CopyMemory(Ptr(Longint(NewImageAlpha) + (Line * CX)),
+ AlphaScanline[Line], Min(CX, Width));
+ FreeMem(Header.ImageAlpha);
+ Header.ImageAlpha := NewImageAlpha;
+ end;
+
+ {$IFDEF Store16bits}
+ if (Header.BitDepth = 16) then
+ begin
+ GetMem(NewImageExtra, CX * CY);
+ Fillchar(NewImageExtra^, CX * CY, 0);
+ for Line := 0 to Min(CY - 1, Height - 1) do
+ CopyMemory(Ptr(Longint(NewImageExtra) + (Line * CX)),
+ ExtraScanline[Line], Min(CX, Width));
+ FreeMem(Header.ExtraImageData);
+ Header.ExtraImageData := NewImageExtra;
+ end;
+ {$ENDIF}
+
+ {Deletes the old image}
+ DeleteObject(Header.ImageHandle);
+ DeleteDC(Header.ImageDC);
+
+ {Prepares the header to get the new image}
+ Header.BytesPerRow := NewBytesPerRow;
+ Header.IHDRData.Width := CX;
+ Header.IHDRData.Height := CY;
+ Header.ImageData := NewImageData;
+
+ {Replaces with the new image}
+ Header.ImageHandle := NewHandle;
+ Header.ImageDC := NewDC;
+ end
+ else
+ {The new size provided is invalid}
+ RaiseError(EPNGInvalidNewSize, EInvalidNewSize)
+
+end;
+
+{Sets a pixel}
+procedure TPngObject.SetPixels(const X, Y: Integer; const Value: TColor);
+begin
+ if ((X >= 0) and (X <= Width - 1)) and
+ ((Y >= 0) and (Y <= Height - 1)) then
+ with Header do
+ begin
+ if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
+ SetByteArrayPixel(Self, X, Y, Value)
+ else if ColorType in [COLOR_GRAYSCALEALPHA] then
+ SetGrayLinePixel(Self, X, Y, Value)
+ else
+ SetRGBLinePixel(Self, X, Y, Value)
+ end {with}
+end;
+
+
+{Returns a pixel}
+function TPngObject.GetPixels(const X, Y: Integer): TColor;
+begin
+ if ((X >= 0) and (X <= Width - 1)) and
+ ((Y >= 0) and (Y <= Height - 1)) then
+ with Header do
+ begin
+ if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
+ Result := GetByteArrayPixel(Self, X, Y)
+ else if ColorType in [COLOR_GRAYSCALEALPHA] then
+ Result := GetGrayLinePixel(Self, X, Y)
+ else
+ Result := GetRGBLinePixel(Self, X, Y)
+ end {with}
+ else Result := 0
+end;
+
+{Returns the image palette}
+function TPngObject.GetPalette: HPALETTE;
+begin
+ Result := Header.ImagePalette;
+end;
+
+{Assigns from another TChunk}
+procedure TChunkpHYs.Assign(Source: TChunk);
+begin
+ fPPUnitY := TChunkpHYs(Source).fPPUnitY;
+ fPPUnitX := TChunkpHYs(Source).fPPUnitX;
+ fUnit := TChunkpHYs(Source).fUnit;
+end;
+
+{Loads the chunk from a stream}
+function TChunkpHYs.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 <> 9) then exit; {Size must be 9}
+
+ {Reads data}
+ fPPUnitX := ByteSwap(pCardinal(Longint(Data))^);
+ fPPUnitY := ByteSwap(pCardinal(Longint(Data) + 4)^);
+ fUnit := pUnitType(Longint(Data) + 8)^;
+end;
+
+{Saves the chunk to a stream}
+function TChunkpHYs.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Update data}
+ ResizeData(9); {Make sure the size is 9}
+ pCardinal(Data)^ := ByteSwap(fPPUnitX);
+ pCardinal(Longint(Data) + 4)^ := ByteSwap(fPPUnitY);
+ pUnitType(Longint(Data) + 8)^ := fUnit;
+
+ {Let inherited save data}
+ Result := inherited SaveToStream(Stream);
+end;
+
+procedure TPngObject.DoSetPalette(Value: HPALETTE; const UpdateColors: boolean);
+begin
+ if (Header.HasPalette) then
+ begin
+ {Update the palette entries}
+ if UpdateColors then
+ Header.PaletteToDIB(Value);
+
+ {Resize the new palette}
+ SelectPalette(Header.ImageDC, Value, False);
+ RealizePalette(Header.ImageDC);
+
+ {Replaces}
+ DeleteObject(Header.ImagePalette);
+ Header.ImagePalette := Value;
+ end
+end;
+
+{Set palette based on a windows palette handle}
+procedure TPngObject.SetPalette(Value: HPALETTE);
+begin
+ DoSetPalette(Value, true);
+end;
+
+{Returns the library version}
+function TPNGObject.GetLibraryVersion: String;
+begin
+ Result := LibraryVersion
+end;
+
+initialization
+ {Initialize}
+ ChunkClasses := nil;
+ {crc table has not being computed yet}
+ crc_table_computed := FALSE;
+ {Register the necessary chunks for png}
+ RegisterCommonChunks;
+ {Registers TPNGObject to use with TPicture}
+ {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
+ TPicture.RegisterFileFormat('PNG', 'Portable Network Graphics', TPNGObject);
+ {$ENDIF}{$ENDIF}
+finalization
+ {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
+ TPicture.UnregisterGraphicClass(TPNGObject);
+ {$ENDIF}{$ENDIF}
+ {Free chunk classes}
+ FreeChunkClassList;
+end.
+
+
diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pnglang.pas b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pnglang.pas new file mode 100644 index 0000000000..c4a5fb84c1 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/pnglang.pas @@ -0,0 +1,355 @@ +{Portable Network Graphics Delphi Language Info (24 July 2002)}
+
+{Feel free to change the text bellow to adapt to your language}
+{Also if you have a translation to other languages and want to}
+{share it, send me: gubadaud@terra.com.br }
+unit pnglang;
+
+interface
+
+{$DEFINE English}
+{.$DEFINE Polish}
+{.$DEFINE Portuguese}
+{.$DEFINE German}
+{.$DEFINE French}
+{.$DEFINE Slovenian}
+
+{Language strings for english}
+resourcestring
+ {$IFDEF Polish}
+ EPngInvalidCRCText = 'Ten obraz "Portable Network Graphics" jest nieprawid³owy ' +
+ 'poniewa¿ zawiera on nieprawid³owe czêœci danych (b³¹d crc)';
+ EPNGInvalidIHDRText = 'Obraz "Portable Network Graphics" nie mo¿e zostaæ ' +
+ 'wgrany poniewa¿ jedna z czêœci danych (ihdr) mo¿e byæ uszkodzona';
+ EPNGMissingMultipleIDATText = 'Obraz "Portable Network Graphics" jest ' +
+ 'nieprawid³owy poniewa¿ brakuje w nim czêœci obrazu.';
+ EPNGZLIBErrorText = 'Nie mo¿na zdekompresowaæ obrazu poniewa¿ zawiera ' +
+ 'b³êdnie zkompresowane dane.'#13#10 + ' Opis b³êdu: ';
+ EPNGInvalidPaletteText = 'Obraz "Portable Network Graphics" zawiera ' +
+ 'niew³aœciw¹ paletê.';
+ EPNGInvalidFileHeaderText = 'Plik który jest odczytywany jest nieprawid³owym '+
+ 'obrazem "Portable Network Graphics" poniewa¿ zawiera nieprawid³owy nag³ówek.' +
+ ' Plik mo¿ê byæ uszkodzony, spróbuj pobraæ go ponownie.';
+ EPNGIHDRNotFirstText = 'Obraz "Portable Network Graphics" nie jest ' +
+ 'obs³ugiwany lub mo¿e byæ niew³aœciwy.'#13#10 + '(stopka IHDR nie jest pierwsza)';
+ EPNGNotExistsText = 'Plik png nie mo¿e zostaæ wgrany poniewa¿ nie ' +
+ 'istnieje.';
+ EPNGSizeExceedsText = 'Obraz "Portable Network Graphics" nie jest ' +
+ 'obs³ugiwany poniewa¿ jego szerokoœæ lub wysokoœæ przekracza maksimum ' +
+ 'rozmiaru, który wynosi 65535 pikseli d³ugoœci.';
+ EPNGUnknownPalEntryText = 'Nie znaleziono wpisów palety.';
+ EPNGMissingPaletteText = 'Obraz "Portable Network Graphics" nie mo¿e zostaæ ' +
+ 'wgrany poniewa¿ u¿ywa tabeli kolorów której brakuje.';
+ EPNGUnknownCriticalChunkText = 'Obraz "Portable Network Graphics" ' +
+ 'zawiera nieznan¹ krytyczn¹ czêœæ która nie mo¿e zostaæ odkodowana.';
+ EPNGUnknownCompressionText = 'Obraz "Portable Network Graphics" jest ' +
+ 'skompresowany nieznanym schemat który nie mo¿e zostaæ odszyfrowany.';
+ EPNGUnknownInterlaceText = 'Obraz "Portable Network Graphics" u¿ywa ' +
+ 'nie znany schamat przeplatania który nie mo¿e zostaæ odszyfrowany.';
+ EPNGCannotAssignChunkText = 'Stopka mysi byæ kompatybilna aby zosta³a wyznaczona.';
+ EPNGUnexpectedEndText = 'Obraz "Portable Network Graphics" jest nieprawid³owy ' +
+ 'poniewa¿ dekoder znalaz³ niespodziewanie koniec pliku.';
+ EPNGNoImageDataText = 'Obraz "Portable Network Graphics" nie zawiera' +
+ 'danych.';
+ EPNGCannotAddChunkText = 'Program próbuje dodaæ krytyczn¹ ' +
+ 'stopkê do aktualnego obrazu co jest niedozwolone.';
+ EPNGCannotAddInvalidImageText = 'Nie mo¿na dodaæ nowej stopki ' +
+ 'poniewa¿ aktualny obraz jest nieprawid³owy.';
+ EPNGCouldNotLoadResourceText = 'Obraz png nie mo¿e zostaæ za³adowany z' +
+ 'zasobów o podanym ID.';
+ EPNGOutMemoryText = 'Niektóre operacje nie mog¹ zostaæ zrealizowane poniewa¿ ' +
+ 'systemowi brakuje zasobów. Zamknij kilka okien i spróbuj ponownie.';
+ EPNGCannotChangeTransparentText = 'Ustawienie bitu przezroczystego koloru jest ' +
+ 'zabronione dla obrazów png zawieraj¹cych wartoœæ alpha dla ka¿dego piksela ' +
+ '(COLOR_RGBALPHA i COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Ta operacja jest niedozwolona poniewa¿ ' +
+ 'aktualny obraz zawiera niew³aœciwy nag³ówek.';
+ EInvalidNewSize = 'The new size provided for image resizing is invalid.';
+ EInvalidSpec = 'The "Portable Network Graphics" could not be created ' +
+ 'because invalid image type parameters have being provided.';
+ {$ENDIF}
+
+ {$IFDEF English}
+ EPngInvalidCRCText = 'This "Portable Network Graphics" image is not valid ' +
+ 'because it contains invalid pieces of data (crc error)';
+ EPNGInvalidIHDRText = 'The "Portable Network Graphics" image could not be ' +
+ 'loaded because one of its main piece of data (ihdr) might be corrupted';
+ EPNGMissingMultipleIDATText = 'This "Portable Network Graphics" image is ' +
+ 'invalid because it has missing image parts.';
+ EPNGZLIBErrorText = 'Could not decompress the image because it contains ' +
+ 'invalid compressed data.'#13#10 + ' Description: ';
+ EPNGInvalidPaletteText = 'The "Portable Network Graphics" image contains ' +
+ 'an invalid palette.';
+ EPNGInvalidFileHeaderText = 'The file being readed is not a valid '+
+ '"Portable Network Graphics" image because it contains an invalid header.' +
+ ' This file may be corruped, try obtaining it again.';
+ EPNGIHDRNotFirstText = 'This "Portable Network Graphics" image is not ' +
+ 'supported or it might be invalid.'#13#10 + '(IHDR chunk is not the first)';
+ EPNGNotExistsText = 'The png file could not be loaded because it does not ' +
+ 'exists.';
+ EPNGSizeExceedsText = 'This "Portable Network Graphics" image is not ' +
+ 'supported because either it''s width or height exceeds the maximum ' +
+ 'size, which is 65535 pixels length.';
+ EPNGUnknownPalEntryText = 'There is no such palette entry.';
+ EPNGMissingPaletteText = 'This "Portable Network Graphics" could not be ' +
+ 'loaded because it uses a color table which is missing.';
+ EPNGUnknownCriticalChunkText = 'This "Portable Network Graphics" image ' +
+ 'contains an unknown critical part which could not be decoded.';
+ EPNGUnknownCompressionText = 'This "Portable Network Graphics" image is ' +
+ 'encoded with an unknown compression scheme which could not be decoded.';
+ EPNGUnknownInterlaceText = 'This "Portable Network Graphics" image uses ' +
+ 'an unknown interlace scheme which could not be decoded.';
+ EPNGCannotAssignChunkText = 'The chunks must be compatible to be assigned.';
+ EPNGUnexpectedEndText = 'This "Portable Network Graphics" image is invalid ' +
+ 'because the decoder found an unexpected end of the file.';
+ EPNGNoImageDataText = 'This "Portable Network Graphics" image contains no ' +
+ 'data.';
+ EPNGCannotAddChunkText = 'The program tried to add a existent critical ' +
+ 'chunk to the current image which is not allowed.';
+ EPNGCannotAddInvalidImageText = 'It''s not allowed to add a new chunk ' +
+ 'because the current image is invalid.';
+ EPNGCouldNotLoadResourceText = 'The png image could not be loaded from the ' +
+ 'resource ID.';
+ EPNGOutMemoryText = 'Some operation could not be performed because the ' +
+ 'system is out of resources. Close some windows and try again.';
+ EPNGCannotChangeTransparentText = 'Setting bit transparency color is not ' +
+ 'allowed for png images containing alpha value for each pixel ' +
+ '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'This operation is not valid because the ' +
+ 'current image contains no valid header.';
+ EInvalidNewSize = 'The new size provided for image resizing is invalid.';
+ EInvalidSpec = 'The "Portable Network Graphics" could not be created ' +
+ 'because invalid image type parameters have being provided.';
+ {$ENDIF}
+ {$IFDEF Portuguese}
+ EPngInvalidCRCText = 'Essa imagem "Portable Network Graphics" não é válida ' +
+ 'porque contém chunks inválidos de dados (erro crc)';
+ EPNGInvalidIHDRText = 'A imagem "Portable Network Graphics" não pode ser ' +
+ 'carregada porque um dos seus chunks importantes (ihdr) pode estar '+
+ 'inválido';
+ EPNGMissingMultipleIDATText = 'Essa imagem "Portable Network Graphics" é ' +
+ 'inválida porque tem chunks de dados faltando.';
+ EPNGZLIBErrorText = 'Não foi possível descomprimir os dados da imagem ' +
+ 'porque ela contém dados inválidos.'#13#10 + ' Descrição: ';
+ EPNGInvalidPaletteText = 'A imagem "Portable Network Graphics" contém ' +
+ 'uma paleta inválida.';
+ EPNGInvalidFileHeaderText = 'O arquivo sendo lido não é uma imagem '+
+ '"Portable Network Graphics" válida porque contém um cabeçalho inválido.' +
+ ' O arquivo pode estar corrompida, tente obter ela novamente.';
+ EPNGIHDRNotFirstText = 'Essa imagem "Portable Network Graphics" não é ' +
+ 'suportada ou pode ser inválida.'#13#10 + '(O chunk IHDR não é o ' +
+ 'primeiro)';
+ EPNGNotExistsText = 'A imagem png não pode ser carregada porque ela não ' +
+ 'existe.';
+ EPNGSizeExceedsText = 'Essa imagem "Portable Network Graphics" não é ' +
+ 'suportada porque a largura ou a altura ultrapassam o tamanho máximo, ' +
+ 'que é de 65535 pixels de diâmetro.';
+ EPNGUnknownPalEntryText = 'Não existe essa entrada de paleta.';
+ EPNGMissingPaletteText = 'Essa imagem "Portable Network Graphics" não pode ' +
+ 'ser carregada porque usa uma paleta que está faltando.';
+ EPNGUnknownCriticalChunkText = 'Essa imagem "Portable Network Graphics" ' +
+ 'contém um chunk crítico desconheçido que não pode ser decodificado.';
+ EPNGUnknownCompressionText = 'Essa imagem "Portable Network Graphics" está ' +
+ 'codificada com um esquema de compressão desconheçido e não pode ser ' +
+ 'decodificada.';
+ EPNGUnknownInterlaceText = 'Essa imagem "Portable Network Graphics" usa um ' +
+ 'um esquema de interlace que não pode ser decodificado.';
+ EPNGCannotAssignChunkText = 'Os chunk devem ser compatíveis para serem ' +
+ 'copiados.';
+ EPNGUnexpectedEndText = 'Essa imagem "Portable Network Graphics" é ' +
+ 'inválida porque o decodificador encontrou um fim inesperado.';
+ EPNGNoImageDataText = 'Essa imagem "Portable Network Graphics" não contém ' +
+ 'dados.';
+ EPNGCannotAddChunkText = 'O programa tentou adicionar um chunk crítico ' +
+ 'já existente para a imagem atual, oque não é permitido.';
+ EPNGCannotAddInvalidImageText = 'Não é permitido adicionar um chunk novo ' +
+ 'porque a imagem atual é inválida.';
+ EPNGCouldNotLoadResourceText = 'A imagem png não pode ser carregada apartir' +
+ ' do resource.';
+ EPNGOutMemoryText = 'Uma operação não pode ser completada porque o sistema ' +
+ 'está sem recursos. Fecha algumas janelas e tente novamente.';
+ EPNGCannotChangeTransparentText = 'Definir transparência booleana não é ' +
+ 'permitido para imagens png contendo informação alpha para cada pixel ' +
+ '(COLOR_RGBALPHA e COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Essa operação não é válida porque a ' +
+ 'imagem atual não contém um cabeçalho válido.';
+ EInvalidNewSize = 'O novo tamanho fornecido para o redimensionamento de ' +
+ 'imagem é inválido.';
+ EInvalidSpec = 'A imagem "Portable Network Graphics" não pode ser criada ' +
+ 'porque parâmetros de tipo de imagem inválidos foram usados.';
+ {$ENDIF}
+ {Language strings for German}
+ {$IFDEF German}
+ EPngInvalidCRCText = 'Dieses "Portable Network Graphics" Bild ist ' +
+ 'ungültig, weil Teile der Daten fehlerhaft sind (CRC-Fehler)';
+ EPNGInvalidIHDRText = 'Dieses "Portable Network Graphics" Bild konnte ' +
+ 'nicht geladen werden, weil wahrscheinlich einer der Hauptdatenbreiche ' +
+ '(IHDR) beschädigt ist';
+ EPNGMissingMultipleIDATText = 'Dieses "Portable Network Graphics" Bild ' +
+ 'ist ungültig, weil Grafikdaten fehlen.';
+ EPNGZLIBErrorText = 'Die Grafik konnte nicht entpackt werden, weil Teile der ' +
+ 'komprimierten Daten fehlerhaft sind.'#13#10 + ' Beschreibung: ';
+ EPNGInvalidPaletteText = 'Das "Portable Network Graphics" Bild enthält ' +
+ 'eine ungültige Palette.';
+ EPNGInvalidFileHeaderText = 'Die Datei, die gelesen wird, ist kein ' +
+ 'gültiges "Portable Network Graphics" Bild, da es keinen gültigen ' +
+ 'Header enthält. Die Datei könnte beschädigt sein, versuchen Sie, ' +
+ 'eine neue Kopie zu bekommen.';
+ EPNGIHDRNotFirstText = 'Dieses "Portable Network Graphics" Bild wird ' +
+ 'nicht unterstützt oder ist ungültig.'#13#10 +
+ '(Der IHDR-Abschnitt ist nicht der erste Abschnitt in der Datei).';
+ EPNGNotExistsText = 'Die PNG Datei konnte nicht geladen werden, da sie ' +
+ 'nicht existiert.';
+ EPNGSizeExceedsText = 'Dieses "Portable Network Graphics" Bild wird nicht ' +
+ 'unterstützt, weil entweder seine Breite oder seine Höhe das Maximum von ' +
+ '65535 Pixeln überschreitet.';
+ EPNGUnknownPalEntryText = 'Es gibt keinen solchen Palettenwert.';
+ EPNGMissingPaletteText = 'Dieses "Portable Network Graphics" Bild konnte ' +
+ 'nicht geladen werden, weil die benötigte Farbtabelle fehlt.';
+ EPNGUnknownCriticalChunkText = 'Dieses "Portable Network Graphics" Bild ' +
+ 'enhält einen unbekannten aber notwendigen Teil, welcher nicht entschlüsselt ' +
+ 'werden kann.';
+ EPNGUnknownCompressionText = 'Dieses "Portable Network Graphics" Bild ' +
+ 'wurde mit einem unbekannten Komprimierungsalgorithmus kodiert, welcher ' +
+ 'nicht entschlüsselt werden kann.';
+ EPNGUnknownInterlaceText = 'Dieses "Portable Network Graphics" Bild ' +
+ 'benutzt ein unbekanntes Interlace-Schema, welches nicht entschlüsselt ' +
+ 'werden kann.';
+ EPNGCannotAssignChunkText = 'Die Abschnitte müssen kompatibel sein, damit ' +
+ 'sie zugewiesen werden können.';
+ EPNGUnexpectedEndText = 'Dieses "Portable Network Graphics" Bild ist ' +
+ 'ungültig: Der Dekoder ist unerwartete auf das Ende der Datei gestoßen.';
+ EPNGNoImageDataText = 'Dieses "Portable Network Graphics" Bild enthält ' +
+ 'keine Daten.';
+ EPNGCannotAddChunkText = 'Das Programm versucht einen existierenden und ' +
+ 'notwendigen Abschnitt zum aktuellen Bild hinzuzufügen. Dies ist nicht ' +
+ 'zulässig.';
+ EPNGCannotAddInvalidImageText = 'Es ist nicht zulässig, einem ungültigen ' +
+ 'Bild einen neuen Abschnitt hinzuzufügen.';
+ EPNGCouldNotLoadResourceText = 'Das PNG Bild konnte nicht aus den ' +
+ 'Resourcendaten geladen werden.';
+ EPNGOutMemoryText = 'Es stehen nicht genügend Resourcen im System zur ' +
+ 'Verfügung, um die Operation auszuführen. Schließen Sie einige Fenster '+
+ 'und versuchen Sie es erneut.';
+ EPNGCannotChangeTransparentText = 'Das Setzen der Bit-' +
+ 'Transparent-Farbe ist für PNG-Images die Alpha-Werte für jedes ' +
+ 'Pixel enthalten (COLOR_RGBALPHA und COLOR_GRAYSCALEALPHA) nicht ' +
+ 'zulässig';
+ EPNGHeaderNotPresentText = 'Die Datei, die gelesen wird, ist kein ' +
+ 'gültiges "Portable Network Graphics" Bild, da es keinen gültigen ' +
+ 'Header enthält.';
+ EInvalidNewSize = 'The new size provided for image resizing is invalid.';
+ EInvalidSpec = 'The "Portable Network Graphics" could not be created ' +
+ 'because invalid image type parameters have being provided.';
+ {$ENDIF}
+ {Language strings for French}
+ {$IFDEF French}
+ EPngInvalidCRCText = 'Cette image "Portable Network Graphics" n''est pas valide ' +
+ 'car elle contient des données invalides (erreur crc)';
+ EPNGInvalidIHDRText = 'Cette image "Portable Network Graphics" n''a pu être ' +
+ 'chargée car l''une de ses principale donnée (ihdr) doit être corrompue';
+ EPNGMissingMultipleIDATText = 'Cette image "Portable Network Graphics" est ' +
+ 'invalide car elle contient des parties d''image manquantes.';
+ EPNGZLIBErrorText = 'Impossible de décompresser l''image car elle contient ' +
+ 'des données compressées invalides.'#13#10 + ' Description: ';
+ EPNGInvalidPaletteText = 'L''image "Portable Network Graphics" contient ' +
+ 'une palette invalide.';
+ EPNGInvalidFileHeaderText = 'Le fichier actuellement lu est une image '+
+ '"Portable Network Graphics" invalide car elle contient un en-tête invalide.' +
+ ' Ce fichier doit être corrompu, essayer de l''obtenir à nouveau.';
+ EPNGIHDRNotFirstText = 'Cette image "Portable Network Graphics" n''est pas ' +
+ 'supportée ou doit être invalide.'#13#10 + '(la partie IHDR n''est pas la première)';
+ EPNGNotExistsText = 'Le fichier png n''a pu être chargé car il n''éxiste pas.';
+ EPNGSizeExceedsText = 'Cette image "Portable Network Graphics" n''est pas supportée ' +
+ 'car sa longueur ou sa largeur excède la taille maximale, qui est de 65535 pixels.';
+ EPNGUnknownPalEntryText = 'Il n''y a aucune entrée pour cette palette.';
+ EPNGMissingPaletteText = 'Cette image "Portable Network Graphics" n''a pu être ' +
+ 'chargée car elle utilise une table de couleur manquante.';
+ EPNGUnknownCriticalChunkText = 'Cette image "Portable Network Graphics" ' +
+ 'contient une partie critique inconnue qui n'' pu être décodée.';
+ EPNGUnknownCompressionText = 'Cette image "Portable Network Graphics" est ' +
+ 'encodée à l''aide d''un schémas de compression inconnu qui ne peut être décodé.';
+ EPNGUnknownInterlaceText = 'Cette image "Portable Network Graphics" utilise ' +
+ 'un schémas d''entrelacement inconnu qui ne peut être décodé.';
+ EPNGCannotAssignChunkText = 'Ce morceau doit être compatible pour être assigné.';
+ EPNGUnexpectedEndText = 'Cette image "Portable Network Graphics" est invalide ' +
+ 'car le decodeur est arrivé à une fin de fichier non attendue.';
+ EPNGNoImageDataText = 'Cette image "Portable Network Graphics" ne contient pas de ' +
+ 'données.';
+ EPNGCannotAddChunkText = 'Le programme a essayé d''ajouter un morceau critique existant ' +
+ 'à l''image actuelle, ce qui n''est pas autorisé.';
+ EPNGCannotAddInvalidImageText = 'Il n''est pas permis d''ajouter un nouveau morceau ' +
+ 'car l''image actuelle est invalide.';
+ EPNGCouldNotLoadResourceText = 'L''image png n''a pu être chargée depuis ' +
+ 'l''ID ressource.';
+ EPNGOutMemoryText = 'Certaines opérations n''ont pu être effectuée car le ' +
+ 'système n''a plus de ressources. Fermez quelques fenêtres et essayez à nouveau.';
+ EPNGCannotChangeTransparentText = 'Définir le bit de transparence n''est pas ' +
+ 'permis pour des images png qui contiennent une valeur alpha pour chaque pixel ' +
+ '(COLOR_RGBALPHA et COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Cette opération n''est pas valide car l''image ' +
+ 'actuelle ne contient pas de header valide.';
+ EPNGAlphaNotSupportedText = 'Le type de couleur de l''image "Portable Network Graphics" actuelle ' +
+ 'contient déjà des informations alpha ou il ne peut être converti.';
+ EInvalidNewSize = 'The new size provided for image resizing is invalid.';
+ EInvalidSpec = 'The "Portable Network Graphics" could not be created ' +
+ 'because invalid image type parameters have being provided.';
+ {$ENDIF}
+ {Language strings for slovenian}
+ {$IFDEF Slovenian}
+ EPngInvalidCRCText = 'Ta "Portable Network Graphics" slika je neveljavna, ' +
+ 'ker vsebuje neveljavne dele podatkov (CRC napaka).';
+ EPNGInvalidIHDRText = 'Slike "Portable Network Graphics" ni bilo možno ' +
+ 'naložiti, ker je eden od glavnih delov podatkov (IHDR) verjetno pokvarjen.';
+ EPNGMissingMultipleIDATText = 'Ta "Portable Network Graphics" slika je ' +
+ 'naveljavna, ker manjkajo deli slike.';
+ EPNGZLIBErrorText = 'Ne morem raztegniti slike, ker vsebuje ' +
+ 'neveljavne stisnjene podatke.'#13#10 + ' Opis: ';
+ EPNGInvalidPaletteText = 'Slika "Portable Network Graphics" vsebuje ' +
+ 'neveljavno barvno paleto.';
+ EPNGInvalidFileHeaderText = 'Datoteka za branje ni veljavna '+
+ '"Portable Network Graphics" slika, ker vsebuje neveljavno glavo.' +
+ ' Datoteka je verjetno pokvarjena, poskusite jo ponovno naložiti.';
+ EPNGIHDRNotFirstText = 'Ta "Portable Network Graphics" slika ni ' +
+ 'podprta ali pa je neveljavna.'#13#10 + '(IHDR del datoteke ni prvi).';
+ EPNGNotExistsText = 'Ne morem naložiti png datoteke, ker ta ne ' +
+ 'obstaja.';
+ EPNGSizeExceedsText = 'Ta "Portable Network Graphics" slika ni ' +
+ 'podprta, ker ali njena širina ali višina presega najvecjo možno vrednost ' +
+ '65535 pik.';
+ EPNGUnknownPalEntryText = 'Slika nima vnešene take barvne palete.';
+ EPNGMissingPaletteText = 'Te "Portable Network Graphics" ne morem ' +
+ 'naložiti, ker uporablja manjkajoco barvno paleto.';
+ EPNGUnknownCriticalChunkText = 'Ta "Portable Network Graphics" slika ' +
+ 'vsebuje neznan kriticni del podatkov, ki ga ne morem prebrati.';
+ EPNGUnknownCompressionText = 'Ta "Portable Network Graphics" slika je ' +
+ 'kodirana z neznano kompresijsko shemo, ki je ne morem prebrati.';
+ EPNGUnknownInterlaceText = 'Ta "Portable Network Graphics" slika uporablja ' +
+ 'neznano shemo za preliv, ki je ne morem prebrati.';
+ EPNGCannotAssignChunkText = Košcki morajo biti med seboj kompatibilni za prireditev vrednosti.';
+ EPNGUnexpectedEndText = 'Ta "Portable Network Graphics" slika je neveljavna, ' +
+ 'ker je bralnik prišel do nepricakovanega konca datoteke.';
+ EPNGNoImageDataText = 'Ta "Portable Network Graphics" ne vsebuje nobenih ' +
+ 'podatkov.';
+ EPNGCannotAddChunkText = 'Program je poskusil dodati obstojeci kriticni ' +
+ 'kos podatkov k trenutni sliki, kar ni dovoljeno.';
+ EPNGCannotAddInvalidImageText = 'Ni dovoljeno dodati nov kos podatkov, ' +
+ 'ker trenutna slika ni veljavna.';
+ EPNGCouldNotLoadResourceText = 'Ne morem naložiti png slike iz ' +
+ 'skladišca.';
+ EPNGOutMemoryText = 'Ne morem izvesti operacije, ker je ' +
+ 'sistem ostal brez resorjev. Zaprite nekaj oken in poskusite znova.';
+ EPNGCannotChangeTransparentText = 'Ni dovoljeno nastaviti prosojnosti posamezne barve ' +
+ 'za png slike, ki vsebujejo alfa prosojno vrednost za vsako piko ' +
+ '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Ta operacija ni veljavna, ker ' +
+ 'izbrana slika ne vsebuje veljavne glave.';
+ EInvalidNewSize = 'The new size provided for image resizing is invalid.';
+ EInvalidSpec = 'The "Portable Network Graphics" could not be created ' +
+ 'because invalid image type parameters have being provided.';
+ {$ENDIF}
+
+
+implementation
+
+end.
diff --git a/plugins/!NotAdopted/Chess4Net/lib/PNGImage/zlibpas.pas b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/zlibpas.pas new file mode 100644 index 0000000000..64a8526bd4 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/PNGImage/zlibpas.pas @@ -0,0 +1,156 @@ +{Portable Network Graphics Delphi ZLIB linking (16 May 2002) }
+
+{This unit links ZLIB to pngimage unit in order to implement }
+{the library. It's now using the new ZLIB version, 1.1.4 }
+{Note: The .obj files must be located in the subdirectory \obj}
+
+unit zlibpas;
+
+interface
+
+type
+
+ TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
+ TFree = procedure (AppData, Block: Pointer);
+
+ // Internal structure. Ignore.
+ TZStreamRec = packed record
+ next_in: PChar; // next input byte
+ avail_in: Integer; // number of bytes available at next_in
+ total_in: Integer; // total nb of input bytes read so far
+
+ next_out: PChar; // next output byte should be put here
+ avail_out: Integer; // remaining free space at next_out
+ total_out: Integer; // total nb of bytes output so far
+
+ msg: PChar; // last error message, NULL if no error
+ internal: Pointer; // not visible by applications
+
+ zalloc: TAlloc; // used to allocate the internal state
+ zfree: TFree; // used to free the internal state
+ AppData: Pointer; // private data object passed to zalloc and zfree
+
+ data_type: Integer; // best guess about the data type: ascii or binary
+ adler: Integer; // adler32 value of the uncompressed data
+ reserved: Integer; // reserved for future use
+ end;
+
+function inflateInit_(var strm: TZStreamRec; version: PChar;
+ recsize: Integer): Integer; forward;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
+function inflateEnd(var strm: TZStreamRec): Integer; forward;
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
+ recsize: Integer): Integer; forward;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
+function deflateEnd(var strm: TZStreamRec): Integer; forward;
+
+const
+ zlib_version = '1.2.3';
+
+
+const
+ Z_NO_FLUSH = 0;
+ Z_PARTIAL_FLUSH = 1;
+ Z_SYNC_FLUSH = 2;
+ Z_FULL_FLUSH = 3;
+ Z_FINISH = 4;
+
+ Z_OK = 0;
+ Z_STREAM_END = 1;
+ Z_NEED_DICT = 2;
+ Z_ERRNO = (-1);
+ Z_STREAM_ERROR = (-2);
+ Z_DATA_ERROR = (-3);
+ Z_MEM_ERROR = (-4);
+ Z_BUF_ERROR = (-5);
+ Z_VERSION_ERROR = (-6);
+
+ Z_NO_COMPRESSION = 0;
+ Z_BEST_SPEED = 1;
+ Z_BEST_COMPRESSION = 9;
+ Z_DEFAULT_COMPRESSION = (-1);
+
+ Z_FILTERED = 1;
+ Z_HUFFMAN_ONLY = 2;
+ Z_DEFAULT_STRATEGY = 0;
+
+ Z_BINARY = 0;
+ Z_ASCII = 1;
+ Z_UNKNOWN = 2;
+
+ Z_DEFLATED = 8;
+
+ _z_errmsg: array[0..9] of PChar = (
+ 'need dictionary', // Z_NEED_DICT (2)
+ 'stream end', // Z_STREAM_END (1)
+ '', // Z_OK (0)
+ 'file error', // Z_ERRNO (-1)
+ 'stream error', // Z_STREAM_ERROR (-2)
+ 'data error', // Z_DATA_ERROR (-3)
+ 'insufficient memory', // Z_MEM_ERROR (-4)
+ 'buffer error', // Z_BUF_ERROR (-5)
+ 'incompatible version', // Z_VERSION_ERROR (-6)
+ ''
+ );
+
+implementation
+
+{$L obj\adler32.obj}
+{$L obj\deflate.obj}
+{$L obj\infback.obj}
+{$L obj\inffast.obj}
+{$L obj\inflate.obj}
+{$L obj\inftrees.obj}
+{$L obj\trees.obj}
+{$L obj\compress.obj}
+{$L obj\crc32.obj}
+
+
+
+function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; external;
+
+procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
+begin
+ FillChar(P^, count, B);
+end;
+
+procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
+begin
+ Move(source^, dest^, count);
+end;
+
+
+// deflate compresses data
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
+ recsize: Integer): Integer; external;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function deflateEnd(var strm: TZStreamRec): Integer; external;
+
+// inflate decompresses data
+function inflateInit_(var strm: TZStreamRec; version: PChar;
+ recsize: Integer): Integer; external;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function inflateEnd(var strm: TZStreamRec): Integer; external;
+function inflateReset(var strm: TZStreamRec): Integer; external;
+
+
+function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
+begin
+ GetMem(Result, Items*Size);
+end;
+
+procedure zcfree(AppData, Block: Pointer);
+begin
+ FreeMem(Block);
+end;
+
+end.
+
+
+
+
+
+
+
+
+
|