diff options
Diffstat (limited to '')
34 files changed, 1955 insertions, 11914 deletions
diff --git a/Game/Code/Classes/UImage.pas b/Game/Code/Classes/UImage.pas new file mode 100644 index 00000000..640e5202 --- /dev/null +++ b/Game/Code/Classes/UImage.pas @@ -0,0 +1,703 @@ +unit UImage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I ../switches.inc}
+
+uses
+ SDL;
+
+{$DEFINE HavePNG}
+{$DEFINE HaveBMP}
+{$DEFINE HaveJPG}
+
+const
+ PixelFmt_RGBA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 24;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_RGB: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 0;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGRA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 24;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGR: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 0;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+
+{$IFDEF HavePNG}
+function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveBMP}
+function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveJPG}
+function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+{$ENDIF}
+
+implementation
+
+uses
+ SysUtils,
+ Classes,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ {$IFDEF HaveJPG}
+ {$IFDEF Delphi}
+ Graphics,
+ jpeg,
+ {$ELSE}
+ jpeglib,
+ jerror,
+ jcparam,
+ jdatadst, jcapimin, jcapistd,
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF HavePNG}
+ png,
+ {$ENDIF}
+ zlib,
+ ULog;
+
+function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.RMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.BMask = $FF0000);
+end;
+
+function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.RMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.BMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.BMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.RMask = $FF0000);
+end;
+
+function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.BMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.RMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+(***************************
+ * PNG section
+ *****************************)
+
+{$IFDEF HavePNG}
+
+// delphi does not support setjmp()/longjmp() -> define our own error-handler
+procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl;
+begin
+ raise Exception.Create(error_msg);
+end;
+
+procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ inFile: TFileStream;
+begin
+ inFile := TFileStream(png_get_io_ptr(png_ptr));
+ inFile.Read(data^, length);
+end;
+
+procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ outFile: TFileStream;
+begin
+ outFile := TFileStream(png_get_io_ptr(png_ptr));
+ outFile.Write(data^, length);
+end;
+
+procedure user_flush_data(png_ptr: png_structp); cdecl;
+//var
+// outFile: TFileStream;
+begin
+ // binary files are flushed automatically, Flush() works with Text-files only
+ //outFile := TFileStream(png_get_io_ptr(png_ptr));
+ //outFile.Flush();
+end;
+
+procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time);
+var
+ year, month, day: word;
+ hour, minute, second, msecond: word;
+begin
+ DecodeDate(time, year, month, day);
+ pngTime.year := year;
+ pngTime.month := month;
+ pngTime.day := day;
+ DecodeTime(time, hour, minute, second, msecond);
+ pngTime.hour := hour;
+ pngTime.minute := minute;
+ pngTime.second := second;
+end;
+
+(*
+ * ImageData must be in RGB-format
+ *)
+function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+var
+ png_ptr: png_structp;
+ info_ptr: png_infop;
+ pngFile: TFileStream;
+ row: integer;
+ rowData: array of png_bytep;
+ rowStride: integer;
+ converted: boolean;
+ colorType: integer;
+ //time: png_time;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ pngFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage');
+ Exit;
+ end;
+
+ // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it
+ Surface := ConvertToRGB_RGBASurface(Surface, converted);
+
+ png_ptr := nil;
+
+ try
+ // initialize png (and enable a user-defined error-handler that throws an exception on error)
+ png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil);
+ // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil
+ if (png_ptr = nil) then
+ begin
+ Log.LogError('png_create_write_struct() failed', 'WritePngImage');
+ if (converted) then
+ SDL_FreeSurface(Surface);
+ Exit;
+ end;
+
+ info_ptr := png_create_info_struct(png_ptr);
+
+ if (Surface^.format^.BitsPerPixel = 24) then
+ colorType := PNG_COLOR_TYPE_RGB
+ else
+ colorType := PNG_COLOR_TYPE_RGBA;
+
+ // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi)
+ png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data);
+ png_set_IHDR(
+ png_ptr, info_ptr,
+ Surface.w, Surface.h,
+ 8,
+ colorType,
+ PNG_INTERLACE_NONE,
+ PNG_COMPRESSION_TYPE_DEFAULT,
+ PNG_FILTER_TYPE_DEFAULT
+ );
+
+ // TODO: do we need the modification time?
+ //DateTimeToPngTime(Now, time);
+ //png_set_tIME(png_ptr, info_ptr, @time);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // setup data
+ SetLength(rowData, Surface.h);
+ for row := 0 to Surface.h-1 do
+ begin
+ // set rowData-elements to beginning of each image row
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch];
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ png_write_info(png_ptr, info_ptr);
+ png_write_image(png_ptr, png_bytepp(rowData));
+ png_write_end(png_ptr, nil);
+
+ Result := true;
+ except on E: Exception do
+ Log.LogError(E.message, 'WritePngImage');
+ end;
+
+ // free row-data
+ SetLength(rowData, 0);
+
+ // free png-resources
+ if (png_ptr <> nil) then
+ png_destroy_write_struct(@png_ptr, nil);
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ pngFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * BMP section
+ *****************************)
+
+{$IFDEF HaveBMP}
+
+{$IFNDEF MSWINDOWS}
+const
+ (* constants for the biCompression field *)
+ BI_RGB = 0;
+ BI_RLE8 = 1;
+ BI_RLE4 = 2;
+ BI_BITFIELDS = 3;
+ BI_JPEG = 4;
+ BI_PNG = 5;
+
+type
+ BITMAPINFOHEADER = record
+ biSize: longword;
+ biWidth: longint;
+ biHeight: longint;
+ biPlanes: word;
+ biBitCount: word;
+ biCompression: longword;
+ biSizeImage: longword;
+ biXPelsPerMeter: longint;
+ biYPelsPerMeter: longint;
+ biClrUsed: longword;
+ biClrImportant: longword;
+ end;
+ LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+ TBITMAPINFOHEADER = BITMAPINFOHEADER;
+ PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+
+ RGBTRIPLE = record
+ rgbtBlue: byte;
+ rgbtGreen: byte;
+ rgbtRed: byte;
+ end;
+ tagRGBTRIPLE = RGBTRIPLE;
+ TRGBTRIPLE = RGBTRIPLE;
+ PRGBTRIPLE = ^RGBTRIPLE;
+
+ RGBQUAD = record
+ rgbBlue: byte;
+ rgbGreen: byte;
+ rgbRed: byte;
+ rgbReserved: byte;
+ end;
+ tagRGBQUAD = RGBQUAD;
+ TRGBQUAD = RGBQUAD;
+ PRGBQUAD = ^RGBQUAD;
+
+ BITMAPINFO = record
+ bmiHeader: BITMAPINFOHEADER;
+ bmiColors: array[0..0] of RGBQUAD;
+ end;
+ LPBITMAPINFO = ^BITMAPINFO;
+ PBITMAPINFO = ^BITMAPINFO;
+ TBITMAPINFO = BITMAPINFO;
+
+ {$PACKRECORDS 2}
+ BITMAPFILEHEADER = record
+ bfType: word;
+ bfSize: longword;
+ bfReserved1: word;
+ bfReserved2: word;
+ bfOffBits: longword;
+ end;
+ {$PACKRECORDS DEFAULT}
+{$ENDIF}
+
+(*
+ * ImageData must be in BGR-format
+ *)
+function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+var
+ bmpFile: TFileStream;
+ FileInfo: BITMAPINFOHEADER;
+ FileHeader: BITMAPFILEHEADER;
+ Converted: boolean;
+ Row: integer;
+ RowSize: integer;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ bmpFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage');
+ Exit;
+ end;
+
+ // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it
+ Surface := ConvertToBGR_BGRASurface(Surface, Converted);
+
+ // aligned (4-byte) row-size in bytes
+ RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4;
+
+ // initialize bitmap info
+ FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0);
+ with FileInfo do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := Surface^.format^.BitsPerPixel;
+ biCompression := BI_RGB;
+ biSizeImage := RowSize * Surface.h;
+ end;
+
+ // initialize header-data
+ FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0);
+ with FileHeader do
+ begin
+ bfType := $4D42; // = 'BM'
+ bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
+ bfSize := bfOffBits + FileInfo.biSizeImage;
+ end;
+
+ // and move the whole stuff into the file ;-)
+ try
+ // write headers
+ bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER));
+ bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER));
+
+ // write image-data
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // BMP needs 4-byte alignment
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // aligned correctly -> write whole image at once
+ bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage);
+ end
+ else
+ begin
+ // misaligned -> write each line separately
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for Row := 0 to Surface.h do
+ bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ Result := true;
+ finally
+ Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage');
+ end;
+
+ if (Converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ bmpFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * JPG section
+ *****************************)
+
+{$IFDEF HaveJPG}
+
+function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+var
+ {$IFDEF Delphi}
+ Bitmap: TBitmap;
+ BitmapInfo: TBitmapInfo;
+ Jpeg: TJpegImage;
+ row: integer;
+ {$ELSE}
+ cinfo: jpeg_compress_struct;
+ jerr : jpeg_error_mgr;
+ jpgFile: TFileStream;
+ rowPtr: array[0..0] of JSAMPROW;
+ {$ENDIF}
+ converted: boolean;
+begin
+ Result := false;
+
+ {$IFDEF Delphi}
+ // only 24bit (BGR) data is supported, so convert to it
+ if (IsBGRSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // create and setup bitmap
+ Bitmap := TBitmap.Create;
+ Bitmap.PixelFormat := pf24bit;
+ Bitmap.Width := Surface.w;
+ Bitmap.Height := Surface.h;
+
+ // setup bitmap info on source image (Surface parameter)
+ ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
+ with BitmapInfo.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := 24;
+ biCompression := BI_RGB;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // if the image is aligned (to a 4-byte boundary) -> copy all data at once
+ // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned
+ SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS);
+ end
+ else
+ begin
+ // wrong alignment -> copy each line separately.
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for row := 0 to Surface.h do
+ begin
+ SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch],
+ BitmapInfo, DIB_RGB_COLORS);
+ end;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // assign Bitmap to JPEG and store the latter
+ Jpeg := TJPEGImage.Create;
+ Jpeg.Assign(Bitmap);
+ Bitmap.Free;
+ Jpeg.CompressionQuality := Quality;
+ try
+ // compress image (don't forget this line, otherwise it won't be compressed)
+ Jpeg.Compress();
+ Jpeg.SaveToFile(FileName);
+ except
+ Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage');
+ Exit;
+ end;
+ Jpeg.Free;
+ {$ELSE}
+ // based on example.pas in FPC's packages/base/pasjpeg directory
+
+ // only 24bit (RGB) data is supported, so convert to it
+ if (IsRGBSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // allocate and initialize JPEG compression object
+ cinfo.err := jpeg_std_error(jerr);
+ // msg_level that will be displayed. (Nomssi)
+ //jerr.trace_level := 3;
+ // initialize the JPEG compression object
+ jpeg_create_compress(@cinfo);
+
+ // open file for writing
+ try
+ jpgFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage');
+ Exit;
+ end;
+
+ // specify data destination
+ jpeg_stdio_dest(@cinfo, @jpgFile);
+
+ // set parameters for compression
+ cinfo.image_width := Surface.w;
+ cinfo.image_height := Surface.h;
+ cinfo.in_color_space := JCS_RGB;
+ cinfo.input_components := 3;
+ cinfo.data_precision := 8;
+
+ // set default compression parameters
+ jpeg_set_defaults(@cinfo);
+ jpeg_set_quality(@cinfo, quality, true);
+
+ // start compressor
+ jpeg_start_compress(@cinfo, true);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ while (cinfo.next_scanline < cinfo.image_height) do
+ begin
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]);
+ jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // finish compression
+ jpeg_finish_compress(@cinfo);
+ // close the output file
+ jpgFile.Free;
+
+ // release JPEG compression object
+ jpeg_destroy_compress(@cinfo);
+ {$ENDIF}
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ Result := true;
+end;
+
+{$ENDIF}
+
+end.
diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 898c7193..2c6c2fe5 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -468,7 +468,7 @@ begin end // ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then - Display.ScreenShot + Display.SaveScreenShot // popup hack... if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f9f0cc10..35757a8e 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -18,6 +18,7 @@ uses OpenGL12, Classes, SysUtils, UCommon, + UImage, SDL, sdlutils, SDL_Image; @@ -139,46 +140,6 @@ uses ULog, {$ENDIF} StrUtils; -const - fmt_rgba: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 32; - BytesPerPixel: 4; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 0; - Gshift: 8; - Bshift: 16; - Ashift: 24; - Rmask: $000000ff; - Gmask: $0000ff00; - Bmask: $00ff0000; - Amask: $ff000000; - ColorKey: 0; - Alpha: 255 - ); - fmt_rgb: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 24; - BytesPerPixel: 3; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 0; - Gshift: 8; - Bshift: 16; - Ashift: 0; - Rmask: $000000ff; - Gmask: $0000ff00; - Bmask: $00ff0000; - Amask: $00000000; - ColorKey: 0; - Alpha: 255 - ); - Constructor TTextureUnit.Create; begin @@ -388,14 +349,14 @@ var TempSurface: PSDL_Surface; NeededPixFmt: PSDL_Pixelformat; begin - NeededPixFmt:=@fmt_rgba; - if (Typ = TEXTURE_TYPE_PLAIN) then NeededPixFmt:=@fmt_rgb - else - if (Typ = TEXTURE_TYPE_TRANSPARENT) or - (Typ = TEXTURE_TYPE_COLORIZED) - then NeededPixFmt:=@fmt_rgba + NeededPixFmt:=@PixelFmt_RGBA; + if (Typ = TEXTURE_TYPE_PLAIN) then + NeededPixFmt:=@PixelFmt_RGB + else if (Typ = TEXTURE_TYPE_TRANSPARENT) or + (Typ = TEXTURE_TYPE_COLORIZED) then + NeededPixFmt:=@PixelFmt_RGBA else - NeededPixFmt:=@fmt_rgb; + NeededPixFmt:=@PixelFmt_RGB; if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas deleted file mode 100644 index 2414002c..00000000 --- a/Game/Code/Classes/Ulazjpeg.pas +++ /dev/null @@ -1,151 +0,0 @@ -{ Copyright (C) 2003 Mattias Gaertner - - This library is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published by - the Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License - for more details. - - You should have received a copy of the GNU Library General Public License - along with this library; if not, write to the Free Software Foundation, - Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -} -unit Ulazjpeg; - -{$mode delphi} - -{$I switches.inc} - -interface - -uses - SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG, - UConfig; - -type - TJPEGQualityRange = TFPJPEGCompressionQuality; - TJPEGPerformance = TJPEGReadPerformance; - - TJPEGImage = class(TFPImageBitmap) - private - FPerformance: TJPEGPerformance; - FProgressiveEncoding: boolean; - FQuality: TJPEGQualityRange; - protected -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; -{$ELSE} - procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; -{$IFEND} - procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; -{$ELSE} - procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; -{$IFEND} - public - constructor Create; override; - class function GetFileExtensions: string; override; - class function GetDefaultFPReader: TFPCustomImageReaderClass; override; - class function GetDefaultFPWriter: TFPCustomImageWriterClass; override; - public - property CompressionQuality: TJPEGQualityRange read FQuality write FQuality; - property ProgressiveEncoding: boolean read FProgressiveEncoding; - property Performance: TJPEGPerformance read FPerformance write FPerformance; - end; - -const - DefaultJPEGMimeType = 'image/jpeg'; - - -implementation - - -{ TJPEGImage } - -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 -procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); -{$ELSE} -procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); -{$IFEND} -var - JPEGReader: TFPReaderJPEG; -begin - if ImgReader is TFPReaderJPEG then begin - JPEGReader:=TFPReaderJPEG(ImgReader); - JPEGReader.Performance:=Performance; -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - JPEGReader.OnProgress:=Progress; -{$IFEND} - end; -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - inherited InitFPImageReader(IntfImg, ImgReader); -{$ELSE} - inherited InitFPImageReader(ImgReader); -{$IFEND} -end; - -procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); -var - JPEGReader: TFPReaderJPEG; -begin - if ImgReader is TFPReaderJPEG then begin - JPEGReader:=TFPReaderJPEG(ImgReader); - FProgressiveEncoding:=JPEGReader.ProgressiveEncoding; - end; - inherited FinalizeFPImageReader(ImgReader); -end; - -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 -procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); -{$ELSE} -procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); -{$IFEND} -var - JPEGWriter: TFPWriterJPEG; -begin - if ImgWriter is TFPWriterJPEG then begin - JPEGWriter:=TFPWriterJPEG(ImgWriter); - if JPEGWriter<>nil then ; - JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; - JPEGWriter.CompressionQuality:=CompressionQuality; -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - JPEGWriter.OnProgress:=Progress; -{$IFEND} - end; -{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 - inherited InitFPImageWriter(IntfImg, ImgWriter); -{$ELSE} - inherited InitFPImageWriter(ImgWriter); -{$IFEND} -end; - -class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; -begin - Result:=TFPReaderJPEG; -end; - -class function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass; -begin - Result:=TFPWriterJPEG; -end; - -constructor TJPEGImage.Create; -begin - inherited Create; - FPerformance:=jpBestQuality; - FProgressiveEncoding:=false; - FQuality:=75; -end; - -class function TJPEGImage.GetFileExtensions: string; -begin - Result:='jpg;jpeg'; -end; - -end. - diff --git a/Game/Code/Menu/UDisplay.pas b/Game/Code/Menu/UDisplay.pas index 896e7656..19c42483 100644 --- a/Game/Code/Menu/UDisplay.pas +++ b/Game/Code/Menu/UDisplay.pas @@ -34,8 +34,6 @@ type OSD_LastError : String;
- PrintScreenData: array[0..1024*768-1] of longword;
-
procedure DrawDebugInformation;
public
NextScreen : PMenu;
@@ -50,8 +48,7 @@ type constructor Create;
destructor Destroy; override;
- procedure PrintScreen;
- procedure ScreenShot;
+ procedure SaveScreenShot;
function Draw: Boolean;
end;
@@ -62,18 +59,15 @@ var implementation
uses
- {$IFDEF Delphi}
- JPEG,
- graphics,
- {$ENDIF}
- TextGL,
-// ULog,
- UMain,
- UTexture,
- UIni,
- UGraphic,
- UTime,
- UCommandLine;
+ UImage,
+ TextGL,
+ ULog,
+ UMain,
+ UTexture,
+ UIni,
+ UGraphic,
+ UTime,
+ UCommandLine;
constructor TDisplay.Create;
var
@@ -327,111 +321,48 @@ begin Result := $FF div FadeStep;
end;}
-procedure TDisplay.PrintScreen;
-(*
+procedure TDisplay.SaveScreenShot;
var
- Bitmap: TBitmap;
- Jpeg: TJpegImage;
- X, Y: integer;
Num: integer;
FileName: string;
-*)
+ ScreenData: PChar;
+ Surface: PSDL_Surface;
+ Success: boolean;
+ Align: integer;
+ RowSize: integer;
begin
-(*
for Num := 1 to 9999 do
begin
FileName := IntToStr(Num);
while Length(FileName) < 4 do
FileName := '0' + FileName;
- FileName := ScreenshotsPath + 'screenshot' + FileName + '.jpg';
+ FileName := ScreenshotsPath + 'screenshot' + FileName + '.png';
if not FileExists(FileName) then
break
end;
- glReadPixels(0, 0, ScreenW, ScreenH, GL_RGBA, GL_UNSIGNED_BYTE, @PrintScreenData[0]);
- Bitmap := TBitmap.Create;
- Bitmap.Width := ScreenW;
- Bitmap.Height := ScreenH;
-
- for Y := 0 to ScreenH-1 do
- for X := 0 to ScreenW-1 do
- Bitmap.Canvas.Pixels[X, Y] := PrintScreenData[(ScreenH-1-Y) * ScreenW + X] and $00FFFFFF;
-
- Jpeg := TJpegImage.Create;
- Jpeg.Assign(Bitmap);
- Bitmap.Free;
- Jpeg.CompressionQuality := 95;//90;
- Jpeg.SaveToFile(FileName);
- Jpeg.Free;
-*)
-end;
-
-procedure TDisplay.ScreenShot;
-{
-var
- F : file;
- FileInfo: BITMAPINFOHEADER;
- FileHeader : BITMAPFILEHEADER;
- pPicData:Pointer;
- FileName: String;
- Num: Integer;
-}
-begin
- // FIXME: something broken in here... quick fix... disabled it
- Exit;
-{
- // search image-file
- for Num := 1 to 9999 do
- begin
- FileName := IntToStr(Num);
- while Length(FileName) < 4 do
- FileName := '0' + FileName;
- FileName := ScreenshotsPath + FileName + '.BMP';
- if not FileExists(FileName) then
- break
- end;
+ // we must take the row-alignment (4byte by default) into account
+ glGetIntegerv(GL_PACK_ALIGNMENT, @Align);
+ // calc aligned row-size
+ RowSize := ((ScreenW*3 + (Align-1)) div Align) * Align;
+
+ GetMem(ScreenData, RowSize * ScreenH);
+ glReadPixels(0, 0, ScreenW, ScreenH, GL_BGR, GL_UNSIGNED_BYTE, ScreenData);
+ Surface := SDL_CreateRGBSurfaceFrom(
+ ScreenData, ScreenW, ScreenH, 24, RowSize,
+ //$0000FF, $00FF00, $FF0000, 0);
+ $FF0000, $00FF00, $0000FF, 0);
+
+ //Success := WriteJPGImage(FileName, Surface, 95);
+ //Success := WriteBMPImage(FileName, Surface);
+ Success := WritePNGImage(FileName, Surface);
+ if Success then
+ ScreenPopupError.ShowPopup('Screenshot saved: ' + ExtractFileName(FileName))
+ else
+ ScreenPopupError.ShowPopup('Screenshot failed');
- // prepare header memory
- ZeroMemory(@FileHeader, SizeOf(BITMAPFILEHEADER));
- ZeroMemory(@FileInfo , SizeOf(BITMAPINFOHEADER));
-
- // initialize header-data
- FileHeader.bfType := 19778; // $4D42 = 'BM'
- FileHeader.bfOffBits := SizeOf(BITMAPINFOHEADER)+SizeOf(BITMAPFILEHEADER);
-
- // write bitmap info
- FileInfo.biSize := SizeOf(BITMAPINFOHEADER);
- FileInfo.biWidth := ScreenW;
- FileInfo.biHeight := ScreenH;
- FileInfo.biPlanes := 1;
- FileInfo.biBitCount := 32;
- FileInfo.biSizeImage := FileInfo.biWidth*FileInfo.biHeight*(FileInfo.biBitCount div 8);
-
- // copy size-info to header
- FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage;
-
- // reserve memory for image-data
- GetMem(pPicData, FileInfo.biSizeImage);
- try
- // retrieve image-data from OpenGL (see above)
- glReadPixels(0, 0, ScreenW, ScreenH, GL_BGRA, GL_UNSIGNED_BYTE, pPicData);
-
- // and move the whole stuff into the file ;-)
- // up-to-date guys use streams for this purpose ...
- AssignFile(f, Filename);
- Rewrite( f,1 );
- try
- BlockWrite(F, FileHeader, SizeOf(BITMAPFILEHEADER));
- BlockWrite(F, FileInfo, SizeOf(BITMAPINFOHEADER));
- BlockWrite(F, pPicData^, FileInfo.biSizeImage );
- finally
- CloseFile(f);
- end;
- finally
- // free allocated data ...
- FreeMem(pPicData, FileInfo.biSizeImage);
- end;
-}
+ SDL_FreeSurface(Surface);
+ FreeMem(ScreenData);
end;
//------------
diff --git a/Game/Code/Screens/UScreenScore.pas b/Game/Code/Screens/UScreenScore.pas index 3ce60b2b..9a13681b 100644 --- a/Game/Code/Screens/UScreenScore.pas +++ b/Game/Code/Screens/UScreenScore.pas @@ -175,7 +175,7 @@ begin end;
SDLK_SYSREQ:
begin
- Display.PrintScreen;
+ Display.SaveScreenShot;
end;
end;
end;
@@ -619,6 +619,7 @@ begin end;
// end todo
+ {{$IFDEF TRANSLATE}
case (Player[PlayerNumber-1].ScoreTotalI) of
0..2000:
begin
@@ -656,6 +657,17 @@ begin Rating := 6;
end;
end;
+ {{$ELSE}{
+ case (Player[PlayerNumber-1].ScoreTotalI) of
+ 0..2000: Text[TextScore[fu]].Text := 'Tone Deaf';
+ 2010..4000: Text[TextScore[fu]].Text := 'Amateur';
+ 4010..6000: Text[TextScore[fu]].Text := 'Rising Star';
+ 6010..8000: Text[TextScore[fu]].Text := 'Lead Singer';
+ 8010..9000: Text[TextScore[fu]].Text := 'Hit Artist';
+ 9010..9800: Text[TextScore[fu]].Text := 'Superstar';
+ 9810..10000: Text[TextScore[fu]].Text := 'Ultrastar';
+ end;
+ {$ENDIF}
// Bounce the rating picture in
PosX := aPlayerScoreScreenRatings[PlayerNumber].RatePic_X + (aPlayerScoreScreenRatings[PlayerNumber].RatePic_Width / 2);
diff --git a/Game/Code/Screens/UScreenTop5.pas b/Game/Code/Screens/UScreenTop5.pas index 4b3356dc..2a673880 100644 --- a/Game/Code/Screens/UScreenTop5.pas +++ b/Game/Code/Screens/UScreenTop5.pas @@ -59,7 +59,7 @@ begin end; SDLK_SYSREQ: begin - Display.PrintScreen; + Display.SaveScreenShot; end; end; end; diff --git a/Game/Code/UltraStar.dpr b/Game/Code/UltraStar.dpr index 5f1ba7e1..9dd65fc8 100644 --- a/Game/Code/UltraStar.dpr +++ b/Game/Code/UltraStar.dpr @@ -25,6 +25,9 @@ uses sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas', sdlutils in 'lib\JEDI-SDL\SDL\Pas\sdlutils.pas', + zlib in 'lib\zlib\zlib.pas', + png in 'lib\libpng\png.pas', + {$IFDEF UseBass} bass in 'lib\bass\delphi\bass.pas', UAudioCore_Bass in 'Classes\UAudioCore_Bass.pas', @@ -109,6 +112,7 @@ uses UXMLSong in 'Classes\UXMLSong.pas', USongs in 'Classes\USongs.pas', UIni in 'Classes\UIni.pas', + UImage in 'Classes\UImage.pas', ULyrics in 'Classes\ULyrics.pas', ULyrics_bak in 'Classes\ULyrics_bak.pas', USkins in 'Classes\USkins.pas', diff --git a/Game/Code/lib/PngImage/Tpngimage.DPK b/Game/Code/lib/PngImage/Tpngimage.DPK deleted file mode 100644 index b9c395f4..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.DPK +++ /dev/null @@ -1,34 +0,0 @@ -package Tpngimage;
-
-{$R *.res}
-{$ALIGN 8}
-{$ASSERTIONS ON}
-{$BOOLEVAL OFF}
-{$DEBUGINFO ON}
-{$EXTENDEDSYNTAX ON}
-{$IMPORTEDDATA ON}
-{$IOCHECKS ON}
-{$LOCALSYMBOLS ON}
-{$LONGSTRINGS ON}
-{$OPENSTRINGS ON}
-{$OPTIMIZATION ON}
-{$OVERFLOWCHECKS OFF}
-{$RANGECHECKS OFF}
-{$REFERENCEINFO ON}
-{$SAFEDIVIDE OFF}
-{$STACKFRAMES OFF}
-{$TYPEDADDRESS OFF}
-{$VARSTRINGCHECKS ON}
-{$WRITEABLECONST OFF}
-{$MINENUMSIZE 1}
-{$IMAGEBASE $400000}
-{$IMPLICITBUILD OFF}
-
-requires
- rtl,
- vcl;
-
-contains
- pngimage in 'pngimage.pas';
-
-end.
diff --git a/Game/Code/lib/PngImage/Tpngimage.bdsproj b/Game/Code/lib/PngImage/Tpngimage.bdsproj deleted file mode 100644 index b7a30970..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.bdsproj +++ /dev/null @@ -1,177 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<BorlandProject>
- <PersonalityInfo>
- <Option>
- <Option Name="Personality">Delphi.Personality</Option>
- <Option Name="ProjectType"></Option>
- <Option Name="Version">1.0</Option>
- <Option Name="GUID">{2C0AD708-246C-40AA-902E-B3901926A7DC}</Option>
- </Option>
- </PersonalityInfo>
- <Delphi.Personality>
- <Source>
- <Source Name="MainSource">Tpngimage.DPK</Source>
- </Source>
- <FileVersion>
- <FileVersion Name="Version">7.0</FileVersion>
- </FileVersion>
- <Compiler>
- <Compiler Name="A">8</Compiler>
- <Compiler Name="B">0</Compiler>
- <Compiler Name="C">1</Compiler>
- <Compiler Name="D">1</Compiler>
- <Compiler Name="E">0</Compiler>
- <Compiler Name="F">0</Compiler>
- <Compiler Name="G">1</Compiler>
- <Compiler Name="H">1</Compiler>
- <Compiler Name="I">1</Compiler>
- <Compiler Name="J">0</Compiler>
- <Compiler Name="K">0</Compiler>
- <Compiler Name="L">1</Compiler>
- <Compiler Name="M">0</Compiler>
- <Compiler Name="N">1</Compiler>
- <Compiler Name="O">1</Compiler>
- <Compiler Name="P">1</Compiler>
- <Compiler Name="Q">0</Compiler>
- <Compiler Name="R">0</Compiler>
- <Compiler Name="S">0</Compiler>
- <Compiler Name="T">0</Compiler>
- <Compiler Name="U">0</Compiler>
- <Compiler Name="V">1</Compiler>
- <Compiler Name="W">0</Compiler>
- <Compiler Name="X">1</Compiler>
- <Compiler Name="Y">1</Compiler>
- <Compiler Name="Z">1</Compiler>
- <Compiler Name="ShowHints">True</Compiler>
- <Compiler Name="ShowWarnings">True</Compiler>
- <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
- <Compiler Name="NamespacePrefix"></Compiler>
- <Compiler Name="GenerateDocumentation">False</Compiler>
- <Compiler Name="DefaultNamespace"></Compiler>
- <Compiler Name="SymbolDeprecated">True</Compiler>
- <Compiler Name="SymbolLibrary">True</Compiler>
- <Compiler Name="SymbolPlatform">True</Compiler>
- <Compiler Name="SymbolExperimental">True</Compiler>
- <Compiler Name="UnitLibrary">True</Compiler>
- <Compiler Name="UnitPlatform">True</Compiler>
- <Compiler Name="UnitDeprecated">True</Compiler>
- <Compiler Name="UnitExperimental">True</Compiler>
- <Compiler Name="HResultCompat">True</Compiler>
- <Compiler Name="HidingMember">True</Compiler>
- <Compiler Name="HiddenVirtual">True</Compiler>
- <Compiler Name="Garbage">True</Compiler>
- <Compiler Name="BoundsError">True</Compiler>
- <Compiler Name="ZeroNilCompat">True</Compiler>
- <Compiler Name="StringConstTruncated">True</Compiler>
- <Compiler Name="ForLoopVarVarPar">True</Compiler>
- <Compiler Name="TypedConstVarPar">True</Compiler>
- <Compiler Name="AsgToTypedConst">True</Compiler>
- <Compiler Name="CaseLabelRange">True</Compiler>
- <Compiler Name="ForVariable">True</Compiler>
- <Compiler Name="ConstructingAbstract">True</Compiler>
- <Compiler Name="ComparisonFalse">True</Compiler>
- <Compiler Name="ComparisonTrue">True</Compiler>
- <Compiler Name="ComparingSignedUnsigned">True</Compiler>
- <Compiler Name="CombiningSignedUnsigned">True</Compiler>
- <Compiler Name="UnsupportedConstruct">True</Compiler>
- <Compiler Name="FileOpen">True</Compiler>
- <Compiler Name="FileOpenUnitSrc">True</Compiler>
- <Compiler Name="BadGlobalSymbol">True</Compiler>
- <Compiler Name="DuplicateConstructorDestructor">True</Compiler>
- <Compiler Name="InvalidDirective">True</Compiler>
- <Compiler Name="PackageNoLink">True</Compiler>
- <Compiler Name="PackageThreadVar">True</Compiler>
- <Compiler Name="ImplicitImport">True</Compiler>
- <Compiler Name="HPPEMITIgnored">True</Compiler>
- <Compiler Name="NoRetVal">True</Compiler>
- <Compiler Name="UseBeforeDef">True</Compiler>
- <Compiler Name="ForLoopVarUndef">True</Compiler>
- <Compiler Name="UnitNameMismatch">True</Compiler>
- <Compiler Name="NoCFGFileFound">True</Compiler>
- <Compiler Name="MessageDirective">True</Compiler>
- <Compiler Name="ImplicitVariants">True</Compiler>
- <Compiler Name="UnicodeToLocale">True</Compiler>
- <Compiler Name="LocaleToUnicode">True</Compiler>
- <Compiler Name="ImagebaseMultiple">True</Compiler>
- <Compiler Name="SuspiciousTypecast">True</Compiler>
- <Compiler Name="PrivatePropAccessor">True</Compiler>
- <Compiler Name="UnsafeType">False</Compiler>
- <Compiler Name="UnsafeCode">False</Compiler>
- <Compiler Name="UnsafeCast">False</Compiler>
- <Compiler Name="OptionTruncated">True</Compiler>
- <Compiler Name="WideCharReduced">True</Compiler>
- <Compiler Name="DuplicatesIgnored">True</Compiler> <Compiler Name="UnitInitSeq">True</Compiler>
- <Compiler Name="LocalPInvoke">True</Compiler>
- <Compiler Name="CodePage"></Compiler>
- </Compiler>
- <Linker>
- <Linker Name="MapFile">3</Linker>
- <Linker Name="OutputObjs">0</Linker>
- <Linker Name="ConsoleApp">1</Linker>
- <Linker Name="DebugInfo">False</Linker>
- <Linker Name="RemoteSymbols">False</Linker>
- <Linker Name="GenerateDRC">False</Linker>
- <Linker Name="MinStackSize">16384</Linker>
- <Linker Name="MaxStackSize">1048576</Linker>
- <Linker Name="ImageBase">4194304</Linker>
- <Linker Name="ExeDescription"></Linker> <Linker Name="GenerateHpps">False</Linker>
- </Linker>
- <Directories>
- <Directories Name="OutputDir"></Directories>
- <Directories Name="UnitOutputDir"></Directories>
- <Directories Name="PackageDLLOutputDir"></Directories>
- <Directories Name="PackageDCPOutputDir"></Directories>
- <Directories Name="SearchPath"></Directories>
- <Directories Name="Packages"></Directories>
- <Directories Name="Conditionals"></Directories>
- <Directories Name="DebugSourceDirs"></Directories>
- <Directories Name="UsePackages">False</Directories>
- </Directories>
- <Parameters>
- <Parameters Name="RunParams"></Parameters>
- <Parameters Name="HostApplication"></Parameters>
- <Parameters Name="Launcher"></Parameters>
- <Parameters Name="UseLauncher">False</Parameters>
- <Parameters Name="DebugCWD"></Parameters>
- <Parameters Name="RemoteHost"></Parameters>
- <Parameters Name="RemotePath"></Parameters>
- <Parameters Name="RemoteLauncher"></Parameters>
- <Parameters Name="RemoteCWD"></Parameters>
- <Parameters Name="RemoteDebug">False</Parameters> <Parameters Name="Debug Symbols Search Path"></Parameters>
- <Parameters Name="LoadAllSymbols">True</Parameters>
- <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
- </Parameters>
- <Language>
- <Language Name="ActiveLang"></Language>
- <Language Name="ProjectLang">$00000000</Language>
- <Language Name="RootDir">C:\Program Files\Borland\Delphi7\Bin\</Language>
- </Language>
- <VersionInfo>
- <VersionInfo Name="IncludeVerInfo">True</VersionInfo>
- <VersionInfo Name="AutoIncBuild">False</VersionInfo>
- <VersionInfo Name="MajorVer">1</VersionInfo>
- <VersionInfo Name="MinorVer">0</VersionInfo>
- <VersionInfo Name="Release">0</VersionInfo>
- <VersionInfo Name="Build">0</VersionInfo>
- <VersionInfo Name="Debug">False</VersionInfo>
- <VersionInfo Name="PreRelease">False</VersionInfo>
- <VersionInfo Name="Special">False</VersionInfo>
- <VersionInfo Name="Private">False</VersionInfo>
- <VersionInfo Name="DLL">False</VersionInfo>
- <VersionInfo Name="Locale">1033</VersionInfo>
- <VersionInfo Name="CodePage">1252</VersionInfo>
- </VersionInfo>
- <VersionInfoKeys>
- <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
- <VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
- <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
- <VersionInfoKeys Name="InternalName"></VersionInfoKeys>
- <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
- <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
- <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
- <VersionInfoKeys Name="ProductName"></VersionInfoKeys>
- <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
- <VersionInfoKeys Name="Comments"></VersionInfoKeys>
- </VersionInfoKeys>
- </Delphi.Personality>
-</BorlandProject>
diff --git a/Game/Code/lib/PngImage/Tpngimage.bdsproj.local b/Game/Code/lib/PngImage/Tpngimage.bdsproj.local deleted file mode 100644 index d576f039..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.bdsproj.local +++ /dev/null @@ -1,2 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<BorlandProject/>
diff --git a/Game/Code/lib/PngImage/Tpngimage.cfg b/Game/Code/lib/PngImage/Tpngimage.cfg deleted file mode 100644 index 4a78a005..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.cfg +++ /dev/null @@ -1,40 +0,0 @@ --$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q-
--$R-
--$S-
--$T-
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--GD
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"C:\Documents and Settings\Jay Binks\My Documents\Borland Studio Projects\Bpl"
--LN"C:\Documents and Settings\Jay Binks\My Documents\Borland Studio Projects\Bpl"
--Z
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Game/Code/lib/PngImage/Tpngimage.dof b/Game/Code/lib/PngImage/Tpngimage.dof deleted file mode 100644 index 45e43c01..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.dof +++ /dev/null @@ -1,136 +0,0 @@ -[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;VclSmp;vclshlctrls;VirtualTreesD7;Tpngimage;THTTPGet;XmlComponents_D6;EmbWb;TINetDetector;FolderDialog;Indy70;madBasic_;madHelp_;madDisAsm_;madExcept_;madRemote_;madKernel_;madCodeHook_;madSecurity_;madShell_;TRegs32;Progress;TTRAYICON;TXPPanel;DelphiX_for5
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=C:\Program Files\Borland\Delphi7\Bin\
-[Version Info]
-IncludeVerInfo=1
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Game/Code/lib/PngImage/Tpngimage.drc b/Game/Code/lib/PngImage/Tpngimage.drc deleted file mode 100644 index 52d3a522..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.drc +++ /dev/null @@ -1,62 +0,0 @@ -/* VER180
- Generated by the Borland Delphi Pascal Compiler
- because -GD or --drc was supplied to the compiler.
-
- This file contains compiler-generated resources that
- were bound to the executable.
- If this file is empty, then no compiler-generated
- resources were bound to the produced executable.
-*/
-
-#define pnglang_EPNGNoImageDataText 65504
-#define pnglang_EPNGCannotChangeSizeText 65505
-#define pnglang_EPNGCannotAddChunkText 65506
-#define pnglang_EPNGCannotAddInvalidImageText 65507
-#define pnglang_EPNGCouldNotLoadResourceText 65508
-#define pnglang_EPNGOutMemoryText 65509
-#define pnglang_EPNGCannotChangeTransparentText 65510
-#define pnglang_EPNGHeaderNotPresentText 65511
-#define pnglang_EPngInvalidCRCText 65520
-#define pnglang_EPNGInvalidIHDRText 65521
-#define pnglang_EPNGMissingMultipleIDATText 65522
-#define pnglang_EPNGZLIBErrorText 65523
-#define pnglang_EPNGInvalidPaletteText 65524
-#define pnglang_EPNGInvalidFileHeaderText 65525
-#define pnglang_EPNGIHDRNotFirstText 65526
-#define pnglang_EPNGNotExistsText 65527
-#define pnglang_EPNGSizeExceedsText 65528
-#define pnglang_EPNGUnknownPalEntryText 65529
-#define pnglang_EPNGMissingPaletteText 65530
-#define pnglang_EPNGUnknownCriticalChunkText 65531
-#define pnglang_EPNGUnknownCompressionText 65532
-#define pnglang_EPNGUnknownInterlaceText 65533
-#define pnglang_EPNGCannotAssignChunkText 65534
-#define pnglang_EPNGUnexpectedEndText 65535
-STRINGTABLE
-BEGIN
- pnglang_EPNGNoImageDataText, "This \"Portable Network Graphics\" image contains no data."
- pnglang_EPNGCannotChangeSizeText, "The \"Portable Network Graphics\" image can not be resize by changing width and height properties. Try assigning the image from a bitmap."
- pnglang_EPNGCannotAddChunkText, "The program tried to add a existent critical chunk to the current image which is not allowed."
- pnglang_EPNGCannotAddInvalidImageText, "It's not allowed to add a new chunk because the current image is invalid."
- pnglang_EPNGCouldNotLoadResourceText, "The png image could not be loaded from the resource ID."
- pnglang_EPNGOutMemoryText, "Some operation could not be performed because the system is out of resources. Close some windows and try again."
- pnglang_EPNGCannotChangeTransparentText, "Setting bit transparency color is not allowed for png images containing alpha value for each pixel (COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)"
- pnglang_EPNGHeaderNotPresentText, "This operation is not valid because the current image contains no valid header."
- pnglang_EPngInvalidCRCText, "This \"Portable Network Graphics\" image is not valid because it contains invalid pieces of data (crc error)"
- pnglang_EPNGInvalidIHDRText, "The \"Portable Network Graphics\" image could not be loaded because one of its main piece of data (ihdr) might be corrupted"
- pnglang_EPNGMissingMultipleIDATText, "This \"Portable Network Graphics\" image is invalid because it has missing image parts."
- pnglang_EPNGZLIBErrorText, "Could not decompress the image because it contains invalid compressed data.\r\n Description: "
- pnglang_EPNGInvalidPaletteText, "The \"Portable Network Graphics\" image contains an invalid palette."
- pnglang_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."
- pnglang_EPNGIHDRNotFirstText, "This \"Portable Network Graphics\" image is not supported or it might be invalid.\r\n(IHDR chunk is not the first)"
- pnglang_EPNGNotExistsText, "The png file could not be loaded because it does not exists."
- pnglang_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."
- pnglang_EPNGUnknownPalEntryText, "There is no such palette entry."
- pnglang_EPNGMissingPaletteText, "This \"Portable Network Graphics\" could not be loaded because it uses a color table which is missing."
- pnglang_EPNGUnknownCriticalChunkText, "This \"Portable Network Graphics\" image contains an unknown critical part which could not be decoded."
- pnglang_EPNGUnknownCompressionText, "This \"Portable Network Graphics\" image is encoded with an unknown compression scheme which could not be decoded."
- pnglang_EPNGUnknownInterlaceText, "This \"Portable Network Graphics\" image uses an unknown interlace scheme which could not be decoded."
- pnglang_EPNGCannotAssignChunkText, "The chunks must be compatible to be assigned."
- pnglang_EPNGUnexpectedEndText, "This \"Portable Network Graphics\" image is invalid because the decoder found an unexpected end of the file."
-END
-
diff --git a/Game/Code/lib/PngImage/Tpngimage.res b/Game/Code/lib/PngImage/Tpngimage.res Binary files differdeleted file mode 100644 index aac9aa64..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.res +++ /dev/null diff --git a/Game/Code/lib/PngImage/Tpngimage.stat b/Game/Code/lib/PngImage/Tpngimage.stat deleted file mode 100644 index 57f32789..00000000 --- a/Game/Code/lib/PngImage/Tpngimage.stat +++ /dev/null @@ -1,10 +0,0 @@ -[Stats]
-EditorSecs=3
-DesignerSecs=1
-InspectorSecs=1
-CompileSecs=1542
-OtherSecs=11
-StartTime=5/6/2004 7:36:05 PM
-RealKeys=0
-EffectiveKeys=0
-DebugSecs=1
diff --git a/Game/Code/lib/PngImage/lazarustest.lpi b/Game/Code/lib/PngImage/lazarustest.lpi deleted file mode 100644 index 4dec8a9e..00000000 --- a/Game/Code/lib/PngImage/lazarustest.lpi +++ /dev/null @@ -1,239 +0,0 @@ -<?xml version="1.0"?>
-<CONFIG>
- <ProjectOptions>
- <PathDelim Value="\"/>
- <Version Value="5"/>
- <General>
- <MainUnit Value="0"/>
- <IconPath Value="./"/>
- <TargetFileExt Value=".exe"/>
- <ActiveEditorIndexAtStart Value="0"/>
- </General>
- <VersionInfo>
- <ProjectVersion Value=""/>
- <Language Value=""/>
- <CharSet Value=""/>
- </VersionInfo>
- <PublishOptions>
- <Version Value="2"/>
- <IgnoreBinaries Value="False"/>
- <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
- <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
- </PublishOptions>
- <RunParams>
- <local>
- <FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
- </local>
- </RunParams>
- <Units Count="8">
- <Unit0>
- <Filename Value="lazarustest.lpr"/>
- <IsPartOfProject Value="True"/>
- <UnitName Value="lazarustest"/>
- <CursorPos X="49" Y="11"/>
- <TopLine Value="1"/>
- <EditorIndex Value="0"/>
- <UsageCount Value="23"/>
- <Loaded Value="True"/>
- </Unit0>
- <Unit1>
- <Filename Value="delphi\bass.pas"/>
- <UnitName Value="Bass"/>
- <CursorPos X="12" Y="539"/>
- <TopLine Value="589"/>
- <UsageCount Value="10"/>
- </Unit1>
- <Unit2>
- <Filename Value="avformat.pas"/>
- <UnitName Value="avformat"/>
- <CursorPos X="38" Y="594"/>
- <TopLine Value="567"/>
- <UsageCount Value="10"/>
- </Unit2>
- <Unit3>
- <Filename Value="avcodec.pas"/>
- <UnitName Value="avcodec"/>
- <CursorPos X="3" Y="1796"/>
- <TopLine Value="1775"/>
- <UsageCount Value="11"/>
- </Unit3>
- <Unit4>
- <Filename Value="avio.pas"/>
- <UnitName Value="avio"/>
- <CursorPos X="1" Y="1"/>
- <TopLine Value="1"/>
- <UsageCount Value="11"/>
- </Unit4>
- <Unit5>
- <Filename Value="pngimage.pas"/>
- <UnitName Value="pngimage"/>
- <CursorPos X="20" Y="133"/>
- <TopLine Value="121"/>
- <EditorIndex Value="1"/>
- <UsageCount Value="10"/>
- <Loaded Value="True"/>
- </Unit5>
- <Unit6>
- <Filename Value="pngzlib.pas"/>
- <UnitName Value="pngzlib"/>
- <CursorPos X="6" Y="111"/>
- <TopLine Value="91"/>
- <EditorIndex Value="3"/>
- <UsageCount Value="10"/>
- <Loaded Value="True"/>
- </Unit6>
- <Unit7>
- <Filename Value="pnglang.pas"/>
- <UnitName Value="pnglang"/>
- <CursorPos X="1" Y="1"/>
- <TopLine Value="1"/>
- <EditorIndex Value="2"/>
- <UsageCount Value="10"/>
- <Loaded Value="True"/>
- </Unit7>
- </Units>
- <JumpHistory Count="30" HistoryIndex="29">
- <Position1>
- <Filename Value="pngimage.pas"/>
- <Caret Line="4037" Column="16" TopLine="4017"/>
- </Position1>
- <Position2>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="19" Column="1" TopLine="1"/>
- </Position2>
- <Position3>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="6" Column="1" TopLine="1"/>
- </Position3>
- <Position4>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="4" Column="1" TopLine="1"/>
- </Position4>
- <Position5>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="8" Column="30" TopLine="1"/>
- </Position5>
- <Position6>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="38" Column="37" TopLine="18"/>
- </Position6>
- <Position7>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="52" Column="16" TopLine="31"/>
- </Position7>
- <Position8>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="6" Column="1" TopLine="1"/>
- </Position8>
- <Position9>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="124" Column="82" TopLine="86"/>
- </Position9>
- <Position10>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="1" Column="1" TopLine="1"/>
- </Position10>
- <Position11>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="103" Column="6" TopLine="83"/>
- </Position11>
- <Position12>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="104" Column="6" TopLine="84"/>
- </Position12>
- <Position13>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="105" Column="6" TopLine="85"/>
- </Position13>
- <Position14>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="106" Column="6" TopLine="86"/>
- </Position14>
- <Position15>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="107" Column="6" TopLine="87"/>
- </Position15>
- <Position16>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="108" Column="6" TopLine="88"/>
- </Position16>
- <Position17>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="109" Column="6" TopLine="89"/>
- </Position17>
- <Position18>
- <Filename Value="pngzlib.pas"/>
- <Caret Line="110" Column="6" TopLine="90"/>
- </Position18>
- <Position19>
- <Filename Value="pngimage.pas"/>
- <Caret Line="4037" Column="62" TopLine="4017"/>
- </Position19>
- <Position20>
- <Filename Value="pnglang.pas"/>
- <Caret Line="275" Column="31" TopLine="255"/>
- </Position20>
- <Position21>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="19" Column="1" TopLine="1"/>
- </Position21>
- <Position22>
- <Filename Value="pngimage.pas"/>
- <Caret Line="1" Column="1" TopLine="1"/>
- </Position22>
- <Position23>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="19" Column="1" TopLine="1"/>
- </Position23>
- <Position24>
- <Filename Value="pngimage.pas"/>
- <Caret Line="1" Column="1" TopLine="1"/>
- </Position24>
- <Position25>
- <Filename Value="pngimage.pas"/>
- <Caret Line="139" Column="10" TopLine="119"/>
- </Position25>
- <Position26>
- <Filename Value="pngimage.pas"/>
- <Caret Line="138" Column="1" TopLine="119"/>
- </Position26>
- <Position27>
- <Filename Value="pngimage.pas"/>
- <Caret Line="146" Column="38" TopLine="121"/>
- </Position27>
- <Position28>
- <Filename Value="pngimage.pas"/>
- <Caret Line="141" Column="2" TopLine="121"/>
- </Position28>
- <Position29>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="11" Column="20" TopLine="1"/>
- </Position29>
- <Position30>
- <Filename Value="lazarustest.lpr"/>
- <Caret Line="14" Column="1" TopLine="1"/>
- </Position30>
- </JumpHistory>
- </ProjectOptions>
- <CompilerOptions>
- <Version Value="5"/>
- <PathDelim Value="\"/>
- <CodeGeneration>
- <Generate Value="Faster"/>
- </CodeGeneration>
- <Other>
- <CompilerPath Value="$(CompPath)"/>
- </Other>
- </CompilerOptions>
- <Debugging>
- <Exceptions Count="2">
- <Item1>
- <Name Value="ECodetoolError"/>
- </Item1>
- <Item2>
- <Name Value="EFOpenError"/>
- </Item2>
- </Exceptions>
- </Debugging>
-</CONFIG>
diff --git a/Game/Code/lib/PngImage/lazarustest.lpr b/Game/Code/lib/PngImage/lazarustest.lpr deleted file mode 100644 index f567b6cb..00000000 --- a/Game/Code/lib/PngImage/lazarustest.lpr +++ /dev/null @@ -1,15 +0,0 @@ -program lazarustest;
-
-uses
- pngimage in 'pngimage.pas',
- pnglang in 'pnglang.pas',
- pngzlib in 'pngzlib.pas',
- sysutils;
-
-begin
- writeln( 'pngimage is NOT lazarus compatible' );
- writeln( 'It might compile ( not link though ), however the object files are in borland obj format' );
- writeln( 'to use this, it will need to be in GCC object file format format' );
- writeln( 'Or we can use the lazarus / freepascal png unit' );
-end.
-
diff --git a/Game/Code/lib/PngImage/obj/adler32.obj b/Game/Code/lib/PngImage/obj/adler32.obj Binary files differdeleted file mode 100644 index 7da9fd19..00000000 --- a/Game/Code/lib/PngImage/obj/adler32.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/deflate.obj b/Game/Code/lib/PngImage/obj/deflate.obj Binary files differdeleted file mode 100644 index 804e9334..00000000 --- a/Game/Code/lib/PngImage/obj/deflate.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/infblock.obj b/Game/Code/lib/PngImage/obj/infblock.obj Binary files differdeleted file mode 100644 index 3bc38e41..00000000 --- a/Game/Code/lib/PngImage/obj/infblock.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/infcodes.obj b/Game/Code/lib/PngImage/obj/infcodes.obj Binary files differdeleted file mode 100644 index faec2222..00000000 --- a/Game/Code/lib/PngImage/obj/infcodes.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/inffast.obj b/Game/Code/lib/PngImage/obj/inffast.obj Binary files differdeleted file mode 100644 index 62e18ceb..00000000 --- a/Game/Code/lib/PngImage/obj/inffast.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/inflate.obj b/Game/Code/lib/PngImage/obj/inflate.obj Binary files differdeleted file mode 100644 index 7dc522e0..00000000 --- a/Game/Code/lib/PngImage/obj/inflate.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/inftrees.obj b/Game/Code/lib/PngImage/obj/inftrees.obj Binary files differdeleted file mode 100644 index 5755233f..00000000 --- a/Game/Code/lib/PngImage/obj/inftrees.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/infutil.obj b/Game/Code/lib/PngImage/obj/infutil.obj Binary files differdeleted file mode 100644 index 7e175a83..00000000 --- a/Game/Code/lib/PngImage/obj/infutil.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/obj/trees.obj b/Game/Code/lib/PngImage/obj/trees.obj Binary files differdeleted file mode 100644 index 81f05568..00000000 --- a/Game/Code/lib/PngImage/obj/trees.obj +++ /dev/null diff --git a/Game/Code/lib/PngImage/pngimage.chm b/Game/Code/lib/PngImage/pngimage.chm Binary files differdeleted file mode 100644 index c7e51b2e..00000000 --- a/Game/Code/lib/PngImage/pngimage.chm +++ /dev/null diff --git a/Game/Code/lib/PngImage/pngimage.pas b/Game/Code/lib/PngImage/pngimage.pas deleted file mode 100644 index ecd52c5b..00000000 --- a/Game/Code/lib/PngImage/pngimage.pas +++ /dev/null @@ -1,5213 +0,0 @@ -{Portable Network Graphics Delphi 1.4361 (8 March 2003) }
-
-{This is the latest implementation for TPngImage component }
-{It's meant to be a full replacement for the previous one. }
-{There are lots of new improvements, including cleaner code, }
-{full partial transparency support, speed improvements, }
-{saving using ADAM 7 interlacing, better error handling, also }
-{the best compression for the final image ever. And now it's }
-{truly able to read about any png image. }
-
-{
- 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 (hope)
- 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: I'm currently looking for bugs on the library. If
- anyone has found one, please send me an email and
- I will fix right away. Thanks for all the help and
- ideias I'm receiving so far.}
-
-{My new email is: gubadaud@terra.com.br}
-{Website link : pngdelphi.sourceforge.net}
-{Gustavo Huffenbacher Daud}
-
-unit pngimage;
-
-interface
-
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-{Triggers avaliable (edit the fields bellow)}
-{$IFNDef FPC}
-{$DEFINE UseDelphi} //Disable fat vcl units (perfect to small apps)
-{$ENDIF}
-
-{$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
-{.$DEFINE Debug} //For programming purposes
-{$RANGECHECKS OFF} {$J+}
-
-
-
-uses
- Windows,
- {$IFDEF UseDelphi}
- Classes,
- Graphics,
- SysUtils,
- {$ENDIF}
- {$IFDEF Debug}
- dialogs,
- {$ENDIF}
- pngzlib,
- pnglang;
-
-{$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);
-
-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
- {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;
- {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
- {Gamma table values}
- GammaTable, InverseGamma: Array[Byte] of Byte;
- procedure InitializeGamma;
- private
- {Temporary palette}
- TempPalette: HPalette;
- {Filters to test to encode}
- fFilters: TFilters;
- {Compression level for ZLIB}
- fCompressionLevel: TCompressionLevel;
- {Maximum size for IDAT chunks}
- fMaxIdatSize: Cardinal;
- {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;
- {Returns linesize and byte offset for pixels}
- procedure GetPixelInfo(var LineSize, Offset: Cardinal);
- procedure SetMaxIdatSize(const Value: Cardinal);
- function GetAlphaScanline(const LineIndex: Integer): pByteArray;
- function GetScanline(const LineIndex: Integer): Pointer;
- {$IFDEF Store16bits}
- function GetExtraScanline(const LineIndex: Integer): Pointer;
- {$ENDIF}
- function GetTransparencyMode: TPNGTransparencyMode;
- function GetTransparentColor: TColor;
- procedure SetTransparentColor(const Value: TColor);
- protected
- {Returns the image palette}
- function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
- {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
- {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}
- property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
- {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: Cardinal 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}
- 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;{$ENDIF}
- 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;
-
- {Output windows bitmap}
- HasPalette: Boolean;
- BitmapInfo: TMaxBitmapInfo;
- BytesPerRow: Integer;
- {Stores the image bytes}
- {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
- ImageData: pointer;
- ImageAlpha: Pointer;
-
- {Contains all the ihdr data}
- IHDRData: TIHDRData;
- protected
- {Resizes the image data to fill the color type, bit depth, }
- {width and height parameters}
- procedure PrepareImageData;
- {Release allocated ImageData memory}
- procedure FreeImageData;
- public
- {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;
-
- {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)
- private
- {Number of items in the palette}
- fCount: Integer;
- {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;
- 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);
-
- // 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(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(pointer(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(Pointer(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) 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}
-
-{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) 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)) then
- fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
- {There must have an IEND and IHDR chunk}
- else if (ItemFromClass(TChunkIEND) = nil) or
- (ItemFromClass(TChunkIHDR) = nil) 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) then
- Insert(Result, IHDR.Index + 1)
- {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, soFromCurrent);
- 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, pointer(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;
-
-{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)^ := 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}
- 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(pointer(Longint(Data) + Length(Keyword) + 1))^ := 0;
- if OutputSize > 0 then
- CopyMemory(pointer(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], pointer(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(pointer(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
- {Call inherited}
- inherited Create(Owner);
- {Prepare pointers}
- ImageHandle := 0;
- ImageDC := 0;
-end;
-
-{Chunk being destroyed}
-destructor TChunkIHDR.Destroy;
-begin
- {Free memory}
- FreeImageData();
-
- {Calls TChunk destroy}
- inherited Destroy;
-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;
- 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);
- {$IFDEF Store16bits}
- if ExtraImageData <> nil then FreeMem(ExtraImageData);
- {$ENDIF}
- ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := 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;
-
-{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;
- {Initialize the structure with zeros}
- fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
- {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);
- ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
- DIB_RGB_COLORS, ImageData, 0, 0);
-
- {Clears the old palette (if any)}
- with Owner do
- if TempPalette <> 0 then
- begin
- DeleteObject(TempPalette);
- TempPalette := 0;
- end {with Owner, if TempPalette <> 0};
-
- {Build array and allocate bytes for each row}
- zeromemory(ImageData, BytesPerRow * Integer(Height));
-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 255 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;
-begin
- Result := 0; {Default: Unknown transparent color}
-
- {Depends on the color type}
- with Header do
- case ColorType of
- COLOR_GRAYSCALE:
- Result := RGB(PaletteValues[0], PaletteValues[0],
- PaletteValues[0]);
- COLOR_RGB:
- Result := RGB(PaletteValues[1], PaletteValues[3], 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;
-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));
-
- FOR j := 0 TO Entries - 1 DO
- with BitmapInfo.bmiColors[j] do
- begin
-
- {Calculate each palette entry}
- rgbRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
- rgbGreen := rgbRed;
- rgbBlue := rgbRed;
- end {with BitmapInfo.bmiColors[j]}
- 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 := pointer(Longint(Header.ImageData) + Header.BytesPerRow * (ImageHeight - 1 - CurrentRow));
- Trans := pointer(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
- {$IFDEF Store16bits}
- Extra := pointer(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, ZLIBAllocate);
-
- {Restore buffer}
- next_out := Data;
- avail_out := ZLIBAllocate;
- 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, ZLIBAllocate - avail_out);
- {Re-update buffer}
- next_out := Data;
- avail_out := ZLIBAllocate;
- end;
-
- if avail_out < ZLIBAllocate then
- {Writes final IDAT}
- WriteIDAT(fStream, Data, ZLIBAllocate - 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 := pointer(Longint(Header.ImageData) + Header.BytesPerRow * (ImageHeight - 1 - CurrentRow));
- Trans := pointer(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;
-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;
- PalColor := Data;
- FOR j := 0 TO fCount - 1 DO
- with Header.BitmapInfo.bmiColors[j] do
- begin
- rgbRed := Owner.GammaTable[PalColor.r];
- rgbGreen := Owner.GammaTable[PalColor.g];
- rgbBlue := Owner.GammaTable[PalColor.b];
- rgbReserved := 0;
- inc(PalColor); {Move to next palette entry}
- end;
-end;
-
-{Saves the PLTE chunk to a stream}
-function TChunkPLTE.SaveToStream(Stream: TStream): Boolean;
-var
- J: Integer;
- DataPtr: pByte;
-begin
- {Adjust size to hold all the palette items}
- ResizeData(fCount * 3);
- {Copy pointer to data}
- DataPtr := fData;
-
- {Copy palette items}
- with Header do
- FOR j := 0 TO fCount - 1 DO
- with BitmapInfo.bmiColors[j] do
- begin
- DataPtr^ := Owner.InverseGamma[rgbRed] ; inc(DataPtr);
- DataPtr^ := Owner.InverseGamma[rgbGreen]; inc(DataPtr);
- DataPtr^ := Owner.InverseGamma[rgbBlue] ; 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
- {Assigns contents from another TPNGObject}
- 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}
-constructor TPngObject.Create;
-begin
- {Let it be created}
- inherited Create;
-
- {Initial properties}
- TempPalette := 0;
- 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;
- {Free the temporary palette}
- if TempPalette <> 0 then DeleteObject(TempPalette);
-
- {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: Cardinal);
-begin
- {Make sure the size is at least 65535}
- if Value < High(Word) then
- fMaxIdatSize := High(Word) else fMaxIdatSize := Value;
-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 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);
-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;
-
- {Transparency/palette chunks}
- TransparencyChunk: TChunktRNS;
- PaletteChunk: TChunkPLTE;
- TransValue, PaletteIndex: Byte;
- CurBit: Integer;
- Data: PByte;
-
- {Buffer bitmap modification}
- BytesPerRowDest,
- BytesPerRowSrc,
- BytesPerRowAlpha: Integer;
- ImageSource,
- AlphaSource : pByteArray;
- ImageData : pPixelLine;
- i, j : Integer;
-begin
- {Prepare to create the bitmap}
- Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
- BitmapInfoHeader.biWidth := Header.Width;
- BitmapInfoHeader.biHeight := -1 * Header.Height;
- 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}
- StretchBlt(BufferDC, 0, 0, Header.Width, Header.height, DC, Rect.Left,
- Rect.Top, Header.Width, Header.Height, SRCCOPY);
-
- {Obtain number of bytes for each row}
- BytesPerRowAlpha := Header.Width;
- BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * Width) + 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);
-
- case Header.BitmapInfo.bmiHeader.biBitCount of
- {R, G, B images}
- 24:
- FOR j := 1 TO Header.Height DO
- begin
- {Process all the pixels in this line}
- FOR i := 0 TO Header.Width - 1 DO
- with ImageData[i] do
- begin
- rgbRed := (255+ImageSource[2+i*3] * AlphaSource[i] + rgbRed * (255 -
- AlphaSource[i])) shr 8;
- rgbGreen := (255+ImageSource[1+i*3] * AlphaSource[i] + rgbGreen *
- (255 - AlphaSource[i])) shr 8;
- rgbBlue := (255+ImageSource[i*3] * AlphaSource[i] + rgbBlue *
- (255 - AlphaSource[i])) shr 8;
- end;
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
- end;
- {Palette images with 1 byte for each pixel}
- 1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
- FOR j := 1 TO Header.Height DO
- begin
- {Process all the pixels in this line}
- FOR i := 0 TO Header.Width - 1 DO
- with ImageData[i], Header.BitmapInfo do begin
- rgbRed := (255 + ImageSource[i] * AlphaSource[i] +
- rgbRed * (255 - AlphaSource[i])) shr 8;
- rgbGreen := (255 + ImageSource[i] * AlphaSource[i] +
- rgbGreen * (255 - AlphaSource[i])) shr 8;
- rgbBlue := (255 + ImageSource[i] * AlphaSource[i] +
- rgbBlue * (255 - AlphaSource[i])) shr 8;
- end;
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
- 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 Header.Height DO
- begin
- {Process all the pixels in this line}
- i := 0; Data := @ImageSource[0];
- repeat
- CurBit := 0;
-
- 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(Header.Width);
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- end
- end {Palette images}
- end {case Header.BitmapInfo.bmiHeader.biBitCount};
-
- {Draws the new bitmap on the foreground}
- StretchBlt(DC, Rect.Left, Rect.Top, Header.Width, Header.Height, BufferDC,
- 0, 0, Header.Width, Header.Height, 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 (Chunks.Count = 0) or not (Chunks.GetItem(0) is TChunkIHDR) 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
- 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 {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
- RaiseError(EPNGError, EPNGCannotChangeSizeText);
-end;
-
-{Changing width is not supported}
-procedure TPngObject.SetWidth(Value: Integer);
-begin
- RaiseError(EPNGError, EPNGCannotChangeSizeText);
-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;
- HasPalette: Boolean);
-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}
-var
- DeskDC: HDC;
- 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
- {Device context}
- DeskDC := GetDC(0);
- {Copy the data}
- TBitmap(Dest).Handle := CreateDIBitmap(DeskDC,
- Header.BitmapInfo.bmiHeader, CBM_INIT, Header.ImageData,
- pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
- ReleaseDC(0, DeskDC);
- {Tests for the best pixelformat}
- case Header.BitmapInfo.bmiHeader.biBitCount of
- 1: TBitmap(Dest).PixelFormat := pf1Bit;
- 4: TBitmap(Dest).PixelFormat := pf4Bit;
- 8: TBitmap(Dest).PixelFormat := pf8Bit;
- 24: TBitmap(Dest).PixelFormat := pf24Bit;
- 32: TBitmap(Dest).PixelFormat := pf32Bit;
- end {case Header.BitmapInfo.bmiHeader.biBitCount};
-
- {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;
- HasPalette: Boolean;
-
- {Chunks}
- Header: TChunkIHDR;
- PLTE: TChunkPLTE;
- IDAT: TChunkIDAT;
- IEND: TChunkIEND;
- TRNS: TChunkTRNS;
-begin
- {Obtain bitmap info}
- GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo);
-
- {Only bit depths 1, 4 and 8 needs a palette}
- HasPalette := (BitmapInfo.bmBitsPixel < 16);
-
- {Clear old chunks and prepare}
- ClearChunks();
-
- {Create the chunks}
- Header := TChunkIHDR.Create(Self);
- if 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 HasPalette then TPNGPointerList(Chunks).Add(PLTE);
- if Transparent then TPNGPointerList(Chunks).Add(TRNS);
- TPNGPointerList(Chunks).Add(IDAT);
- TPNGPointerList(Chunks).Add(IEND);
-
- {This method will fill the Header chunk with bitmap information}
- {and copy the image data}
- BuildHeader(Header, Handle, @BitmapInfo, HasPalette);
- {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 HasPalette then PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
-
- {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(TChunkText) as TChunkzTXt;
- TextChunk.Keyword := Keyword;
- TextChunk.Text := Text;
-end;
-
-{Removes the image transparency}
-procedure TPngObject.RemoveTransparency;
-var
- TRNS: TChunkTRNS;
-begin
- TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
- if TRNS <> nil then Chunks.RemoveChunk(TRNS)
-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
- 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
- ByteData := GammaTable[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;
-
-{Sets a pixel}
-procedure TPngObject.SetPixels(const X, Y: Integer; const Value: TColor);
-begin
- if (X in [0..Width - 1]) and (Y in [0..Height - 1]) then
- with Header do
- begin
- if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
- SetByteArrayPixel(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 in [0..Width - 1]) and (Y in [0..Height - 1]) then
- with Header do
- begin
- if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
- Result := GetByteArrayPixel(Self, X, Y)
- else
- Result := GetRGBLinePixel(Self, X, Y)
- end {with}
- else Result := 0
-end;
-
-{Returns the image palette}
-function TPngObject.GetPalette: HPALETTE;
-var
- LogPalette: TMaxLogPalette;
- i: Integer;
-begin
- {Palette is avaliable for COLOR_PALETTE and COLOR_GRAYSCALE modes}
- if (Header.ColorType in [COLOR_PALETTE, COLOR_GRAYSCALE]) then
- begin
- {In case the pal}
- if TempPalette = 0 then
- with LogPalette do
- begin
- {Prepares the new palette}
- palVersion := $300;
- palNumEntries := 256;
- {Copy entries}
- for i := 0 to LogPalette.palNumEntries - 1 do
- begin
- palPalEntry[i].peRed := Header.BitmapInfo.bmiColors[i].rgbRed;
- palPalEntry[i].peGreen := Header.BitmapInfo.bmiColors[i].rgbGreen;
- palPalEntry[i].peBlue := Header.BitmapInfo.bmiColors[i].rgbBlue;
- palPalEntry[i].peFlags := 0;
- end {for i};
- {Creates the palette}
- TempPalette := CreatePalette(pLogPalette(@LogPalette)^);
- end {with LogPalette, if Temppalette = 0}
- end {if Header.ColorType in ...};
- Result := TempPalette;
-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/Game/Code/lib/PngImage/pngimage.~pas b/Game/Code/lib/PngImage/pngimage.~pas deleted file mode 100644 index ec712737..00000000 --- a/Game/Code/lib/PngImage/pngimage.~pas +++ /dev/null @@ -1,5205 +0,0 @@ -{Portable Network Graphics Delphi 1.4361 (8 March 2003) }
-
-{This is the latest implementation for TPngImage component }
-{It's meant to be a full replacement for the previous one. }
-{There are lots of new improvements, including cleaner code, }
-{full partial transparency support, speed improvements, }
-{saving using ADAM 7 interlacing, better error handling, also }
-{the best compression for the final image ever. And now it's }
-{truly able to read about any png image. }
-
-{
- 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 (hope)
- 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: I'm currently looking for bugs on the library. If
- anyone has found one, please send me an email and
- I will fix right away. Thanks for all the help and
- ideias I'm receiving so far.}
-
-{My new email is: gubadaud@terra.com.br}
-{Website link : pngdelphi.sourceforge.net}
-{Gustavo Huffenbacher Daud}
-
-unit pngimage;
-
-interface
-
-{Triggers avaliable (edit the fields bellow)}
-{$DEFINE UseDelphi} //Disable fat vcl units (perfect to 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
-{.$DEFINE Debug} //For programming purposes
-{$RANGECHECKS OFF} {$J+}
-
-
-
-uses
- Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF} {$IFDEF Debug},
- dialogs{$ENDIF}, pngzlib, pnglang;
-
-{$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);
-
-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
- {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;
- {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
- {Gamma table values}
- GammaTable, InverseGamma: Array[Byte] of Byte;
- procedure InitializeGamma;
- private
- {Temporary palette}
- TempPalette: HPalette;
- {Filters to test to encode}
- fFilters: TFilters;
- {Compression level for ZLIB}
- fCompressionLevel: TCompressionLevel;
- {Maximum size for IDAT chunks}
- fMaxIdatSize: Cardinal;
- {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;
- {Returns linesize and byte offset for pixels}
- procedure GetPixelInfo(var LineSize, Offset: Cardinal);
- procedure SetMaxIdatSize(const Value: Cardinal);
- function GetAlphaScanline(const LineIndex: Integer): pByteArray;
- function GetScanline(const LineIndex: Integer): Pointer;
- {$IFDEF Store16bits}
- function GetExtraScanline(const LineIndex: Integer): Pointer;
- {$ENDIF}
- function GetTransparencyMode: TPNGTransparencyMode;
- function GetTransparentColor: TColor;
- procedure SetTransparentColor(const Value: TColor);
- protected
- {Returns the image palette}
- function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
- {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
- {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}
- property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
- {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: Cardinal 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}
- 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;{$ENDIF}
- 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;
-
- {Output windows bitmap}
- HasPalette: Boolean;
- BitmapInfo: TMaxBitmapInfo;
- BytesPerRow: Integer;
- {Stores the image bytes}
- {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
- ImageData: pointer;
- ImageAlpha: Pointer;
-
- {Contains all the ihdr data}
- IHDRData: TIHDRData;
- protected
- {Resizes the image data to fill the color type, bit depth, }
- {width and height parameters}
- procedure PrepareImageData;
- {Release allocated ImageData memory}
- procedure FreeImageData;
- public
- {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;
-
- {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)
- private
- {Number of items in the palette}
- fCount: Integer;
- {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;
- 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);
-
- // 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(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) 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}
-
-{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) 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)) then
- fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
- {There must have an IEND and IHDR chunk}
- else if (ItemFromClass(TChunkIEND) = nil) or
- (ItemFromClass(TChunkIHDR) = nil) 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) then
- Insert(Result, IHDR.Index + 1)
- {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, soFromCurrent);
- 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;
-
-{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)^ := 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}
- 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
- {Call inherited}
- inherited Create(Owner);
- {Prepare pointers}
- ImageHandle := 0;
- ImageDC := 0;
-end;
-
-{Chunk being destroyed}
-destructor TChunkIHDR.Destroy;
-begin
- {Free memory}
- FreeImageData();
-
- {Calls TChunk destroy}
- inherited Destroy;
-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;
- 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);
- {$IFDEF Store16bits}
- if ExtraImageData <> nil then FreeMem(ExtraImageData);
- {$ENDIF}
- ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := 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;
-
-{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;
- {Initialize the structure with zeros}
- fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
- {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);
- ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
- DIB_RGB_COLORS, ImageData, 0, 0);
-
- {Clears the old palette (if any)}
- with Owner do
- if TempPalette <> 0 then
- begin
- DeleteObject(TempPalette);
- TempPalette := 0;
- end {with Owner, if TempPalette <> 0};
-
- {Build array and allocate bytes for each row}
- zeromemory(ImageData, BytesPerRow * Integer(Height));
-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 255 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;
-begin
- Result := 0; {Default: Unknown transparent color}
-
- {Depends on the color type}
- with Header do
- case ColorType of
- COLOR_GRAYSCALE:
- Result := RGB(PaletteValues[0], PaletteValues[0],
- PaletteValues[0]);
- COLOR_RGB:
- Result := RGB(PaletteValues[1], PaletteValues[3], 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;
-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));
-
- FOR j := 0 TO Entries - 1 DO
- with BitmapInfo.bmiColors[j] do
- begin
-
- {Calculate each palette entry}
- rgbRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
- rgbGreen := rgbRed;
- rgbBlue := rgbRed;
- end {with BitmapInfo.bmiColors[j]}
- 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, ZLIBAllocate);
-
- {Restore buffer}
- next_out := Data;
- avail_out := ZLIBAllocate;
- 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, ZLIBAllocate - avail_out);
- {Re-update buffer}
- next_out := Data;
- avail_out := ZLIBAllocate;
- end;
-
- if avail_out < ZLIBAllocate then
- {Writes final IDAT}
- WriteIDAT(fStream, Data, ZLIBAllocate - 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;
-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;
- PalColor := Data;
- FOR j := 0 TO fCount - 1 DO
- with Header.BitmapInfo.bmiColors[j] do
- begin
- rgbRed := Owner.GammaTable[PalColor.r];
- rgbGreen := Owner.GammaTable[PalColor.g];
- rgbBlue := Owner.GammaTable[PalColor.b];
- rgbReserved := 0;
- inc(PalColor); {Move to next palette entry}
- end;
-end;
-
-{Saves the PLTE chunk to a stream}
-function TChunkPLTE.SaveToStream(Stream: TStream): Boolean;
-var
- J: Integer;
- DataPtr: pByte;
-begin
- {Adjust size to hold all the palette items}
- ResizeData(fCount * 3);
- {Copy pointer to data}
- DataPtr := fData;
-
- {Copy palette items}
- with Header do
- FOR j := 0 TO fCount - 1 DO
- with BitmapInfo.bmiColors[j] do
- begin
- DataPtr^ := Owner.InverseGamma[rgbRed]; inc(DataPtr);
- DataPtr^ := Owner.InverseGamma[rgbGreen]; inc(DataPtr);
- DataPtr^ := Owner.InverseGamma[rgbBlue]; 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
- {Assigns contents from another TPNGObject}
- 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}
-constructor TPngObject.Create;
-begin
- {Let it be created}
- inherited Create;
-
- {Initial properties}
- TempPalette := 0;
- 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;
- {Free the temporary palette}
- if TempPalette <> 0 then DeleteObject(TempPalette);
-
- {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: Cardinal);
-begin
- {Make sure the size is at least 65535}
- if Value < High(Word) then
- fMaxIdatSize := High(Word) else fMaxIdatSize := Value;
-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 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);
-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;
-
- {Transparency/palette chunks}
- TransparencyChunk: TChunktRNS;
- PaletteChunk: TChunkPLTE;
- TransValue, PaletteIndex: Byte;
- CurBit: Integer;
- Data: PByte;
-
- {Buffer bitmap modification}
- BytesPerRowDest,
- BytesPerRowSrc,
- BytesPerRowAlpha: Integer;
- ImageSource,
- AlphaSource : pByteArray;
- ImageData : pPixelLine;
- i, j : Integer;
-begin
- {Prepare to create the bitmap}
- Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
- BitmapInfoHeader.biWidth := Header.Width;
- BitmapInfoHeader.biHeight := -1 * Header.Height;
- 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}
- StretchBlt(BufferDC, 0, 0, Header.Width, Header.height, DC, Rect.Left,
- Rect.Top, Header.Width, Header.Height, SRCCOPY);
-
- {Obtain number of bytes for each row}
- BytesPerRowAlpha := Header.Width;
- BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * Width) + 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);
-
- case Header.BitmapInfo.bmiHeader.biBitCount of
- {R, G, B images}
- 24:
- FOR j := 1 TO Header.Height DO
- begin
- {Process all the pixels in this line}
- FOR i := 0 TO Header.Width - 1 DO
- with ImageData[i] do
- begin
- rgbRed := (255+ImageSource[2+i*3] * AlphaSource[i] + rgbRed * (255 -
- AlphaSource[i])) shr 8;
- rgbGreen := (255+ImageSource[1+i*3] * AlphaSource[i] + rgbGreen *
- (255 - AlphaSource[i])) shr 8;
- rgbBlue := (255+ImageSource[i*3] * AlphaSource[i] + rgbBlue *
- (255 - AlphaSource[i])) shr 8;
- end;
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
- end;
- {Palette images with 1 byte for each pixel}
- 1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
- FOR j := 1 TO Header.Height DO
- begin
- {Process all the pixels in this line}
- FOR i := 0 TO Header.Width - 1 DO
- with ImageData[i], Header.BitmapInfo do begin
- rgbRed := (255 + ImageSource[i] * AlphaSource[i] +
- rgbRed * (255 - AlphaSource[i])) shr 8;
- rgbGreen := (255 + ImageSource[i] * AlphaSource[i] +
- rgbGreen * (255 - AlphaSource[i])) shr 8;
- rgbBlue := (255 + ImageSource[i] * AlphaSource[i] +
- rgbBlue * (255 - AlphaSource[i])) shr 8;
- end;
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
- 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 Header.Height DO
- begin
- {Process all the pixels in this line}
- i := 0; Data := @ImageSource[0];
- repeat
- CurBit := 0;
-
- 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(Header.Width);
-
- {Move pointers}
- Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
- Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
- end
- end {Palette images}
- end {case Header.BitmapInfo.bmiHeader.biBitCount};
-
- {Draws the new bitmap on the foreground}
- StretchBlt(DC, Rect.Left, Rect.Top, Header.Width, Header.Height, BufferDC,
- 0, 0, Header.Width, Header.Height, 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 (Chunks.Count = 0) or not (Chunks.GetItem(0) is TChunkIHDR) 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
- 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 {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
- RaiseError(EPNGError, EPNGCannotChangeSizeText);
-end;
-
-{Changing width is not supported}
-procedure TPngObject.SetWidth(Value: Integer);
-begin
- RaiseError(EPNGError, EPNGCannotChangeSizeText);
-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;
- HasPalette: Boolean);
-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}
-var
- DeskDC: HDC;
- 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
- {Device context}
- DeskDC := GetDC(0);
- {Copy the data}
- TBitmap(Dest).Handle := CreateDIBitmap(DeskDC,
- Header.BitmapInfo.bmiHeader, CBM_INIT, Header.ImageData,
- pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
- ReleaseDC(0, DeskDC);
- {Tests for the best pixelformat}
- case Header.BitmapInfo.bmiHeader.biBitCount of
- 1: TBitmap(Dest).PixelFormat := pf1Bit;
- 4: TBitmap(Dest).PixelFormat := pf4Bit;
- 8: TBitmap(Dest).PixelFormat := pf8Bit;
- 24: TBitmap(Dest).PixelFormat := pf24Bit;
- 32: TBitmap(Dest).PixelFormat := pf32Bit;
- end {case Header.BitmapInfo.bmiHeader.biBitCount};
-
- {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;
- HasPalette: Boolean;
-
- {Chunks}
- Header: TChunkIHDR;
- PLTE: TChunkPLTE;
- IDAT: TChunkIDAT;
- IEND: TChunkIEND;
- TRNS: TChunkTRNS;
-begin
- {Obtain bitmap info}
- GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo);
-
- {Only bit depths 1, 4 and 8 needs a palette}
- HasPalette := (BitmapInfo.bmBitsPixel < 16);
-
- {Clear old chunks and prepare}
- ClearChunks();
-
- {Create the chunks}
- Header := TChunkIHDR.Create(Self);
- if 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 HasPalette then TPNGPointerList(Chunks).Add(PLTE);
- if Transparent then TPNGPointerList(Chunks).Add(TRNS);
- TPNGPointerList(Chunks).Add(IDAT);
- TPNGPointerList(Chunks).Add(IEND);
-
- {This method will fill the Header chunk with bitmap information}
- {and copy the image data}
- BuildHeader(Header, Handle, @BitmapInfo, HasPalette);
- {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 HasPalette then PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
-
- {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(TChunkText) as TChunkzTXt;
- TextChunk.Keyword := Keyword;
- TextChunk.Text := Text;
-end;
-
-{Removes the image transparency}
-procedure TPngObject.RemoveTransparency;
-var
- TRNS: TChunkTRNS;
-begin
- TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
- if TRNS <> nil then Chunks.RemoveChunk(TRNS)
-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
- 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
- ByteData := GammaTable[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;
-
-{Sets a pixel}
-procedure TPngObject.SetPixels(const X, Y: Integer; const Value: TColor);
-begin
- if (X in [0..Width - 1]) and (Y in [0..Height - 1]) then
- with Header do
- begin
- if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
- SetByteArrayPixel(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 in [0..Width - 1]) and (Y in [0..Height - 1]) then
- with Header do
- begin
- if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
- Result := GetByteArrayPixel(Self, X, Y)
- else
- Result := GetRGBLinePixel(Self, X, Y)
- end {with}
- else Result := 0
-end;
-
-{Returns the image palette}
-function TPngObject.GetPalette: HPALETTE;
-var
- LogPalette: TMaxLogPalette;
- i: Integer;
-begin
- {Palette is avaliable for COLOR_PALETTE and COLOR_GRAYSCALE modes}
- if (Header.ColorType in [COLOR_PALETTE, COLOR_GRAYSCALE]) then
- begin
- {In case the pal}
- if TempPalette = 0 then
- with LogPalette do
- begin
- {Prepares the new palette}
- palVersion := $300;
- palNumEntries := 256;
- {Copy entries}
- for i := 0 to LogPalette.palNumEntries - 1 do
- begin
- palPalEntry[i].peRed := Header.BitmapInfo.bmiColors[i].rgbRed;
- palPalEntry[i].peGreen := Header.BitmapInfo.bmiColors[i].rgbGreen;
- palPalEntry[i].peBlue := Header.BitmapInfo.bmiColors[i].rgbBlue;
- palPalEntry[i].peFlags := 0;
- end {for i};
- {Creates the palette}
- TempPalette := CreatePalette(pLogPalette(@LogPalette)^);
- end {with LogPalette, if Temppalette = 0}
- end {if Header.ColorType in ...};
- Result := TempPalette;
-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/Game/Code/lib/PngImage/pnglang.pas b/Game/Code/lib/PngImage/pnglang.pas deleted file mode 100644 index 7a9c5078..00000000 --- a/Game/Code/lib/PngImage/pnglang.pas +++ /dev/null @@ -1,301 +0,0 @@ -{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 Portuguese}
-{.$DEFINE German}
-{.$DEFINE French}
-{.$DEFINE Slovenian}
-
-{Language strings for english}
-resourcestring
- {$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.';
- EPNGCannotChangeSizeText = 'The "Portable Network Graphics" image can not ' +
- 'be resize by changing width and height properties. Try assigning the ' +
- 'image from a bitmap.';
- 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.';
- {$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.';
- EPNGCannotChangeSizeText = 'A imagem "Portable Network Graphics" não pode ' +
- 'ser redimensionada mudando as propriedades width e height. Tente ' +
- 'copiar a imagem de um bitmap usando a função assign.';
- 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.';
- {$ENDIF}
- {Language strings for German}
- {$IFDEF German}
- EPngInvalidCRCText = 'Dieses "Portable Network Graphics" Image ist ' +
- 'ungültig, weil Teile der Daten ungültig sind (CRC-Fehler).';
- EPNGInvalidIHDRText = 'Dieses "Portable Network Graphics" Image konnte ' +
- 'nicht geladen werden, weil eine der Hauptdaten (IHDR) beschädigt ' +
- 'sein könnte.';
- EPNGMissingMultipleIDATText = 'Dieses "Portable Network Graphics" Image ' +
- 'ist ungültig, weil Grafikdaten fehlen.';
- EPNGZLIBErrorText = 'Die Grafik konnte nicht entpackt werden, weil sie ' +
- 'fehlerhafte komprimierte Daten enthält.'#13#10 + ' Beschreibung: ';
- EPNGInvalidPaletteText = 'Das "Portable Network Graphics" Image enthält ' +
- 'eine ungültige Palette.';
- EPNGInvalidFileHeaderText = 'Die Datei, die gelesen wird, ist kein ' +
- 'gültiges "Portable Network Graphics" Image, 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" Image wird ' +
- 'nicht unterstützt bzw. es könnte ungültig sein.'#13#10 +
- '(Der IHDR-Chunk ist nicht der erste Chunk in der Datei).';
- EPNGNotExistsText = 'Die PNG Datei konnte nicht geladen werden, da sie ' +
- 'nicht existiert.';
- EPNGSizeExceedsText = 'Dieses "Portable Network Graphics" Image 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" Image konnte ' +
- 'nicht geladen werden, weil die benötigte Farbtabelle fehlt.';
- EPNGUnknownCriticalChunkText = 'Dieses "Portable Network Graphics" Image ' +
- 'enhält einen unbekannten kritischen Teil, welcher nicht entschlüsselt ' +
- 'werden kann.';
- EPNGUnknownCompressionText = 'Dieses "Portable Network Graphics" Image ' +
- 'wurde mit einem unbekannten Komprimierungsalgorithmus kodiert, welcher ' +
- 'nicht entschlüsselt werden kann.';
- EPNGUnknownInterlaceText = 'Dieses "Portable Network Graphics" Image ' +
- 'benutzt ein unbekanntes Interlace-Schema, welcher nicht entschlüsselt ' +
- 'werden kann.';
- EPNGCannotAssignChunkText = 'Die Chunks müssen kompatibel sein, um ' +
- 'zugewiesen werden zu können.';
- EPNGUnexpectedEndText = 'Dieses "Portable Network Graphics" Image ist ' +
- 'ungültig, der Dekoder stieß unerwarteterweise auf das Ende der Datei.';
- EPNGNoImageDataText = 'Dieses "Portable Network Graphics" Image enthält ' +
- 'keine Daten.';
- EPNGCannotChangeSizeText = 'Das "Portable Network Graphics" Image kann ' +
- 'nicht durch Ändern der Eigenschaften Width und Height in seinen ' +
- 'Abmessungen geändert werden. Versuchen Sie das Image von einer Bitmap ' +
- 'aus zuzuweisen.';
- EPNGCannotAddChunkText = 'Das Programm versucht einen existierenden ' +
- 'kritischen Chunk zum aktuellen Image hinzuzufügen. Dies ist nicht ' +
- 'zulässig.';
- EPNGCannotAddInvalidImageText = 'Es ist nicht zulässig, dem aktuellen ' +
- 'Image einen neuen Chunk hinzuzufügen, da es ungültig ist.';
- EPNGCouldNotLoadResourceText = 'Das PNG Image konnte nicht von 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 fuer PNG-Images die Alpha-Werte fuer jedes ' +
- 'Pixel enthalten (COLOR_RGBALPHA und COLOR_GRAYSCALEALPHA) nicht ' +
- 'zulaessig';
- EPNGHeaderNotPresentText = 'Die Datei, die gelesen wird, ist kein ' +
- 'gültiges "Portable Network Graphics" Image, da es keinen gültigen ' +
- 'Header enthält.';
- {$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.';
- EPNGCannotChangeSizeText = 'Cette image "Portable Network Graphics" ne peut pas ' +
- 'être retaillée en changeant ses propriétés width et height. Essayer d''assigner l''image depuis ' +
- 'un bitmap.';
- 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.';
- {$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.';
- EPNGCannotChangeSizeText = 'Te "Portable Network Graphics" sliki ne morem ' +
- 'spremeniti velikosti s spremembo lastnosti višine in širine. Poskusite ' +
- 'sliko prirediti v bitno sliko.';
- 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.';
- {$ENDIF}
-
-
-implementation
-
-end.
diff --git a/Game/Code/lib/PngImage/pngzlib.pas b/Game/Code/lib/PngImage/pngzlib.pas deleted file mode 100644 index 3155946a..00000000 --- a/Game/Code/lib/PngImage/pngzlib.pas +++ /dev/null @@ -1,172 +0,0 @@ -{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 pngzlib;
-
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-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.1.4';
-
-function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
-
-
-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
-
-{$IFNDef FPC}
- {$L obj\deflate.obj}
- {$L obj\trees.obj}
- {$L obj\inflate.obj}
- {$L obj\inftrees.obj}
- {$L obj\adler32.obj}
- {$L obj\infblock.obj}
- {$L obj\infcodes.obj}
- {$L obj\infutil.obj}
- {$L obj\inffast.obj}
-{$ENDIF}
-
-procedure _tr_init; external;
-procedure _tr_tally; external;
-procedure _tr_flush_block; external;
-procedure _tr_align; external;
-procedure _tr_stored_block; external;
-function adler32; external;
-procedure inflate_blocks_new; external;
-procedure inflate_blocks; external;
-procedure inflate_blocks_reset; external;
-procedure inflate_blocks_free; external;
-procedure inflate_set_dictionary; external;
-procedure inflate_trees_bits; external;
-procedure inflate_trees_dynamic; external;
-procedure inflate_trees_fixed; external;
-procedure inflate_codes_new; external;
-procedure inflate_codes; external;
-procedure inflate_codes_free; external;
-procedure _inflate_mask; external;
-procedure inflate_flush; external;
-procedure inflate_fast; 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.
-
-
-
diff --git a/Game/Code/lib/libpng/png.pas b/Game/Code/lib/libpng/png.pas new file mode 100644 index 00000000..f4424a2a --- /dev/null +++ b/Game/Code/lib/libpng/png.pas @@ -0,0 +1,980 @@ +(*
+ * libpng pascal headers
+ * Version: 1.2.12
+ *)
+
+{$IFDEF FPC}
+ {$ifndef NO_SMART_LINK}
+ {$smartlink on}
+ {$endif}
+{$ENDIF}
+unit png;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+ {$PACKRECORDS C}
+{$ENDIF}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ {$IFDEF UNIX}
+ baseunix,
+ {$ENDIF}
+ zlib;
+
+const
+{$ifdef MSWINDOWS}
+ // use libpng12-0 (Version 1.2.18), delivered wih SDL_Image
+ LibPng = 'libpng12-0'; // 'libpng13';
+ // matching lib version for libpng13.dll, needed for initialization
+ PNG_LIBPNG_VER_STRING='1.2.12';
+ // define the compiler that was used to built the DLL (necessary for jmp_buf)
+ // SDL_Image was compiled with GCC
+ //{$define MSVC_DLL} // MS Visual C++
+ {$define GCC_DLL} // GCC
+{$else}
+ LibPng = 'png';
+ // matching lib version for libpng, needed for initialization
+ PNG_LIBPNG_VER_STRING='1.2.12';
+{$endif}
+
+
+{$ifdef MSWINDOWS}
+const
+ // JB_LEN (#elements in jmp_buf) depends on the compiler used to compile the DLL
+ // MSVC++: 16 (x86/AMD64), GCC: 52
+ {$if Defined(MSVC_DLL)}
+ JB_LEN = 16;
+ {$elseif Defined(GCC_DLL)}
+ JB_LEN = 52;
+ {$else}
+ JB_LEN = 0;
+ {$ifend}
+{$endif}
+
+type
+ {$IFNDEF FPC}
+ // defines for Delphi
+ size_t = longword;
+ {$ENDIF}
+
+ {$ifdef MSWINDOWS}
+ {$if JB_LEN > 0}
+ jmp_buf = array[0..JB_LEN-1] of integer;
+ // the png_struct cannot be accessed if the size of jmp_buf is unknown
+ {$define UsePngStruct}
+ {$ifend}
+ // Do NOT use time_t on windows! It might be 32 or 64bit, depending on the compiler and system.
+ // MSVS-2005 starts using 64bit for time_t on x86 by default, but GCC uses just 32bit.
+ //time_t = longint;
+ {$endif}
+
+ z_stream = TZStream;
+
+ png_uint_32 = dword;
+ png_int_32 = longint;
+ png_uint_16 = word;
+ png_int_16 = smallint;
+ png_byte = byte;
+ ppng_uint_32 = ^png_uint_32;
+ ppng_int_32 = ^png_int_32;
+ ppng_uint_16 = ^png_uint_16;
+ ppng_int_16 = ^png_int_16;
+ ppng_byte = ^png_byte;
+ pppng_uint_32 = ^ppng_uint_32;
+ pppng_int_32 = ^ppng_int_32;
+ pppng_uint_16 = ^ppng_uint_16;
+ pppng_int_16 = ^ppng_int_16;
+ pppng_byte = ^ppng_byte;
+ png_size_t = size_t;
+ png_fixed_point = png_int_32;
+ ppng_fixed_point = ^png_fixed_point;
+ pppng_fixed_point = ^ppng_fixed_point;
+ png_voidp = pointer;
+ png_bytep = Ppng_byte;
+ ppng_bytep = ^png_bytep;
+ png_uint_32p = Ppng_uint_32;
+ png_int_32p = Ppng_int_32;
+ png_uint_16p = Ppng_uint_16;
+ ppng_uint_16p = ^png_uint_16p;
+ png_int_16p = Ppng_int_16;
+ png_const_charp = {const} Pchar;
+ png_charp = Pchar;
+ ppng_charp = ^png_charp;
+ png_fixed_point_p = Ppng_fixed_point;
+ png_FILE_p = Pointer;
+ png_doublep = Pdouble;
+ png_bytepp = PPpng_byte;
+ png_uint_32pp = PPpng_uint_32;
+ png_int_32pp = PPpng_int_32;
+ png_uint_16pp = PPpng_uint_16;
+ png_int_16pp = PPpng_int_16;
+ png_const_charpp = {const} PPchar;
+ png_charpp = PPchar;
+ ppng_charpp = ^png_charpp;
+ png_fixed_point_pp = PPpng_fixed_point;
+ PPDouble = ^PDouble;
+ png_doublepp = PPdouble;
+ PPPChar = ^PPCHar;
+ png_charppp = PPPchar;
+ Pcharf = Pchar;
+ PPcharf = ^Pcharf;
+ png_zcharp = Pcharf;
+ png_zcharpp = PPcharf;
+ png_zstreamp = Pzstream;
+
+const
+ (* Maximum positive integer used in PNG is (2^31)-1 *)
+ PNG_UINT_31_MAX = (png_uint_32($7fffffff));
+ PNG_UINT_32_MAX = (png_uint_32(-1));
+ PNG_SIZE_MAX = (png_size_t(-1));
+ {$if defined(PNG_1_0_X) or defined (PNG_1_2_X)}
+ (* PNG_MAX_UINT is deprecated; use PNG_UINT_31_MAX instead. *)
+ PNG_MAX_UINT = PNG_UINT_31_MAX;
+ {$ifend}
+
+ (* These describe the color_type field in png_info. *)
+ (* color type masks *)
+ PNG_COLOR_MASK_PALETTE = 1;
+ PNG_COLOR_MASK_COLOR = 2;
+ PNG_COLOR_MASK_ALPHA = 4;
+
+ (* color types. Note that not all combinations are legal *)
+ PNG_COLOR_TYPE_GRAY = 0;
+ PNG_COLOR_TYPE_PALETTE = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_PALETTE);
+ PNG_COLOR_TYPE_RGB = (PNG_COLOR_MASK_COLOR);
+ PNG_COLOR_TYPE_RGB_ALPHA = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_ALPHA);
+ PNG_COLOR_TYPE_GRAY_ALPHA = (PNG_COLOR_MASK_ALPHA);
+ (* aliases *)
+ PNG_COLOR_TYPE_RGBA = PNG_COLOR_TYPE_RGB_ALPHA;
+ PNG_COLOR_TYPE_GA = PNG_COLOR_TYPE_GRAY_ALPHA;
+
+ (* This is for compression type. PNG 1.0-1.2 only define the single type. *)
+ PNG_COMPRESSION_TYPE_BASE = 0; (* Deflate method 8, 32K window *)
+ PNG_COMPRESSION_TYPE_DEFAULT = PNG_COMPRESSION_TYPE_BASE;
+
+ (* This is for filter type. PNG 1.0-1.2 only define the single type. *)
+ PNG_FILTER_TYPE_BASE = 0; (* Single row per-byte filtering *)
+ PNG_INTRAPIXEL_DIFFERENCING = 64; (* Used only in MNG datastreams *)
+ PNG_FILTER_TYPE_DEFAULT = PNG_FILTER_TYPE_BASE;
+
+ (* These are for the interlacing type. These values should NOT be changed. *)
+ PNG_INTERLACE_NONE = 0; (* Non-interlaced image *)
+ PNG_INTERLACE_ADAM7 = 1; (* Adam7 interlacing *)
+ PNG_INTERLACE_LAST = 2; (* Not a valid value *)
+
+ (* These are for the oFFs chunk. These values should NOT be changed. *)
+ PNG_OFFSET_PIXEL = 0; (* Offset in pixels *)
+ PNG_OFFSET_MICROMETER = 1; (* Offset in micrometers (1/10^6 meter) *)
+ PNG_OFFSET_LAST = 2; (* Not a valid value *)
+
+ (* These are for the pCAL chunk. These values should NOT be changed. *)
+ PNG_EQUATION_LINEAR = 0; (* Linear transformation *)
+ PNG_EQUATION_BASE_E = 1; (* Exponential base e transform *)
+ PNG_EQUATION_ARBITRARY = 2; (* Arbitrary base exponential transform *)
+ PNG_EQUATION_HYPERBOLIC = 3; (* Hyperbolic sine transformation *)
+ PNG_EQUATION_LAST = 4; (* Not a valid value *)
+
+ (* These are for the sCAL chunk. These values should NOT be changed. *)
+ PNG_SCALE_UNKNOWN = 0; (* unknown unit (image scale) *)
+ PNG_SCALE_METER = 1; (* meters per pixel *)
+ PNG_SCALE_RADIAN = 2; (* radians per pixel *)
+ PNG_SCALE_LAST = 3; (* Not a valid value *)
+
+ (* These are for the pHYs chunk. These values should NOT be changed. *)
+ PNG_RESOLUTION_UNKNOWN = 0; (* pixels/unknown unit (aspect ratio) *)
+ PNG_RESOLUTION_METER = 1; (* pixels/meter *)
+ PNG_RESOLUTION_LAST = 2; (* Not a valid value *)
+
+ (* These are for the sRGB chunk. These values should NOT be changed. *)
+ PNG_sRGB_INTENT_PERCEPTUAL = 0;
+ PNG_sRGB_INTENT_RELATIVE = 1;
+ PNG_sRGB_INTENT_SATURATION = 2;
+ PNG_sRGB_INTENT_ABSOLUTE = 3;
+ PNG_sRGB_INTENT_LAST = 4; (* Not a valid value *)
+
+ (* This is for text chunks *)
+ PNG_KEYWORD_MAX_LENGTH = 79;
+
+ (* Maximum number of entries in PLTE/sPLT/tRNS arrays *)
+ PNG_MAX_PALETTE_LENGTH = 256;
+
+ (* These determine if an ancillary chunk's data has been successfully read
+ * from the PNG header, or if the application has filled in the corresponding
+ * data in the info_struct to be written into the output file. The values
+ * of the PNG_INFO_<chunk> defines should NOT be changed.
+ *)
+ PNG_INFO_gAMA = $0001;
+ PNG_INFO_sBIT = $0002;
+ PNG_INFO_cHRM = $0004;
+ PNG_INFO_PLTE = $0008;
+ PNG_INFO_tRNS = $0010;
+ PNG_INFO_bKGD = $0020;
+ PNG_INFO_hIST = $0040;
+ PNG_INFO_pHYs = $0080;
+ PNG_INFO_oFFs = $0100;
+ PNG_INFO_tIME = $0200;
+ PNG_INFO_pCAL = $0400;
+ PNG_INFO_sRGB = $0800; (* GR-P, 0.96a *)
+ PNG_INFO_iCCP = $1000; (* ESR, 1.0.6 *)
+ PNG_INFO_sPLT = $2000; (* ESR, 1.0.6 *)
+ PNG_INFO_sCAL = $4000; (* ESR, 1.0.6 *)
+ PNG_INFO_IDAT = $8000; (* ESR, 1.0.6 *)
+
+
+{$IFDEF FPC}
+{$IF Defined(Linux)}
+var
+ png_libpng_ver : array[0..11] of char; cvar; external;
+ png_pass_start : array[0..6] of integer; cvar; external;
+ png_pass_inc : array[0..6] of integer; cvar; external;
+ png_pass_ystart : array[0..6] of integer; cvar; external;
+ png_pass_yinc : array[0..6] of integer; cvar; external;
+ png_pass_mask : array[0..6] of integer; cvar; external;
+ png_pass_dsp_mask : array[0..6] of integer; cvar; external;
+{$ELSEIF Defined(Darwin)}
+var
+ png_libpng_ver : array[0..11] of char; external LibPng name 'png_libpng_ver';
+ png_pass_start : array[0..6] of integer; external LibPng name 'png_pass_start';
+ png_pass_inc : array[0..6] of integer; external LibPng name 'png_pass_inc';
+ png_pass_ystart : array[0..6] of integer; external LibPng name 'png_pass_ystart';
+ png_pass_yinc : array[0..6] of integer; external LibPng name 'png_pass_yinc';
+ png_pass_mask : array[0..6] of integer; external LibPng name 'png_pass_mask';
+ png_pass_dsp_mask : array[0..6] of integer; external LibPng name 'png_pass_dsp_mask';
+{$IFEND}
+{$ENDIF}
+
+type
+ (* Three color definitions. The order of the red, green, and blue, (and the
+ * exact size) is not important, although the size of the fields need to
+ * be png_byte or png_uint_16 (as defined below).
+ *)
+ png_color = record
+ red : png_byte;
+ green : png_byte;
+ blue : png_byte;
+ end;
+ ppng_color = ^png_color;
+ pppng_color = ^ppng_color;
+ png_color_struct = png_color;
+ png_colorp = Ppng_color;
+ ppng_colorp = ^png_colorp;
+ png_colorpp = PPpng_color;
+
+ png_color_16 = record
+ index : png_byte; (* used for palette files *)
+ red : png_uint_16; (* for use in red green blue files *)
+ green : png_uint_16;
+ blue : png_uint_16;
+ gray : png_uint_16; (* for use in grayscale files *)
+ end;
+ ppng_color_16 = ^png_color_16 ;
+ pppng_color_16 = ^ppng_color_16 ;
+ png_color_16_struct = png_color_16;
+ png_color_16p = Ppng_color_16;
+ ppng_color_16p = ^png_color_16p;
+ png_color_16pp = PPpng_color_16;
+
+ png_color_8 = record
+ red : png_byte; (* for use in red green blue files *)
+ green : png_byte;
+ blue : png_byte;
+ gray : png_byte; (* for use in grayscale files *)
+ alpha : png_byte; (* for alpha channel files *)
+ end;
+ ppng_color_8 = ^png_color_8;
+ pppng_color_8 = ^ppng_color_8;
+ png_color_8_struct = png_color_8;
+ png_color_8p = Ppng_color_8;
+ ppng_color_8p = ^png_color_8p;
+ png_color_8pp = PPpng_color_8;
+
+ (*
+ * The following two structures are used for the in-core representation
+ * of sPLT chunks.
+ *)
+ png_sPLT_entry = record
+ red : png_uint_16;
+ green : png_uint_16;
+ blue : png_uint_16;
+ alpha : png_uint_16;
+ frequency : png_uint_16;
+ end;
+ ppng_sPLT_entry = ^png_sPLT_entry;
+ pppng_sPLT_entry = ^ppng_sPLT_entry;
+ png_sPLT_entry_struct = png_sPLT_entry;
+ png_sPLT_entryp = Ppng_sPLT_entry;
+ png_sPLT_entrypp = PPpng_sPLT_entry;
+
+ (* When the depth of the sPLT palette is 8 bits, the color and alpha samples
+ * occupy the LSB of their respective members, and the MSB of each member
+ * is zero-filled. The frequency member always occupies the full 16 bits.
+ *)
+
+ png_sPLT_t = record
+ name : png_charp; (* palette name *)
+ depth : png_byte; (* depth of palette samples *)
+ entries : png_sPLT_entryp; (* palette entries *)
+ nentries : png_int_32; (* number of palette entries *)
+ end;
+ ppng_sPLT_t = ^png_sPLT_t;
+ pppng_sPLT_t = ^ppng_sPLT_t;
+ png_sPLT_struct = png_sPLT_t;
+ png_sPLT_tp = Ppng_sPLT_t;
+ png_sPLT_tpp = PPpng_sPLT_t;
+
+ (* png_text holds the contents of a text/ztxt/itxt chunk in a PNG file,
+ * and whether that contents is compressed or not. The "key" field
+ * points to a regular zero-terminated C string. The "text", "lang", and
+ * "lang_key" fields can be regular C strings, empty strings, or NULL pointers.
+ * However, the * structure returned by png_get_text() will always contain
+ * regular zero-terminated C strings (possibly empty), never NULL pointers,
+ * so they can be safely used in printf() and other string-handling functions.
+ *)
+ png_text = record
+ compression : integer; (* compression value:
+ -1: tEXt, none
+ 0: zTXt, deflate
+ 1: iTXt, none
+ 2: iTXt, deflate *)
+ key : png_charp; (* keyword, 1-79 character description of "text" *)
+ text : png_charp; (* comment, may be an empty string (ie "")
+ or a NULL pointer *)
+ text_length : png_size_t; (* length of the text string *)
+ end;
+ ppng_text = ^png_text;
+ pppng_text = ^ppng_text;
+ png_text_struct = png_text;
+ png_textp = Ppng_text;
+ ppng_textp = ^png_textp;
+ png_textpp = PPpng_text;
+
+ (* png_time is a way to hold the time in an machine independent way.
+ * Two conversions are provided, both from time_t and struct tm. There
+ * is no portable way to convert to either of these structures, as far
+ * as I know. If you know of a portable way, send it to me. As a side
+ * note - PNG has always been Year 2000 compliant!
+ *)
+ png_time = record
+ year : png_uint_16; (* full year, as in, 1995 *)
+ month : png_byte; (* month of year, 1 - 12 *)
+ day : png_byte; (* day of month, 1 - 31 *)
+ hour : png_byte; (* hour of day, 0 - 23 *)
+ minute : png_byte; (* minute of hour, 0 - 59 *)
+ second : png_byte; (* second of minute, 0 - 60 (for leap seconds) *)
+ end;
+ ppng_time = ^png_time;
+ pppng_time = ^ppng_time;
+ png_time_struct = png_time;
+ png_timep = Ppng_time;
+ PPNG_TIMEP = ^PNG_TIMEP;
+ png_timepp = PPpng_time;
+
+const
+ PNG_CHUNK_NAME_LENGTH = 5;
+type
+ (* png_unknown_chunk is a structure to hold queued chunks for which there is
+ * no specific support. The idea is that we can use this to queue
+ * up private chunks for output even though the library doesn't actually
+ * know about their semantics.
+ *)
+ png_unknown_chunk = record
+ name : array[0..PNG_CHUNK_NAME_LENGTH-1] of png_byte;
+ data : Ppng_byte;
+ size : png_size_t;
+
+ (* libpng-using applications should NOT directly modify this byte. *)
+ location : png_byte; (* mode of operation at read time *)
+ end;
+ ppng_unknown_chunk = ^png_unknown_chunk;
+ pppng_unknown_chunk = ^ppng_unknown_chunk;
+ png_unknown_chunk_t = png_unknown_chunk;
+ png_unknown_chunkp = Ppng_unknown_chunk;
+ png_unknown_chunkpp = PPpng_unknown_chunk;
+
+ (* png_info is a structure that holds the information in a PNG file so
+ * that the application can find out the characteristics of the image.
+ * If you are reading the file, this structure will tell you what is
+ * in the PNG file. If you are writing the file, fill in the information
+ * you want to put into the PNG file, then call png_write_info().
+ * The names chosen should be very close to the PNG specification, so
+ * consult that document for information about the meaning of each field.
+ *
+ * With libpng < 0.95, it was only possible to directly set and read the
+ * the values in the png_info_struct, which meant that the contents and
+ * order of the values had to remain fixed. With libpng 0.95 and later,
+ * however, there are now functions that abstract the contents of
+ * png_info_struct from the application, so this makes it easier to use
+ * libpng with dynamic libraries, and even makes it possible to use
+ * libraries that don't have all of the libpng ancillary chunk-handing
+ * functionality.
+ *
+ * In any case, the order of the parameters in png_info_struct should NOT
+ * be changed for as long as possible to keep compatibility with applications
+ * that use the old direct-access method with png_info_struct.
+ *
+ * The following members may have allocated storage attached that should be
+ * cleaned up before the structure is discarded: palette, trans, text,
+ * pcal_purpose, pcal_units, pcal_params, hist, iccp_name, iccp_profile,
+ * splt_palettes, scal_unit, row_pointers, and unknowns. By default, these
+ * are automatically freed when the info structure is deallocated, if they were
+ * allocated internally by libpng. This behavior can be changed by means
+ * of the png_data_freer() function.
+ *
+ * More allocation details: all the chunk-reading functions that
+ * change these members go through the corresponding png_set_*
+ * functions. A function to clear these members is available: see
+ * png_free_data(). The png_set_* functions do not depend on being
+ * able to point info structure members to any of the storage they are
+ * passed (they make their own copies), EXCEPT that the png_set_text
+ * functions use the same storage passed to them in the text_ptr or
+ * itxt_ptr structure argument, and the png_set_rows and png_set_unknowns
+ * functions do not make their own copies.
+ *)
+ png_info = record
+ width : png_uint_32; (* width of image in pixels (from IHDR) *)
+ height : png_uint_32; (* height of image in pixels (from IHDR) *)
+ valid : png_uint_32; (* valid chunk data (see PNG_INFO_ below) *)
+ rowbytes : png_uint_32; (* bytes needed to hold an untransformed row *)
+ palette : png_colorp; (* array of color values (valid & PNG_INFO_PLTE) *)
+ num_palette : png_uint_16; (* number of color entries in "palette" (PLTE) *)
+ num_trans : png_uint_16; (* number of transparent palette color (tRNS) *)
+ bit_depth : png_byte; (* 1, 2, 4, 8, or 16 bits/channel (from IHDR) *)
+ color_type : png_byte; (* see PNG_COLOR_TYPE_ below (from IHDR) *)
+ (* The following three should have been named *_method not *_type *)
+ compression_type : png_byte; (* must be PNG_COMPRESSION_TYPE_BASE (IHDR) *)
+ filter_type : png_byte; (* must be PNG_FILTER_TYPE_BASE (from IHDR) *)
+ interlace_type : png_byte; (* One of PNG_INTERLACE_NONE, PNG_INTERLACE_ADAM7 *)
+
+ (* The following is informational only on read, and not used on writes. *)
+ channels : png_byte; (* number of data channels per pixel (1, 2, 3, 4) *)
+ pixel_depth : png_byte; (* number of bits per pixel *)
+ spare_byte : png_byte; (* to align the data, and for future use *)
+ signature : array[0..7] of png_byte; (* magic bytes read by libpng from start of file *)
+
+ (* The rest of the data is optional. If you are reading, check the
+ * valid field to see if the information in these are valid. If you
+ * are writing, set the valid field to those chunks you want written,
+ * and initialize the appropriate fields below.
+ *)
+
+ gamma : single;
+ srgb_intent : png_byte;
+ num_text : integer;
+ max_text : integer;
+ text : png_textp;
+ mod_time : png_time;
+ sig_bit : png_color_8;
+ trans : png_bytep;
+ trans_values : png_color_16;
+ background : png_color_16;
+ x_offset : png_int_32;
+ y_offset : png_int_32;
+ offset_unit_type : png_byte;
+ x_pixels_per_unit : png_uint_32;
+ y_pixels_per_unit : png_uint_32;
+ phys_unit_type : png_byte;
+ hist : png_uint_16p;
+ x_white : single;
+ y_white : single;
+ x_red : single;
+ y_red : single;
+ x_green : single;
+ y_green : single;
+ x_blue : single;
+ y_blue : single;
+ pcal_purpose : png_charp;
+ pcal_X0 : png_int_32;
+ pcal_X1 : png_int_32;
+ pcal_units : png_charp;
+ pcal_params : png_charpp;
+ pcal_type : png_byte;
+ pcal_nparams : png_byte;
+ free_me : png_uint_32;
+ unknown_chunks : png_unknown_chunkp;
+ unknown_chunks_num : png_size_t;
+ iccp_name : png_charp;
+ iccp_profile : png_charp;
+ iccp_proflen : png_uint_32;
+ iccp_compression : png_byte;
+ splt_palettes : png_sPLT_tp;
+ splt_palettes_num : png_uint_32;
+ scal_unit : png_byte;
+ scal_pixel_width : double;
+ scal_pixel_height : double;
+ scal_s_width : png_charp;
+ scal_s_height : png_charp;
+ row_pointers : png_bytepp;
+ int_gamma : png_fixed_point;
+ int_x_white : png_fixed_point;
+ int_y_white : png_fixed_point;
+ int_x_red : png_fixed_point;
+ int_y_red : png_fixed_point;
+ int_x_green : png_fixed_point;
+ int_y_green : png_fixed_point;
+ int_x_blue : png_fixed_point;
+ int_y_blue : png_fixed_point;
+ end;
+ ppng_info = ^png_info;
+ pppng_info = ^ppng_info;
+ png_info_struct = png_info;
+ png_infop = Ppng_info;
+ png_infopp = PPpng_info;
+
+ (* This is used for the transformation routines, as some of them
+ * change these values for the row. It also should enable using
+ * the routines for other purposes.
+ *)
+ png_row_info = record
+ width : png_uint_32; (* width of row *)
+ rowbytes : png_uint_32; (* number of bytes in row *)
+ color_type : png_byte; (* color type of row *)
+ bit_depth : png_byte; (* bit depth of row *)
+ channels : png_byte; (* number of channels (1, 2, 3, or 4) *)
+ pixel_depth : png_byte; (* bits per pixel (depth * channels) *)
+ end;
+ ppng_row_info = ^png_row_info;
+ pppng_row_info = ^ppng_row_info;
+ png_row_info_struct = png_row_info;
+ png_row_infop = Ppng_row_info;
+ png_row_infopp = PPpng_row_info;
+ png_structp = ^png_struct;
+
+
+ (* These are the function types for the I/O functions and for the functions
+ * that allow the user to override the default I/O functions with his or her
+ * own. The png_error_ptr type should match that of user-supplied warning
+ * and error functions, while the png_rw_ptr type should match that of the
+ * user read/write data functions.
+ *)
+ png_error_ptr = procedure(Arg1 : png_structp; Arg2 : png_const_charp);cdecl;
+ png_rw_ptr = procedure(Arg1 : png_structp; Arg2 : png_bytep; Arg3 : png_size_t);cdecl;
+ png_flush_ptr = procedure (Arg1 : png_structp) ;cdecl;
+ png_read_status_ptr = procedure (Arg1 : png_structp; Arg2 : png_uint_32; Arg3: integer);cdecl;
+ png_write_status_ptr = procedure (Arg1 : png_structp; Arg2:png_uint_32;Arg3 : integer) ;cdecl;
+ png_progressive_info_ptr = procedure (Arg1 : png_structp; Arg2 : png_infop) ;cdecl;
+ png_progressive_end_ptr = procedure (Arg1 : png_structp; Arg2 : png_infop) ;cdecl;
+ png_progressive_row_ptr = procedure (Arg1 : png_structp; Arg2 : png_bytep; Arg3 : png_uint_32; Arg4 : integer) ;cdecl;
+ png_user_transform_ptr = procedure (Arg1 : png_structp; Arg2 : png_row_infop; Arg3 : png_bytep) ;cdecl;
+ png_user_chunk_ptr = function (Arg1 : png_structp; Arg2 : png_unknown_chunkp): integer;cdecl;
+ png_unknown_chunk_ptr = procedure (Arg1 : png_structp);cdecl;
+ png_malloc_ptr = function (Arg1 : png_structp; Arg2 : png_size_t) : png_voidp ;cdecl;
+ png_free_ptr = procedure (Arg1 : png_structp; Arg2 : png_voidp) ; cdecl;
+
+ png_struct_def = record
+ {$ifdef UsePngStruct}
+ jmpbuf : jmp_buf; (* used in png_error *)
+ error_fn : png_error_ptr; (* function for printing errors and aborting *)
+ warning_fn : png_error_ptr; (* function for printing warnings *)
+ error_ptr : png_voidp; (* user supplied struct for error functions *)
+ write_data_fn : png_rw_ptr; (* function for writing output data *)
+ read_data_fn : png_rw_ptr; (* function for reading input data *)
+ io_ptr : png_voidp; (* ptr to application struct for I/O functions *)
+
+ read_user_transform_fn : png_user_transform_ptr; (* user read transform *)
+
+ write_user_transform_fn : png_user_transform_ptr; (* user write transform *)
+
+ (* These were added in libpng-1.0.2 *)
+ user_transform_ptr : png_voidp; (* user supplied struct for user transform *)
+ user_transform_depth : png_byte; (* bit depth of user transformed pixels *)
+ user_transform_channels : png_byte; (* channels in user transformed pixels *)
+
+ mode : png_uint_32; (* tells us where we are in the PNG file *)
+ flags : png_uint_32; (* flags indicating various things to libpng *)
+ transformations : png_uint_32; (* which transformations to perform *)
+
+ zstream : z_stream; (* pointer to decompression structure (below) *)
+ zbuf : png_bytep; (* buffer for zlib *)
+ zbuf_size : png_size_t; (* size of zbuf *)
+ zlib_level : integer; (* holds zlib compression level *)
+ zlib_method : integer; (* holds zlib compression method *)
+ zlib_window_bits : integer; (* holds zlib compression window bits *)
+ zlib_mem_level : integer; (* holds zlib compression memory level *)
+ zlib_strategy : integer; (* holds zlib compression strategy *)
+
+ width : png_uint_32; (* width of image in pixels *)
+ height : png_uint_32; (* height of image in pixels *)
+ num_rows : png_uint_32; (* number of rows in current pass *)
+ usr_width : png_uint_32; (* width of row at start of write *)
+ rowbytes : png_uint_32; (* size of row in bytes *)
+ irowbytes : png_uint_32; (* size of current interlaced row in bytes *)
+ iwidth : png_uint_32; (* width of current interlaced row in pixels *)
+ row_number : png_uint_32; (* current row in interlace pass *)
+ prev_row : png_bytep; (* buffer to save previous (unfiltered) row *)
+ row_buf : png_bytep; (* buffer to save current (unfiltered) row *)
+ sub_row : png_bytep; (* buffer to save "sub" row when filtering *)
+ up_row : png_bytep; (* buffer to save "up" row when filtering *)
+ avg_row : png_bytep; (* buffer to save "avg" row when filtering *)
+ paeth_row : png_bytep; (* buffer to save "Paeth" row when filtering *)
+ row_info : png_row_info; (* used for transformation routines *)
+
+ idat_size : png_uint_32; (* current IDAT size for read *)
+ crc : png_uint_32; (* current chunk CRC value *)
+ palette : png_colorp; (* palette from the input file *)
+ num_palette : png_uint_16; (* number of color entries in palette *)
+ num_trans : png_uint_16; (* number of transparency values *)
+ chunk_name : array[0..4] of png_byte; (* null-terminated name of current chunk *)
+ compression : png_byte; (* file compression type (always 0) *)
+ filter : png_byte; (* file filter type (always 0) *)
+ interlaced : png_byte; (* PNG_INTERLACE_NONE, PNG_INTERLACE_ADAM7 *)
+ pass : png_byte; (* current interlace pass (0 - 6) *)
+ do_filter : png_byte; (* row filter flags (see PNG_FILTER_ below ) *)
+ color_type : png_byte; (* color type of file *)
+ bit_depth : png_byte; (* bit depth of file *)
+ usr_bit_depth : png_byte; (* bit depth of users row *)
+ pixel_depth : png_byte; (* number of bits per pixel *)
+ channels : png_byte; (* number of channels in file *)
+ usr_channels : png_byte; (* channels at start of write *)
+ sig_bytes : png_byte; (* magic bytes read/written from start of file *)
+
+ filler : png_uint_16;
+
+ background_gamma_type : png_byte;
+ background_gamma : single;
+ background : png_color_16;
+ background_1 : png_color_16;
+ output_flush_fn : png_flush_ptr;
+ flush_dist : png_uint_32;
+ flush_rows : png_uint_32;
+ gamma_shift : integer;
+ gamma : single;
+ screen_gamma : single;
+ gamma_table : png_bytep;
+ gamma_from_1 : png_bytep;
+ gamma_to_1 : png_bytep;
+ gamma_16_table : png_uint_16pp;
+ gamma_16_from_1 : png_uint_16pp;
+ gamma_16_to_1 : png_uint_16pp;
+ sig_bit : png_color_8;
+ shift : png_color_8;
+ trans : png_bytep;
+ trans_values : png_color_16;
+ read_row_fn : png_read_status_ptr;
+ write_row_fn : png_write_status_ptr;
+ info_fn : png_progressive_info_ptr;
+ row_fn : png_progressive_row_ptr;
+ end_fn : png_progressive_end_ptr;
+ save_buffer_ptr : png_bytep;
+ save_buffer : png_bytep;
+ current_buffer_ptr : png_bytep;
+ current_buffer : png_bytep;
+ push_length : png_uint_32;
+ skip_length : png_uint_32;
+ save_buffer_size : png_size_t;
+ save_buffer_max : png_size_t;
+ buffer_size : png_size_t;
+ current_buffer_size : png_size_t;
+ process_mode : integer;
+ cur_palette : integer;
+ current_text_size : png_size_t;
+ current_text_left : png_size_t;
+ current_text : png_charp;
+ current_text_ptr : png_charp;
+ palette_lookup : png_bytep;
+ dither_index : png_bytep;
+ hist : png_uint_16p;
+ heuristic_method : png_byte;
+ num_prev_filters : png_byte;
+ prev_filters : png_bytep;
+ filter_weights : png_uint_16p;
+ inv_filter_weights : png_uint_16p;
+ filter_costs : png_uint_16p;
+ inv_filter_costs : png_uint_16p;
+ time_buffer : png_charp;
+ free_me : png_uint_32;
+ user_chunk_ptr : png_voidp;
+ read_user_chunk_fn : png_user_chunk_ptr;
+ num_chunk_list : integer;
+ chunk_list : png_bytep;
+ rgb_to_gray_status : png_byte;
+ rgb_to_gray_red_coeff : png_uint_16;
+ rgb_to_gray_green_coeff : png_uint_16;
+ rgb_to_gray_blue_coeff : png_uint_16;
+ empty_plte_permitted : png_byte;
+ int_gamma : png_fixed_point;
+ {$endif UsePngStruct}
+ end;
+ ppng_struct_def = ^png_struct_def;
+ pppng_struct_def = ^ppng_struct_def;
+ png_struct = png_struct_def;
+ ppng_struct = ^png_struct;
+ pppng_struct = ^ppng_struct;
+
+ version_1_0_8 = png_structp;
+ png_structpp = PPpng_struct;
+
+function png_access_version_number:png_uint_32;cdecl; external LibPng;
+
+procedure png_set_sig_bytes(png_ptr:png_structp; num_bytes:integer);cdecl; external LibPng;
+function png_sig_cmp(sig:png_bytep; start:png_size_t; num_to_check:png_size_t):integer;cdecl; external LibPng;
+function png_check_sig(sig:png_bytep; num:integer):integer;cdecl; external LibPng;
+
+(* Allocate and initialize png_ptr struct for reading, and any other memory. *)
+function png_create_read_struct(user_png_ver:png_const_charp; error_ptr:png_voidp; error_fn:png_error_ptr; warn_fn:png_error_ptr):png_structp;cdecl; external LibPng;
+
+(* Allocate and initialize png_ptr struct for writing, and any other memory *)
+function png_create_write_struct(user_png_ver:png_const_charp; error_ptr:png_voidp; error_fn:png_error_ptr; warn_fn:png_error_ptr):png_structp;cdecl; external LibPng;
+
+function png_get_compression_buffer_size(png_ptr:png_structp):png_uint_32;cdecl; external LibPng;
+procedure png_set_compression_buffer_size(png_ptr:png_structp; size:png_uint_32);cdecl; external LibPng;
+function png_reset_zstream(png_ptr:png_structp):integer;cdecl; external LibPng;
+
+procedure png_write_chunk(png_ptr:png_structp; chunk_name:png_bytep; data:png_bytep; length:png_size_t);cdecl; external LibPng;
+procedure png_write_chunk_start(png_ptr:png_structp; chunk_name:png_bytep; length:png_uint_32);cdecl; external LibPng;
+procedure png_write_chunk_data(png_ptr:png_structp; data:png_bytep; length:png_size_t);cdecl; external LibPng;
+procedure png_write_chunk_end(png_ptr:png_structp);cdecl; external LibPng;
+
+(* Allocate and initialize the info structure *)
+function png_create_info_struct(png_ptr:png_structp):png_infop;cdecl; external LibPng;
+
+(* Initialize the info structure (old interface - DEPRECATED) *)
+procedure png_info_init(info_ptr:png_infop);cdecl; external LibPng;
+
+(* Writes all the PNG information before the image. *)
+procedure png_write_info_before_PLTE(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+procedure png_write_info(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+
+(* read the information before the actual image data. *)
+procedure png_read_info(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+
+function png_convert_to_rfc1123(png_ptr:png_structp; ptime:png_timep):png_charp;cdecl; external LibPng;
+procedure png_convert_from_struct_tm(ptime:png_timep; ttime:Pointer);cdecl; external LibPng;
+{$IFDEF UNIX}
+procedure png_convert_from_time_t(ptime:png_timep; ttime:time_t);cdecl; external LibPng;
+{$ENDIF}
+procedure png_set_expand(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_gray_1_2_4_to_8(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_palette_to_rgb(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_tRNS_to_alpha(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_bgr(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_gray_to_rgb(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_rgb_to_gray(png_ptr:png_structp; error_action:integer; red:double; green:double);cdecl; external LibPng;
+procedure png_set_rgb_to_gray_fixed(png_ptr:png_structp; error_action:integer; red:png_fixed_point; green:png_fixed_point);cdecl; external LibPng;
+function png_get_rgb_to_gray_status(png_ptr:png_structp):png_byte;cdecl; external LibPng;
+procedure png_build_grayscale_palette(bit_depth:integer; palette:png_colorp);cdecl; external LibPng;
+procedure png_set_strip_alpha(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_swap_alpha(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_invert_alpha(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_filler(png_ptr:png_structp; filler:png_uint_32; flags:integer);cdecl; external LibPng;
+procedure png_set_swap(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_packing(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_packswap(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_shift(png_ptr:png_structp; true_bits:png_color_8p);cdecl; external LibPng;
+function png_set_interlace_handling(png_ptr:png_structp):integer;cdecl; external LibPng;
+procedure png_set_invert_mono(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_background(png_ptr:png_structp; background_color:png_color_16p; background_gamma_code:integer; need_expand:integer; background_gamma:double);cdecl; external LibPng;
+procedure png_set_strip_16(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_set_dither(png_ptr:png_structp; palette:png_colorp; num_palette:integer; maximum_colors:integer; histogram:png_uint_16p;
+ full_dither:integer);cdecl; external LibPng;
+procedure png_set_gamma(png_ptr:png_structp; screen_gamma:double; default_file_gamma:double);cdecl; external LibPng;
+procedure png_permit_empty_plte(png_ptr:png_structp; empty_plte_permitted:integer);cdecl; external LibPng;
+procedure png_set_flush(png_ptr:png_structp; nrows:integer);cdecl; external LibPng;
+procedure png_write_flush(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_start_read_image(png_ptr:png_structp);cdecl; external LibPng;
+procedure png_read_update_info(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+
+(* read one or more rows of image data. *)
+procedure png_read_rows(png_ptr:png_structp; row:png_bytepp; display_row:png_bytepp; num_rows:png_uint_32);cdecl; external LibPng;
+
+(* read a row of data. *)
+procedure png_read_row(png_ptr:png_structp; row:png_bytep; display_row:png_bytep);cdecl; external LibPng;
+
+(* read the whole image into memory at once. *)
+procedure png_read_image(png_ptr:png_structp; image:png_bytepp);cdecl; external LibPng;
+
+(* write a row of image data *)
+procedure png_write_row(png_ptr:png_structp; row:png_bytep);cdecl; external LibPng;
+
+(* write a few rows of image data *)
+procedure png_write_rows(png_ptr:png_structp; row:png_bytepp; num_rows:png_uint_32);cdecl; external LibPng;
+
+(* write the image data *)
+procedure png_write_image(png_ptr:png_structp; image:png_bytepp);cdecl; external LibPng;
+
+(* writes the end of the PNG file. *)
+procedure png_write_end(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+
+(* read the end of the PNG file. *)
+procedure png_read_end(png_ptr:png_structp; info_ptr:png_infop);cdecl; external LibPng;
+
+(* free any memory associated with the png_info_struct *)
+procedure png_destroy_info_struct(png_ptr:png_structp; info_ptr_ptr:png_infopp);cdecl; external LibPng;
+
+(* free any memory associated with the png_struct and the png_info_structs *)
+procedure png_destroy_read_struct(png_ptr_ptr:png_structpp; info_ptr_ptr:png_infopp; end_info_ptr_ptr:png_infopp);cdecl; external LibPng;
+
+(* free all memory used by the read (old method - NOT DLL EXPORTED) *)
+procedure png_read_destroy(png_ptr:png_structp; info_ptr:png_infop; end_info_ptr:png_infop);cdecl; external LibPng;
+
+(* free any memory associated with the png_struct and the png_info_structs *)
+procedure png_destroy_write_struct(png_ptr_ptr:png_structpp; info_ptr_ptr:png_infopp);cdecl; external LibPng;
+
+procedure png_write_destroy_info(info_ptr:png_infop);cdecl; external LibPng;
+procedure png_write_destroy(png_ptr:png_structp);cdecl; external LibPng;
+
+procedure png_set_crc_action(png_ptr:png_structp; crit_action:integer; ancil_action:integer);cdecl; external LibPng;
+
+procedure png_set_filter(png_ptr:png_structp; method:integer; filters:integer);cdecl; external LibPng;
+procedure png_set_filter_heuristics(png_ptr:png_structp; heuristic_method:integer; num_weights:integer; filter_weights:png_doublep; filter_costs:png_doublep);cdecl; external LibPng;
+
+procedure png_set_compression_level(png_ptr:png_structp; level:integer);cdecl; external LibPng;
+procedure png_set_compression_mem_level(png_ptr:png_structp; mem_level:integer);cdecl; external LibPng;
+procedure png_set_compression_strategy(png_ptr:png_structp; strategy:integer);cdecl; external LibPng;
+procedure png_set_compression_window_bits(png_ptr:png_structp; window_bits:integer);cdecl; external LibPng;
+procedure png_set_compression_method(png_ptr:png_structp; method:integer);cdecl; external LibPng;
+
+procedure png_init_io(png_ptr:png_structp; fp:png_FILE_p);cdecl; external LibPng;
+
+(* Replace the (error and abort), and warning functions with user
+ * supplied functions. If no messages are to be printed you must still
+ * write and use replacement functions. The replacement error_fn should
+ * still do a longjmp to the last setjmp location if you are using this
+ * method of error handling. If error_fn or warning_fn is NULL, the
+ * default function will be used.
+ *)
+procedure png_set_error_fn(png_ptr:png_structp; error_ptr:png_voidp; error_fn:png_error_ptr; warning_fn:png_error_ptr);cdecl; external LibPng;
+
+(* Return the user pointer associated with the error functions *)
+function png_get_error_ptr(png_ptr:png_structp):png_voidp;cdecl; external LibPng;
+
+(* Replace the default data output functions with a user supplied one(s).
+ * If buffered output is not used, then output_flush_fn can be set to NULL.
+ * If PNG_WRITE_FLUSH_SUPPORTED is not defined at libpng compile time
+ * output_flush_fn will be ignored (and thus can be NULL).
+ *)
+procedure png_set_write_fn(png_ptr:png_structp; io_ptr:png_voidp; write_data_fn:png_rw_ptr; output_flush_fn:png_flush_ptr);cdecl; external LibPng;
+
+(* Replace the default data input function with a user supplied one. *)
+procedure png_set_read_fn(png_ptr:png_structp; io_ptr:png_voidp; read_data_fn:png_rw_ptr);cdecl; external LibPng;
+
+(* Return the user pointer associated with the I/O functions *)
+function png_get_io_ptr(png_ptr:png_structp):png_voidp;cdecl; external LibPng;
+
+procedure png_set_read_status_fn(png_ptr:png_structp; read_row_fn:png_read_status_ptr);cdecl; external LibPng;
+procedure png_set_write_status_fn(png_ptr:png_structp; write_row_fn:png_write_status_ptr);cdecl; external LibPng;
+procedure png_set_read_user_transform_fn(png_ptr:png_structp; read_user_transform_fn:png_user_transform_ptr);cdecl; external LibPng;
+procedure png_set_write_user_transform_fn(png_ptr:png_structp; write_user_transform_fn:png_user_transform_ptr);cdecl; external LibPng;
+procedure png_set_user_transform_info(png_ptr:png_structp; user_transform_ptr:png_voidp; user_transform_depth:integer; user_transform_channels:integer);cdecl; external LibPng;
+function png_get_user_transform_ptr(png_ptr:png_structp):png_voidp;cdecl; external LibPng;
+procedure png_set_read_user_chunk_fn(png_ptr:png_structp; user_chunk_ptr:png_voidp; read_user_chunk_fn:png_user_chunk_ptr);cdecl; external LibPng;
+function png_get_user_chunk_ptr(png_ptr:png_structp):png_voidp;cdecl; external LibPng;
+procedure png_set_progressive_read_fn(png_ptr:png_structp; progressive_ptr:png_voidp; info_fn:png_progressive_info_ptr; row_fn:png_progressive_row_ptr; end_fn:png_progressive_end_ptr);cdecl; external LibPng;
+function png_get_progressive_ptr(png_ptr:png_structp):png_voidp;cdecl; external LibPng;
+procedure png_process_data(png_ptr:png_structp; info_ptr:png_infop; buffer:png_bytep; buffer_size:png_size_t);cdecl; external LibPng;
+procedure png_progressive_combine_row(png_ptr:png_structp; old_row:png_bytep; new_row:png_bytep);cdecl; external LibPng;
+function png_malloc(png_ptr:png_structp; size:png_uint_32):png_voidp;cdecl; external LibPng;
+procedure png_free(png_ptr:png_structp; ptr:png_voidp);cdecl; external LibPng;
+procedure png_free_data(png_ptr:png_structp; info_ptr:png_infop; free_me:png_uint_32; num:integer);cdecl; external LibPng;
+procedure png_data_freer(png_ptr:png_structp; info_ptr:png_infop; freer:integer; mask:png_uint_32);cdecl; external LibPng;
+function png_memcpy_check(png_ptr:png_structp; s1:png_voidp; s2:png_voidp; size:png_uint_32):png_voidp;cdecl; external LibPng;
+function png_memset_check(png_ptr:png_structp; s1:png_voidp; value:integer; size:png_uint_32):png_voidp;cdecl; external LibPng;
+procedure png_error(png_ptr:png_structp; error:png_const_charp);cdecl; external LibPng;
+procedure png_chunk_error(png_ptr:png_structp; error:png_const_charp);cdecl; external LibPng;
+procedure png_warning(png_ptr:png_structp; message:png_const_charp);cdecl; external LibPng;
+procedure png_chunk_warning(png_ptr:png_structp; message:png_const_charp);cdecl; external LibPng;
+function png_get_valid(png_ptr:png_structp; info_ptr:png_infop; flag:png_uint_32):png_uint_32;cdecl; external LibPng;
+function png_get_rowbytes(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_rows(png_ptr:png_structp; info_ptr:png_infop):png_bytepp;cdecl; external LibPng;
+procedure png_set_rows(png_ptr:png_structp; info_ptr:png_infop; row_pointers:png_bytepp);cdecl; external LibPng;
+function png_get_channels(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_image_width(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_image_height(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_bit_depth(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_color_type(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_filter_type(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_interlace_type(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_compression_type(png_ptr:png_structp; info_ptr:png_infop):png_byte;cdecl; external LibPng;
+function png_get_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_x_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_y_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32;cdecl; external LibPng;
+function png_get_pixel_aspect_ratio(png_ptr:png_structp; info_ptr:png_infop):single;cdecl; external LibPng;
+function png_get_x_offset_pixels(png_ptr:png_structp; info_ptr:png_infop):png_int_32;cdecl; external LibPng;
+function png_get_y_offset_pixels(png_ptr:png_structp; info_ptr:png_infop):png_int_32;cdecl; external LibPng;
+function png_get_x_offset_microns(png_ptr:png_structp; info_ptr:png_infop):png_int_32;cdecl; external LibPng;
+function png_get_y_offset_microns(png_ptr:png_structp; info_ptr:png_infop):png_int_32;cdecl; external LibPng;
+function png_get_signature(png_ptr:png_structp; info_ptr:png_infop):png_bytep;cdecl; external LibPng;
+
+function png_get_bKGD(png_ptr:png_structp; info_ptr:png_infop; background:Ppng_color_16p):png_uint_32;cdecl; external LibPng;
+procedure png_set_bKGD(png_ptr:png_structp; info_ptr:png_infop; background:png_color_16p);cdecl; external LibPng;
+function png_get_cHRM(png_ptr:png_structp; info_ptr:png_infop; white_x:Pdouble; white_y:Pdouble; red_x:Pdouble;
+ red_y:Pdouble; green_x:Pdouble; green_y:Pdouble; blue_x:Pdouble; blue_y:Pdouble):png_uint_32;cdecl; external LibPng;
+function png_get_cHRM_fixed(png_ptr:png_structp; info_ptr:png_infop; int_white_x:Ppng_fixed_point; int_white_y:Ppng_fixed_point; int_red_x:Ppng_fixed_point;
+ int_red_y:Ppng_fixed_point; int_green_x:Ppng_fixed_point; int_green_y:Ppng_fixed_point; int_blue_x:Ppng_fixed_point; int_blue_y:Ppng_fixed_point):png_uint_32;cdecl; external LibPng;
+procedure png_set_cHRM(png_ptr:png_structp; info_ptr:png_infop; white_x:double; white_y:double; red_x:double;
+ red_y:double; green_x:double; green_y:double; blue_x:double; blue_y:double);cdecl; external LibPng;
+procedure png_set_cHRM_fixed(png_ptr:png_structp; info_ptr:png_infop; int_white_x:png_fixed_point; int_white_y:png_fixed_point; int_red_x:png_fixed_point;
+ int_red_y:png_fixed_point; int_green_x:png_fixed_point; int_green_y:png_fixed_point; int_blue_x:png_fixed_point; int_blue_y:png_fixed_point);cdecl; external LibPng;
+function png_get_gAMA(png_ptr:png_structp; info_ptr:png_infop; file_gamma:Pdouble):png_uint_32;cdecl; external LibPng;
+function png_get_gAMA_fixed(png_ptr:png_structp; info_ptr:png_infop; int_file_gamma:Ppng_fixed_point):png_uint_32;cdecl; external LibPng;
+procedure png_set_gAMA(png_ptr:png_structp; info_ptr:png_infop; file_gamma:double);cdecl; external LibPng;
+procedure png_set_gAMA_fixed(png_ptr:png_structp; info_ptr:png_infop; int_file_gamma:png_fixed_point);cdecl; external LibPng;
+function png_get_hIST(png_ptr:png_structp; info_ptr:png_infop; hist:Ppng_uint_16p):png_uint_32;cdecl; external LibPng;
+procedure png_set_hIST(png_ptr:png_structp; info_ptr:png_infop; hist:png_uint_16p);cdecl; external LibPng;
+function png_get_IHDR(png_ptr:png_structp; info_ptr:png_infop; width:Ppng_uint_32; height:Ppng_uint_32; bit_depth:Pinteger;
+ color_type:Pinteger; interlace_type:Pinteger; compression_type:Pinteger; filter_type:Pinteger):png_uint_32;cdecl; external LibPng;
+procedure png_set_IHDR(png_ptr:png_structp; info_ptr:png_infop; width:png_uint_32; height:png_uint_32; bit_depth:integer;
+ color_type:integer; interlace_type:integer; compression_type:integer; filter_type:integer);cdecl; external LibPng;
+function png_get_oFFs(png_ptr:png_structp; info_ptr:png_infop; offset_x:Ppng_int_32; offset_y:Ppng_int_32; unit_type:Pinteger):png_uint_32;cdecl; external LibPng;
+procedure png_set_oFFs(png_ptr:png_structp; info_ptr:png_infop; offset_x:png_int_32; offset_y:png_int_32; unit_type:integer);cdecl; external LibPng;
+function png_get_pCAL(png_ptr:png_structp; info_ptr:png_infop; purpose:Ppng_charp; X0:Ppng_int_32; X1:Ppng_int_32;
+ atype:Pinteger; nparams:Pinteger; units:Ppng_charp; params:Ppng_charpp):png_uint_32;cdecl; external LibPng;
+procedure png_set_pCAL(png_ptr:png_structp; info_ptr:png_infop; purpose:png_charp; X0:png_int_32; X1:png_int_32;
+ atype:integer; nparams:integer; units:png_charp; params:png_charpp);cdecl; external LibPng;
+function png_get_pHYs(png_ptr:png_structp; info_ptr:png_infop; res_x:Ppng_uint_32; res_y:Ppng_uint_32; unit_type:Pinteger):png_uint_32;cdecl; external LibPng;
+procedure png_set_pHYs(png_ptr:png_structp; info_ptr:png_infop; res_x:png_uint_32; res_y:png_uint_32; unit_type:integer);cdecl; external LibPng;
+function png_get_PLTE(png_ptr:png_structp; info_ptr:png_infop; palette:Ppng_colorp; num_palette:Pinteger):png_uint_32;cdecl; external LibPng;
+procedure png_set_PLTE(png_ptr:png_structp; info_ptr:png_infop; palette:png_colorp; num_palette:integer);cdecl; external LibPng;
+function png_get_sBIT(png_ptr:png_structp; info_ptr:png_infop; sig_bit:Ppng_color_8p):png_uint_32;cdecl; external LibPng;
+procedure png_set_sBIT(png_ptr:png_structp; info_ptr:png_infop; sig_bit:png_color_8p);cdecl; external LibPng;
+function png_get_sRGB(png_ptr:png_structp; info_ptr:png_infop; intent:Pinteger):png_uint_32;cdecl; external LibPng;
+procedure png_set_sRGB(png_ptr:png_structp; info_ptr:png_infop; intent:integer);cdecl; external LibPng;
+procedure png_set_sRGB_gAMA_and_cHRM(png_ptr:png_structp; info_ptr:png_infop; intent:integer);cdecl; external LibPng;
+function png_get_iCCP(png_ptr:png_structp; info_ptr:png_infop; name:png_charpp; compression_type:Pinteger; profile:png_charpp;
+ proflen:Ppng_uint_32):png_uint_32;cdecl; external LibPng;
+procedure png_set_iCCP(png_ptr:png_structp; info_ptr:png_infop; name:png_charp; compression_type:integer; profile:png_charp;
+ proflen:png_uint_32);cdecl; external LibPng;
+function png_get_sPLT(png_ptr:png_structp; info_ptr:png_infop; entries:png_sPLT_tpp):png_uint_32;cdecl; external LibPng;
+procedure png_set_sPLT(png_ptr:png_structp; info_ptr:png_infop; entries:png_sPLT_tp; nentries:integer);cdecl; external LibPng;
+
+(* png_get_text also returns the number of text chunks in *num_text *)
+function png_get_text(png_ptr:png_structp; info_ptr:png_infop; text_ptr:Ppng_textp; num_text:Pinteger):png_uint_32;cdecl; external LibPng;
+
+(*
+ * Note while png_set_text() will accept a structure whose text,
+ * language, and translated keywords are NULL pointers, the structure
+ * returned by png_get_text will always contain regular
+ * zero-terminated C strings. They might be empty strings but
+ * they will never be NULL pointers.
+ *)
+procedure png_set_text(png_ptr:png_structp; info_ptr:png_infop; text_ptr:png_textp; num_text:integer);cdecl; external LibPng;
+
+function png_get_tIME(png_ptr:png_structp; info_ptr:png_infop; mod_time:Ppng_timep):png_uint_32;cdecl; external LibPng;
+procedure png_set_tIME(png_ptr:png_structp; info_ptr:png_infop; mod_time:png_timep);cdecl; external LibPng;
+function png_get_tRNS(png_ptr:png_structp; info_ptr:png_infop; trans:Ppng_bytep; num_trans:Pinteger; trans_values:Ppng_color_16p):png_uint_32;cdecl; external LibPng;
+procedure png_set_tRNS(png_ptr:png_structp; info_ptr:png_infop; trans:png_bytep; num_trans:integer; trans_values:png_color_16p);cdecl; external LibPng;
+function png_get_sCAL(png_ptr:png_structp; info_ptr:png_infop; aunit:Pinteger; width:Pdouble; height:Pdouble):png_uint_32;cdecl; external LibPng;
+procedure png_set_sCAL(png_ptr:png_structp; info_ptr:png_infop; aunit:integer; width:double; height:double);cdecl; external LibPng;
+procedure png_set_sCAL_s(png_ptr:png_structp; info_ptr:png_infop; aunit:integer; swidth:png_charp; sheight:png_charp);cdecl; external LibPng;
+
+procedure png_set_keep_unknown_chunks(png_ptr:png_structp; keep:integer; chunk_list:png_bytep; num_chunks:integer);cdecl; external LibPng;
+procedure png_set_unknown_chunks(png_ptr:png_structp; info_ptr:png_infop; unknowns:png_unknown_chunkp; num_unknowns:integer);cdecl; external LibPng;
+procedure png_set_unknown_chunk_location(png_ptr:png_structp; info_ptr:png_infop; chunk:integer; location:integer);cdecl; external LibPng;
+function png_get_unknown_chunks(png_ptr:png_structp; info_ptr:png_infop; entries:png_unknown_chunkpp):png_uint_32;cdecl; external LibPng;
+
+procedure png_set_invalid(png_ptr:png_structp; info_ptr:png_infop; mask:integer);cdecl; external LibPng;
+
+procedure png_read_png(png_ptr:png_structp; info_ptr:png_infop; transforms:integer; params:png_voidp);cdecl; external LibPng;
+procedure png_write_png(png_ptr:png_structp; info_ptr:png_infop; transforms:integer; params:png_voidp);cdecl; external LibPng;
+
+function png_get_header_ver(png_ptr:png_structp):png_charp;cdecl; external LibPng;
+function png_get_header_version(png_ptr:png_structp):png_charp;cdecl; external LibPng;
+function png_get_libpng_ver(png_ptr:png_structp):png_charp;cdecl; external LibPng;
+
+implementation
+
+end.
diff --git a/Game/Code/lib/zlib/zlib.pas b/Game/Code/lib/zlib/zlib.pas new file mode 100644 index 00000000..8c8362ba --- /dev/null +++ b/Game/Code/lib/zlib/zlib.pas @@ -0,0 +1,207 @@ +(*
+ * zlib pascal headers
+ * This file is part of Free Pascal, released under the LGPL.
+ *)
+
+{$ifdef FPC}
+ {$ifndef NO_SMART_LINK}
+ {$smartlink on}
+ {$endif}
+{$endif}
+unit zlib;
+
+interface
+
+{$ifdef FPC}
+ {$mode objfpc} // Needed for array of const
+ {$PACKRECORDS C}
+{$endif}
+
+const
+ ZLIB_VERSION = '1.2.3';
+
+{$ifdef MSWINDOWS}
+ libz = 'zlib1';
+{$else}
+ libz = 'z';
+{$endif}
+
+type
+ { Compatible with paszlib }
+ Uint = Cardinal;
+ Ulong = Longword;
+ Ulongf = Longword;
+ Pulongf = ^Ulongf;
+ z_off_t = longint;
+ pbyte = ^byte;
+ pbytef = ^byte;
+ voidpf = pointer;
+
+ TAllocfunc = function (opaque: voidpf; items: uInt; size: uInt): voidpf; cdecl;
+ TFreeFunc = procedure (opaque: voidpf; address: voidpf); cdecl;
+
+ TInternalState = record
+ end;
+ PInternalState = ^TInternalstate;
+
+ TZStream = record
+ next_in: pbytef;
+ avail_in: uInt;
+ total_in: uLong;
+ next_out: pbytef;
+ avail_out: uInt;
+ total_out: uLong;
+ msg: pchar;
+ state: PInternalState;
+ zalloc: TAllocFunc;
+ zfree: TFreeFunc;
+ opaque: voidpf;
+ data_type: integer;
+ adler: uLong;
+ reserved: uLong;
+ end;
+ TZStreamRec = TZStream;
+ PZstream = ^TZStream;
+ gzFile = pointer;
+
+
+const
+ Z_NO_FLUSH = 0;
+ Z_PARTIAL_FLUSH = 1;
+ Z_SYNC_FLUSH = 2;
+ Z_FULL_FLUSH = 3;
+ Z_FINISH = 4;
+ Z_BLOCK = 5;
+
+ 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_RLE = 3;
+ Z_FIXED = 4;
+ Z_DEFAULT_STRATEGY = 0;
+
+ Z_BINARY = 0;
+ Z_TEXT = 1;
+ Z_ASCII = Z_TEXT;
+ Z_UNKNOWN = 2;
+
+ Z_DEFLATED = 8;
+
+ Z_NULL = 0;
+
+function zlibVersionpchar(): pchar; cdecl; external libz name 'zlibVersion';
+function zlibVersion(): string;
+
+function deflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'deflate';
+function deflateEnd(var strm: TZStream): integer; cdecl; external libz name 'deflateEnd';
+function inflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'inflate';
+function inflateEnd(var strm: TZStream): integer; cdecl; external libz name 'inflateEnd';
+function deflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'deflateSetDictionary';
+function deflateCopy(var dest, source: TZstream): integer; cdecl; external libz name 'deflateCopy';
+function deflateReset(var strm: TZStream): integer; cdecl; external libz name 'deflateReset';
+function deflateParams(var strm: TZStream; level: integer; strategy: integer): integer; cdecl; external libz name 'deflateParams';
+//...
+function inflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'inflateSetDictionary';
+function inflateSync(var strm: TZStream): integer; cdecl; external libz name 'inflateSync';
+//...
+function inflateReset(var strm: TZStream): integer; cdecl; external libz name 'inflateReset';
+
+function compress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'compress';
+function compress2(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong; level: integer): integer; cdecl; external libz name 'compress2';
+function uncompress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'uncompress';
+
+function gzopen(path: pchar; mode: pchar): gzFile; cdecl; external libz name 'gzopen';
+function gzdopen(fd: integer; mode: pchar): gzFile; cdecl; external libz name 'gzdopen';
+function gzsetparams(thefile: gzFile; level: integer; strategy: integer): integer; cdecl; external libz name 'gzsetparams';
+function gzread(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzread';
+function gzwrite(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzwrite';
+function gzprintf(thefile: gzFile; format: pbytef; args: array of const): integer; cdecl; external libz name 'gzprintf';
+function gzputs(thefile: gzFile; s: pbytef): integer; cdecl; external libz name 'gzputs';
+function gzgets(thefile: gzFile; buf: pbytef; len: integer): pchar; cdecl; external libz name 'gzgets';
+function gzputc(thefile: gzFile; c: integer): integer; cdecl; external libz name 'gzputc';
+function gzgetc(thefile: gzFile): integer; cdecl; external libz name 'gzgetc';
+function gzflush(thefile: gzFile; flush: integer): integer; cdecl; external libz name 'gzflush';
+function gzseek(thefile: gzFile; offset: z_off_t; whence: integer): z_off_t; cdecl; external libz name 'gzseek';
+function gzrewind(thefile: gzFile): integer; cdecl; external libz name 'gzrewind';
+function gztell(thefile: gzFile): z_off_t; cdecl; external libz name 'gztell';
+function gzeof(thefile: gzFile): integer; cdecl; external libz name 'gzeof';
+function gzclose(thefile: gzFile): integer; cdecl; external libz name 'gzclose';
+function gzerror(thefile: gzFile; var errnum: integer): pchar; cdecl; external libz name 'gzerror';
+
+function adler32(adler: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'adler32';
+function crc32(crc: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'crc32';
+
+function deflateInit_(var strm: TZStream; level: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit_';
+function deflateInit(var strm: TZStream; level : integer) : integer;
+function inflateInit_(var strm: TZStream; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit_';
+function inflateInit(var strm:TZStream) : integer;
+function deflateInit2_(var strm: TZStream; level: integer; method: integer; windowBits: integer; memLevel: integer; strategy: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit2_';
+function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer): integer;
+function inflateInit2_(var strm: TZStream; windowBits: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit2_';
+function inflateInit2(var strm: TZStream; windowBits: integer): integer;
+
+function zErrorpchar(err: integer): pchar; cdecl; external libz name 'zError';
+function zError(err: integer): string;
+function inflateSyncPoint(z: PZstream): integer; cdecl; external libz name 'inflateSyncPoint';
+function get_crc_table(): pointer; cdecl; external libz name 'get_crc_table';
+
+function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
+procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
+
+implementation
+
+function zlibversion(): string;
+begin
+ zlibversion := string(zlibversionpchar);
+end;
+
+function deflateInit(var strm: TZStream; level: integer) : integer;
+begin
+ deflateInit := deflateInit_(strm, level, ZLIB_VERSION, sizeof(TZStream));
+end;
+
+function inflateInit(var strm: TZStream): integer;
+begin
+ inflateInit := inflateInit_(strm, ZLIB_VERSION, sizeof(TZStream));
+end;
+
+function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer) : integer;
+begin
+ deflateInit2 := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, sizeof(TZStream));
+end;
+
+function inflateInit2(var strm: TZStream; windowBits: integer): integer;
+begin
+ inflateInit2 := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(TZStream));
+end;
+
+function zError(err: integer): string;
+begin
+ zerror := string(zErrorpchar(err));
+end;
+
+function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
+begin
+ Result := GetMemory(Items * Size);
+end;
+
+procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
+begin
+ FreeMem(Block);
+end;
+
+end.
|