{*********************************************************** glBitmap by Steffen Xonna aka Lossy eX (2003-2008) http://www.opengl24.de/index.php?cat=header&file=glbitmap ------------------------------------------------------------ The contents of this file are used with permission, subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html ------------------------------------------------------------ Version 2.0.3 ------------------------------------------------------------ History 21-03-2010 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi then it's your problem if that isn't true. This prevents the unit for incompatibility with newer versions of Delphi. - Problems with D2009+ resolved (Thanks noeska and all i forgot) - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson) 10-08-2008 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson) - Additional Datapointer for functioninterface now has the name CustomData 24-07-2008 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson) - If you load an texture from an file the property Filename will be set to the name of the file - Three new properties to attach custom data to the Texture objects - CustomName (free for use string) - CustomNameW (free for use widestring) - CustomDataPointer (free for use pointer to attach other objects or complex structures) 27-05-2008 - RLE TGAs loaded much faster 26-05-2008 - fixed some problem with reading RLE TGAs. 21-05-2008 - function clone now only copys data if it's assigned and now it also copies the ID - it seems that lazarus dont like comments in comments. 01-05-2008 - It's possible to set the id of the texture - define GLB_NO_NATIVE_GL deactivated by default 27-04-2008 - Now supports the following libraries - SDL and SDL_image - libPNG - libJPEG - Linux compatibillity via free pascal compatibility (delphi sources optional) - BMPs now loaded manuel - Large restructuring - Property DataPtr now has the name Data - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR - Unused Depth removed - Function FreeData to freeing image data added 24-10-2007 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen) 15-11-2006 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER) - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel - Function ReadOpenGLExtension is now only intern 29-06-2006 - pngimage now disabled by default like all other versions. 26-06-2006 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi) 22-06-2006 - Fixed some Problem with Delphi 5 - Now uses the newest version of pngimage. Makes saving pngs much easier. 22-03-2006 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi) 09-03-2006 - Internal Format ifDepth8 added - function GrabScreen now supports all uncompressed formats 31-01-2006 - AddAlphaFromglBitmap implemented 29-12-2005 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID) 28-12-2005 - Width, Height and Depth internal changed to TglBitmapPixelPosition. property Width, Height, Depth are still existing and new property Dimension are avail 11-12-2005 - Added native OpenGL Support. Breaking the dglOpenGL "barrier". 19-10-2005 - Added function GrabScreen to class TglBitmap2D 18-10-2005 - Added support to Save images - Added function Clone to Clone Instance 11-10-2005 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel. Usefull for Future - Several speed optimizations 09-10-2005 - Internal structure change. Loading of TGA, PNG and DDS improved. Data, format and size will now set directly with SetDataPtr. - AddFunc now works with all Types of Images and Formats - Some Funtions moved to Baseclass TglBitmap 06-10-2005 - Added Support to decompress DXT3 and DXT5 compressed Images. - Added Mapping to convert data from one format into an other. 05-10-2005 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every supported Input format (supported by GetPixel) into any uncompresed Format - Added Support to decompress DXT1 compressed Images. - SwapColors replaced by ConvertTo 04-10-2005 - Added Support for compressed DDSs - Added new internal formats (DXT1, DXT3, DXT5) 29-09-2005 - Parameter Components renamed to InternalFormat 23-09-2005 - Some AllocMem replaced with GetMem (little speed change) - better exception handling. Better protection from memory leaks. 22-09-2005 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only) - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5) 07-09-2005 - Added support for Grayscale textures - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8) 10-07-2005 - Added support for GL_VERSION_2_0 - Added support for GL_EXT_texture_filter_anisotropic 04-07-2005 - Function FillWithColor fills the Image with one Color - Function LoadNormalMap added 30-06-2005 - ToNormalMap allows to Create an NormalMap from the Alphachannel - ToNormalMap now supports Sobel (nmSobel) function. 29-06-2005 - support for RLE Compressed RGB TGAs added 28-06-2005 - Class TglBitmapNormalMap added to support Normalmap generation - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures. 3 Filters are supported. (4 Samples, 3x3 and 5x5) 16-06-2005 - Method LoadCubeMapClass removed - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures - virtual abstract method GenTexture in class TglBitmap now is protected 12-06-2005 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal 10-06-2005 - little enhancement for IsPowerOfTwo - TglBitmap1D.GenTexture now tests NPOT Textures 06-06-2005 - some little name changes. All properties or function with Texture in name are now without texture in name. We have allways texture so we dosn't name it. 03-06-2005 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception. 02-06-2005 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle 25-04-2005 - Function Unbind added - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture. 21-04-2005 - class TglBitmapCubeMap added (allows to Create Cubemaps) 29-03-2005 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/) To Enable png's use the define pngimage 22-03-2005 - New Functioninterface added - Function GetPixel added 27-11-2004 - Property BuildMipMaps renamed to MipMap 21-11-2004 - property Name removed. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap 22-05-2004 - property name added. Only used in glForms! 26-11-2003 - property FreeDataAfterGenTexture is now available as default (default = true) - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it) - function MoveMemory replaced with function Move (little speed change) - several calculations stored in variables (little speed change) 29-09-2003 - property BuildMipsMaps added (default = true) if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps - property FreeDataAfterGenTexture added (default = true) if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated. - parameter DisableOtherTextureUnits of Bind removed - parameter FreeDataAfterGeneration of GenTextures removed 12-09-2003 - TglBitmap dosn't delete data if class was destroyed (fixed) 09-09-2003 - Bind now enables TextureUnits (by params) - GenTextures can leave data (by param) - LoadTextures now optimal 03-09-2003 - Performance optimization in AddFunc - procedure Bind moved to subclasses - Added new Class TglBitmap1D to support real OpenGL 1D Textures 19-08-2003 - Texturefilter and texturewrap now also as defaults Minfilter = GL_LINEAR_MIPMAP_LINEAR Magfilter = GL_LINEAR Wrap(str) = GL_CLAMP_TO_EDGE - Added new format tfCompressed to create a compressed texture. - propertys IsCompressed, TextureSize and IsResident added IsCompressed and TextureSize only contains data from level 0 18-08-2003 - Added function AddFunc to add PerPixelEffects to Image - LoadFromFunc now based on AddFunc - Invert now based on AddFunc - SwapColors now based on AddFunc 16-08-2003 - Added function FlipHorz 15-08-2003 - Added function LaodFromFunc to create images with function - Added function FlipVert - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported 29-07-2003 - Added Alphafunctions to calculate alpha per function - Added Alpha from ColorKey using alphafunctions 28-07-2003 - First full functionally Version of glBitmap - Support for 24Bit and 32Bit TGA Pictures added 25-07-2003 - begin of programming ***********************************************************} unit glBitmap; {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'} // Please uncomment the defines below to configure the glBitmap to your preferences. // If you have configured the unit you can uncomment the warning above. // ###### Start of preferences ################################################ {$DEFINE GLB_NO_NATIVE_GL} // To enable the dglOpenGL.pas Header // With native GL then bindings are staticlly declared to support other headers // or use the glBitmap inside of DLLs (minimize codesize). {.$DEFINE GLB_SDL} // To enable the support for SDL_surfaces {.$DEFINE GLB_DELPHI} // To enable the support for TBitmap from Delphi (not lazarus) // *** image libs *** {.$DEFINE GLB_SDL_IMAGE} // To enable the support of SDL_image to load files. (READ ONLY) // If you enable SDL_image all other libraries will be ignored! {.$DEFINE GLB_PNGIMAGE} // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/ // if you enable pngimage the libPNG will be ignored {.$DEFINE GLB_LIB_PNG} // to use the libPNG http://www.libpng.org/ // You will need an aditional header. // http://www.opengl24.de/index.php?cat=header&file=libpng {.$DEFINE GLB_DELPHI_JPEG} // if you enable delphi jpegs the libJPEG will be ignored {.$DEFINE GLB_LIB_JPEG} // to use the libJPEG http://www.ijg.org/ // You will need an aditional header. // http://www.opengl24.de/index.php?cat=header&file=libjpeg // ###### End of preferences ################################################## // ###### PRIVATE. Do not change anything. #################################### // *** old defines for compatibility *** {$IFDEF NO_NATIVE_GL} {$DEFINE GLB_NO_NATIVE_GL} {$ENDIF} {$IFDEF pngimage} {$definde GLB_PNGIMAGE} {$ENDIF} // *** Delphi Versions *** {$IFDEF fpc} {$MODE Delphi} {$IFDEF CPUI386} {$DEFINE CPU386} {$ASMMODE INTEL} {$ENDIF} {$IFNDEF WINDOWS} {$linklib c} {$ENDIF} {$ENDIF} // *** checking define combinations *** {$IFDEF GLB_SDL_IMAGE} {$IFNDEF GLB_SDL} {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'} {$DEFINE GLB_SDL} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'} {$undef GLB_PNGIMAGE} {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'} {$undef GLB_DELPHI_JPEG} {$ENDIF} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'} {$undef GLB_LIB_PNG} {$ENDIF} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_JPEG_READ} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'} {$undef GLB_LIB_PNG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} {$IFDEF GLB_LIB_PNG} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} {$IFDEF GLB_LIB_JPEG} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // *** general options *** {$EXTENDEDSYNTAX ON} {$LONGSTRINGS ON} {$ALIGN ON} {$IFNDEF FPC} {$OPTIMIZATION ON} {$ENDIF} interface uses {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL, {$ENDIF} {$IFDEF GLB_SDL} SDL, {$ENDIF} {$IFDEF GLB_DELPHI} Dialogs, Windows, Graphics, {$ENDIF} {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF} {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF} {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF} {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF} Classes, SysUtils; {$IFNDEF GLB_DELPHI} type HGLRC = Cardinal; DWORD = Cardinal; PDWORD = ^DWORD; TRGBQuad = packed record rgbBlue: Byte; rgbGreen: Byte; rgbRed: Byte; rgbReserved: Byte; end; {$ENDIF} (* TODO dglOpenGL {$IFNDEF GLB_NO_NATIVE_GL} // Native OpenGL Implementation type PByteBool = ^ByteBool; {$IFDEF GLB_DELPHI} var gLastContext: HGLRC; {$ENDIF} const // Generell GL_VERSION = $1F02; GL_EXTENSIONS = $1F03; GL_TRUE = 1; GL_FALSE = 0; GL_TEXTURE_1D = $0DE0; GL_TEXTURE_2D = $0DE1; GL_MAX_TEXTURE_SIZE = $0D33; GL_PACK_ALIGNMENT = $0D05; GL_UNPACK_ALIGNMENT = $0CF5; // Textureformats GL_RGB = $1907; GL_RGB4 = $804F; GL_RGB8 = $8051; GL_RGBA = $1908; GL_RGBA4 = $8056; GL_RGBA8 = $8058; GL_BGR = $80E0; GL_BGRA = $80E1; GL_ALPHA4 = $803B; GL_ALPHA8 = $803C; GL_LUMINANCE4 = $803F; GL_LUMINANCE8 = $8040; GL_LUMINANCE4_ALPHA4 = $8043; GL_LUMINANCE8_ALPHA8 = $8045; GL_DEPTH_COMPONENT = $1902; GL_UNSIGNED_BYTE = $1401; GL_ALPHA = $1906; GL_LUMINANCE = $1909; GL_LUMINANCE_ALPHA = $190A; GL_TEXTURE_WIDTH = $1000; GL_TEXTURE_HEIGHT = $1001; GL_TEXTURE_INTERNAL_FORMAT = $1003; GL_TEXTURE_RED_SIZE = $805C; GL_TEXTURE_GREEN_SIZE = $805D; GL_TEXTURE_BLUE_SIZE = $805E; GL_TEXTURE_ALPHA_SIZE = $805F; GL_TEXTURE_LUMINANCE_SIZE = $8060; // Dataformats GL_UNSIGNED_SHORT_5_6_5 = $8363; GL_UNSIGNED_SHORT_5_6_5_REV = $8364; GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; GL_UNSIGNED_INT_2_10_10_10_REV = $8368; // Filter GL_NEAREST = $2600; GL_LINEAR = $2601; GL_NEAREST_MIPMAP_NEAREST = $2700; GL_LINEAR_MIPMAP_NEAREST = $2701; GL_NEAREST_MIPMAP_LINEAR = $2702; GL_LINEAR_MIPMAP_LINEAR = $2703; GL_TEXTURE_MAG_FILTER = $2800; GL_TEXTURE_MIN_FILTER = $2801; // Wrapmodes GL_TEXTURE_WRAP_S = $2802; GL_TEXTURE_WRAP_T = $2803; GL_CLAMP = $2900; GL_REPEAT = $2901; GL_CLAMP_TO_EDGE = $812F; GL_CLAMP_TO_BORDER = $812D; GL_TEXTURE_WRAP_R = $8072; GL_MIRRORED_REPEAT = $8370; // Border Color GL_TEXTURE_BORDER_COLOR = $1004; // Texgen GL_NORMAL_MAP = $8511; GL_REFLECTION_MAP = $8512; GL_S = $2000; GL_T = $2001; GL_R = $2002; GL_TEXTURE_GEN_MODE = $2500; GL_TEXTURE_GEN_S = $0C60; GL_TEXTURE_GEN_T = $0C61; GL_TEXTURE_GEN_R = $0C62; // Cubemaps GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C; GL_TEXTURE_CUBE_MAP = $8513; GL_TEXTURE_BINDING_CUBE_MAP = $8514; GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; GL_TEXTURE_RECTANGLE_ARB = $84F5; // GL_SGIS_generate_mipmap GL_GENERATE_MIPMAP = $8191; // GL_EXT_texture_compression_s3tc GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; // GL_EXT_texture_filter_anisotropic GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; // GL_ARB_texture_compression GL_COMPRESSED_RGB = $84ED; GL_COMPRESSED_RGBA = $84EE; GL_COMPRESSED_ALPHA = $84E9; GL_COMPRESSED_LUMINANCE = $84EA; GL_COMPRESSED_LUMINANCE_ALPHA = $84EB; // Extensions var GL_VERSION_1_2, GL_VERSION_1_3, GL_VERSION_1_4, GL_VERSION_2_0, GL_ARB_texture_border_clamp, GL_ARB_texture_cube_map, GL_ARB_texture_compression, GL_ARB_texture_non_power_of_two, GL_ARB_texture_rectangle, GL_ARB_texture_mirrored_repeat, GL_EXT_bgra, GL_EXT_texture_edge_clamp, GL_EXT_texture_cube_map, GL_EXT_texture_compression_s3tc, GL_EXT_texture_filter_anisotropic, GL_EXT_texture_rectangle, GL_NV_texture_rectangle, GL_IBM_texture_mirrored_repeat, GL_SGIS_generate_mipmap: Boolean; const {$IFDEF LINUX} libglu = 'libGLU.so.1'; libopengl = 'libGL.so.1'; {$else} libglu = 'glu32.dll'; libopengl = 'opengl32.dll'; {$ENDIF} {$IFDEF LINUX} function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl; {$else} function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl; {$ENDIF} function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl; function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu; function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu; var glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} {$ENDIF} *) type //////////////////////////////////////////////////////////////////////////////////////////////////// EglBitmapException = class(Exception); EglBitmapSizeToLargeException = class(EglBitmapException); EglBitmapNonPowerOfTwoException = class(EglBitmapException); EglBitmapUnsupportedFormatFormat = class(EglBitmapException); //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapPixelDesc = packed record RedRange: Cardinal; RedShift: Shortint; GreenRange: Cardinal; GreenShift: Shortint; BlueRange: Cardinal; BlueShift: Shortint; AlphaRange: Cardinal; AlphaShift: Shortint; end; PglBitmapPixelDesc = ^TglBitmapPixelDesc; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapPixelData = packed record Red: Cardinal; Green: Cardinal; Blue: Cardinal; Alpha: Cardinal; PixelDesc: TglBitmapPixelDesc; end; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapFormatDesc = packed record Format: Cardinal; InternalFormat: Cardinal; DataType: Cardinal; end; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapPixelPositionFields = set of (ffX, ffY); TglBitmapPixelPosition = record Fields : TglBitmapPixelPositionFields; X : Word; Y : Word; end; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap = class; TglBitmapFunctionRec = record Sender: TglBitmap; Size: TglBitmapPixelPosition; Position: TglBitmapPixelPosition; Source: TglBitmapPixelData; Dest: TglBitmapPixelData; Args: PtrInt; end; TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec); //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapFileType = ( {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} ftDDS, ftTGA, ftBMP); TglBitmapFileTypes = set of TglBitmapFileType; TglBitmapMipMap = ( mmNone, mmMipmap, mmMipmapGlu); TglBitmapNormalMapFunc = ( nm4Samples, nmSobel, nm3x3, nm5x5); TglBitmapFormat = ( tfEmpty = 0, //TODO //tfAlpha4, //tfAlpha8, //tfAlpha12, //tfAlpha16, //tfLuminance4, tfLuminance8, //tfLuminance12, //tfLuminance16, // //tfuminance4Alpha4, //tfLuminance6Alpha2, tfLuminance8Alpha8, //tfLuminance12Alpha4, //tfLuminance12Alpha12, //tfLuminance16Alpha16, //tfR3G3B2, //tfRGB4, tfRGB5, tfRGB8, //tfRGB10, //tfRGB12, //tfRGB16, //tfRGBA2, //tfRGBA4, tfRGB5A1, tfRGBA8, //tfRGB10A2, //tfRGBA12, //tfRGBA16, //tfBGR4, //tfBGR5, tfBGR8, //tfBGR10, //tfBGR12, //tfBGR16, //tfBGRA2, //tfBGRA4, //tfBGR5A1, tfBGRA8 //tfBGR10A2, //tfBGRA12, //tfBGRA16, //tfDepth16, //tfDepth24, //tfDepth32 ); //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapGetPixel = procedure(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData) of object; TglBitmapSetPixel = procedure(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData) of object; TglBitmapMapFunc = procedure(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); TglBitmapUnMapFunc = procedure(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapFormatDescriptor = class(TObject) public //virtual abstract class function GetFormat: TglBitmapFormat; virtual; abstract; class function GetPixelDesc: TglBitmapPixelDesc; virtual; abstract; class function GetFormatDesc: TglBitmapFormatDesc; virtual; abstract; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); virtual; abstract; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); virtual; abstract; //virtual class function WithoutAlpha: TglBitmapFormat; virtual; class function WithAlpha: TglBitmapFormat; virtual; class function GetSize: Single; virtual; overload; class function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload; class function GetColorCompCount: Integer; virtual; class function IsEmpty: Boolean; virtual; class function HasAlpha: Boolean; virtual; class function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual; class procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual; (* TODO function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean; function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean; function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean; function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean; function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean; *) end; TglBitmapFormatDescClass = class of TglBitmapFormatDescriptor; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap = class protected fID: GLuint; fTarget: GLuint; fAnisotropic: Integer; fDeleteTextureOnFree: Boolean; fFreeDataAfterGenTexture: Boolean; fData: PByte; fIsResident: Boolean; fBorderColor: array[0..3] of Single; fDimension: TglBitmapPixelPosition; fMipMap: TglBitmapMipMap; fFormat: TglBitmapFormat; // Mapping fPixelSize: Integer; fRowSize: Integer; //TODO delete? fUnmapFunc: TglBitmapUnMapFunc; //TODO delete? fMapFunc: TglBitmapMapFunc; // Filtering fFilterMin: Cardinal; fFilterMag: Cardinal; // TexturWarp fWrapS: Cardinal; fWrapT: Cardinal; fWrapR: Cardinal; //TODO delete? fGetPixelFunc: TglBitmapGetPixel; //TODO delete? fSetPixelFunc: TglBitmapSetPixel; // CustomData fFilename: String; fCustomName: String; fCustomNameW: WideString; fCustomData: Pointer; //Getter function GetWidth: Integer; virtual; function GetHeight: Integer; virtual; function GetFileWidth: Integer; virtual; function GetFileHeight: Integer; virtual; //Setter procedure SetCustomData(const aValue: Pointer); procedure SetCustomName(const aValue: String); procedure SetCustomNameW(const aValue: WideString); procedure SetDeleteTextureOnFree(const aValue: Boolean); procedure SetFormat(const aValue: TglBitmapFormat); procedure SetFreeDataAfterGenTexture(const aValue: Boolean); procedure SetID(const aValue: Cardinal); procedure SetMipMap(const aValue: TglBitmapMipMap); procedure SetTarget(const aValue: Cardinal); procedure SetAnisotropic(const aValue: Integer); procedure CreateID; procedure SetupParameters(var aBuildWithGlu: Boolean); procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract; function FlipHorz: Boolean; virtual; function FlipVert: Boolean; virtual; property Width: Integer read GetWidth; property Height: Integer read GetHeight; property FileWidth: Integer read GetFileWidth; property FileHeight: Integer read GetFileHeight; public //Properties property ID: Cardinal read fID write SetID; property Target: Cardinal read fTarget write SetTarget; property Format: TglBitmapFormat read fFormat write SetFormat; property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; property Anisotropic: Integer read fAnisotropic write SetAnisotropic; property Filename: String read fFilename; property CustomName: String read fCustomName write SetCustomName; property CustomNameW: WideString read fCustomNameW write SetCustomNameW; property CustomData: Pointer read fCustomData write SetCustomData; property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; property Dimension: TglBitmapPixelPosition read fDimension; property Data: PByte read fData; property IsResident: Boolean read fIsResident; procedure AfterConstruction; override; procedure BeforeDestruction; override; //Load procedure LoadFromFile(const aFilename: String); procedure LoadFromStream(const aStream: TStream); virtual; procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction; const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0); {$IFDEF GLB_DELPHI} procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); {$ENDIF} //Save procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType); procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual; //Convert function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload; function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean; const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload; public //Alpha & Co {$IFDEF GLB_SDL} function AssignToSurface(out aSurface: PSDL_Surface): Boolean; function AssignFromSurface(const aSurface: PSDL_Surface): Boolean; function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean; function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; {$ENDIF} {$IFDEF GLB_DELPHI} function AssignToBitmap(const aBitmap: TBitmap): Boolean; function AssignFromBitmap(const aBitmap: TBitmap): Boolean; function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean; function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; {$ENDIF} function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual; function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean; function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean; function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean; function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean; function AddAlphaFromValue(const aAlpha: Byte): Boolean; function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean; function AddAlphaFromValueFloat(const aAlpha: Single): Boolean; function RemoveAlpha: Boolean; virtual; public //Common function Clone: TglBitmap; function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual; procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false); procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); procedure FreeData; //ColorFill procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255); procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF); procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1); //TexParameters procedure SetFilter(const aMin, aMag: Cardinal); procedure SetWrap( const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); virtual; procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual; procedure Bind(const aEnableTextureUnit: Boolean = true); virtual; procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual; //Constructors constructor Create; overload; constructor Create(const aFileName: String); overload; constructor Create(const aStream: TStream); overload; constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload; constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload; {$IFDEF GLB_DELPHI} constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload; constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload; {$ENDIF} private {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; procedure SavePNG(const aStream: TStream); virtual; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF} function LoadBMP(const aStream: TStream): Boolean; virtual; procedure SaveBMP(const aStream: TStream); virtual; function LoadTGA(const aStream: TStream): Boolean; virtual; procedure SaveTGA(const aStream: TStream); virtual; function LoadDDS(const aStream: TStream): Boolean; virtual; procedure SaveDDS(const aStream: TStream); virtual; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap2D = class(TglBitmap) protected // Bildeinstellungen fLines: array of PByte; (* TODO procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData); procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData); *) function GetScanline(const aIndex: Integer): Pointer; procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override; procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean); public property Width; property Height; property Scanline[const aIndex: Integer]: Pointer read GetScanline; procedure AfterConstruction; override; procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat); procedure GetDataFromTexture; procedure GenTexture(const aTestTextureSize: Boolean = true); override; function FlipHorz: Boolean; override; function FlipVert: Boolean; override; procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3; const aScale: Single = 2; const aUseAlpha: Boolean = false); end; (* TODO TglBitmapCubeMap = class(TglBitmap2D) protected fGenMode: Integer; // Hide GenTexture procedure GenTexture(TestTextureSize: Boolean = true); reintroduce; public procedure AfterConstruction; override; procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true); procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual; procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual; end; TglBitmapNormalMap = class(TglBitmapCubeMap) public procedure AfterConstruction; override; procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true); end; TglBitmap1D = class(TglBitmap) protected procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override; procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean); public // propertys property Width; procedure AfterConstruction; override; // Other function FlipHorz: Boolean; override; // Generation procedure GenTexture(TestTextureSize: Boolean = true); override; end; *) const NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0); procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean); procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean); procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap); procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat); procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer); procedure glBitmapSetDefaultWrap( const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); function glBitmapGetDefaultDeleteTextureOnFree: Boolean; function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean; function glBitmapGetDefaultMipmap: TglBitmapMipMap; function glBitmapGetDefaultFormat: TglBitmapFormat; procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal); procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal); function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition; var glBitmapDefaultDeleteTextureOnFree: Boolean; glBitmapDefaultFreeDataAfterGenTextures: Boolean; glBitmapDefaultFormat: TglBitmapFormat; glBitmapDefaultMipmap: TglBitmapMipMap; glBitmapDefaultFilterMin: Cardinal; glBitmapDefaultFilterMag: Cardinal; glBitmapDefaultWrapS: Cardinal; glBitmapDefaultWrapT: Cardinal; glBitmapDefaultWrapR: Cardinal; {$IFDEF GLB_DELPHI} function CreateGrayPalette: HPALETTE; {$ENDIF} implementation uses Math; type ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TBitfieldFormat = class(TObject) private fRedShift: ShortInt; fGreenShift: ShortInt; fBlueShift: ShortInt; fAlphaShift: ShortInt; fRedRange: Cardinal; fGreenRange: Cardinal; fBlueRange: Cardinal; fAlphaRange: Cardinal; fRedMask: UInt64; fGreenMask: UInt64; fBlueMask: UInt64; fAlphaMask: UInt64; function GetSize: Integer; procedure SetAlphaMask(aValue: UInt64); procedure SetAlphaRange(aValue: Cardinal); procedure SetAlphaShift(aValue: ShortInt); procedure SetBlueMask(aValue: UInt64); procedure SetBlueRange(aValue: Cardinal); procedure SetBlueShift(aValue: ShortInt); procedure SetGreenMask(aValue: UInt64); procedure SetGreenRange(aValue: Cardinal); procedure SetGreenShift(aValue: ShortInt); procedure SetRedMask(aValue: UInt64); procedure SetRedRange(aValue: Cardinal); procedure SetRedShift(aValue: ShortInt); procedure CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal; out aShift: ShortInt); public property RedShift: ShortInt read fRedShift write SetRedShift; property GreenShift: ShortInt read fGreenShift write SetGreenShift; property BlueShift: ShortInt read fBlueShift write SetBlueShift; property AlphaShift: ShortInt read fAlphaShift write SetAlphaShift; property RedRange: Cardinal read fRedRange write SetRedRange; property GreenRange: Cardinal read fGreenRange write SetGreenRange; property BlueRange: Cardinal read fBlueRange write SetBlueRange; property AlphaRange: Cardinal read fAlphaRange write SetAlphaRange; property RedMask: UInt64 read fRedMask write SetRedMask; property GreenMask: UInt64 read fGreenMask write SetGreenMask; property BlueMask: UInt64 read fBlueMask write SetBlueMask; property AlphaMask: UInt64 read fAlphaMask write SetAlphaMask; property Size: Integer read GetSize; procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); overload; procedure Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData); overload; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdEmpty = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdLuminance8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdLuminance8Alpha8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithoutAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdRGB5 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdRGB8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdRGB5A1 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithoutAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdRGBA8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithoutAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdBGR8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdBGRA8 = class(TglBitmapFormatDescriptor) public class function GetFormat: TglBitmapFormat; override; class function GetPixelDesc: TglBitmapPixelDesc; override; class function GetFormatDesc: TglBitmapFormatDesc; override; class function WithoutAlpha: TglBitmapFormat; override; class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override; class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override; end; const LUMINANCE_WEIGHT_R = 0.30; LUMINANCE_WEIGHT_G = 0.59; LUMINANCE_WEIGHT_B = 0.11; ALPHA_WEIGHT_R = 0.30; ALPHA_WEIGHT_G = 0.59; ALPHA_WEIGHT_B = 0.11; UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.'; FORMAT_DESCRIPTORS: array[TglBitmapFormat] of TglBitmapFormatDescClass = ( TfdEmpty, TfdLuminance8, TfdLuminance8Alpha8, TfdRGB5, TfdRGB8, TfdRGB5A1, TfdRGBA8, TfdBGR8, TfdBGRA8 ); {$REGION Private Helper} ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition; begin result.Fields := []; if X >= 0 then result.Fields := result.Fields + [ffX]; if Y >= 0 then result.Fields := result.Fields + [ffY]; result.X := Max(0, X); result.Y := Max(0, Y); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes; begin //TODO Supported File Formats! result := [ftDDS, ftTGA, ftBMP]; (* {$IFDEF GLB_SUPPORT_PNG_WRITE} if aFormat in [ tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16, tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16, tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16, tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16, tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16, tfDepth16, tfDepth24, tfDepth32] then result := result + [ftPNG]; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} if Format in [ tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16, tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16, tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16, tfDepth16, tfDepth24, tfDepth32] then result := result + [ftJPEG]; {$ENDIF} if aFormat in [ tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16, tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16, tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16, tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16, tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16, tfDepth16, tfDepth24, tfDepth32] then result := result + [ftDDS, ftTGA, ftBMP]; *) end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function IsPowerOfTwo(aNumber: Integer): Boolean; begin while (aNumber and 1) = 0 do aNumber := aNumber shr 1; result := aNumber = 1; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function GetTopMostBit(aBitSet: UInt64): Integer; begin result := 0; while aBitSet > 0 do begin inc(result); aBitSet := aBitSet shr 1; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CountSetBits(aBitSet: UInt64): Integer; begin result := 0; while aBitSet > 0 do begin if (aBitSet and 1) = 1 then inc(result); aBitSet := aBitSet shr 1; end; end; {$ENDREGION} //TODO check _ARB functions and constants (* GLB_NO_NATIVE_GL {$IFNDEF GLB_NO_NATIVE_GL} procedure ReadOpenGLExtensions; var {$IFDEF GLB_DELPHI} Context: HGLRC; {$ENDIF} Buffer: AnsiString; MajorVersion, MinorVersion: Integer; procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer); var Separator: Integer; begin Minor := 0; Major := 0; Separator := Pos(AnsiString('.'), Buffer); if (Separator > 1) and (Separator < Length(Buffer)) and (Buffer[Separator - 1] in ['0'..'9']) and (Buffer[Separator + 1] in ['0'..'9']) then begin Dec(Separator); while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do Dec(Separator); Delete(Buffer, 1, Separator); Separator := Pos(AnsiString('.'), Buffer) + 1; while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do Inc(Separator); Delete(Buffer, Separator, 255); Separator := Pos(AnsiString('.'), Buffer); Major := StrToInt(Copy(String(Buffer), 1, Separator - 1)); Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1)); end; end; function CheckExtension(const Extension: AnsiString): Boolean; var ExtPos: Integer; begin ExtPos := Pos(Extension, Buffer); result := ExtPos > 0; if result then result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']); end; function glLoad (aFunc: pAnsiChar): pointer; begin {$IFDEF LINUX} result := glXGetProcAddress(aFunc); {$else} result := wglGetProcAddress(aFunc); {$ENDIF} end; begin {$IFDEF GLB_DELPHI} Context := wglGetCurrentContext; if Context <> gLastContext then begin gLastContext := Context; {$ENDIF} // Version Buffer := glGetString(GL_VERSION); TrimVersionString(Buffer, MajorVersion, MinorVersion); GL_VERSION_1_2 := false; GL_VERSION_1_3 := false; GL_VERSION_1_4 := false; GL_VERSION_2_0 := false; if MajorVersion = 1 then begin if MinorVersion >= 1 then begin if MinorVersion >= 2 then GL_VERSION_1_2 := true; if MinorVersion >= 3 then GL_VERSION_1_3 := true; if MinorVersion >= 4 then GL_VERSION_1_4 := true; end; end; if MajorVersion >= 2 then begin GL_VERSION_1_2 := true; GL_VERSION_1_3 := true; GL_VERSION_1_4 := true; GL_VERSION_2_0 := true; end; // Extensions Buffer := glGetString(GL_EXTENSIONS); GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp'); GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map'); GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression'); GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two'); GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle'); GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat'); GL_EXT_bgra := CheckExtension('GL_EXT_bgra'); GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp'); GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map'); GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc'); GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic'); GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle'); GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle'); GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat'); GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap'); // Funtions if GL_VERSION_1_3 then begin // Loading Core glCompressedTexImage1D := glLoad('glCompressedTexImage1D'); glCompressedTexImage2D := glLoad('glCompressedTexImage2D'); glGetCompressedTexImage := glLoad('glGetCompressedTexImage'); end else begin // Try loading Extension glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB'); glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB'); glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB'); end; {$IFDEF GLB_DELPHI} end; {$ENDIF} end; {$ENDIF} *) (* TODO GLB_DELPHI {$IFDEF GLB_DELPHI} function CreateGrayPalette: HPALETTE; var Idx: Integer; Pal: PLogPalette; begin GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256)); Pal.palVersion := $300; Pal.palNumEntries := 256; {$IFOPT R+} {$DEFINE GLB_TEMPRANGECHECK} {$R-} {$ENDIF} for Idx := 0 to 256 - 1 do begin Pal.palPalEntry[Idx].peRed := Idx; Pal.palPalEntry[Idx].peGreen := Idx; Pal.palPalEntry[Idx].peBlue := Idx; Pal.palPalEntry[Idx].peFlags := 0; end; {$IFDEF GLB_TEMPRANGECHECK} {$UNDEF GLB_TEMPRANGECHECK} {$R+} {$ENDIF} result := CreatePalette(Pal^); FreeMem(Pal); end; {$ENDIF} *) (* TODO GLB_SDL_IMAGE {$IFDEF GLB_SDL_IMAGE} function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Seek(offset, whence); end; function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum); end; function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Write(Ptr^, size * num); end; function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl; begin result := 0; end; function glBitmapCreateRWops(Stream: TStream): PSDL_RWops; begin result := SDL_AllocRW; if result = nil then raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.'); result^.seek := glBitmapRWseek; result^.read := glBitmapRWread; result^.write := glBitmapRWwrite; result^.close := glBitmapRWclose; result^.unknown.data1 := Stream; end; {$ENDIF} *) (* TODO LoadFuncs function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean; var glBitmap: TglBitmap2D; begin result := false; Texture := 0; {$IFDEF GLB_DELPHI} if Instance = 0 then Instance := HInstance; if (LoadFromRes) then glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName) else {$ENDIF} glBitmap := TglBitmap2D.Create(FileName); try glBitmap.DeleteTextureOnFree := false; glBitmap.FreeDataAfterGenTexture := false; glBitmap.GenTexture(true); if (glBitmap.ID > 0) then begin Texture := glBitmap.ID; result := true; end; finally glBitmap.Free; end; end; function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean; var CM: TglBitmapCubeMap; begin Texture := 0; {$IFDEF GLB_DELPHI} if Instance = 0 then Instance := HInstance; {$ENDIF} CM := TglBitmapCubeMap.Create; try CM.DeleteTextureOnFree := false; // Maps {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, PositiveX) else {$ENDIF} CM.LoadFromFile(PositiveX); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X); {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, NegativeX) else {$ENDIF} CM.LoadFromFile(NegativeX); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X); {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, PositiveY) else {$ENDIF} CM.LoadFromFile(PositiveY); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y); {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, NegativeY) else {$ENDIF} CM.LoadFromFile(NegativeY); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y); {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, PositiveZ) else {$ENDIF} CM.LoadFromFile(PositiveZ); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z); {$IFDEF GLB_DELPHI} if (LoadFromRes) then CM.LoadFromResource(Instance, NegativeZ) else {$ENDIF} CM.LoadFromFile(NegativeZ); CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z); Texture := CM.ID; result := true; finally CM.Free; end; end; function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean; var NM: TglBitmapNormalMap; begin Texture := 0; NM := TglBitmapNormalMap.Create; try NM.DeleteTextureOnFree := false; NM.GenerateNormalMap(Size); Texture := NM.ID; result := true; finally NM.Free; end; end; *) {$REGION default Setter and Gettter} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean); begin glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean); begin glBitmapDefaultFreeDataAfterGenTextures := aFreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap); begin glBitmapDefaultMipmap := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat); begin glBitmapDefaultFormat := aFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer); begin glBitmapDefaultFilterMin := aMin; glBitmapDefaultFilterMag := aMag; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); begin glBitmapDefaultWrapS := S; glBitmapDefaultWrapT := T; glBitmapDefaultWrapR := R; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultDeleteTextureOnFree: Boolean; begin result := glBitmapDefaultDeleteTextureOnFree; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean; begin result := glBitmapDefaultFreeDataAfterGenTextures; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultMipmap: TglBitmapMipMap; begin result := glBitmapDefaultMipmap; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultFormat: TglBitmapFormat; begin result := glBitmapDefaultFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal); begin aMin := glBitmapDefaultFilterMin; aMag := glBitmapDefaultFilterMag; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal); begin S := glBitmapDefaultWrapS; T := glBitmapDefaultWrapT; R := glBitmapDefaultWrapR; end; {$ENDREGION} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TCustomFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetAlphaMask(aValue: UInt64); begin if fAlphaMask = aValue then Exit; fAlphaMask := aValue; CalcShiftAndRange(fAlphaMask, fAlphaRange, fAlphaShift); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TBitfieldFormat.GetSize: Integer; var tmp: UInt64; begin tmp := (fRedRange shl fRedShift) or (fGreenRange shl fGreenShift) or (fBlueRange shl fBlueShift) or (fAlphaRange shl fAlphaShift); result := Trunc(GetTopMostBit(tmp) / 8); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetAlphaRange(aValue: Cardinal); begin if fAlphaRange = aValue then Exit; fAlphaRange := aValue; fAlphaMask := fAlphaRange shl fAlphaShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetAlphaShift(aValue: ShortInt); begin if fAlphaShift = aValue then Exit; fAlphaShift := aValue; fAlphaMask := fAlphaRange shl fAlphaShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetBlueMask(aValue: UInt64); begin if fBlueMask = aValue then Exit; fBlueMask := aValue; CalcShiftAndRange(fBlueMask, fBlueRange, fBlueShift); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetBlueRange(aValue: Cardinal); begin if fBlueRange = aValue then Exit; fBlueRange := aValue; fBlueMask := fBlueRange shl fBlueShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetBlueShift(aValue: ShortInt); begin if fBlueShift = aValue then Exit; fBlueShift := aValue; fBlueMask := fBlueRange shl fBlueShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetGreenMask(aValue: UInt64); begin if fGreenMask = aValue then Exit; fGreenMask := aValue; CalcShiftAndRange(fGreenMask, fGreenRange, fGreenShift); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetGreenRange(aValue: Cardinal); begin if fGreenRange = aValue then Exit; fGreenRange := aValue; fGreenMask := fGreenRange shl fGreenShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetGreenShift(aValue: ShortInt); begin if fGreenShift = aValue then Exit; fGreenShift := aValue; fGreenMask := fGreenRange shl fGreenShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetRedMask(aValue: UInt64); begin if fRedMask = aValue then Exit; fRedMask := aValue; CalcShiftAndRange(fRedMask, fRedRange, fRedShift); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetRedRange(aValue: Cardinal); begin if fRedRange = aValue then Exit; fRedRange := aValue; fRedMask := fRedRange shl fRedShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.SetRedShift(aValue: ShortInt); begin if fRedShift = aValue then Exit; fRedShift := aValue; fRedMask := fRedRange shl fRedShift; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal; out aShift: ShortInt); begin aShift := 0; aRange := 0; if (aMask = 0) then exit; while (aMask > 0) and ((aMask and 1) = 0) do begin inc(aShift); aMask := aMask shr 1; end; aRange := 1; while (aMask > 0) do begin aRange := aRange shl 1; aMask := aMask shr 1; end; dec(aRange); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte); var data: UInt64; s: Integer; type PUInt64 = ^UInt64; begin data := ((aPixel.Red and fRedRange) shl fRedShift) or ((aPixel.Green and fGreenRange) shl fGreenShift) or ((aPixel.Blue and fBlueRange) shl fBlueShift) or ((aPixel.Alpha and fAlphaRange) shl fAlphaShift); s := Size; case s of 1: aData^ := data; 2: PWord(aData)^ := data; 4: PCardinal(aData)^ := data; 8: PUInt64(aData)^ := data; end; inc(aData, s); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); var data: UInt64; s: Integer; type PUInt64 = ^UInt64; begin s := Size; case s of 1: data := aData^; 2: data := PWord(aData)^; 4: data := PCardinal(aData)^; 8: data := PUInt64(aData)^; end; Unmap(data, aPixel); inc(aData, s); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TBitfieldFormat.Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData); begin aPixel.Red := (aData shr fRedShift) and fRedRange; aPixel.Green := (aData shr fGreenShift) and fGreenRange; aPixel.Blue := (aData shr fBlueShift) and fBlueRange; aPixel.Alpha := (aData shr fAlphaShift) and fAlphaRange; end; {$REGION TglBitmapFormatDescriptor} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.WithoutAlpha: TglBitmapFormat; begin if not HasAlpha then result := GetFormat else result := tfEmpty; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.WithAlpha: TglBitmapFormat; begin if HasAlpha then result := GetFormat else result := tfEmpty; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.GetSize: Single; var tmp: UInt64; begin with GetPixelDesc do begin tmp := (RedRange shl RedShift) or (GreenRange shl GreenShift) or (BlueRange shl BlueShift) or (AlphaRange shl AlphaShift); end; result := Trunc(GetTopMostBit(tmp) / 4) / 2; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer; var w, h: Integer; begin if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin w := Max(1, aSize.X); h := Max(1, aSize.Y); result := Ceil(w * h * GetSize); end else result := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.GetColorCompCount: Integer; begin result := 0; with GetPixelDesc do begin if (RedRange > 0) then inc(result); if (GreenRange > 0) then inc(result); if (BlueRange > 0) then inc(result); if (AlphaRange > 0) then inc(result); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.IsEmpty: Boolean; begin result := (GetFormat = tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.HasAlpha: Boolean; begin result := (GetPixelDesc.AlphaRange > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; var PixelDesc: TglBitmapPixelDesc; begin result := false; if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0'); PixelDesc := GetPixelDesc; with PixelDesc do begin if (aRedMask <> 0) and (aRedMask <> (RedRange shl RedShift)) then exit; if (aGreenMask <> 0) and (aGreenMask <> (GreenRange shl GreenShift)) then exit; if (aBlueMask <> 0) and (aBlueMask <> (BlueRange shl BlueShift)) then exit; if (aAlphaMask <> 0) and (aAlphaMask <> (AlphaRange shl AlphaShift)) then exit; end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TglBitmapFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData); begin FillChar(aPixel, SizeOf(aPixel), 0); aPixel.PixelDesc := GetPixelDesc; with aPixel.PixelDesc do begin aPixel.Red := RedRange; aPixel.Green := GreenRange; aPixel.Blue := BlueRange; aPixel.Alpha := AlphaRange; end; end; {$ENDREGION} {$REGION TfdEmpty} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdEmpty//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdEmpty.GetFormat: TglBitmapFormat; begin result := tfEmpty; end; class function TfdEmpty.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $00000000; RedShift := 0; GreenRange := $00000000; GreenShift := 0; BlueRange := $00000000; BlueShift := 0; AlphaRange := $00000000; AlphaShift := 0; end; end; class function TfdEmpty.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := 0; InternalFormat := 0; DataType := 0; end; end; class procedure TfdEmpty.Map(const aPixel: TglBitmapPixelData; var aData: PByte ); begin raise EglBitmapException.Create('format does not support mapping'); end; class procedure TfdEmpty.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin raise EglBitmapException.Create('format does not support unmapping'); end; {$ENDREGION} {$REGION TfdLuminance8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdLuminance8.GetFormat: TglBitmapFormat; begin result := tfEmpty; end; class function TfdLuminance8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 0; GreenRange := $000000FF; GreenShift := 0; BlueRange := $000000FF; BlueShift := 0; AlphaRange := $00000000; AlphaShift := 0; end; end; class function TfdLuminance8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_LUMINANCE; InternalFormat := GL_LUMINANCE8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdLuminance8.WithAlpha: TglBitmapFormat; begin result := tfLuminance8Alpha8; end; class procedure TfdLuminance8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := Trunc( aPixel.Red * LUMINANCE_WEIGHT_R + aPixel.Green * LUMINANCE_WEIGHT_G + aPixel.Blue * LUMINANCE_WEIGHT_B); inc(aData); end; class procedure TfdLuminance8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := aData^; aPixel.Green := aData^; aPixel.Blue := aData^; aPixel.Alpha := 0; inc(aData); end; {$ENDREGION} {$REGION TfdLuminance8Alpha8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance8Alpha8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdLuminance8Alpha8.GetFormat: TglBitmapFormat; begin result := tfLuminance8Alpha8; end; class function TfdLuminance8Alpha8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 0; GreenRange := $000000FF; GreenShift := 0; BlueRange := $000000FF; BlueShift := 0; AlphaRange := $000000FF; AlphaShift := 8; end; end; class function TfdLuminance8Alpha8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_LUMINANCE_ALPHA; InternalFormat := GL_LUMINANCE8_ALPHA8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdLuminance8Alpha8.WithoutAlpha: TglBitmapFormat; begin result := tfLuminance8; end; class procedure TfdLuminance8Alpha8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := Trunc( aPixel.Red * LUMINANCE_WEIGHT_R + aPixel.Green * LUMINANCE_WEIGHT_G + aPixel.Blue * LUMINANCE_WEIGHT_B); inc(aData); aData^ := aPixel.Alpha; inc(aData); end; class procedure TfdLuminance8Alpha8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := aData^; aPixel.Green := aData^; aPixel.Blue := aData^; inc(aData); aPixel.Alpha := aData^; inc(aData); end; {$ENDREGION} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB5///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdRGB5.GetFormat: TglBitmapFormat; begin result := tfRGB5; end; class function TfdRGB5.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $0000001F; RedShift := 0; GreenRange := $0000001F; GreenShift := 5; BlueRange := $0000001F; BlueShift := 10; AlphaRange := $00000000; AlphaShift := 0; end; end; class function TfdRGB5.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_RGB; InternalFormat := GL_RGB5; DataType := GL_UNSIGNED_SHORT_5_5_5_1; end; end; class function TfdRGB5.WithAlpha: TglBitmapFormat; begin result := tfRGB5A1; end; class procedure TfdRGB5.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin PWord(aData)^ := ((aPixel.Red and aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or ((aPixel.Blue and aPixel.PixelDesc.BlueRange) shl aPixel.PixelDesc.BlueShift); inc(aData, 2); end; class procedure TfdRGB5.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := (PWord(aData)^ shr aPixel.PixelDesc.RedShift) and aPixel.PixelDesc.RedRange; aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange; aPixel.Blue := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift) and aPixel.PixelDesc.BlueRange; aPixel.Alpha := 0; inc(aData, 2); end; {$REGION TfdRGB8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdRGB8.GetFormat: TglBitmapFormat; begin result := tfRGB8; end; class function TfdRGB8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 0; GreenRange := $000000FF; GreenShift := 8; BlueRange := $000000FF; BlueShift := 16; AlphaRange := $00000000; AlphaShift := 0; end; end; class function TfdRGB8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_LUMINANCE; InternalFormat := GL_LUMINANCE8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdRGB8.WithAlpha: TglBitmapFormat; begin result := tfRGBA8; end; class procedure TfdRGB8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := aPixel.Red; inc(aData); aData^ := aPixel.Green; inc(aData); aData^ := aPixel.Blue; inc(aData); end; class procedure TfdRGB8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := aData^; inc(aData); aPixel.Green := aData^; inc(aData); aPixel.Blue := aData^; inc(aData); aPixel.Alpha := 0; end; {$ENDREGION} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB5A1/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdRGB5A1.GetFormat: TglBitmapFormat; begin result := tfRGB5A1; end; class function TfdRGB5A1.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $0000001F; RedShift := 0; GreenRange := $0000001F; GreenShift := 5; BlueRange := $0000001F; BlueShift := 10; AlphaRange := $00000001; AlphaShift := 15; end; end; class function TfdRGB5A1.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_RGBA; InternalFormat := GL_RGB5_A1; DataType := GL_UNSIGNED_SHORT_5_5_5_1; end; end; class function TfdRGB5A1.WithoutAlpha: TglBitmapFormat; begin //TODO result := tfRGB5; end; class procedure TfdRGB5A1.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin PWord(aData)^ := ((aPixel.Red and aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or ((aPixel.Blue and aPixel.PixelDesc.BlueRange) shl aPixel.PixelDesc.BlueShift) or ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift); inc(aData, 2); end; class procedure TfdRGB5A1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := (PWord(aData)^ shr aPixel.PixelDesc.RedShift) and aPixel.PixelDesc.RedRange; aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange; aPixel.Blue := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift) and aPixel.PixelDesc.BlueRange; aPixel.Alpha := (PWord(aData)^ shr aPixel.PixelDesc.AlphaShift) and aPixel.PixelDesc.AlphaRange; inc(aData, 2); end; {$REGION TfdRGBA8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA8//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdRGBA8.GetFormat: TglBitmapFormat; begin result := tfRGBA8; end; class function TfdRGBA8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 0; GreenRange := $000000FF; GreenShift := 8; BlueRange := $000000FF; BlueShift := 16; AlphaRange := $000000FF; AlphaShift := 24; end; end; class function TfdRGBA8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_RGB; InternalFormat := GL_RGB8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdRGBA8.WithoutAlpha: TglBitmapFormat; begin result := tfRGB8; end; class procedure TfdRGBA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := aPixel.Red; inc(aData); aData^ := aPixel.Green; inc(aData); aData^ := aPixel.Blue; inc(aData); aData^ := aPixel.Alpha; inc(aData); end; class procedure TfdRGBA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Red := aData^; inc(aData); aPixel.Green := aData^; inc(aData); aPixel.Blue := aData^; inc(aData); aPixel.Alpha := aData^; inc(aData); end; {$ENDREGION} {$REGION TfdBGR8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdBGR8.GetFormat: TglBitmapFormat; begin result := tfBGR8; end; class function TfdBGR8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 16; GreenRange := $000000FF; GreenShift := 8; BlueRange := $000000FF; BlueShift := 0; AlphaRange := $00000000; AlphaShift := 0; end; end; class function TfdBGR8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_BGR; InternalFormat := GL_RGB8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdBGR8.WithAlpha: TglBitmapFormat; begin result := tfBGRA8; end; class procedure TfdBGR8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := aPixel.Blue; inc(aData); aData^ := aPixel.Green; inc(aData); aData^ := aPixel.Red; inc(aData); end; class procedure TfdBGR8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Blue := aData^; inc(aData); aPixel.Green := aData^; inc(aData); aPixel.Red := aData^; inc(aData); end; {$ENDREGION} {$REGION TfdBGRA8} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA8//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TfdBGRA8.GetFormat: TglBitmapFormat; begin result := tfBGRA8; end; class function TfdBGRA8.GetPixelDesc: TglBitmapPixelDesc; begin with result do begin RedRange := $000000FF; RedShift := 16; GreenRange := $000000FF; GreenShift := 8; BlueRange := $000000FF; BlueShift := 0; AlphaRange := $000000FF; AlphaShift := 24; end; end; class function TfdBGRA8.GetFormatDesc: TglBitmapFormatDesc; begin with result do begin Format := GL_BGRA; InternalFormat := GL_RGBA8; DataType := GL_UNSIGNED_BYTE; end; end; class function TfdBGRA8.WithoutAlpha: TglBitmapFormat; begin result := tfBGR8; end; class procedure TfdBGRA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte); begin aData^ := aPixel.Blue; inc(aData); aData^ := aPixel.Green; inc(aData); aData^ := aPixel.Red; inc(aData); aData^ := aPixel.Alpha; inc(aData); end; class procedure TfdBGRA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); begin aPixel.Blue := aData^; inc(aData); aPixel.Green := aData^; inc(aData); aPixel.Red := aData^; inc(aData); aPixel.Alpha := aData^; inc(aData); end; {$ENDREGION} {$REGION TglBitmap} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin if (Source.PixelDesc.RedRange > 0) then Dest.Red := Source.Red; if (Source.PixelDesc.GreenRange > 0) then Dest.Green := Source.Green; if (Source.PixelDesc.BlueRange > 0) then Dest.Blue := Source.Blue; if (Source.PixelDesc.AlphaRange > 0) then Dest.Alpha := Source.Alpha; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin if (Source.PixelDesc.RedRange > 0) then Dest.Red := Round(Dest.PixelDesc.RedRange * Source.Red / Source.PixelDesc.RedRange); if (Source.PixelDesc.GreenRange > 0) then Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange); if (Source.PixelDesc.BlueRange > 0) then Dest.Blue := Round(Dest.PixelDesc.BlueRange * Source.Blue / Source.PixelDesc.BlueRange); if (Source.PixelDesc.AlphaRange > 0) then Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do with PglBitmapPixelDesc(Args)^ do begin if (Source.PixelDesc.RedRange > 0) then Dest.Red := Source.Red shr RedShift; if (Source.PixelDesc.GreenRange > 0) then Dest.Green := Source.Green shr GreenShift; if (Source.PixelDesc.BlueRange > 0) then Dest.Blue := Source.Blue shr BlueShift; if (Source.PixelDesc.AlphaRange > 0) then Dest.Alpha := Source.Alpha shr AlphaShift; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin Dest.Red := Source.Red; Dest.Green := Source.Green; Dest.Blue := Source.Blue; Dest.Alpha := Source.Alpha; if (Args and $1 > 0) then begin Dest.Red := Dest.Red xor Dest.PixelDesc.RedRange; Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange; Dest.Blue := Dest.Blue xor Dest.PixelDesc.BlueRange; end; if (Args and $2 > 0) then begin Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec); type PglBitmapPixelData = ^TglBitmapPixelData; begin with aFuncRec do begin Dest.Red := PglBitmapPixelData(Args)^.Red; Dest.Green := PglBitmapPixelData(Args)^.Green; Dest.Blue := PglBitmapPixelData(Args)^.Blue; Dest.Alpha := PglBitmapPixelData(Args)^.Alpha; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec); var Temp: Single; begin with FuncRec do begin if (FuncRec.Args = 0) then begin //source has no alpha Temp := Source.Red / Source.PixelDesc.RedRange * ALPHA_WEIGHT_R + Source.Green / Source.PixelDesc.GreenRange * ALPHA_WEIGHT_G + Source.Blue / Source.PixelDesc.BlueRange * ALPHA_WEIGHT_B; Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Temp); end else Dest.Alpha := Round(Source.Alpha / Source.PixelDesc.AlphaRange * Dest.PixelDesc.AlphaRange); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec); type PglBitmapPixelData = ^TglBitmapPixelData; begin with FuncRec do begin Dest.Red := Source.Red; Dest.Green := Source.Green; Dest.Blue := Source.Blue; with PglBitmapPixelData(Args)^ do if ((Dest.Red <= Red ) and (Dest.Red >= PixelDesc.RedRange ) and (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and (Dest.Blue <= Blue ) and (Dest.Blue >= PixelDesc.BlueRange )) then Dest.Alpha := 0 else Dest.Alpha := Dest.PixelDesc.AlphaRange; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec); type PglBitmapPixelData = ^TglBitmapPixelData; begin with FuncRec do begin Dest.Red := Source.Red; Dest.Green := Source.Green; Dest.Blue := Source.Blue; with PglBitmapPixelData(Args)^ do Dest.Alpha := Alpha; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean); type PRGBPix = ^TRGBPix; TRGBPix = array [0..2] of byte; var Temp: Byte; begin while aWidth > 0 do begin Temp := PRGBPix(aData)^[0]; PRGBPix(aData)^[0] := PRGBPix(aData)^[2]; PRGBPix(aData)^[2] := Temp; if aHasAlpha then Inc(aData, 4) else Inc(aData, 3); dec(aWidth); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - PROTECTED/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$REGION Getter} function TglBitmap.GetWidth: Integer; begin if (ffX in fDimension.Fields) then result := fDimension.X else result := -1; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetHeight: Integer; begin if (ffY in fDimension.Fields) then result := fDimension.Y else result := -1; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFileWidth: Integer; begin result := Max(1, Width); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFileHeight: Integer; begin result := Max(1, Height); end; {$ENDREGION} {$REGION Setter} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomData(const aValue: Pointer); begin if fCustomData = aValue then exit; fCustomData := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomName(const aValue: String); begin if fCustomName = aValue then exit; fCustomName := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomNameW(const aValue: WideString); begin if fCustomNameW = aValue then exit; fCustomNameW := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean); begin if fDeleteTextureOnFree = aValue then exit; fDeleteTextureOnFree := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat); begin if fFormat = aValue then exit; if (FORMAT_DESCRIPTORS[Format].GetSize <> FORMAT_DESCRIPTORS[aValue].GetSize) then raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT); SetDataPointer(Data, aValue, Width, Height); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean); begin if fFreeDataAfterGenTexture = aValue then exit; fFreeDataAfterGenTexture := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetID(const aValue: Cardinal); begin if fID = aValue then exit; fID := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap); begin if fMipMap = aValue then exit; fMipMap := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetTarget(const aValue: Cardinal); begin if fTarget = aValue then exit; fTarget := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetAnisotropic(const aValue: Integer); var MaxAnisotropic: Integer; begin fAnisotropic := aValue; if (ID > 0) then begin if GL_EXT_texture_filter_anisotropic then begin if fAnisotropic > 0 then begin Bind(false); glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic); if aValue > MaxAnisotropic then fAnisotropic := MaxAnisotropic; glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic); end; end else begin fAnisotropic := 0; end; end; end; {$ENDREGION} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.CreateID; begin if (ID <> 0) then glDeleteTextures(1, @fID); glGenTextures(1, @fID); Bind(false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean); begin // Set Up Parameters SetWrap(fWrapS, fWrapT, fWrapR); SetFilter(fFilterMin, fFilterMag); SetAnisotropic(fAnisotropic); SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]); // Mip Maps Generation Mode aBuildWithGlu := false; if (MipMap = mmMipmap) then begin if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE) else aBuildWithGlu := true; end else if (MipMap = mmMipmapGlu) then aBuildWithGlu := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var s: Single; begin if (Data <> aData) then begin if (Assigned(Data)) then FreeMem(Data); fData := aData; end; FillChar(fDimension, SizeOf(fDimension), 0); if not Assigned(fData) then begin fFormat := tfEmpty; fPixelSize := 0; fRowSize := 0; end else begin if aWidth <> -1 then begin fDimension.Fields := fDimension.Fields + [ffX]; fDimension.X := aWidth; end; if aHeight <> -1 then begin fDimension.Fields := fDimension.Fields + [ffY]; fDimension.Y := aHeight; end; s := FORMAT_DESCRIPTORS[aFormat].GetSize; fFormat := aFormat; fPixelSize := Ceil(s); fRowSize := Ceil(s * aWidth); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipHorz: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipVert: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - PUBLIC////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.AfterConstruction; begin inherited AfterConstruction; fID := 0; fTarget := 0; fIsResident := false; fFormat := glBitmapGetDefaultFormat; fMipMap := glBitmapDefaultMipmap; fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture; fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree; glBitmapGetDefaultFilter (fFilterMin, fFilterMag); glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.BeforeDestruction; begin SetDataPointer(nil, tfEmpty); if (fID > 0) and fDeleteTextureOnFree then glDeleteTextures(1, @fID); inherited BeforeDestruction; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromFile(const aFilename: String); var fs: TFileStream; begin fFilename := aFilename; fs := TFileStream.Create(fFilename, fmOpenRead); try fs.Position := 0; LoadFromStream(fs); finally fs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromStream(const aStream: TStream); begin {$IFDEF GLB_SUPPORT_PNG_READ} if not LoadPNG(aStream) then {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} if not LoadJPEG(aStream) then {$ENDIF} if not LoadDDS(aStream) then if not LoadTGA(aStream) then if not LoadBMP(aStream) then raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.'); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction; const aFormat: TglBitmapFormat; const aArgs: PtrInt); var tmpData: PByte; size: Integer; begin size := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize); GetMem(tmpData, size); try FillChar(tmpData^, size, #$FF); SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); except FreeMem(tmpData); raise; end; AddFunc(Self, aFunc, false, Format, aArgs); end; {$IFDEF GLB_DELPHI} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); var rs: TResourceStream; TempPos: Integer; ResTypeStr: String; TempResType: PChar; begin if not Assigned(ResType) then begin TempPos := Pos('.', Resource); ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos)); Resource := UpperCase(Copy(Resource, 0, TempPos -1)); TempResType := PChar(ResTypeStr); end else TempResType := ResType rs := TResourceStream.Create(Instance, Resource, TempResType); try LoadFromStream(rs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); var rs: TResourceStream; begin rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType); try LoadFromStream(rs); finally rs.Free; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType); var fs: TFileStream; begin fs := TFileStream.Create(aFileName, fmCreate); try fs.Position := 0; SaveToStream(fs, aFileType); finally fs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); begin case aFileType of {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG: SavePng(aStream); {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} ftJPEG: SaveJPEG(aStream); {$ENDIF} ftDDS: SaveDDS(aStream); ftTGA: SaveTGA(aStream); ftBMP: SaveBMP(aStream); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean; begin result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean; const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean; var DestData, TmpData, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TglBitmapFormatDescClass; FuncRec: TglBitmapFunctionRec; begin Assert(Assigned(Data)); Assert(Assigned(aSource)); Assert(Assigned(aSource.Data)); result := false; if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin SourceFD := FORMAT_DESCRIPTORS[aSource.Format]; DestFD := FORMAT_DESCRIPTORS[aFormat]; // inkompatible Formats so CreateTemp if (SourceFD.GetSize <> DestFD.GetSize) then aCreateTemp := true; // Values TempHeight := Max(1, aSource.Height); TempWidth := Max(1, aSource.Width); FuncRec.Sender := Self; FuncRec.Args := aArgs; TmpData := nil; if aCreateTemp then begin GetMem(TmpData, Ceil(FORMAT_DESCRIPTORS[aFormat].GetSize * TempHeight * TempWidth)); DestData := TmpData; end else DestData := Data; try SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); FuncRec.Size := aSource.Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; if {FormatIsUncompressed(Source.InternalFormat)} true then begin SourceData := aSource.Data; FuncRec.Position.Y := 0; while FuncRec.Position.Y < TempHeight do begin FuncRec.Position.X := 0; while FuncRec.Position.X < TempWidth do begin SourceFD.Unmap(SourceData, FuncRec.Source); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; end else begin (* TODO // Compressed Images FuncRec.Position.Y := 0; while FuncRec.Position.Y < TempHeight do begin FuncRec.Position.X := 0; while FuncRec.Position.X < TempWidth do begin // Get Data fGetPixelFunc(FuncRec.Position, FuncRec.Source); // Func Func(FuncRec); // Set Data MapFunc(FuncRec.Dest, dest); Inc(FuncRec.Position.X); end; Inc(FuncRec.Position.Y); end; *) end; // Updating Image or InternalFormat if aCreateTemp then SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) else if (aFormat <> fFormat) then Format := aFormat; result := true; except if aCreateTemp then FreeMem(TmpData); raise; end; end; end; {$IFDEF GLB_SDL} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean; var Row, RowSize: Integer; SourceData, TmpData: PByte; TempDepth: Integer; Pix: TglBitmapPixelData; FormatDesc: TglBitmapFormatDescriptor; function GetRowPointer(Row: Integer): pByte; begin result := Surface.pixels; Inc(result, Row * RowSize); end; begin result := false; (* TODO if not FormatIsUncompressed(InternalFormat) then raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT); *) FormatDesc := FORMAT_DESCRIPTORS[Format]; if Assigned(Data) then begin case Trunc(FormatDesc.GetSize) of 1: TempDepth := 8; 2: TempDepth := 16; 3: TempDepth := 24; 4: TempDepth := 32; else raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT); end; FormatDesc.PreparePixel(Pix); with Pix.PixelDesc do Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift); SourceData := Data; RowSize := Ceil(FileWidth * FormatDesc.GetSize); for Row := 0 to FileHeight -1 do begin TmpData := GetRowPointer(Row); if Assigned(TmpData) then begin Move(SourceData^, TmpData^, RowSize); inc(SourceData, RowSize); end; end; result := true; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; IntFormat, f: TglBitmapInternalFormat; FormatDesc: TglBitmapFormatDescriptor; function GetRowPointer(Row: Integer): pByte; begin result := Surface^.pixels; Inc(result, Row * RowSize); end; begin result := false; if (Assigned(Surface)) then begin with Surface^.format^ do begin IntFormat := tfEmpty; for f := Low(f) to High(f) do begin if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin IntFormat := f; break; end; end; if (IntFormat = tfEmpty) then raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.'); end; FormatDesc := FORMAT_DESCRIPTORS[IntFormat]; TempWidth := Surface^.w; TempHeight := Surface^.h; RowSize := Trunc(TempWidth * FormatDesc.GetSize); GetMem(pData, TempHeight * RowSize); try pTempData := pData; for Row := 0 to TempHeight -1 do begin pSource := GetRowPointer(Row); if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; SetDataPointer(pData, IntFormat, TempWidth, TempHeight); result := true; except FreeMem(pData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean; var Row, Col, AlphaInterleave: Integer; pSource, pDest: PByte; function GetRowPointer(Row: Integer): pByte; begin result := aSurface.pixels; Inc(result, Row * Width); end; begin result := false; if Assigned(Data) then begin if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0); AlphaInterleave := 0; case Format of ifLuminance8Alpha8: AlphaInterleave := 1; ifBGRA8, ifRGBA8: AlphaInterleave := 3; end; pSource := Data; for Row := 0 to Height -1 do begin pDest := GetRowPointer(Row); if Assigned(pDest) then begin for Col := 0 to Width -1 do begin Inc(pSource, AlphaInterleave); pDest^ := pSource^; Inc(pDest); Inc(pSource); end; end; end; result := true; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var bmp: TglBitmap2D; begin bmp := TglBitmap2D.Create; try bmp.AssignFromSurface(Surface); result := AddAlphaFromGlBitmap(bmp, Func, CustomData); finally bmp.Free; end; end; {$ENDIF} {$IFDEF GLB_DELPHI} //TODO rework & test ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean; var Row: Integer; pSource, pData: PByte; begin result := false; if Assigned(Data) then begin if Assigned(aBitmap) then begin aBitmap.Width := Width; aBitmap.Height := Height; case Format of tfAlpha8, ifLuminance, ifDepth8: begin Bitmap.PixelFormat := pf8bit; Bitmap.Palette := CreateGrayPalette; end; ifRGB5A1: Bitmap.PixelFormat := pf15bit; ifR5G6B5: Bitmap.PixelFormat := pf16bit; ifRGB8, ifBGR8: Bitmap.PixelFormat := pf24bit; ifRGBA8, ifBGRA8: Bitmap.PixelFormat := pf32bit; else raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.'); end; pSource := Data; for Row := 0 to FileHeight -1 do begin pData := Bitmap.Scanline[Row]; Move(pSource^, pData^, fRowSize); Inc(pSource, fRowSize); // swap RGB(A) to BGR(A) if InternalFormat in [ifRGB8, ifRGBA8] then SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8); end; result := true; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; IntFormat: TglBitmapInternalFormat; begin result := false; if (Assigned(Bitmap)) then begin case Bitmap.PixelFormat of pf8bit: IntFormat := ifLuminance; pf15bit: IntFormat := ifRGB5A1; pf16bit: IntFormat := ifR5G6B5; pf24bit: IntFormat := ifBGR8; pf32bit: IntFormat := ifBGRA8; else raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.'); end; TempWidth := Bitmap.Width; TempHeight := Bitmap.Height; RowSize := Trunc(TempWidth * FormatGetSize(IntFormat)); GetMem(pData, TempHeight * RowSize); try pTempData := pData; for Row := 0 to TempHeight -1 do begin pSource := Bitmap.Scanline[Row]; if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; SetDataPointer(pData, IntFormat, TempWidth, TempHeight); result := true; except FreeMem(pData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean; var Row, Col, AlphaInterleave: Integer; pSource, pDest: PByte; begin result := false; if Assigned(Data) then begin if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin if Assigned(Bitmap) then begin Bitmap.PixelFormat := pf8bit; Bitmap.Palette := CreateGrayPalette; Bitmap.Width := Width; Bitmap.Height := Height; case InternalFormat of ifLuminanceAlpha: AlphaInterleave := 1; ifRGBA8, ifBGRA8: AlphaInterleave := 3; else AlphaInterleave := 0; end; // Copy Data pSource := Data; for Row := 0 to Height -1 do begin pDest := Bitmap.Scanline[Row]; if Assigned(pDest) then begin for Col := 0 to Width -1 do begin Inc(pSource, AlphaInterleave); pDest^ := pSource^; Inc(pDest); Inc(pSource); end; end; end; result := true; end; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try tex.AssignFromBitmap(Bitmap); result := AddAlphaFromglBitmap(tex, Func, CustomData); finally tex.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var RS: TResourceStream; TempPos: Integer; ResTypeStr: String; TempResType: PChar; begin if Assigned(ResType) then TempResType := ResType else begin TempPos := Pos('.', Resource); ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos)); Resource := UpperCase(Copy(Resource, 0, TempPos -1)); TempResType := PChar(ResTypeStr); end; RS := TResourceStream.Create(Instance, Resource, TempResType); try result := AddAlphaFromStream(RS, Func, CustomData); finally RS.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var RS: TResourceStream; begin RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType); try result := AddAlphaFromStream(RS, Func, CustomData); finally RS.Free; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; begin (* TODO if not FormatIsUncompressed(InternalFormat) then raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT); *) result := AddFunc(Self, aFunc, false, FORMAT_DESCRIPTORS[Format].WithAlpha, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var FS: TFileStream; begin FS := TFileStream.Create(FileName, fmOpenRead); try result := AddAlphaFromStream(FS, aFunc, aArgs); finally FS.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create(aStream); try result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; var DestData, DestData2, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TglBitmapFormatDescClass; FuncRec: TglBitmapFunctionRec; begin result := false; Assert(Assigned(Data)); Assert(Assigned(aBitmap)); Assert(Assigned(aBitmap.Data)); if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin result := ConvertTo(FORMAT_DESCRIPTORS[Format].WithAlpha); if not Assigned(aFunc) then aFunc := glBitmapAlphaFunc; SourceFD := FORMAT_DESCRIPTORS[aBitmap.Format]; DestFD := FORMAT_DESCRIPTORS[Format]; // Values TempHeight := aBitmap.FileHeight; TempWidth := aBitmap.FileWidth; FuncRec.Sender := Self; FuncRec.Args := aArgs; FuncRec.Size := Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1; DestData := Data; DestData2 := Data; SourceData := aBitmap.Data; // Mapping SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); FuncRec.Position.Y := 0; while FuncRec.Position.Y < TempHeight do begin FuncRec.Position.X := 0; while FuncRec.Position.X < TempWidth do begin SourceFD.Unmap(SourceData, FuncRec.Source); DestFD.Unmap (DestData, FuncRec.Dest); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData2); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean; begin result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean; var PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData); result := AddAlphaFromColorKeyFloat( aRed / PixelData.PixelDesc.RedRange, aGreen / PixelData.PixelDesc.GreenRange, aBlue / PixelData.PixelDesc.BlueRange, aDeviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange))); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean; var TempR, TempG, TempB: Cardinal; PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData); with PixelData.PixelDesc do begin TempR := Trunc(RedRange * aDeviation); TempG := Trunc(GreenRange * aDeviation); TempB := Trunc(BlueRange * aDeviation); PixelData.Red := Min(RedRange, Trunc(RedRange * aRed) + TempR); RedRange := Max(0, Trunc(RedRange * aRed) - TempR); PixelData.Green := Min(GreenRange, Trunc(GreenRange * aGreen) + TempG); GreenRange := Max(0, Trunc(GreenRange * aGreen) - TempG); PixelData.Blue := Min(BlueRange, Trunc(BlueRange * aBlue) + TempB); BlueRange := Max(0, Trunc(BlueRange * aBlue) - TempB); PixelData.Alpha := 0; AlphaRange := 0; end; result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean; begin result := AddAlphaFromValueFloat(aAlpha / $FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean; var PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData); result := AddAlphaFromValueFloat(aAlpha / PixelData.PixelDesc.AlphaRange); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean; var PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData); with PixelData.PixelDesc do PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * aAlpha))); result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.RemoveAlpha: Boolean; var FormatDesc: TglBitmapFormatDescClass; begin result := false; FormatDesc := FORMAT_DESCRIPTORS[Format]; if Assigned(Data) then begin if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT); result := ConvertTo(FormatDesc.WithoutAlpha); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.Clone: TglBitmap; var Temp: TglBitmap; TempPtr: PByte; Size: Integer; begin result := nil; Temp := (ClassType.Create as TglBitmap); try // copy texture data if assigned if Assigned(Data) then begin Size := FORMAT_DESCRIPTORS[Format].GetSize(fDimension); GetMem(TempPtr, Size); try Move(Data^, TempPtr^, Size); Temp.SetDataPointer(TempPtr, Format, Width, Height); except FreeMem(TempPtr); raise; end; end else Temp.SetDataPointer(nil, Format, Width, Height); // copy properties Temp.fID := ID; Temp.fTarget := Target; Temp.fFormat := Format; Temp.fMipMap := MipMap; Temp.fAnisotropic := Anisotropic; Temp.fBorderColor := fBorderColor; Temp.fDeleteTextureOnFree := DeleteTextureOnFree; Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture; Temp.fFilterMin := fFilterMin; Temp.fFilterMag := fFilterMag; Temp.fWrapS := fWrapS; Temp.fWrapT := fWrapT; Temp.fWrapR := fWrapR; Temp.fFilename := fFilename; Temp.fCustomName := fCustomName; Temp.fCustomNameW := fCustomNameW; Temp.fCustomData := fCustomData; result := Temp; except FreeAndNil(Temp); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean; var SourceFD, DestFD: TglBitmapFormatDescClass; SourcePD, DestPD: TglBitmapPixelData; PixelDesc: TglBitmapPixelDesc; function CanCopyDirect: Boolean; begin result := ((SourcePD.PixelDesc.RedRange = DestPD.PixelDesc.RedRange) or (SourcePD.PixelDesc.RedRange = 0) or (DestPD.PixelDesc.RedRange = 0)) and ((SourcePD.PixelDesc.GreenRange = DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and ((SourcePD.PixelDesc.BlueRange = DestPD.PixelDesc.BlueRange) or (SourcePD.PixelDesc.BlueRange = 0) or (DestPD.PixelDesc.BlueRange = 0)) and ((SourcePD.PixelDesc.AlphaRange = DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0)); end; function CanShift: Boolean; begin result := ((SourcePD.PixelDesc.RedRange >= DestPD.PixelDesc.RedRange ) or (SourcePD.PixelDesc.RedRange = 0) or (DestPD.PixelDesc.RedRange = 0)) and ((SourcePD.PixelDesc.GreenRange >= DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and ((SourcePD.PixelDesc.BlueRange >= DestPD.PixelDesc.BlueRange ) or (SourcePD.PixelDesc.BlueRange = 0) or (DestPD.PixelDesc.BlueRange = 0)) and ((SourcePD.PixelDesc.AlphaRange >= DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0)); end; function GetShift(aSource, aDest: Cardinal) : ShortInt; begin result := 0; while (aSource > aDest) and (aSource > 0) do begin inc(result); aSource := aSource shr 1; end; end; begin if aFormat <> fFormat then begin SourceFD := FORMAT_DESCRIPTORS[Format]; DestFD := FORMAT_DESCRIPTORS[aFormat]; SourceFD.PreparePixel(SourcePD); DestFD.PreparePixel (DestPD); if CanCopyDirect then result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat) else if CanShift then begin PixelDesc.RedShift := GetShift(SourcePD.PixelDesc.RedRange, DestPD.PixelDesc.RedRange); PixelDesc.GreenShift := GetShift(SourcePD.PixelDesc.GreenRange, DestPD.PixelDesc.GreenRange); PixelDesc.BlueShift := GetShift(SourcePD.PixelDesc.BlueRange, DestPD.PixelDesc.BlueRange); PixelDesc.AlphaShift := GetShift(SourcePD.PixelDesc.AlphaRange, DestPD.PixelDesc.AlphaRange); result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@PixelDesc)); end else result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat); end else result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean); begin if aUseRGB or aUseAlpha then AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); begin fBorderColor[0] := aRed; fBorderColor[1] := aGreen; fBorderColor[2] := aBlue; fBorderColor[3] := aAlpha; if (ID > 0) then begin Bind(false); glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FreeData; begin SetDataPointer(nil, tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte); begin FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal); var PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData); FillWithColorFloat( aRed / PixelData.PixelDesc.RedRange, aGreen / PixelData.PixelDesc.GreenRange, aBlue / PixelData.PixelDesc.BlueRange, aAlpha / PixelData.PixelDesc.AlphaRange); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single); var PixelData: TglBitmapPixelData; begin FORMAT_DESCRIPTORS[Format].PreparePixel(PixelData); PixelData.Red := Max(0, Min(PixelData.PixelDesc.RedRange, Trunc(PixelData.PixelDesc.RedRange * aRed))); PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * aGreen))); PixelData.Blue := Max(0, Min(PixelData.PixelDesc.BlueRange, Trunc(PixelData.PixelDesc.BlueRange * aBlue))); PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * aAlpha))); AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal); begin //check MIN filter case aMin of GL_NEAREST: fFilterMin := GL_NEAREST; GL_LINEAR: fFilterMin := GL_LINEAR; GL_NEAREST_MIPMAP_NEAREST: fFilterMin := GL_NEAREST_MIPMAP_NEAREST; GL_LINEAR_MIPMAP_NEAREST: fFilterMin := GL_LINEAR_MIPMAP_NEAREST; GL_NEAREST_MIPMAP_LINEAR: fFilterMin := GL_NEAREST_MIPMAP_LINEAR; GL_LINEAR_MIPMAP_LINEAR: fFilterMin := GL_LINEAR_MIPMAP_LINEAR; else raise EglBitmapException.Create('SetFilter - Unknow MIN filter.'); end; //check MAG filter case aMag of GL_NEAREST: fFilterMag := GL_NEAREST; GL_LINEAR: fFilterMag := GL_LINEAR; else raise EglBitmapException.Create('SetFilter - Unknow MAG filter.'); end; //apply filter if (ID > 0) then begin Bind(false); glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag); if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin case fFilterMin of GL_NEAREST, GL_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST); GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR); end; end else glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal); procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal); begin case aValue of GL_CLAMP: aTarget := GL_CLAMP; GL_REPEAT: aTarget := GL_REPEAT; GL_CLAMP_TO_EDGE: begin if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then aTarget := GL_CLAMP_TO_EDGE else aTarget := GL_CLAMP; end; GL_CLAMP_TO_BORDER: begin if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then aTarget := GL_CLAMP_TO_BORDER else aTarget := GL_CLAMP; end; GL_MIRRORED_REPEAT: begin if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then aTarget := GL_MIRRORED_REPEAT else raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).'); end; else raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).'); end; end; begin CheckAndSetWrap(S, fWrapS); CheckAndSetWrap(T, fWrapT); CheckAndSetWrap(R, fWrapR); if (ID > 0) then begin Bind(false); glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS); glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT); glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); begin { TODO delete? if Assigned (fGetPixelFunc) then fGetPixelFunc(aPos, aPixel); } end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); begin {TODO delete? if Assigned (fSetPixelFunc) then fSetPixelFuc(aPos, aPixel); } end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean); begin if aEnableTextureUnit then glEnable(Target); if (ID > 0) then glBindTexture(Target, ID); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean); begin if aDisableTextureUnit then glDisable(Target); glBindTexture(Target, 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create; begin {$IFNDEF GLB_NO_NATIVE_GL} ReadOpenGLExtensions; {$ENDIF} if (ClassType = TglBitmap) then raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.'); inherited Create; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aFileName: String); begin Create; LoadFromFile(FileName); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aStream: TStream); begin Create; LoadFromStream(aStream); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); var Image: PByte; ImageSize: Integer; begin Create; ImageSize := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize); GetMem(Image, ImageSize); try FillChar(Image^, ImageSize, #$FF); SetDataPointer(Image, aFormat, aSize.X, aSize.Y); except FreeMem(Image); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt); begin Create; LoadFromFunc(aSize, aFunc, aFormat, aArgs); end; {$IFDEF GLB_DELPHI} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar); begin Create; LoadFromResource(aInstance, aResource, aResType); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); begin Create; LoadFromResourceID(aInstance, aResourceID, aResType); end; {$ENDIF} {$IFDEF GLB_SUPPORT_PNG_READ} {$IF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //PNG///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var Surface: PSDL_Surface; RWops: PSDL_RWops; begin result := false; RWops := glBitmapCreateRWops(aStream); try if IMG_isPNG(RWops) > 0 then begin Surface := IMG_LoadPNG_RW(RWops); try AssignFromSurface(Surface); Rresult := true; finally SDL_FreeSurface(Surface); end; end; finally SDL_FreeRW(RWops); end; end; {$ELSEIF DEFINED(GLB_LIB_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl; begin TStream(png_get_io_ptr(png)).Read(buffer^, size); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var StreamPos: Int64; signature: array [0..7] of byte; png: png_structp; png_info: png_infop; TempHeight, TempWidth: Integer; Format: TglBitmapInternalFormat; png_data: pByte; png_rows: array of pByte; Row, LineSize: Integer; begin result := false; if not init_libPNG then raise Exception.Create('LoadPNG - unable to initialize libPNG.'); try // signature StreamPos := Stream.Position; Stream.Read(signature, 8); Stream.Position := StreamPos; if png_check_sig(@signature, 8) <> 0 then begin // png read struct png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil); if png = nil then raise EglBitmapException.Create('LoadPng - couldn''t create read struct.'); // png info png_info := png_create_info_struct(png); if png_info = nil then begin png_destroy_read_struct(@png, nil, nil); raise EglBitmapException.Create('LoadPng - couldn''t create info struct.'); end; // set read callback png_set_read_fn(png, stream, glBitmap_libPNG_read_func); // read informations png_read_info(png, png_info); // size TempHeight := png_get_image_height(png, png_info); TempWidth := png_get_image_width(png, png_info); // format case png_get_color_type(png, png_info) of PNG_COLOR_TYPE_GRAY: Format := tfLuminance8; PNG_COLOR_TYPE_GRAY_ALPHA: Format := tfLuminance8Alpha8; PNG_COLOR_TYPE_RGB: Format := tfRGB8; PNG_COLOR_TYPE_RGB_ALPHA: Format := tfRGBA8; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; // cut upper 8 bit from 16 bit formats if png_get_bit_depth(png, png_info) > 8 then png_set_strip_16(png); // expand bitdepth smaller than 8 if png_get_bit_depth(png, png_info) < 8 then png_set_expand(png); // allocating mem for scanlines LineSize := png_get_rowbytes(png, png_info); GetMem(png_data, TempHeight * LineSize); try SetLength(png_rows, TempHeight); for Row := Low(png_rows) to High(png_rows) do begin png_rows[Row] := png_data; Inc(png_rows[Row], Row * LineSize); end; // read complete image into scanlines png_read_image(png, @png_rows[0]); // read end png_read_end(png, png_info); // destroy read struct png_destroy_read_struct(@png, @png_info, nil); SetLength(png_rows, 0); // set new data SetDataPointer(png_data, Format, TempWidth, TempHeight); result := true; except FreeMem(png_data); raise; end; end; finally quit_libPNG; end; end; {$ELSEIF DEFINED(GLB_PNGIMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var StreamPos: Int64; Png: TPNGObject; Header: Array[0..7] of Byte; Row, Col, PixSize, LineSize: Integer; NewImage, pSource, pDest, pAlpha: pByte; Format: TglBitmapInternalFormat; const PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10); begin result := false; StreamPos := Stream.Position; Stream.Read(Header[0], SizeOf(Header)); Stream.Position := StreamPos; {Test if the header matches} if Header = PngHeader then begin Png := TPNGObject.Create; try Png.LoadFromStream(Stream); case Png.Header.ColorType of COLOR_GRAYSCALE: Format := ifLuminance; COLOR_GRAYSCALEALPHA: Format := ifLuminanceAlpha; COLOR_RGB: Format := ifBGR8; COLOR_RGBALPHA: Format := ifBGRA8; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; PixSize := Trunc(FormatGetSize(Format)); LineSize := Integer(Png.Header.Width) * PixSize; GetMem(NewImage, LineSize * Integer(Png.Header.Height)); try pDest := NewImage; case Png.Header.ColorType of COLOR_RGB, COLOR_GRAYSCALE: begin for Row := 0 to Png.Height -1 do begin Move (Png.Scanline[Row]^, pDest^, LineSize); Inc(pDest, LineSize); end; end; COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: begin PixSize := PixSize -1; for Row := 0 to Png.Height -1 do begin pSource := Png.Scanline[Row]; pAlpha := pByte(Png.AlphaScanline[Row]); for Col := 0 to Png.Width -1 do begin Move (pSource^, pDest^, PixSize); Inc(pSource, PixSize); Inc(pDest, PixSize); pDest^ := pAlpha^; inc(pAlpha); Inc(pDest); end; end; end; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height); result := true; except FreeMem(NewImage); raise; end; finally Png.Free; end; end; end; {$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_PNG_WRITE} {$IFDEF GLB_LIB_PNG} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl; begin TStream(png_get_io_ptr(png)).Write(buffer^, size); end; {$ENDIF} {$IF DEFINED(GLB_LIB_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var png: png_structp; png_info: png_infop; png_rows: array of pByte; LineSize: Integer; ColorType: Integer; Row: Integer; begin if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT); if not init_libPNG then raise Exception.Create('SavePNG - unable to initialize libPNG.'); try case FInternalFormat of ifAlpha, ifLuminance, ifDepth8: ColorType := PNG_COLOR_TYPE_GRAY; ifLuminanceAlpha: ColorType := PNG_COLOR_TYPE_GRAY_ALPHA; ifBGR8, ifRGB8: ColorType := PNG_COLOR_TYPE_RGB; ifBGRA8, ifRGBA8: ColorType := PNG_COLOR_TYPE_RGBA; else raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT); end; LineSize := Trunc(FormatGetSize(FInternalFormat) * Width); // creating array for scanline SetLength(png_rows, Height); try for Row := 0 to Height - 1 do begin png_rows[Row] := Data; Inc(png_rows[Row], Row * LineSize) end; // write struct png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil); if png = nil then raise EglBitmapException.Create('SavePng - couldn''t create write struct.'); // create png info png_info := png_create_info_struct(png); if png_info = nil then begin png_destroy_write_struct(@png, nil); raise EglBitmapException.Create('SavePng - couldn''t create info struct.'); end; // set read callback png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil); // set compression png_set_compression_level(png, 6); if InternalFormat in [ifBGR8, ifBGRA8] then png_set_bgr(png); png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT); png_write_info(png, png_info); png_write_image(png, @png_rows[0]); png_write_end(png, png_info); png_destroy_write_struct(@png, @png_info); finally SetLength(png_rows, 0); end; finally quit_libPNG; end; end; {$ELSEIF DEFINED(GLB_PNGIMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var Png: TPNGObject; pSource, pDest: pByte; X, Y, PixSize: Integer; ColorType: Cardinal; Alpha: Boolean; pTemp: pByte; Temp: Byte; begin if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT); case FInternalFormat of ifAlpha, ifLuminance, ifDepth8: begin ColorType := COLOR_GRAYSCALE; PixSize := 1; Alpha := false; end; ifLuminanceAlpha: begin ColorType := COLOR_GRAYSCALEALPHA; PixSize := 1; Alpha := true; end; ifBGR8, ifRGB8: begin ColorType := COLOR_RGB; PixSize := 3; Alpha := false; end; ifBGRA8, ifRGBA8: begin ColorType := COLOR_RGBALPHA; PixSize := 3; Alpha := true end; else raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT); end; Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height); try // Copy ImageData pSource := Data; for Y := 0 to Height -1 do begin pDest := png.ScanLine[Y]; for X := 0 to Width -1 do begin Move(pSource^, pDest^, PixSize); Inc(pDest, PixSize); Inc(pSource, PixSize); if Alpha then begin png.AlphaScanline[Y]^[X] := pSource^; Inc(pSource); end; end; // convert RGB line to BGR if InternalFormat in [ifRGB8, ifRGBA8] then begin pTemp := png.ScanLine[Y]; for X := 0 to Width -1 do begin Temp := pByteArray(pTemp)^[0]; pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2]; pByteArray(pTemp)^[2] := Temp; Inc(pTemp, 3); end; end; end; // Save to Stream Png.CompressionLevel := 6; Png.SaveToStream(Stream); finally FreeAndNil(Png); end; end; {$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //JPEG//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IFDEF GLB_LIB_JPEG} type glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr; glBitmap_libJPEG_source_mgr = record pub: jpeg_source_mgr; SrcStream: TStream; SrcBuffer: array [1..4096] of byte; end; glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr; glBitmap_libJPEG_dest_mgr = record pub: jpeg_destination_mgr; DestStream: TStream; DestBuffer: array [1..4096] of byte; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl; var Msg: String; begin SetLength(Msg, 256); cinfo^.err^.format_message(cinfo, pChar(Msg)); Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg); cinfo^.global_state := 0; jpeg_abort(cinfo); end; } ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl; var Msg: String; begin SetLength(Msg, 256); cinfo^.err^.format_message(cinfo, pChar(Msg)); Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg); cinfo^.global_state := 0; end; } ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl; begin end; } ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl; var src: glBitmap_libJPEG_source_mgr_ptr; bytes: integer; begin src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src); bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096); if (bytes <= 0) then begin src^.SrcBuffer[1] := $FF; src^.SrcBuffer[2] := JPEG_EOI; bytes := 2; end; src^.pub.next_input_byte := @(src^.SrcBuffer[1]); src^.pub.bytes_in_buffer := bytes; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl; var src: glBitmap_libJPEG_source_mgr_ptr; begin src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src); if num_bytes > 0 then begin // wanted byte isn't in buffer so set stream position and read buffer if num_bytes > src^.pub.bytes_in_buffer then begin src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer; src^.pub.fill_input_buffer(cinfo); end else begin // wanted byte is in buffer so only skip inc(src^.pub.next_input_byte, num_bytes); dec(src^.pub.bytes_in_buffer, num_bytes); end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl; begin end; } ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl; begin end; } ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl; var dest: glBitmap_libJPEG_dest_mgr_ptr; begin dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest); if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin // write complete buffer dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer)); // reset buffer dest^.pub.next_output_byte := @dest^.DestBuffer[1]; dest^.pub.free_in_buffer := Length(dest^.DestBuffer); end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl; var Idx: Integer; dest: glBitmap_libJPEG_dest_mgr_ptr; begin dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest); for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin // check for endblock if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin // write endblock dest^.DestStream.Write(dest^.DestBuffer[Idx], 2); // leave break; end else dest^.DestStream.Write(dest^.DestBuffer[Idx], 1); end; end; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} {$IF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var Surface: PSDL_Surface; RWops: PSDL_RWops; begin result := false; RWops := glBitmapCreateRWops(Stream); try if IMG_isJPG(RWops) > 0 then begin Surface := IMG_LoadJPG_RW(RWops); try AssignFromSurface(Surface); result := true; finally SDL_FreeSurface(Surface); end; end; finally SDL_FreeRW(RWops); end; end; {$ELSEIF DEFINED(GLB_LIB_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var StreamPos: Int64; Temp: array[0..1]of Byte; jpeg: jpeg_decompress_struct; jpeg_err: jpeg_error_mgr; IntFormat: TglBitmapInternalFormat; pImage: pByte; TempHeight, TempWidth: Integer; pTemp: pByte; Row: Integer; begin result := false; if not init_libJPEG then raise Exception.Create('LoadJPG - unable to initialize libJPEG.'); try // reading first two bytes to test file and set cursor back to begin StreamPos := Stream.Position; Stream.Read(Temp[0], 2); Stream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00); FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00); // error managment jpeg.err := jpeg_std_error(@jpeg_err); jpeg_err.error_exit := glBitmap_libJPEG_error_exit; jpeg_err.output_message := glBitmap_libJPEG_output_message; // decompression struct jpeg_create_decompress(@jpeg); // allocation space for streaming methods jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr)); // seeting up custom functions with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin pub.init_source := glBitmap_libJPEG_init_source; pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer; pub.skip_input_data := glBitmap_libJPEG_skip_input_data; pub.resync_to_restart := jpeg_resync_to_restart; // use default method pub.term_source := glBitmap_libJPEG_term_source; pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read pub.next_input_byte := nil; // until buffer loaded SrcStream := Stream; end; // set global decoding state jpeg.global_state := DSTATE_START; // read header of jpeg jpeg_read_header(@jpeg, false); // setting output parameter case jpeg.jpeg_color_space of JCS_GRAYSCALE: begin jpeg.out_color_space := JCS_GRAYSCALE; IntFormat := ifLuminance; end; else jpeg.out_color_space := JCS_RGB; IntFormat := ifRGB8; end; // reading image jpeg_start_decompress(@jpeg); TempHeight := jpeg.output_height; TempWidth := jpeg.output_width; // creating new image GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat)); try pTemp := pImage; for Row := 0 to TempHeight -1 do begin jpeg_read_scanlines(@jpeg, @pTemp, 1); Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth)); end; // finish decompression jpeg_finish_decompress(@jpeg); // destroy decompression jpeg_destroy_decompress(@jpeg); SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); result := true; except FreeMem(pImage); raise; end; end; finally quit_libJPEG; end; end; {$ELSEIF DEFINED(GLB_DELPHI_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var bmp: TBitmap; jpg: TJPEGImage; StreamPos: Int64; Temp: array[0..1]of Byte; begin result := false; // reading first two bytes to test file and set cursor back to begin StreamPos := Stream.Position; Stream.Read(Temp[0], 2); Stream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin bmp := TBitmap.Create; try jpg := TJPEGImage.Create; try jpg.LoadFromStream(Stream); bmp.Assign(jpg); result := AssignFromBitmap(bmp); finally jpg.Free; end; finally bmp.Free; end; end; end; {$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} {$IF DEFEFINED(GLB_LIB_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(Stream: TStream); var jpeg: jpeg_compress_struct; jpeg_err: jpeg_error_mgr; Row: Integer; pTemp, pTemp2: pByte; procedure CopyRow(pDest, pSource: pByte); var X: Integer; begin for X := 0 to Width - 1 do begin pByteArray(pDest)^[0] := pByteArray(pSource)^[2]; pByteArray(pDest)^[1] := pByteArray(pSource)^[1]; pByteArray(pDest)^[2] := pByteArray(pSource)^[0]; Inc(pDest, 3); Inc(pSource, 3); end; end; begin if not (ftJPEG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT); if not init_libJPEG then raise Exception.Create('SaveJPG - unable to initialize libJPEG.'); try FillChar(jpeg, SizeOf(jpeg_compress_struct), $00); FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00); // error managment jpeg.err := jpeg_std_error(@jpeg_err); jpeg_err.error_exit := glBitmap_libJPEG_error_exit; jpeg_err.output_message := glBitmap_libJPEG_output_message; // compression struct jpeg_create_compress(@jpeg); // allocation space for streaming methods jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr)); // seeting up custom functions with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin pub.init_destination := glBitmap_libJPEG_init_destination; pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer; pub.term_destination := glBitmap_libJPEG_term_destination; pub.next_output_byte := @DestBuffer[1]; pub.free_in_buffer := Length(DestBuffer); DestStream := Stream; end; // very important state jpeg.global_state := CSTATE_START; jpeg.image_width := Width; jpeg.image_height := Height; case InternalFormat of ifAlpha, ifLuminance, ifDepth8: begin jpeg.input_components := 1; jpeg.in_color_space := JCS_GRAYSCALE; end; ifRGB8, ifBGR8: begin jpeg.input_components := 3; jpeg.in_color_space := JCS_RGB; end; end; jpeg_set_defaults(@jpeg); jpeg_set_quality(@jpeg, 95, true); jpeg_start_compress(@jpeg, true); pTemp := Data; if InternalFormat = ifBGR8 then GetMem(pTemp2, fRowSize) else pTemp2 := pTemp; try for Row := 0 to jpeg.image_height -1 do begin // prepare row if InternalFormat = ifBGR8 then CopyRow(pTemp2, pTemp) else pTemp2 := pTemp; // write row jpeg_write_scanlines(@jpeg, @pTemp2, 1); inc(pTemp, fRowSize); end; finally // free memory if InternalFormat = ifBGR8 then FreeMem(pTemp2); end; jpeg_finish_compress(@jpeg); jpeg_destroy_compress(@jpeg); finally quit_libJPEG; end; end; {$ELSEIF DEFINED(GLB_DELPHI_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(Stream: TStream); var Bmp: TBitmap; Jpg: TJPEGImage; begin if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT); Bmp := TBitmap.Create; try Jpg := TJPEGImage.Create; try AssignToBitmap(Bmp); if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin Jpg.Grayscale := true; Jpg.PixelFormat := jf8Bit; end; Jpg.Assign(Bmp); Jpg.SaveToStream(Stream); finally FreeAndNil(Jpg); end; finally FreeAndNil(Bmp); end; end; {$ENDIF} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //BMP///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// const BMP_MAGIC = $4D42; BMP_COMP_RGB = 0; BMP_COMP_RLE8 = 1; BMP_COMP_RLE4 = 2; BMP_COMP_BITFIELDS = 3; type TBMPHeader = packed record bfType: Word; bfSize: Cardinal; bfReserved1: Word; bfReserved2: Word; bfOffBits: Cardinal; end; TBMPInfo = packed record biSize: Cardinal; biWidth: Longint; biHeight: Longint; biPlanes: Word; biBitCount: Word; biCompression: Cardinal; biSizeImage: Cardinal; biXPelsPerMeter: Longint; biYPelsPerMeter: Longint; biClrUsed: Cardinal; biClrImportant: Cardinal; end; TBMPInfoOS = packed record biSize: Cardinal; biWidth: Longint; biHeight: Longint; biPlanes: Word; biBitCount: Word; end; // TBMPPalette = record // case Boolean of // true : (Colors: array[Byte] of TRGBQUAD); // false: (redMask, greenMask, blueMask: Cardinal); // end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadBMP(const aStream: TStream): Boolean; type TMaskValues = packed record Red: Cardinal; Green: Cardinal; Blue: Cardinal; Alpha: Cardinal; end; var StartPos: Int64; ////////////////////////////////////////////////////////////////////////////////////////////////// function ReadInfo(var aInfo: TBMPInfo; var aMask: TMaskValues): TglBitmapFormat; begin result := tfEmpty; aStream.Read(aInfo, SizeOf(aInfo)); FillChar(aMask, SizeOf(aMask), 0); //Read Compression if aInfo.biCompression <> BMP_COMP_RGB then begin if aInfo.biCompression = BMP_COMP_BITFIELDS then begin // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!) if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin aStream.Read(aMask.Red, SizeOf(Cardinal)); aStream.Read(aMask.Green, SizeOf(Cardinal)); aStream.Read(aMask.Blue, SizeOf(Cardinal)); aStream.Read(aMask.Alpha, SizeOf(Cardinal)); end else raise EglBitmapException.Create('Bitmask is not supported for 24bit formats'); end else begin aStream.Position := StartPos; raise EglBitmapException.Create('RLE compression is not supported'); end; end; //get suitable format case aInfo.biBitCount of 8: result := tfLuminance8; 16: result := tfRGB5A1; 24: result := tfBGR8; 32: result := tfBGRA8; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////// function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TMaskValues): TBitfieldFormat; var TmpFormat: TglBitmapFormat; FormatDesc: TglBitmapFormatDescClass; begin result := nil; if (aMask.Red <> 0) or (aMask.Green <> 0) or (aMask.Blue <> 0) or (aMask.Alpha <> 0) then begin for TmpFormat := High(FORMAT_DESCRIPTORS) downto Low(FORMAT_DESCRIPTORS) do begin FormatDesc := FORMAT_DESCRIPTORS[TmpFormat]; if FormatDesc.MaskMatch(aMask.Red, aMask.Green, aMask.Blue, aMask.Alpha) then begin aFormat := FormatDesc.GetFormat; exit; end; end; if (aMask.Alpha = 0) then aFormat := FORMAT_DESCRIPTORS[aFormat].WithoutAlpha; result := TBitfieldFormat.Create; result.RedMask := aMask.Red; result.GreenMask := aMask.Green; result.BlueMask := aMask.Blue; result.AlphaMask := aMask.Alpha; end; end; var //simple types ImageSize, rbLineSize, wbLineSize, Padding, i: Integer; PaddingBuff: Cardinal; LineBuf, ImageData, TmpData: PByte; BmpFormat: TglBitmapFormat; //records Mask: TMaskValues; Header: TBMPHeader; Info: TBMPInfo; //classes BitfieldFormat: TBitfieldFormat; FormatDesc: TglBitmapFormatDescClass; Tick: QWord; { ImageData, pData, pTmp, LineBuf, TmpData: PByte; BitOffset: Byte; BmpFormat: TglBitmapFormat; LineSize, Padding, LineIdx, PixelIdx: Integer; RedMask, GreenMask, BlueMask, AlphaMask, FormatSize: Cardinal; Pixel: TglBitmapPixelData; PaddingBuff: Cardinal; } ////////////////////////////////////////////////////////////////////////////////////////////////// procedure ReadBitfieldLine(aData: PByte; aLineBuf: PByte); var i: Integer; Pixel: TglBitmapPixelData; //////////////////////////////////////////////////////////////////////////////////////////////// procedure ChangeRange(var aValue: Cardinal; const aOldRange, aNewRange: Cardinal); begin if (aOldRange = aNewRange) then exit; if (aOldRange > 0) then aValue := Round(aValue / aOldRange * aNewRange) else aValue := 0; end; begin aStream.Read(aLineBuf^, rbLineSize); for i := 0 to Info.biWidth-1 do begin BitfieldFormat.Unmap(PCardinal(aLineBuf)^, Pixel); //if is 16bit Bitfield only 2 last significant Bytes are taken from Cardinal inc(aLineBuf, Info.biBitCount shr 3); with FormatDesc.GetPixelDesc do begin ChangeRange(Pixel.Red, BitfieldFormat.RedRange, RedRange); ChangeRange(Pixel.Green, BitfieldFormat.GreenRange, GreenRange); ChangeRange(Pixel.Blue, BitfieldFormat.BlueRange, BlueRange); ChangeRange(Pixel.Alpha, BitfieldFormat.AlphaRange, AlphaRange); end; FormatDesc.Map(Pixel, aData); end; end; begin result := false; BmpFormat := tfEmpty; BitfieldFormat := nil; LineBuf := nil; // Header StartPos := aStream.Position; aStream.Read(Header, SizeOf(Header)); if Header.bfType = BMP_MAGIC then begin BmpFormat := ReadInfo(Info, Mask); BitfieldFormat := CheckBitfields(BmpFormat, Mask); try if (Info.biBitCount < 16) then aStream.Position := aStream.Position + Info.biClrUsed * 4; aStream.Position := StartPos + Header.bfOffBits; if (BmpFormat <> tfEmpty) then begin FormatDesc := FORMAT_DESCRIPTORS[BmpFormat]; rbLineSize := Info.biWidth * (Info.biBitCount shr 3); //ReadBuffer LineSize wbLineSize := Trunc(Info.biWidth * FormatDesc.GetSize); Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize; //get Memory ImageSize := FormatDesc.GetSize(glBitmapPosition(Info.biWidth, Info.biHeight)); GetMem(ImageData, ImageSize); if Assigned(BitfieldFormat) then GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields //read Data try try FillChar(ImageData^, ImageSize, $FF); TmpData := ImageData; Inc(TmpData, wbLineSize * (Info.biHeight -1)); for i := 0 to Info.biHeight-1 do begin if Assigned(BitfieldFormat) then ReadBitfieldLine(TmpData, LineBuf) //if is bitfield format read and convert data else aStream.Read(TmpData^, wbLineSize); //else only read data Dec(TmpData, wbLineSize); aStream.Read(PaddingBuff, Padding); end; SetDataPointer(ImageData, BmpFormat, Info.biWidth, Info.biHeight); result := true; finally if Assigned(LineBuf) then FreeMem(LineBuf); end; except FreeMem(ImageData); raise; end; end else raise EglBitmapException.Create('LoadBMP - No suitable format found'); finally FreeAndNil(BitfieldFormat); end; end else aStream.Position := StartPos; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveBMP(const aStream: TStream); var Header: TBMPHeader; Info: TBMPInfo; pData, pTemp: pByte; PixelFormat: TglBitmapPixelData; ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer; Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; PaddingBuff: Cardinal; function GetLineWidth : Integer; begin result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3; end; begin if not (ftBMP in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT); ImageSize := FORMAT_DESCRIPTORS[Format].GetSize(Dimension); Header.bfType := BMP_MAGIC; Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize; Header.bfReserved1 := 0; Header.bfReserved2 := 0; Header.bfOffBits := SizeOf(Header) + SizeOf(Info); FillChar(Info, SizeOf(Info), 0); Info.biSize := SizeOf(Info); Info.biWidth := Width; Info.biHeight := Height; Info.biPlanes := 1; Info.biCompression := BMP_COMP_RGB; Info.biSizeImage := ImageSize; case Format of //TODO tfAlpha8, ifLuminance8, ifDepth8: tfLuminance8: begin Info.biBitCount := 8; Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); Info.biClrUsed := 256; Info.biClrImportant := 256; end; //TODO ifLuminance8Alpha8, tfRGBA4, ifR5G6B5, tfRGB5A1: tfLuminance8Alpha8, tfRGB5A1: begin Info.biBitCount := 16; Info.biCompression := BMP_COMP_BITFIELDS; end; tfBGR8, tfRGB8: Info.biBitCount := 24; //TODO tfBGRA8, tfRGBA8, tfRGB10A2: tfBGRA8, tfRGBA8: begin Info.biBitCount := 32; Info.biCompression := BMP_COMP_BITFIELDS; end; else raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT); end; Info.biXPelsPerMeter := 2835; Info.biYPelsPerMeter := 2835; // prepare bitmasks if Info.biCompression = BMP_COMP_BITFIELDS then begin Info.biSize := Info.biSize + 4 * SizeOf(Cardinal); Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal); FORMAT_DESCRIPTORS[Format].PreparePixel(PixelFormat); with PixelFormat.PixelDesc do begin RedMask := RedRange shl RedShift; GreenMask := GreenRange shl GreenShift; BlueMask := BlueRange shl BlueShift; AlphaMask := AlphaRange shl AlphaShift; end; end; // headers aStream.Write(Header, SizeOf(Header)); aStream.Write(Info, SizeOf(Info)); // colortable if Info.biBitCount = 8 then begin Temp := 0; for ColorIdx := Low(Byte) to High(Byte) do begin aStream.Write(Temp, 4); Temp := Temp + $00010101; end; end; // bitmasks if Info.biCompression = BMP_COMP_BITFIELDS then begin aStream.Write(RedMask, SizeOf(Cardinal)); aStream.Write(GreenMask, SizeOf(Cardinal)); aStream.Write(BlueMask, SizeOf(Cardinal)); aStream.Write(AlphaMask, SizeOf(Cardinal)); end; // image data LineSize := Trunc(Width * FORMAT_DESCRIPTORS[Format].GetSize); Padding := GetLineWidth - LineSize; PaddingBuff := 0; pData := Data; Inc(pData, (Height -1) * LineSize); // prepare row buffer. But only for RGB because RGBA supports color masks // so it's possible to change color within the image. if (Format = tfRGB8) then GetMem(pTemp, fRowSize) else pTemp := nil; try // write image data for LineIdx := 0 to Height - 1 do begin // preparing row if Format = tfRGB8 then begin Move(pData^, pTemp^, fRowSize); SwapRGB(pTemp, Width, false); end else pTemp := pData; aStream.Write(pTemp^, LineSize); Dec(pData, LineSize); if Padding > 0 then aStream.Write(PaddingBuff, Padding); end; finally // destroy row buffer if Format = tfRGB8 then FreeMem(pTemp); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TGA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TTGAHeader = packed record ImageID: Byte; ColorMapType: Byte; ImageType: Byte; ColorMapSpec: Array[0..4] of Byte; OrigX: Word; OrigY: Word; Width: Word; Height: Word; Bpp: Byte; ImageDes: Byte; end; const TGA_UNCOMPRESSED_RGB = 2; TGA_UNCOMPRESSED_GRAY = 3; TGA_COMPRESSED_RGB = 10; TGA_COMPRESSED_GRAY = 11; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadTGA(const aStream: TStream): Boolean; var Header: TTGAHeader; NewImage, pData: PByte; StreamPos: Int64; PixelSize, LineSize, YStart, YEnd, YInc: Integer; Format: TglBitmapFormat; const CACHE_SIZE = $4000; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadUncompressed; var RowSize: Integer; begin RowSize := Header.Width * PixelSize; // copy line by line while YStart <> YEnd + YInc do begin pData := NewImage; Inc(pData, YStart * LineSize); aStream.Read(pData^, RowSize); Inc(YStart, YInc); end; end; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadCompressed; var HeaderWidth, HeaderHeight: Integer; LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer; Cache: PByte; CacheSize, CachePos: Integer; Temp: Byte; TempBuf: Array [0..15] of Byte; PixelRepeat: Boolean; PixelToRead, TempPixels: Integer; ///////////////////////////////////////////////////////////////// procedure CheckLine; begin if LinePixelsRead >= HeaderWidth then begin LinePixelsRead := 0; pData := NewImage; Inc(YStart, YInc); Inc(pData, YStart * LineSize); end; end; ///////////////////////////////////////////////////////////////// procedure CachedRead(out Buffer; Count: Integer); var BytesRead: Integer; begin if (CachePos + Count) > CacheSize then begin BytesRead := 0; // Read Data if CacheSize - CachePos > 0 then begin BytesRead := CacheSize - CachePos; Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead); Inc(CachePos, BytesRead); end; // Reload Data CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position); aStream.Read(Cache^, CacheSize); CachePos := 0; // Read else if Count - BytesRead > 0 then begin Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead); Inc(CachePos, Count - BytesRead); end; end else begin Move(pByteArray(Cache)^[CachePos], Buffer, Count); Inc(CachePos, Count); end; end; begin CacheSize := 0; CachePos := 0; HeaderWidth := Header.Width; HeaderHeight := Header.Height; GetMem(Cache, CACHE_SIZE); // 16K Buffer try ImgPixelsToRead := HeaderWidth * HeaderHeight; ImgPixelsRead := 0; LinePixelsRead := 0; pData := NewImage; Inc(pData, YStart * LineSize); // Read until all Pixels repeat CachedRead(Temp, 1); PixelRepeat := Temp and $80 > 0; PixelToRead := (Temp and $7F) + 1; Inc(ImgPixelsRead, PixelToRead); if PixelRepeat then begin // repeat one pixel x times CachedRead(TempBuf[0], PixelSize); // repeat Pixel while PixelToRead > 0 do begin CheckLine; TempPixels := HeaderWidth - LinePixelsRead; if PixelToRead < TempPixels then TempPixels := PixelToRead; Inc(LinePixelsRead, TempPixels); Dec(PixelToRead, TempPixels); while TempPixels > 0 do begin case PixelSize of 1: begin pData^ := TempBuf[0]; Inc(pData); end; 2: begin pWord(pData)^ := pWord(@TempBuf[0])^; Inc(pData, 2); end; 3: begin pWord(pData)^ := pWord(@TempBuf[0])^; Inc(pData, 2); pData^ := TempBuf[2]; Inc(pData); end; 4: begin pDWord(pData)^ := pDWord(@TempBuf[0])^; Inc(pData, 4); end; end; Dec(TempPixels); end; end; end else begin // copy x pixels while PixelToRead > 0 do begin CheckLine; TempPixels := HeaderWidth - LinePixelsRead; if PixelToRead < TempPixels then TempPixels := PixelToRead; CachedRead(pData^, PixelSize * TempPixels); Inc(pData, PixelSize * TempPixels); Inc(LinePixelsRead, TempPixels); Dec(PixelToRead, TempPixels); end; end; until ImgPixelsRead >= ImgPixelsToRead; finally FreeMem(Cache) end; end; begin result := false; // reading header to test file and set cursor back to begin StreamPos := aStream.Position; aStream.Read(Header, SizeOf(Header)); // no colormapped files if (Header.ColorMapType = 0) then begin if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin case Header.Bpp of //TODO 8: Format := tfAlpha8; 16: Format := tfLuminance8Alpha8; 24: Format := tfBGR8; 32: Format := tfBGRA8; else raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.'); end; // skip image ID if Header.ImageID <> 0 then aStream.Position := aStream.Position + Header.ImageID; PixelSize := Trunc(FORMAT_DESCRIPTORS[Format].GetSize); LineSize := Trunc(Header.Width * PixelSize); GetMem(NewImage, LineSize * Header.Height); try // Row direction if (Header.ImageDes and $20 > 0) then begin YStart := 0; YEnd := Header.Height -1; YInc := 1; end else begin YStart := Header.Height -1; YEnd := 0; YInc := -1; end; // Read Image case Header.ImageType of TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY: ReadUncompressed; TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY: ReadCompressed; end; SetDataPointer(NewImage, Format, Header.Width, Header.Height); result := true; except FreeMem(NewImage); raise; end; end else aStream.Position := StreamPos; end else aStream.Position := StreamPos; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveTGA(const aStream: TStream); var Header: TTGAHeader; Size: Integer; pTemp: pByte; FormatDesc: TglBitmapFormatDescClass; procedure ConvertData(pTemp: pByte); var Idx, PixelSize: Integer; Temp: byte; begin PixelSize := fPixelSize; for Idx := 1 to Height * Width do begin Temp := pByteArray(pTemp)^[2]; pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0]; pByteArray(pTemp)^[0] := Temp; Inc(pTemp, PixelSize); end; end; begin if not (ftTGA in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT); FillChar(Header, SizeOf(Header), 0); case Format of //TODO ifAlpha8, ifLuminance8, ifDepth8: begin tfLuminance8: begin Header.ImageType := TGA_UNCOMPRESSED_GRAY; Header.Bpp := 8; end; tfLuminance8Alpha8: begin Header.ImageType := TGA_UNCOMPRESSED_GRAY; Header.Bpp := 16; end; tfRGB8, tfBGR8: begin Header.ImageType := TGA_UNCOMPRESSED_RGB; Header.Bpp := 24; end; tfRGBA8, tfBGRA8: begin Header.ImageType := TGA_UNCOMPRESSED_RGB; Header.Bpp := 32; end; else raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT); end; Header.Width := Width; Header.Height := Height; Header.ImageDes := $20; FormatDesc := FORMAT_DESCRIPTORS[Format]; if FormatDesc.HasAlpha then Header.ImageDes := Header.ImageDes or $08; aStream.Write(Header, SizeOf(Header)); // convert RGB(A) to BGR(A) Size := FormatDesc.GetSize(Dimension); if Format in [tfRGB8, tfRGBA8] then begin GetMem(pTemp, Size); end else pTemp := Data; try // convert data if Format in [tfRGB8, tfRGBA8] then begin Move(Data^, pTemp^, Size); ConvertData(pTemp); end; // write data aStream.Write(pTemp^, Size); finally // free tempdata if Format in [tfRGB8, tfRGBA8] then FreeMem(pTemp); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //DDS///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// const DDS_MAGIC = $20534444; // DDS_header.dwFlags DDSD_CAPS = $00000001; DDSD_HEIGHT = $00000002; DDSD_WIDTH = $00000004; DDSD_PITCH = $00000008; DDSD_PIXELFORMAT = $00001000; DDSD_MIPMAPCOUNT = $00020000; DDSD_LINEARSIZE = $00080000; DDSD_DEPTH = $00800000; // DDS_header.sPixelFormat.dwFlags DDPF_ALPHAPIXELS = $00000001; DDPF_FOURCC = $00000004; DDPF_INDEXED = $00000020; DDPF_RGB = $00000040; // DDS_header.sCaps.dwCaps1 DDSCAPS_COMPLEX = $00000008; DDSCAPS_TEXTURE = $00001000; DDSCAPS_MIPMAP = $00400000; // DDS_header.sCaps.dwCaps2 DDSCAPS2_CUBEMAP = $00000200; DDSCAPS2_CUBEMAP_POSITIVEX = $00000400; DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800; DDSCAPS2_CUBEMAP_POSITIVEY = $00001000; DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000; DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000; DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000; DDSCAPS2_VOLUME = $00200000; D3DFMT_DXT1 = $31545844; D3DFMT_DXT3 = $33545844; D3DFMT_DXT5 = $35545844; type TDDSPixelFormat = packed record dwSize: Cardinal; dwFlags: Cardinal; dwFourCC: Cardinal; dwRGBBitCount: Cardinal; dwRBitMask: Cardinal; dwGBitMask: Cardinal; dwBBitMask: Cardinal; dwAlphaBitMask: Cardinal; end; TDDSCaps = packed record dwCaps1: Cardinal; dwCaps2: Cardinal; dwDDSX: Cardinal; dwReserved: Cardinal; end; TDDSHeader = packed record dwMagic: Cardinal; dwSize: Cardinal; dwFlags: Cardinal; dwHeight: Cardinal; dwWidth: Cardinal; dwPitchOrLinearSize: Cardinal; dwDepth: Cardinal; dwMipMapCount: Cardinal; dwReserved: array[0..10] of Cardinal; PixelFormat: TDDSPixelFormat; Caps: TDDSCaps; dwReserved2: Cardinal; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadDDS(const aStream: TStream): Boolean; var Header: TDDSHeader; StreamPos: Int64; Y, LineSize: Cardinal; RowSize: Cardinal; NewImage, pData: pByte; ddsFormat: TglBitmapFormat; function RaiseEx : Exception; begin result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.'); end; function GetDDSFormat: TglBitmapFormat; begin with Header.PixelFormat do begin // Compresses if (dwFlags and DDPF_FOURCC) > 0 then begin (* TODO case Header.PixelFormat.dwFourCC of D3DFMT_DXT1: result := ifDXT1; D3DFMT_DXT3: result := ifDXT3; D3DFMT_DXT5: result := ifDXT5; else raise RaiseEx; end; *) raise RaiseEx; end else // RGB if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin case dwRGBBitCount of 8: begin (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then result := tfAlpha else *) result := tfLuminance8; end; 16: begin if dwFlags and DDPF_ALPHAPIXELS > 0 then begin // Alpha case CountSetBits(dwRBitMask) of 5: result := tfRGB5A1; //TODO 4: result := tfRGBA4; else result := tfLuminance8Alpha8; end; end else begin // no Alpha //TODO result := ifR5G6B5; raise RaiseEx; end; end; 24: begin if dwRBitMask > dwBBitMask then result := tfBGR8 else result := tfRGB8; end; 32: begin if CountSetBits(dwRBitMask) = 10 then //TODO result := tfRGB10A2 raise RaiseEx else if dwRBitMask > dwBBitMask then result := tfBGRA8 else result := tfRGBA8; end; else raise RaiseEx; end; end else raise RaiseEx; end; end; begin result := false; // Header StreamPos := aStream.Position; aStream.Read(Header, sizeof(Header)); if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin aStream.Position := StreamPos; exit; end; ddsFormat := GetDDSFormat; LineSize := Trunc(Header.dwWidth * FORMAT_DESCRIPTORS[ddsFormat].GetSize); GetMem(NewImage, Header.dwHeight * LineSize); try pData := NewImage; // Compressed if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin RowSize := Header.dwPitchOrLinearSize div Header.dwWidth; for Y := 0 to Header.dwHeight -1 do begin aStream.Read(pData^, RowSize); Inc(pData, LineSize); end; end else // RGB(A) if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin RowSize := Header.dwPitchOrLinearSize; for Y := 0 to Header.dwHeight -1 do begin aStream.Read(pData^, RowSize); Inc(pData, LineSize); end; end else raise RaiseEx; SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); result := true; except FreeMem(NewImage); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveDDS(const aStream: TStream); var Header: TDDSHeader; Pix: TglBitmapPixelData; begin //if not FormatIsUncompressed(InternalFormat) then // raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT); (* TODO if Format = tfAlpha8 then FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix); else *) FORMAT_DESCRIPTORS[Format].PreparePixel(Pix); // Generell FillChar(Header, SizeOf(Header), 0); Header.dwMagic := DDS_MAGIC; Header.dwSize := 124; Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT; if Width > 0 then begin Header.dwWidth := Width; Header.dwFlags := Header.dwFlags or DDSD_WIDTH; end; if Height > 0 then begin Header.dwHeight := Height; Header.dwFlags := Header.dwFlags or DDSD_HEIGHT; end; Header.dwPitchOrLinearSize := fRowSize; Header.dwMipMapCount := 1; // Caps Header.Caps.dwCaps1 := DDSCAPS_TEXTURE; // Pixelformat Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat); Header.PixelFormat.dwFlags := DDPF_RGB; (* TODO tfAlpha8 if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS; *) Header.PixelFormat.dwRGBBitCount := Trunc(FORMAT_DESCRIPTORS[Format].GetSize * 8); Header.PixelFormat.dwRBitMask := Pix.PixelDesc.RedRange shl Pix.PixelDesc.RedShift; Header.PixelFormat.dwGBitMask := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift; Header.PixelFormat.dwBBitMask := Pix.PixelDesc.BlueRange shl Pix.PixelDesc.BlueShift; Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift; aStream.Write(Header, SizeOf(Header)); aStream.Write(Data^, FORMAT_DESCRIPTORS[Format].GetSize(Dimension)); end; {$ENDREGION} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap2D///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer; begin if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then result := fLines[aIndex] else result := nil; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var Idx, LineWidth: Integer; begin inherited SetDataPointer(aData, aFormat, aWidth, aHeight); //TODO compression if {FormatIsUncompressed(Format)} true then begin (* TODO PixelFuncs fGetPixelFunc := GetPixel2DUnmap; fSetPixelFunc := SetPixel2DUnmap; *) // Assigning Data if Assigned(Data) then begin SetLength(fLines, GetHeight); LineWidth := Trunc(GetWidth * FORMAT_DESCRIPTORS[Format].GetSize); for Idx := 0 to GetHeight -1 do begin fLines[Idx] := Data; Inc(fLines[Idx], Idx * LineWidth); end; end else SetLength(fLines, 0); end else begin (* SetLength(fLines, 0); fSetPixelFunc := nil; case Format of ifDXT1: fGetPixelFunc := GetPixel2DDXT1; ifDXT3: fGetPixelFunc := GetPixel2DDXT3; ifDXT5: fGetPixelFunc := GetPixel2DDXT5; else fGetPixelFunc := nil; end; *) end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean); var FormatDescriptor: TglBitmapFormatDescClass; FormatDesc: TglBitmapFormatDesc; begin glPixelStorei(GL_UNPACK_ALIGNMENT, 1); (* TODO compression if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data) else *) FormatDescriptor := FORMAT_DESCRIPTORS[Format]; FormatDesc := FormatDescriptor.GetFormatDesc; if aBuildWithGlu then gluBuild2DMipmaps(aTarget, FormatDescriptor.GetColorCompCount, Width, Height, FormatDesc.Format, FormatDesc.DataType, Data) else glTexImage2D(aTarget, 0, FormatDesc.InternalFormat, Width, Height, 0, FormatDesc.Format, FormatDesc.DataType, Data); // Freigeben if (FreeDataAfterGenTexture) then FreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.AfterConstruction; begin inherited; Target := GL_TEXTURE_2D; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat); var Temp: pByte; Size, w, h: Integer; FormatDesc: TglBitmapFormatDescClass; glFormatDesc: TglBitmapFormatDesc; begin (* TODO compression if not FormatIsUncompressed(Format) then raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT); *) w := aRight - aLeft; h := aBottom - aTop; FormatDesc := FORMAT_DESCRIPTORS[Format]; glFormatDesc := FormatDesc.GetFormatDesc; Size := FormatDesc.GetSize(glBitmapPosition(w, h)); GetMem(Temp, Size); try glPixelStorei(GL_PACK_ALIGNMENT, 1); glReadPixels(aLeft, aTop, w, h, glFormatDesc.Format, glFormatDesc.DataType, Temp); SetDataPointer(Temp, Format, w, h); FlipVert; except FreeMem(Temp); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GetDataFromTexture; var Temp: PByte; TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer; TempType, TempIntFormat: Cardinal; IntFormat: TglBitmapFormat; FormatDesc: TglBitmapFormatDescClass; begin Bind; // Request Data glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE, @RedSize); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE, @GreenSize); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE, @BlueSize); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE, @AlphaSize); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize); IntFormat := tfEmpty; for FormatDesc in FORMAT_DESCRIPTORS do if (FormatDesc.GetFormatDesc.InternalFormat = TempIntFormat) then begin IntFormat := FormatDesc.GetFormat; break; end; // Getting data from OpenGL GetMem(Temp, FormatDesc.GetSize(glBitmapPosition(TempWidth, TempHeight))); try (* TODO Compression if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then glGetCompressedTexImage(Target, 0, Temp) else *) with FormatDesc.GetFormatDesc do glGetTexImage(Target, 0, InternalFormat, DataType, Temp); SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); except FreeMem(Temp); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean); var BuildWithGlu, PotTex, TexRec: Boolean; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if ((Height > TexSize) or (Width > TexSize)) then raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.'); PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width); TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB); if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); end; CreateId; SetupParameters(BuildWithGlu); UploadData(Target, BuildWithGlu); glAreTexturesResident(1, @fID, @fIsResident); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.FlipHorz: Boolean; var Col, Row: Integer; TempDestData, DestData, SourceData: PByte; ImgSize: Integer; begin result := inherited FlipHorz; if Assigned(Data) then begin SourceData := Data; ImgSize := Height * fRowSize; GetMem(DestData, ImgSize); try TempDestData := DestData; Dec(TempDestData, fRowSize + fPixelSize); for Row := 0 to Height -1 do begin Inc(TempDestData, fRowSize * 2); for Col := 0 to Width -1 do begin Move(SourceData^, TempDestData^, fPixelSize); Inc(SourceData, fPixelSize); Dec(TempDestData, fPixelSize); end; end; SetDataPointer(DestData, Format); result := true; except FreeMem(DestData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.FlipVert: Boolean; var Row: Integer; TempDestData, DestData, SourceData: PByte; begin result := inherited FlipVert; if Assigned(Data) then begin SourceData := Data; GetMem(DestData, Height * fRowSize); try TempDestData := DestData; Inc(TempDestData, Width * (Height -1) * fPixelSize); for Row := 0 to Height -1 do begin Move(SourceData^, TempDestData^, fRowSize); Dec(TempDestData, fRowSize); Inc(SourceData, fRowSize); end; SetDataPointer(DestData, Format); result := true; except FreeMem(DestData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap2D - ToNormalMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TMatrixItem = record X, Y: Integer; W: Single; end; PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec; TglBitmapToNormalMapRec = Record Scale: Single; Heights: array of Single; MatrixU : array of TMatrixItem; MatrixV : array of TMatrixItem; end; const oneover255 = 1 / 255; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec); var Val: Single; begin with FuncRec do begin Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue * 0.11; PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec); begin with FuncRec do PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec); type TVec = Array[0..2] of Single; var Idx: Integer; du, dv: Double; Len: Single; Vec: TVec; function GetHeight(X, Y: Integer): Single; begin with FuncRec do begin X := Max(0, Min(Size.X -1, X)); Y := Max(0, Min(Size.Y -1, Y)); result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X]; end; end; begin with FuncRec do begin with PglBitmapToNormalMapRec(Args)^ do begin du := 0; for Idx := Low(MatrixU) to High(MatrixU) do du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W; dv := 0; for Idx := Low(MatrixU) to High(MatrixU) do dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W; Vec[0] := -du * Scale; Vec[1] := -dv * Scale; Vec[2] := 1; end; // Normalize Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2])); if Len <> 0 then begin Vec[0] := Vec[0] * Len; Vec[1] := Vec[1] * Len; Vec[2] := Vec[2] * Len; end; // Farbe zuweisem Dest.Red := Trunc((Vec[0] + 1) * 127.5); Dest.Green := Trunc((Vec[1] + 1) * 127.5); Dest.Blue := Trunc((Vec[2] + 1) * 127.5); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean); var Rec: TglBitmapToNormalMapRec; procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single); begin if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin Matrix[Index].X := X; Matrix[Index].Y := Y; Matrix[Index].W := W; end; end; begin (* TODO Compression if not FormatIsUncompressed(InternalFormat) then raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT); *) if aScale > 100 then Rec.Scale := 100 else if aScale < -100 then Rec.Scale := -100 else Rec.Scale := aScale; SetLength(Rec.Heights, Width * Height); try case aFunc of nm4Samples: begin SetLength(Rec.MatrixU, 2); SetEntry(Rec.MatrixU, 0, -1, 0, -0.5); SetEntry(Rec.MatrixU, 1, 1, 0, 0.5); SetLength(Rec.MatrixV, 2); SetEntry(Rec.MatrixV, 0, 0, 1, 0.5); SetEntry(Rec.MatrixV, 1, 0, -1, -0.5); end; nmSobel: begin SetLength(Rec.MatrixU, 6); SetEntry(Rec.MatrixU, 0, -1, 1, -1.0); SetEntry(Rec.MatrixU, 1, -1, 0, -2.0); SetEntry(Rec.MatrixU, 2, -1, -1, -1.0); SetEntry(Rec.MatrixU, 3, 1, 1, 1.0); SetEntry(Rec.MatrixU, 4, 1, 0, 2.0); SetEntry(Rec.MatrixU, 5, 1, -1, 1.0); SetLength(Rec.MatrixV, 6); SetEntry(Rec.MatrixV, 0, -1, 1, 1.0); SetEntry(Rec.MatrixV, 1, 0, 1, 2.0); SetEntry(Rec.MatrixV, 2, 1, 1, 1.0); SetEntry(Rec.MatrixV, 3, -1, -1, -1.0); SetEntry(Rec.MatrixV, 4, 0, -1, -2.0); SetEntry(Rec.MatrixV, 5, 1, -1, -1.0); end; nm3x3: begin SetLength(Rec.MatrixU, 6); SetEntry(Rec.MatrixU, 0, -1, 1, -1/6); SetEntry(Rec.MatrixU, 1, -1, 0, -1/6); SetEntry(Rec.MatrixU, 2, -1, -1, -1/6); SetEntry(Rec.MatrixU, 3, 1, 1, 1/6); SetEntry(Rec.MatrixU, 4, 1, 0, 1/6); SetEntry(Rec.MatrixU, 5, 1, -1, 1/6); SetLength(Rec.MatrixV, 6); SetEntry(Rec.MatrixV, 0, -1, 1, 1/6); SetEntry(Rec.MatrixV, 1, 0, 1, 1/6); SetEntry(Rec.MatrixV, 2, 1, 1, 1/6); SetEntry(Rec.MatrixV, 3, -1, -1, -1/6); SetEntry(Rec.MatrixV, 4, 0, -1, -1/6); SetEntry(Rec.MatrixV, 5, 1, -1, -1/6); end; nm5x5: begin SetLength(Rec.MatrixU, 20); SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16); SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10); SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10); SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16); SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10); SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8); SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8); SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10); SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8); SetEntry(Rec.MatrixU, 9, -1, 0, -0.5); SetEntry(Rec.MatrixU, 10, 1, 0, 0.5); SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8); SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10); SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8); SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8); SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10); SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16); SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10); SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10); SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16); SetLength(Rec.MatrixV, 20); SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16); SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10); SetEntry(Rec.MatrixV, 2, 0, 2, 0.25); SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10); SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16); SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10); SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8); SetEntry(Rec.MatrixV, 7, 0, 1, 0.5); SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8); SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16); SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16); SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8); SetEntry(Rec.MatrixV, 12, 0, -1, -0.5); SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8); SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10); SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16); SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10); SetEntry(Rec.MatrixV, 17, 0, -2, -0.25); SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10); SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16); end; end; // Daten Sammeln if aUseAlpha and FORMAT_DESCRIPTORS[Format].HasAlpha then AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec)) else AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec)); AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec)); finally SetLength(Rec.Heights, 0); end; end; (* procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer); var pTemp: pByte; Size: Integer; begin if Height > 1 then begin // extract first line of the data Size := FormatGetImageSize(glBitmapPosition(Width), Format); GetMem(pTemp, Size); Move(Data^, pTemp^, Size); FreeMem(Data); end else pTemp := Data; // set data pointer inherited SetDataPointer(pTemp, Format, Width); if FormatIsUncompressed(Format) then begin fUnmapFunc := FormatGetUnMapFunc(Format); fGetPixelFunc := GetPixel1DUnmap; end; end; procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); var pTemp: pByte; begin pTemp := Data; Inc(pTemp, Pos.X * fPixelSize); fUnmapFunc(pTemp, Pixel); end; function TglBitmap1D.FlipHorz: Boolean; var Col: Integer; pTempDest, pDest, pSource: pByte; begin result := inherited FlipHorz; if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin pSource := Data; GetMem(pDest, fRowSize); try pTempDest := pDest; Inc(pTempDest, fRowSize); for Col := 0 to Width -1 do begin Move(pSource^, pTempDest^, fPixelSize); Inc(pSource, fPixelSize); Dec(pTempDest, fPixelSize); end; SetDataPointer(pDest, InternalFormat); result := true; finally FreeMem(pDest); end; end; end; procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean); begin // Upload data if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data) else // Upload data if BuildWithGlu then gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data) else glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data); // Freigeben if (FreeDataAfterGenTexture) then FreeData; end; procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean); var BuildWithGlu, TexRec: Boolean; glFormat, glInternalFormat, glType: Cardinal; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (TestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if (Width > TexSize) then raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.'); TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB); if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.'); end; CreateId; SetupParameters(BuildWithGlu); SelectFormat(InternalFormat, glFormat, glInternalFormat, glType); UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu); // Infos sammeln glAreTexturesResident(1, @fID, @fIsResident); end; end; procedure TglBitmap1D.AfterConstruction; begin inherited; Target := GL_TEXTURE_1D; end; { TglBitmapCubeMap } procedure TglBitmapCubeMap.AfterConstruction; begin inherited; if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); SetWrap; // set all to GL_CLAMP_TO_EDGE Target := GL_TEXTURE_CUBE_MAP; fGenMode := GL_REFLECTION_MAP; end; procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean); begin inherited Bind (EnableTextureUnit); if EnableTexCoordsGen then begin glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode); glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode); glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode); glEnable(GL_TEXTURE_GEN_S); glEnable(GL_TEXTURE_GEN_T); glEnable(GL_TEXTURE_GEN_R); end; end; procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean); var glFormat, glInternalFormat, glType: Cardinal; BuildWithGlu: Boolean; TexSize: Integer; begin // Check Texture Size if (TestTextureSize) then begin glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize); if ((Height > TexSize) or (Width > TexSize)) then raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.'); if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.'); end; // create Texture if ID = 0 then begin CreateID; SetupParameters(BuildWithGlu); end; SelectFormat(InternalFormat, glFormat, glInternalFormat, glType); UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu); end; procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean); begin Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.'); end; procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen, DisableTextureUnit: Boolean); begin inherited Unbind (DisableTextureUnit); if DisableTexCoordsGen then begin glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); glDisable(GL_TEXTURE_GEN_R); end; end; { TglBitmapNormalMap } type TVec = Array[0..2] of Single; TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); PglBitmapNormalMapRec = ^TglBitmapNormalMapRec; TglBitmapNormalMapRec = record HalfSize : Integer; Func: TglBitmapNormalMapGetVectorFunc; end; procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := HalfSize; Vec[1] := - (Position.Y + 0.5 - HalfSize); Vec[2] := - (Position.X + 0.5 - HalfSize); end; procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := - HalfSize; Vec[1] := - (Position.Y + 0.5 - HalfSize); Vec[2] := Position.X + 0.5 - HalfSize; end; procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := Position.X + 0.5 - HalfSize; Vec[1] := HalfSize; Vec[2] := Position.Y + 0.5 - HalfSize; end; procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := Position.X + 0.5 - HalfSize; Vec[1] := - HalfSize; Vec[2] := - (Position.Y + 0.5 - HalfSize); end; procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := Position.X + 0.5 - HalfSize; Vec[1] := - (Position.Y + 0.5 - HalfSize); Vec[2] := HalfSize; end; procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer); begin Vec[0] := - (Position.X + 0.5 - HalfSize); Vec[1] := - (Position.Y + 0.5 - HalfSize); Vec[2] := - HalfSize; end; procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec); var Vec : TVec; Len: Single; begin with FuncRec do begin with PglBitmapNormalMapRec (CustomData)^ do begin Func(Vec, Position, HalfSize); // Normalize Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2])); if Len <> 0 then begin Vec[0] := Vec[0] * Len; Vec[1] := Vec[1] * Len; Vec[2] := Vec[2] * Len; end; // Scale Vector and AddVectro Vec[0] := Vec[0] * 0.5 + 0.5; Vec[1] := Vec[1] * 0.5 + 0.5; Vec[2] := Vec[2] * 0.5 + 0.5; end; // Set Color Dest.Red := Round(Vec[0] * 255); Dest.Green := Round(Vec[1] * 255); Dest.Blue := Round(Vec[2] * 255); end; end; procedure TglBitmapNormalMap.AfterConstruction; begin inherited; fGenMode := GL_NORMAL_MAP; end; procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer; TestTextureSize: Boolean); var Rec: TglBitmapNormalMapRec; SizeRec: TglBitmapPixelPosition; begin Rec.HalfSize := Size div 2; FreeDataAfterGenTexture := false; SizeRec.Fields := [ffX, ffY]; SizeRec.X := Size; SizeRec.Y := Size; // Positive X Rec.Func := glBitmapNormalMapPosX; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize); // Negative X Rec.Func := glBitmapNormalMapNegX; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize); // Positive Y Rec.Func := glBitmapNormalMapPosY; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize); // Negative Y Rec.Func := glBitmapNormalMapNegY; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize); // Positive Z Rec.Func := glBitmapNormalMapPosZ; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize); // Negative Z Rec.Func := glBitmapNormalMapNegZ; LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize); end; *) initialization glBitmapSetDefaultFormat(tfEmpty); glBitmapSetDefaultMipmap(mmMipmap); glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR); glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE); glBitmapSetDefaultFreeDataAfterGenTexture(true); glBitmapSetDefaultDeleteTextureOnFree (true); finalization end.