aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes
diff options
context:
space:
mode:
authortobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-04-06 12:18:01 +0000
committertobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-04-06 12:18:01 +0000
commit93f69ff9a0c9b05dfbbdcf6f7d737a68fc4d3bd1 (patch)
tree2e78e1b8acb099c952ff1c4931dcc0e4d013900d /Game/Code/Classes
parentb2a824d8f4fcf4d9038e2a360ac586fb0279e739 (diff)
downloadusdx-93f69ff9a0c9b05dfbbdcf6f7d737a68fc4d3bd1.tar.gz
usdx-93f69ff9a0c9b05dfbbdcf6f7d737a68fc4d3bd1.tar.xz
usdx-93f69ff9a0c9b05dfbbdcf6f7d737a68fc4d3bd1.zip
- removed (linux incompatible) PngImage. In addition it was rather outdated (from 2003, newest version is from 2006)
- introduced UImage-unit for JPG/PNG/BMP image saving - the png part uses the libpng12-0.dll (part of SDL_Image) so - the jpg part uses either Delphi's Jpeg unit or FPC's base/pasjpeg unit -> so no additional libs are needed. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1007 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to '')
-rw-r--r--Game/Code/Classes/UImage.pas703
-rw-r--r--Game/Code/Classes/UMain.pas2
-rw-r--r--Game/Code/Classes/UTexture.pas55
-rw-r--r--Game/Code/Classes/Ulazjpeg.pas151
4 files changed, 712 insertions, 199 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.
-