diff options
Diffstat (limited to 'unicode/src/base')
| -rw-r--r-- | unicode/src/base/UCommon.pas | 76 | ||||
| -rw-r--r-- | unicode/src/base/UImage.pas | 48 |
2 files changed, 37 insertions, 87 deletions
diff --git a/unicode/src/base/UCommon.pas b/unicode/src/base/UCommon.pas index c0a98815..1bee9d29 100644 --- a/unicode/src/base/UCommon.pas +++ b/unicode/src/base/UCommon.pas @@ -39,7 +39,6 @@ uses {$IFDEF MSWINDOWS} Windows, {$ENDIF} - sdl, UConfig, ULog, UPath; @@ -51,8 +50,6 @@ procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo); procedure ConsoleWriteLn(const msg: string); -function RWopsFromStream(Stream: TStream): PSDL_RWops; - {$IFDEF FPC} function RandomRange(aMin: integer; aMax: integer): integer; {$ENDIF} @@ -62,8 +59,8 @@ procedure SetDefaultNumericLocale(); procedure RestoreNumericLocale(); {$IFNDEF MSWINDOWS} - procedure ZeroMemory(Destination: pointer; Length: dword); - function MakeLong(a, b: word): longint; +procedure ZeroMemory(Destination: pointer; Length: dword); +function MakeLong(a, b: word): longint; {$ENDIF} type @@ -91,6 +88,7 @@ uses {$IFDEF Delphi} Dialogs, {$ENDIF} + sdl, UFilesystem, UMain, UUnicodeUtils; @@ -269,74 +267,6 @@ begin end; end; -// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ -function SdlStreamSeek(context: PSDL_RWops; offset: integer; whence: integer): integer; cdecl; -var - stream: TStream; - origin: word; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamSeek on nil'); - case whence of - 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. - 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. - 2 : origin := soFromEnd; - else - origin := soFromBeginning; // just in case - end; - Result := stream.Seek(offset, origin); -end; - -function SdlStreamRead(context: PSDL_RWops; Ptr: pointer; size: integer; maxnum: integer): integer; cdecl; -var - stream: TStream; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamRead on nil'); - try - Result := stream.read(Ptr^, Size * maxnum) div size; - except - Result := -1; - end; -end; - -function SDLStreamClose(context: PSDL_RWops): integer; cdecl; -var - stream: TStream; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamClose on nil'); - stream.Free; - Result := 1; -end; -// ----------------------------------------------- - -(* - * Creates an SDL_RWops handle from a TStream. - * The stream and RWops must be freed by the user after usage. - * Use SDL_FreeRW(...) to free the RWops data-struct. - *) -function RWopsFromStream(Stream: TStream): PSDL_RWops; -begin - Result := SDL_AllocRW(); - if (Result = nil) then - Exit; - - // set RW-callbacks - with Result^ do - begin - unknown := TUnknown(Stream); - seek := SDLStreamSeek; - read := SDLStreamRead; - write := nil; - close := SDLStreamClose; - type_ := 2; - end; -end; - {$IFDEF FPC} function RandomRange(aMin: integer; aMax: integer): integer; begin diff --git a/unicode/src/base/UImage.pas b/unicode/src/base/UImage.pas index 25b0d1e2..b5d853dd 100644 --- a/unicode/src/base/UImage.pas +++ b/unicode/src/base/UImage.pas @@ -182,6 +182,7 @@ uses zlib, sdl_image, sdlutils, + sdlstreams, UCommon, ULog; @@ -601,14 +602,15 @@ end; function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean; var {$IFDEF Delphi} - Bitmap: TBitmap; + Bitmap: TBitmap; BitmapInfo: TBitmapInfo; - Jpeg: TJpegImage; - row: integer; + Jpeg: TJpegImage; + row: integer; + FileStream: TBinaryFileStream; {$ELSE} cinfo: jpeg_compress_struct; jerr : jpeg_error_mgr; - jpgFile: TFileStream; + jpgFile: TBinaryFileStream; rowPtr: array[0..0] of JSAMPROW; {$ENDIF} converted: boolean; @@ -670,19 +672,32 @@ begin 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.ToNative); + // init with nil so Free() will not fail if an exception occurs + Jpeg := nil; + Bitmap := nil; + FileStream := nil; + + try + Jpeg := TJPEGImage.Create; + Jpeg.Assign(Bitmap); + + // compress image (don't forget this line, otherwise it won't be compressed) + Jpeg.CompressionQuality := Quality; + Jpeg.Compress(); + + // Note: FileStream needed for unicode filename support + FileStream := TBinaryFileStream.Create(Filename, fmCreate); + Jpeg.SaveToStream(FileStream); + finally + FileStream.Free; + Bitmap.Free; + Jpeg.Free; + end; except Log.LogError('Could not save file: "' + FileName.ToNative + '"', 'WriteJPGImage'); Exit; end; - Jpeg.Free; {$ELSE} // based on example.pas in FPC's packages/base/pasjpeg directory @@ -704,7 +719,7 @@ begin // open file for writing try - jpgFile := TFileStream.Create(FileName, fmCreate); + jpgFile := TBinaryFileStream.Create(FileName, fmCreate); except Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage'); Exit; @@ -767,6 +782,8 @@ end; function LoadImage(const Filename: IPath): PSDL_Surface; var FilenameCaseAdj: IPath; + FileStream: TBinaryFileStream; + SDLStream: PSDL_RWops; begin Result := nil; @@ -780,7 +797,10 @@ begin // load from file try - Result := IMG_Load(PChar(FilenameCaseAdj.ToNative)); + SDLStream := SDLStreamSetup(TBinaryFileStream.Create(FilenameCaseAdj, fmOpenRead)); + Result := IMG_Load_RW(SDLStream, 1); + // Note: the TBinaryFileStream is freed by the SDL-stream. The SDL-stream in + // turn is freed automatically by IMG_Load_RW(). except Log.LogError('Could not load from file "' + FilenameCaseAdj.ToNative + '"', 'LoadImage'); Exit; |