{*********************************************************** glBitmap by Steffen Xonna aka Lossy eX (2003-2008) http://www.opengl24.de/index.php?cat=header&file=glbitmap modified by Delphi OpenGL Community (http://delphigl.com/) (2013) ------------------------------------------------------------ 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 3.0.1 ------------------------------------------------------------ History 20-11-2013 - refactoring of the complete library 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; // Please uncomment the defines below to configure the glBitmap to your preferences. // If you have configured the unit you can uncomment the warning above. {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Preferences /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // enable OpenGL ES support {.$DEFINE OPENGL_ES_1_1} {.$DEFINE OPENGL_ES_2_0} {.$DEFINE OPENGL_ES_3_0} {.$DEFINE OPENGL_ES_EXT} // activate to enable build-in OpenGL support with statically linked methods // use dglOpenGL.pas if not enabled {.$DEFINE GLB_NATIVE_OGL_STATIC} // activate to enable build-in OpenGL support with dynamically linked methods // use dglOpenGL.pas if not enabled {.$DEFINE GLB_NATIVE_OGL_DYNAMIC} // activate to enable the support for SDL_surfaces {.$DEFINE GLB_SDL} // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap) {.$DEFINE GLB_DELPHI} // activate to enable the support for TLazIntfImage from Lazarus {.$DEFINE GLB_LAZARUS} // activate 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_SDL_IMAGE} // activate to enable Lazarus TPortableNetworkGraphic support // if you enable this pngImage and libPNG will be ignored {.$DEFINE GLB_LAZ_PNG} // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/ // if you enable pngimage the libPNG will be ignored {.$DEFINE GLB_PNGIMAGE} // activate 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_LIB_PNG} // activate to enable Lazarus TJPEGImage support // if you enable this delphi jpegs and libJPEG will be ignored {.$DEFINE GLB_LAZ_JPEG} // if you enable delphi jpegs the libJPEG will be ignored {.$DEFINE GLB_DELPHI_JPEG} // activate to use the libJPEG -> http://www.ijg.org/ // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg {.$DEFINE GLB_LIB_JPEG} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // PRIVATE: do not change anything! ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Delphi Versions {$IFDEF fpc} {$MODE Delphi} {$IFDEF CPUI386} {$DEFINE CPU386} {$ASMMODE INTEL} {$ENDIF} {$IFNDEF WINDOWS} {$linklib c} {$ENDIF} {$ENDIF} // Operation System {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)} {$DEFINE GLB_WIN} {$ELSEIF DEFINED(LINUX)} {$DEFINE GLB_LINUX} {$IFEND} // OpenGL ES {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND} {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND} {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND} {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND} // native OpenGL Support {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)} {$IFDEF OPENGL_ES} {$ERROR 'native OpenGL is not supported yet for OpenGL ES, please use dglOpenGLES.pas instead'} {$ELSE} {$DEFINE GLB_NATIVE_OGL} {$ENDIF} {$IFEND} // checking define combinations //SDL Image {$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_LAZ_PNG} {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'} {$undef GLB_LAZ_PNG} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'} {$undef GLB_PNGIMAGE} {$ENDIF} {$IFDEF GLB_LAZ_JPEG} {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'} {$undef GLB_LAZ_JPEG} {$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} // Lazarus TPortableNetworkGraphic {$IFDEF GLB_LAZ_PNG} {$IFNDEF GLB_LAZARUS} {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'} {$DEFINE GLB_LAZARUS} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'} {$undef GLB_PNGIMAGE} {$ENDIF} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'} {$undef GLB_LIB_PNG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} // PNG Image {$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} // libPNG {$IFDEF GLB_LIB_PNG} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} // Lazarus TJPEGImage {$IFDEF GLB_LAZ_JPEG} {$IFNDEF GLB_LAZARUS} {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'} {$DEFINE GLB_LAZARUS} {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'} {$undef GLB_DELPHI_JPEG} {$ENDIF} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // JPEG Image {$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} // libJPEG {$IFDEF GLB_LIB_JPEG} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // native OpenGL {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)} {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'} {$IFEND} // general options {$EXTENDEDSYNTAX ON} {$LONGSTRINGS ON} {$ALIGN ON} {$IFNDEF FPC} {$OPTIMIZATION ON} {$ENDIF} interface uses {$IFNDEF GLB_NATIVE_OGL} {$IFDEF OPENGL_ES} dglOpenGLES, {$ELSE} dglOpenGL, {$ENDIF} {$ENDIF} {$IF DEFINED(GLB_WIN) AND (DEFINED(GLB_NATIVE_OGL) OR DEFINED(GLB_DELPHI))} windows, {$IFEND} {$IFDEF GLB_SDL} SDL, {$ENDIF} {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF} {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$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; {$IFDEF GLB_NATIVE_OGL} const GL_TRUE = 1; GL_FALSE = 0; GL_ZERO = 0; GL_ONE = 1; GL_VERSION = $1F02; GL_EXTENSIONS = $1F03; GL_TEXTURE_1D = $0DE0; GL_TEXTURE_2D = $0DE1; GL_TEXTURE_RECTANGLE = $84F5; GL_NORMAL_MAP = $8511; GL_TEXTURE_CUBE_MAP = $8513; GL_REFLECTION_MAP = $8512; 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_WIDTH = $1000; GL_TEXTURE_HEIGHT = $1001; GL_TEXTURE_INTERNAL_FORMAT = $1003; GL_TEXTURE_SWIZZLE_RGBA = $8E46; GL_S = $2000; GL_T = $2001; GL_R = $2002; GL_Q = $2003; GL_TEXTURE_GEN_S = $0C60; GL_TEXTURE_GEN_T = $0C61; GL_TEXTURE_GEN_R = $0C62; GL_TEXTURE_GEN_Q = $0C63; GL_RED = $1903; GL_GREEN = $1904; GL_BLUE = $1905; GL_ALPHA = $1906; GL_ALPHA4 = $803B; GL_ALPHA8 = $803C; GL_ALPHA12 = $803D; GL_ALPHA16 = $803E; GL_LUMINANCE = $1909; GL_LUMINANCE4 = $803F; GL_LUMINANCE8 = $8040; GL_LUMINANCE12 = $8041; GL_LUMINANCE16 = $8042; GL_LUMINANCE_ALPHA = $190A; GL_LUMINANCE4_ALPHA4 = $8043; GL_LUMINANCE6_ALPHA2 = $8044; GL_LUMINANCE8_ALPHA8 = $8045; GL_LUMINANCE12_ALPHA4 = $8046; GL_LUMINANCE12_ALPHA12 = $8047; GL_LUMINANCE16_ALPHA16 = $8048; GL_RGB = $1907; GL_BGR = $80E0; GL_R3_G3_B2 = $2A10; GL_RGB4 = $804F; GL_RGB5 = $8050; GL_RGB565 = $8D62; GL_RGB8 = $8051; GL_RGB10 = $8052; GL_RGB12 = $8053; GL_RGB16 = $8054; GL_RGBA = $1908; GL_BGRA = $80E1; GL_RGBA2 = $8055; GL_RGBA4 = $8056; GL_RGB5_A1 = $8057; GL_RGBA8 = $8058; GL_RGB10_A2 = $8059; GL_RGBA12 = $805A; GL_RGBA16 = $805B; GL_DEPTH_COMPONENT = $1902; GL_DEPTH_COMPONENT16 = $81A5; GL_DEPTH_COMPONENT24 = $81A6; GL_DEPTH_COMPONENT32 = $81A7; GL_COMPRESSED_RGB = $84ED; GL_COMPRESSED_RGBA = $84EE; 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_UNSIGNED_BYTE = $1401; GL_UNSIGNED_BYTE_3_3_2 = $8032; GL_UNSIGNED_BYTE_2_3_3_REV = $8362; GL_UNSIGNED_SHORT = $1403; GL_UNSIGNED_SHORT_5_6_5 = $8363; GL_UNSIGNED_SHORT_4_4_4_4 = $8033; GL_UNSIGNED_SHORT_5_5_5_1 = $8034; 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 = $1405; GL_UNSIGNED_INT_8_8_8_8 = $8035; GL_UNSIGNED_INT_10_10_10_2 = $8036; GL_UNSIGNED_INT_8_8_8_8_REV = $8367; GL_UNSIGNED_INT_2_10_10_10_REV = $8368; { Texture Filter } GL_TEXTURE_MAG_FILTER = $2800; GL_TEXTURE_MIN_FILTER = $2801; GL_NEAREST = $2600; GL_NEAREST_MIPMAP_NEAREST = $2700; GL_NEAREST_MIPMAP_LINEAR = $2702; GL_LINEAR = $2601; GL_LINEAR_MIPMAP_NEAREST = $2701; GL_LINEAR_MIPMAP_LINEAR = $2703; { Texture Wrap } GL_TEXTURE_WRAP_S = $2802; GL_TEXTURE_WRAP_T = $2803; GL_TEXTURE_WRAP_R = $8072; GL_CLAMP = $2900; GL_REPEAT = $2901; GL_CLAMP_TO_EDGE = $812F; GL_CLAMP_TO_BORDER = $812D; GL_MIRRORED_REPEAT = $8370; { Other } GL_GENERATE_MIPMAP = $8191; GL_TEXTURE_BORDER_COLOR = $1004; GL_MAX_TEXTURE_SIZE = $0D33; GL_PACK_ALIGNMENT = $0D05; GL_UNPACK_ALIGNMENT = $0CF5; GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C; GL_TEXTURE_GEN_MODE = $2500; {$IF DEFINED(GLB_WIN)} libglu = 'glu32.dll'; libopengl = 'opengl32.dll'; {$ELSEIF DEFINED(GLB_LINUX)} libglu = 'libGLU.so.1'; libopengl = 'libGL.so.1'; {$IFEND} type GLboolean = BYTEBOOL; GLint = Integer; GLsizei = Integer; GLuint = Cardinal; GLfloat = Single; GLenum = Cardinal; PGLvoid = Pointer; PGLboolean = ^GLboolean; PGLint = ^GLint; PGLuint = ^GLuint; PGLfloat = ^GLfloat; TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} {$IF DEFINED(GLB_WIN)} TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall; {$ELSEIF DEFINED(GLB_LINUX)} TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl; TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl; {$IFEND} {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)} TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)} procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu; function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu; {$IFEND} var GL_VERSION_1_2, GL_VERSION_1_3, GL_VERSION_1_4, GL_VERSION_2_0, GL_VERSION_3_3, GL_SGIS_generate_mipmap, GL_ARB_texture_border_clamp, GL_ARB_texture_mirrored_repeat, GL_ARB_texture_rectangle, GL_ARB_texture_non_power_of_two, GL_ARB_texture_swizzle, GL_ARB_texture_cube_map, GL_IBM_texture_mirrored_repeat, GL_NV_texture_rectangle, GL_EXT_texture_edge_clamp, GL_EXT_texture_rectangle, GL_EXT_texture_swizzle, GL_EXT_texture_cube_map, GL_EXT_texture_filter_anisotropic: Boolean; glCompressedTexImage1D: TglCompressedTexImage1D; glCompressedTexImage2D: TglCompressedTexImage2D; glGetCompressedTexImage: TglGetCompressedTexImage; {$IF DEFINED(GLB_WIN)} wglGetProcAddress: TwglGetProcAddress; {$ELSEIF DEFINED(GLB_LINUX)} glXGetProcAddress: TglXGetProcAddress; glXGetProcAddressARB: TglXGetProcAddress; {$IFEND} {$IFDEF GLB_NATIVE_OGL_DYNAMIC} glEnable: TglEnable; glDisable: TglDisable; glGetString: TglGetString; glGetIntegerv: TglGetIntegerv; glTexParameteri: TglTexParameteri; glTexParameteriv: TglTexParameteriv; glTexParameterfv: TglTexParameterfv; glGetTexParameteriv: TglGetTexParameteriv; glGetTexParameterfv: TglGetTexParameterfv; glGetTexLevelParameteriv: TglGetTexLevelParameteriv; glGetTexLevelParameterfv: TglGetTexLevelParameterfv; glTexGeni: TglTexGeni; glGenTextures: TglGenTextures; glBindTexture: TglBindTexture; glDeleteTextures: TglDeleteTextures; glAreTexturesResident: TglAreTexturesResident; glReadPixels: TglReadPixels; glPixelStorei: TglPixelStorei; glTexImage1D: TglTexImage1D; glTexImage2D: TglTexImage2D; glGetTexImage: TglGetTexImage; gluBuild1DMipmaps: TgluBuild1DMipmaps; gluBuild2DMipmaps: TgluBuild2DMipmaps; {$ENDIF} {$ENDIF} type //////////////////////////////////////////////////////////////////////////////////////////////////// // the name of formats is composed of the following constituents: // - multiple chanals: // - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved) // - width of the chanel in bit (4, 8, 16, ...) // - data type (e.g. ub, us, ui) // - number of data types {$IFNDEF fpc} QWord = System.UInt64; PQWord = ^QWord; PtrInt = Longint; PtrUInt = DWord; {$ENDIF} TglBitmapFormat = ( tfEmpty = 0, //must be smallest value! tfAlpha4ub1, // 1 x unsigned byte tfAlpha8ub1, // 1 x unsigned byte tfAlpha16us1, // 1 x unsigned short tfLuminance4ub1, // 1 x unsigned byte tfLuminance8ub1, // 1 x unsigned byte tfLuminance16us1, // 1 x unsigned short tfLuminance4Alpha4ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance6Alpha2ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance8Alpha8ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance12Alpha4us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha) tfLuminance16Alpha16us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha) tfR3G3B2ub1, // 1 x unsigned byte (3bit red, 3bit green, 2bit blue) tfRGBX4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd) tfXRGB4us1, // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue) tfR5G6B5us1, // 1 x unsigned short (5bit red, 6bit green, 5bit blue) tfRGB5X1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved) tfX1RGB5us1, // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue) tfRGB8ub3, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue) tfRGBX8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved) tfXRGB8ui1, // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue) tfRGB10X2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved) tfX2RGB10ui1, // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue) tfRGB16us3, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue) tfRGBA4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha) tfARGB4us1, // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue) tfRGB5A1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha) tfA1RGB5us1, // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue) tfRGBA8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha) tfARGB8ui1, // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue) tfRGBA8ub4, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha) tfRGB10A2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha) tfA2RGB10ui1, // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue) tfRGBA16us4, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha) tfBGRX4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved) tfXBGR4us1, // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red) tfB5G6R5us1, // 1 x unsigned short (5bit blue, 6bit green, 5bit red) tfBGR5X1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved) tfX1BGR5us1, // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red) tfBGR8ub3, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red) tfBGRX8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved) tfXBGR8ui1, // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red) tfBGR10X2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved) tfX2BGR10ui1, // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red) tfBGR16us3, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red) tfBGRA4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha) tfABGR4us1, // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red) tfBGR5A1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha) tfA1BGR5us1, // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red) tfBGRA8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha) tfABGR8ui1, // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red) tfBGRA8ub4, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha) tfBGR10A2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha) tfA2BGR10ui1, // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red) tfBGRA16us4, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha) tfDepth16us1, // 1 x unsigned short (depth) tfDepth24ui1, // 1 x unsigned int (depth) tfDepth32ui1, // 1 x unsigned int (depth) tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA ); TglBitmapFileType = ( {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} ftDDS, ftTGA, ftBMP, ftRAW); TglBitmapFileTypes = set of TglBitmapFileType; TglBitmapMipMap = ( mmNone, mmMipmap, mmMipmapGlu); TglBitmapNormalMapFunc = ( nm4Samples, nmSobel, nm3x3, nm5x5); //////////////////////////////////////////////////////////////////////////////////////////////////// EglBitmap = class(Exception); EglBitmapNotSupported = class(Exception); EglBitmapSizeToLarge = class(EglBitmap); EglBitmapNonPowerOfTwo = class(EglBitmap); EglBitmapUnsupportedFormat = class(EglBitmap) public constructor Create(const aFormat: TglBitmapFormat); overload; constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload; end; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapRec4ui = packed record case Integer of 0: (r, g, b, a: Cardinal); 1: (arr: array[0..3] of Cardinal); end; TglBitmapRec4ub = packed record case Integer of 0: (r, g, b, a: Byte); 1: (arr: array[0..3] of Byte); end; TglBitmapRec4ul = packed record case Integer of 0: (r, g, b, a: QWord); 1: (arr: array[0..3] of QWord); end; TglBitmapFormatDescriptor = class(TObject) private // cached properties fBytesPerPixel: Single; fChannelCount: Integer; fMask: TglBitmapRec4ul; fRange: TglBitmapRec4ui; function GetHasRed: Boolean; function GetHasGreen: Boolean; function GetHasBlue: Boolean; function GetHasAlpha: Boolean; function GetHasColor: Boolean; function GetIsGrayscale: Boolean; protected fFormat: TglBitmapFormat; fWithAlpha: TglBitmapFormat; fWithoutAlpha: TglBitmapFormat; fOpenGLFormat: TglBitmapFormat; fRGBInverted: TglBitmapFormat; fUncompressed: TglBitmapFormat; fBitsPerPixel: Integer; fIsCompressed: Boolean; fPrecision: TglBitmapRec4ub; fShift: TglBitmapRec4ub; fglFormat: GLenum; fglInternalFormat: GLenum; fglDataFormat: GLenum; procedure SetValues; virtual; procedure CalcValues; public property Format: TglBitmapFormat read fFormat; property ChannelCount: Integer read fChannelCount; property IsCompressed: Boolean read fIsCompressed; property BitsPerPixel: Integer read fBitsPerPixel; property BytesPerPixel: Single read fBytesPerPixel; property Precision: TglBitmapRec4ub read fPrecision; property Shift: TglBitmapRec4ub read fShift; property Range: TglBitmapRec4ui read fRange; property Mask: TglBitmapRec4ul read fMask; property RGBInverted: TglBitmapFormat read fRGBInverted; property WithAlpha: TglBitmapFormat read fWithAlpha; property WithoutAlpha: TglBitmapFormat read fWithAlpha; property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; property Uncompressed: TglBitmapFormat read fUncompressed; property glFormat: GLenum read fglFormat; property glInternalFormat: GLenum read fglInternalFormat; property glDataFormat: GLenum read fglDataFormat; property HasRed: Boolean read GetHasRed; property HasGreen: Boolean read GetHasGreen; property HasBlue: Boolean read GetHasBlue; property HasAlpha: Boolean read GetHasAlpha; property HasColor: Boolean read GetHasColor; property IsGrayscale: Boolean read GetIsGrayscale; constructor Create; public class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; end; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapPixelData = packed record Data: TglBitmapRec4ui; Range: TglBitmapRec4ui; Format: TglBitmapFormat; end; PglBitmapPixelData = ^TglBitmapPixelData; 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: Pointer; end; TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec); ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap = class private function GetFormatDesc: TglBitmapFormatDescriptor; protected fID: GLuint; fTarget: GLuint; fAnisotropic: Integer; fDeleteTextureOnFree: Boolean; fFreeDataOnDestroy: Boolean; fFreeDataAfterGenTexture: Boolean; fData: PByte; {$IFNDEF OPENGL_ES} fIsResident: GLboolean; {$ENDIF} fBorderColor: array[0..3] of Single; fDimension: TglBitmapPixelPosition; fMipMap: TglBitmapMipMap; fFormat: TglBitmapFormat; // Mapping fPixelSize: Integer; fRowSize: Integer; // Filtering fFilterMin: GLenum; fFilterMag: GLenum; // TexturWarp fWrapS: GLenum; fWrapT: GLenum; fWrapR: GLenum; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} //Swizzle fSwizzle: array[0..3] of GLenum; {$IFEND} // 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 SetFreeDataOnDestroy(const aValue: Boolean); 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({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF}); procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method 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 FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc; 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 FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy; property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; property Dimension: TglBitmapPixelPosition read fDimension; property Data: PByte read fData; {$IFNDEF OPENGL_ES} property IsResident: GLboolean read fIsResident; {$ENDIF} procedure AfterConstruction; override; procedure BeforeDestruction; override; procedure PrepareResType(var aResource: String; var aResType: PChar); //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: Pointer = nil); procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil); procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); //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: Pointer = nil): Boolean; overload; function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean; const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): 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: Pointer = nil): 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: Pointer = nil): Boolean; {$ENDIF} {$IFDEF GLB_LAZARUS} function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean; function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean; function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean; function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; {$ENDIF} function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual; function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): 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); {$IFNDEF OPENGL_ES} procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); {$ENDIF} 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: GLenum); procedure SetWrap( const S: GLenum = GL_CLAMP_TO_EDGE; const T: GLenum = GL_CLAMP_TO_EDGE; const R: GLenum = GL_CLAMP_TO_EDGE); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} procedure SetSwizzle(const r, g, b, a: GLenum); {$IFEND} 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; aData: PByte = nil); overload; constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload; 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; private {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF} {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF} function LoadRAW(const aStream: TStream): Boolean; procedure SaveRAW(const aStream: TStream); function LoadBMP(const aStream: TStream): Boolean; procedure SaveBMP(const aStream: TStream); function LoadTGA(const aStream: TStream): Boolean; procedure SaveTGA(const aStream: TStream); function LoadDDS(const aStream: TStream): Boolean; procedure SaveDDS(const aStream: TStream); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IFNDEF OPENGL_ES} TglBitmap1D = class(TglBitmap) protected procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override; procedure UploadData(const aBuildWithGlu: Boolean); public property Width; procedure AfterConstruction; override; function FlipHorz: Boolean; override; procedure GenTexture(const aTestTextureSize: Boolean = true); override; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap2D = class(TglBitmap) protected fLines: array of PByte; function GetScanline(const aIndex: Integer): Pointer; procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override; procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF}); 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); {$IFNDEF OPENGL_ES} procedure GetDataFromTexture; {$ENDIF} 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} TglBitmapCubeMap = class(TglBitmap2D) protected {$IFNDEF OPENGL_ES} fGenMode: Integer; {$ENDIF} procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce; public procedure AfterConstruction; override; procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true); procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual; procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual; end; {$IFEND} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapNormalMap = class(TglBitmapCubeMap) public procedure AfterConstruction; override; procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true); end; {$IFEND} 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; function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub; function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui; function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul; function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean; function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean; function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D; var glBitmapDefaultDeleteTextureOnFree: Boolean; glBitmapDefaultFreeDataAfterGenTextures: Boolean; glBitmapDefaultFormat: TglBitmapFormat; glBitmapDefaultMipmap: TglBitmapMipMap; glBitmapDefaultFilterMin: Cardinal; glBitmapDefaultFilterMag: Cardinal; glBitmapDefaultWrapS: Cardinal; glBitmapDefaultWrapT: Cardinal; glBitmapDefaultWrapR: Cardinal; glDefaultSwizzle: array[0..3] of GLenum; {$IFDEF GLB_DELPHI} function CreateGrayPalette: HPALETTE; {$ENDIF} implementation uses Math, syncobjs, typinfo {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND}; //////////////////////////////////////////////////////////////////////////////////////////////////// type TFormatDescriptor = class(TglBitmapFormatDescriptor) public procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract; function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual; function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual; function CreateMappingData: Pointer; virtual; procedure FreeMappingData(var aMappingData: Pointer); virtual; function IsEmpty: Boolean; virtual; function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual; procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual; constructor Create; virtual; public class procedure Init; class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor; class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor; class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor; class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor; class procedure Clear; class procedure Finalize; end; TFormatDescriptorClass = class of TFormatDescriptor; TfdEmpty = class(TFormatDescriptor); ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdARGBus4 = class(TfdRGBus3) //4* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlpha4ub1 = class(TfdAlphaUB1) procedure SetValues; override; end; TfdAlpha8ub1 = class(TfdAlphaUB1) procedure SetValues; override; end; TfdAlpha16us1 = class(TfdAlphaUS1) procedure SetValues; override; end; TfdLuminance4ub1 = class(TfdLuminanceUB1) procedure SetValues; override; end; TfdLuminance8ub1 = class(TfdLuminanceUB1) procedure SetValues; override; end; TfdLuminance16us1 = class(TfdLuminanceUS1) procedure SetValues; override; end; TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2) procedure SetValues; override; end; TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2) procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdR3G3B2ub1 = class(TfdUniversalUB1) procedure SetValues; override; end; TfdRGBX4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdXRGB4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdR5G6B5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB5X1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdX1RGB5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB8ub3 = class(TfdRGBub3) procedure SetValues; override; end; TfdRGBX8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdXRGB8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGB10X2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdX2RGB10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGB16us3 = class(TfdRGBus3) procedure SetValues; override; end; TfdRGBA4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdARGB4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB5A1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdA1RGB5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGBA8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdARGB8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGBA8ub4 = class(TfdRGBAub4) procedure SetValues; override; end; TfdRGB10A2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdA2RGB10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGBA16us4 = class(TfdRGBAus4) procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdBGRX4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdXBGR4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdB5G6R5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR5X1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdX1BGR5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR8ub3 = class(TfdBGRub3) procedure SetValues; override; end; TfdBGRX8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdXBGR8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGR10X2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdX2BGR10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGR16us3 = class(TfdBGRus3) procedure SetValues; override; end; TfdBGRA4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdABGR4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR5A1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdA1BGR5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGRA8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdABGR8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGRA8ub4 = class(TfdBGRAub4) procedure SetValues; override; end; TfdBGR10A2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdA2BGR10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGRA16us4 = class(TfdBGRAus4) procedure SetValues; override; end; TfdDepth16us1 = class(TfdDepthUS1) procedure SetValues; override; end; TfdDepth24ui1 = class(TfdDepthUI1) procedure SetValues; override; end; TfdDepth32ui1 = class(TfdDepthUI1) procedure SetValues; override; end; TfdS3tcDtx1RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; TfdS3tcDtx3RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; TfdS3tcDtx5RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TbmpBitfieldFormat = class(TFormatDescriptor) public procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload; procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload; procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TbmpColorTableEnty = packed record b, g, r, a: Byte; end; TbmpColorTable = array of TbmpColorTableEnty; TbmpColorTableFormat = class(TFormatDescriptor) private fBitsPerPixel: Integer; fColorTable: TbmpColorTable; protected procedure SetValues; override; public property ColorTable: TbmpColorTable read fColorTable write fColorTable; property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel; procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload; procedure CalcValues; procedure CreateColorTable; procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; destructor Destroy; 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; DEPTH_WEIGHT_R = 0.333333333; DEPTH_WEIGHT_G = 0.333333333; DEPTH_WEIGHT_B = 0.333333333; FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = ( TfdEmpty, TfdAlpha4ub1, TfdAlpha8ub1, TfdAlpha16us1, TfdLuminance4ub1, TfdLuminance8ub1, TfdLuminance16us1, TfdLuminance4Alpha4ub2, TfdLuminance6Alpha2ub2, TfdLuminance8Alpha8ub2, TfdLuminance12Alpha4us2, TfdLuminance16Alpha16us2, TfdR3G3B2ub1, TfdRGBX4us1, TfdXRGB4us1, TfdR5G6B5us1, TfdRGB5X1us1, TfdX1RGB5us1, TfdRGB8ub3, TfdRGBX8ui1, TfdXRGB8ui1, TfdRGB10X2ui1, TfdX2RGB10ui1, TfdRGB16us3, TfdRGBA4us1, TfdARGB4us1, TfdRGB5A1us1, TfdA1RGB5us1, TfdRGBA8ui1, TfdARGB8ui1, TfdRGBA8ub4, TfdRGB10A2ui1, TfdA2RGB10ui1, TfdRGBA16us4, TfdBGRX4us1, TfdXBGR4us1, TfdB5G6R5us1, TfdBGR5X1us1, TfdX1BGR5us1, TfdBGR8ub3, TfdBGRX8ui1, TfdXBGR8ui1, TfdBGR10X2ui1, TfdX2BGR10ui1, TfdBGR16us3, TfdBGRA4us1, TfdABGR4us1, TfdBGR5A1us1, TfdA1BGR5us1, TfdBGRA8ui1, TfdABGR8ui1, TfdBGRA8ub4, TfdBGR10A2ui1, TfdA2BGR10ui1, TfdBGRA16us4, TfdDepth16us1, TfdDepth24ui1, TfdDepth32ui1, TfdS3tcDtx1RGBA, TfdS3tcDtx3RGBA, TfdS3tcDtx5RGBA ); var FormatDescriptorCS: TCriticalSection; FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat); begin inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat); begin inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapPosition(X: Integer; 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 glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean; var i: Integer; begin result := false; for i := 0 to high(r1.arr) do if (r1.arr[i] <> r2.arr[i]) then exit; result := true; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean; var i: Integer; begin result := false; for i := 0 to high(r1.arr) do if (r1.arr[i] <> r2.arr[i]) then exit; result := true; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D; var desc: TFormatDescriptor; p, tmp: PByte; x, y, i: Integer; md: Pointer; px: TglBitmapPixelData; begin result := nil; desc := TFormatDescriptor.Get(aFormat); if (desc.IsCompressed) or (desc.glFormat = 0) then exit; p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel md := desc.CreateMappingData; try tmp := p; desc.PreparePixel(px); for y := 0 to 4 do for x := 0 to 4 do begin px.Data := glBitmapRec4ui(0, 0, 0, 0); for i := 0 to 3 do begin if ((y < 3) and (y = i)) or ((y = 3) and (i < 3)) or ((y = 4) and (i = 3)) then px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x) else if ((y < 4) and (i = 3)) or ((y = 4) and (i < 3)) then px.Data.arr[i] := px.Range.arr[i] else px.Data.arr[i] := 0; //px.Range.arr[i]; end; desc.Map(px, tmp, md); end; finally desc.FreeMappingData(md); end; result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p); result.FreeDataOnDestroy := true; result.FreeDataAfterGenTexture := false; result.SetFilter(GL_NEAREST, GL_NEAREST); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes; begin result := []; if (aFormat in [ //8bpp tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1, //16bpp tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1, tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1, //24bpp tfBGR8ub3, tfRGB8ub3, //32bpp tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1, tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1]) then result := result + [ ftBMP ]; if (aFormat in [ //8bbp tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, //16bbp tfAlpha16us1, tfLuminance16us1, tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1, //24bbp tfBGR8ub3, //32bbp tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1, tfDepth24ui1, tfDepth32ui1]) then result := result + [ftTGA]; if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then result := result + [ftDDS]; {$IFDEF GLB_SUPPORT_PNG_WRITE} if aFormat in [ tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2, tfRGB8ub3, tfRGBA8ui1, tfBGR8ub3, tfBGRA8ui1] then result := result + [ftPNG]; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then result := result + [ftJPEG]; {$ENDIF} end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function IsPowerOfTwo(aNumber: Integer): Boolean; begin while (aNumber and 1) = 0 do aNumber := aNumber shr 1; result := aNumber = 1; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function GetTopMostBit(aBitSet: QWord): Integer; begin result := 0; while aBitSet > 0 do begin inc(result); aBitSet := aBitSet shr 1; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CountSetBits(aBitSet: QWord): Integer; begin result := 0; while aBitSet > 0 do begin if (aBitSet and 1) = 1 then inc(result); aBitSet := aBitSet shr 1; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal; begin result := Trunc( LUMINANCE_WEIGHT_R * aPixel.Data.r + LUMINANCE_WEIGHT_G * aPixel.Data.g + LUMINANCE_WEIGHT_B * aPixel.Data.b); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal; begin result := Trunc( DEPTH_WEIGHT_R * aPixel.Data.r + DEPTH_WEIGHT_G * aPixel.Data.g + DEPTH_WEIGHT_B * aPixel.Data.b); end; {$IFDEF GLB_NATIVE_OGL} ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //OpenGLInitialization/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// var GL_LibHandle: Pointer = nil; function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer; begin if not Assigned(aLibHandle) then aLibHandle := GL_LibHandle; {$IF DEFINED(GLB_WIN)} result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName); if Assigned(result) then exit; if Assigned(wglGetProcAddress) then result := wglGetProcAddress(aProcName); {$ELSEIF DEFINED(GLB_LINUX)} if Assigned(glXGetProcAddress) then begin result := glXGetProcAddress(aProcName); if Assigned(result) then exit; end; if Assigned(glXGetProcAddressARB) then begin result := glXGetProcAddressARB(aProcName); if Assigned(result) then exit; end; result := dlsym(aLibHandle, aProcName); {$IFEND} if not Assigned(result) and aRaiseOnErr then raise EglBitmap.Create('unable to load procedure form library: ' + aProcName); end; {$IFDEF GLB_NATIVE_OGL_DYNAMIC} var GLU_LibHandle: Pointer = nil; OpenGLInitialized: Boolean; InitOpenGLCS: TCriticalSection; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glbInitOpenGL; //////////////////////////////////////////////////////////////////////////////// function glbLoadLibrary(const aName: PChar): Pointer; begin {$IF DEFINED(GLB_WIN)} result := {%H-}Pointer(LoadLibrary(aName)); {$ELSEIF DEFINED(GLB_LINUX)} result := dlopen(Name, RTLD_LAZY); {$ELSE} result := nil; {$IFEND} end; //////////////////////////////////////////////////////////////////////////////// function glbFreeLibrary(const aLibHandle: Pointer): Boolean; begin result := false; if not Assigned(aLibHandle) then exit; {$IF DEFINED(GLB_WIN)} Result := FreeLibrary({%H-}HINST(aLibHandle)); {$ELSEIF DEFINED(GLB_LINUX)} Result := dlclose(aLibHandle) = 0; {$IFEND} end; begin if Assigned(GL_LibHandle) then glbFreeLibrary(GL_LibHandle); if Assigned(GLU_LibHandle) then glbFreeLibrary(GLU_LibHandle); GL_LibHandle := glbLoadLibrary(libopengl); if not Assigned(GL_LibHandle) then raise EglBitmap.Create('unable to load library: ' + libopengl); GLU_LibHandle := glbLoadLibrary(libglu); if not Assigned(GLU_LibHandle) then raise EglBitmap.Create('unable to load library: ' + libglu); {$IF DEFINED(GLB_WIN)} wglGetProcAddress := glbGetProcAddress('wglGetProcAddress'); {$ELSEIF DEFINED(GLB_LINUX)} glXGetProcAddress := glbGetProcAddress('glXGetProcAddress'); glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB'); {$IFEND} glEnable := glbGetProcAddress('glEnable'); glDisable := glbGetProcAddress('glDisable'); glGetString := glbGetProcAddress('glGetString'); glGetIntegerv := glbGetProcAddress('glGetIntegerv'); glTexParameteri := glbGetProcAddress('glTexParameteri'); glTexParameteriv := glbGetProcAddress('glTexParameteriv'); glTexParameterfv := glbGetProcAddress('glTexParameterfv'); glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv'); glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv'); glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv'); glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv'); glTexGeni := glbGetProcAddress('glTexGeni'); glGenTextures := glbGetProcAddress('glGenTextures'); glBindTexture := glbGetProcAddress('glBindTexture'); glDeleteTextures := glbGetProcAddress('glDeleteTextures'); glAreTexturesResident := glbGetProcAddress('glAreTexturesResident'); glReadPixels := glbGetProcAddress('glReadPixels'); glPixelStorei := glbGetProcAddress('glPixelStorei'); glTexImage1D := glbGetProcAddress('glTexImage1D'); glTexImage2D := glbGetProcAddress('glTexImage2D'); glGetTexImage := glbGetProcAddress('glGetTexImage'); gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle); gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle); end; {$ENDIF} ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glbReadOpenGLExtensions; var Buffer: AnsiString; MajorVersion, MinorVersion: Integer; /////////////////////////////////////////////////////////////////////////////////////////// procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer); var Separator: Integer; begin aMinor := 0; aMajor := 0; Separator := Pos(AnsiString('.'), aBuffer); if (Separator > 1) and (Separator < Length(aBuffer)) and (aBuffer[Separator - 1] in ['0'..'9']) and (aBuffer[Separator + 1] in ['0'..'9']) then begin Dec(Separator); while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do Dec(Separator); Delete(aBuffer, 1, Separator); Separator := Pos(AnsiString('.'), aBuffer) + 1; while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do Inc(Separator); Delete(aBuffer, Separator, 255); Separator := Pos(AnsiString('.'), aBuffer); aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1)); aMinor := StrToInt(Copy(String(aBuffer), 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 CheckVersion(const aMajor, aMinor: Integer): Boolean; begin result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor)); end; begin {$IFDEF GLB_NATIVE_OGL_DYNAMIC} InitOpenGLCS.Enter; try if not OpenGLInitialized then begin glbInitOpenGL; OpenGLInitialized := true; end; finally InitOpenGLCS.Leave; end; {$ENDIF} // Version Buffer := glGetString(GL_VERSION); TrimVersionString(Buffer, MajorVersion, MinorVersion); GL_VERSION_1_2 := CheckVersion(1, 2); GL_VERSION_1_3 := CheckVersion(1, 3); GL_VERSION_1_4 := CheckVersion(1, 4); GL_VERSION_2_0 := CheckVersion(2, 0); GL_VERSION_3_3 := CheckVersion(3, 3); // Extensions Buffer := glGetString(GL_EXTENSIONS); GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp'); GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two'); GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle'); GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map'); GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle'); GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat'); GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp'); GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic'); GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle'); GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle'); GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map'); 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'); if GL_VERSION_1_3 then begin glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D'); glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D'); glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage'); end else begin glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false); glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false); glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false); end; end; {$ENDIF} {$IFDEF GLB_SDL_IMAGE} ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // SDL Image Helper ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.'); result^.seek := glBitmapRWseek; result^.read := glBitmapRWread; result^.write := glBitmapRWwrite; result^.close := glBitmapRWclose; result^.unknown.data1 := Stream; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA); begin glDefaultSwizzle[0] := r; glDefaultSwizzle[1] := g; glDefaultSwizzle[2] := b; glDefaultSwizzle[3] := a; end; {$IFEND} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum); begin r := glDefaultSwizzle[0]; g := glDefaultSwizzle[1]; b := glDefaultSwizzle[2]; a := glDefaultSwizzle[3]; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.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 := GetSize(w, h); end else result := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer; begin result := 0; if (aWidth <= 0) or (aHeight <= 0) then exit; result := Ceil(aWidth * aHeight * BytesPerPixel); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.CreateMappingData: Pointer; begin result := nil; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer); begin //DUMMY end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.IsEmpty: Boolean; begin result := (fFormat = tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean; var i: Integer; m: TglBitmapRec4ul; begin result := false; if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then raise EglBitmap.Create('FormatCheckFormat - All Masks are 0'); m := Mask; for i := 0 to 3 do if (aMask.arr[i] <> m.arr[i]) then exit; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData); begin FillChar(aPixel{%H-}, SizeOf(aPixel), 0); aPixel.Data := Range; aPixel.Format := fFormat; aPixel.Range := Range; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TFormatDescriptor.Create; begin inherited Create; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.a; inc(aData); end; procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := 0; aPixel.Data.g := 0; aPixel.Data.b := 0; aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := LuminanceWeight(aPixel); inc(aData); end; procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := aData^; aPixel.Data.g := aData^; aPixel.Data.b := aData^; aPixel.Data.a := 0; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin aData^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData); end; procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i]; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminanceAlpha_UB2/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB_UB3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.r; inc(aData); aData^ := aPixel.Data.g; inc(aData); aData^ := aPixel.Data.b; inc(aData); end; procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := aData^; inc(aData); aPixel.Data.g := aData^; inc(aData); aPixel.Data.b := aData^; inc(aData); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_UB3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.b; inc(aData); aData^ := aPixel.Data.g; inc(aData); aData^ := aPixel.Data.r; inc(aData); end; procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.b := aData^; inc(aData); aPixel.Data.g := aData^; inc(aData); aPixel.Data.r := aData^; inc(aData); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA_UB4////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA_UB4////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := 0; aPixel.Data.g := 0; aPixel.Data.b := 0; aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := LuminanceWeight(aPixel); inc(aData, 2); end; procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; aPixel.Data.g := PWord(aData)^; aPixel.Data.b := PWord(aData)^; aPixel.Data.a := 0; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PWord(aData)^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData, 2); end; procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := DepthWeight(aPixel); inc(aData, 2); end; procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; aPixel.Data.g := PWord(aData)^; aPixel.Data.b := PWord(aData)^; aPixel.Data.a := PWord(aData)^;; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminanceAlpha_US2/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB_US3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.r; inc(aData, 2); PWord(aData)^ := aPixel.Data.g; inc(aData, 2); PWord(aData)^ := aPixel.Data.b; inc(aData, 2); end; procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; inc(aData, 2); aPixel.Data.g := PWord(aData)^; inc(aData, 2); aPixel.Data.b := PWord(aData)^; inc(aData, 2); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_US3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.b; inc(aData, 2); PWord(aData)^ := aPixel.Data.g; inc(aData, 2); PWord(aData)^ := aPixel.Data.r; inc(aData, 2); end; procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.b := PWord(aData)^; inc(aData, 2); aPixel.Data.g := PWord(aData)^; inc(aData, 2); aPixel.Data.r := PWord(aData)^; inc(aData, 2); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdARGB_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); inherited Map(aPixel, aData, aMapData); end; procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.a := PWord(aData)^; inc(aData, 2); inherited Unmap(aData, aPixel, aMapData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdABGR_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); inherited Map(aPixel, aData, aMapData); end; procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.a := PWord(aData)^; inc(aData, 2); inherited Unmap(aData, aPixel, aMapData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PCardinal(aData)^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData, 4); end; procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PCardinal(aData)^ := DepthWeight(aPixel); inc(aData, 4); end; procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PCardinal(aData)^; aPixel.Data.g := PCardinal(aData)^; aPixel.Data.b := PCardinal(aData)^; aPixel.Data.a := PCardinal(aData)^; inc(aData, 4); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlpha4ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfAlpha4ub1; fWithAlpha := tfAlpha4ub1; fPrecision := glBitmapRec4ub(0, 0, 0, 8); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfAlpha4ub1; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfAlpha8ub1; {$ENDIF} end; procedure TfdAlpha8ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfAlpha8ub1; fWithAlpha := tfAlpha8ub1; fPrecision := glBitmapRec4ub(0, 0, 0, 8); fShift := glBitmapRec4ub(0, 0, 0, 0); fOpenGLFormat := tfAlpha8ub1; fglFormat := GL_ALPHA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdAlpha16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfAlpha16us1; fWithAlpha := tfAlpha16us1; fPrecision := glBitmapRec4ub(0, 0, 0, 16); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfAlpha16us1; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfAlpha8ub1; {$ENDIF} end; procedure TfdLuminance4ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfLuminance4ub1; fWithAlpha := tfLuminance4Alpha4ub2; fWithoutAlpha := tfLuminance4ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance4ub1; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8ub1; {$ENDIF} end; procedure TfdLuminance8ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfLuminance8ub1; fWithAlpha := tfLuminance8Alpha8ub2; fWithoutAlpha := tfLuminance8ub1; fOpenGLFormat := tfLuminance8ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 0, 0, 0); fglFormat := GL_LUMINANCE; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdLuminance16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance16us1; fWithAlpha := tfLuminance16Alpha16us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance16us1; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8ub1; {$ENDIF} end; procedure TfdLuminance4Alpha4ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance4Alpha4ub2; fWithAlpha := tfLuminance4Alpha4ub2; fWithoutAlpha := tfLuminance4ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance4Alpha4ub2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE4_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance6Alpha2ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance6Alpha2ub2; fWithAlpha := tfLuminance6Alpha2ub2; fWithoutAlpha := tfLuminance8ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance6Alpha2ub2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE6_ALPHA2; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance8Alpha8ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance8Alpha8ub2; fWithAlpha := tfLuminance8Alpha8ub2; fWithoutAlpha := tfLuminance8ub1; fOpenGLFormat := tfLuminance8Alpha8ub2; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdLuminance12Alpha4us2.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfLuminance12Alpha4us2; fWithAlpha := tfLuminance12Alpha4us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 16); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance12Alpha4us2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE12_ALPHA4; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance16Alpha16us2.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfLuminance16Alpha16us2; fWithAlpha := tfLuminance16Alpha16us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 16); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance16Alpha16us2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE16_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdR3G3B2ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfR3G3B2ub1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfR3G3B2ub1; fRGBInverted := tfEmpty; fPrecision := glBitmapRec4ub(3, 3, 2, 0); fShift := glBitmapRec4ub(5, 2, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfR3G3B2ub1; fglFormat := GL_RGB; fglInternalFormat := GL_R3_G3_B2; fglDataFormat := GL_UNSIGNED_BYTE_3_3_2; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdRGBX4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGBX4us1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfRGBX4us1; fRGBInverted := tfBGRX4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub(12, 8, 4, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBX4us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdXRGB4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfXRGB4us1; fWithAlpha := tfARGB4us1; fWithoutAlpha := tfXRGB4us1; fRGBInverted := tfXBGR4us1; fPrecision := glBitmapRec4ub(4, 4, 4, 0); fShift := glBitmapRec4ub(8, 4, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXRGB4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdR5G6B5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfR5G6B5us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfR5G6B5us1; fRGBInverted := tfB5G6R5us1; fPrecision := glBitmapRec4ub( 5, 6, 5, 0); fShift := glBitmapRec4ub(11, 5, 0, 0); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfR5G6B5us1; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$IFEND} end; procedure TfdRGB5X1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGB5X1us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfRGB5X1us1; fRGBInverted := tfBGR5X1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub(11, 6, 1, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB5X1us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdX1RGB5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfX1RGB5us1; fWithAlpha := tfA1RGB5us1; fWithoutAlpha := tfX1RGB5us1; fRGBInverted := tfX1BGR5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub(10, 5, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX1RGB5us1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdRGB8ub3.SetValues; begin inherited SetValues; fBitsPerPixel := 24; fFormat := tfRGB8ub3; fWithAlpha := tfRGBA8ub4; fWithoutAlpha := tfRGB8ub3; fRGBInverted := tfBGR8ub3; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 8, 16, 0); fOpenGLFormat := tfRGB8ub3; fglFormat := GL_RGB; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdRGBX8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBX8ui1; fWithAlpha := tfRGBA8ui1; fWithoutAlpha := tfRGBX8ui1; fRGBInverted := tfBGRX8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(24, 16, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBX8ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdXRGB8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfXRGB8ui1; fWithAlpha := tfXRGB8ui1; fWithoutAlpha := tfXRGB8ui1; fOpenGLFormat := tfXRGB8ui1; fRGBInverted := tfXBGR8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(16, 8, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXRGB8ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdRGB10X2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGB10X2ui1; fWithAlpha := tfRGB10A2ui1; fWithoutAlpha := tfRGB10X2ui1; fRGBInverted := tfBGR10X2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub(22, 12, 2, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB10X2ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdX2RGB10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfX2RGB10ui1; fWithAlpha := tfA2RGB10ui1; fWithoutAlpha := tfX2RGB10ui1; fRGBInverted := tfX2BGR10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub(20, 10, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX2RGB10ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdRGB16us3.SetValues; begin inherited SetValues; fBitsPerPixel := 48; fFormat := tfRGB16us3; fWithAlpha := tfRGBA16us4; fWithoutAlpha := tfRGB16us3; fRGBInverted := tfBGR16us3; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub( 0, 16, 32, 0); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfRGB16us3; fglFormat := GL_RGB; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF}; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$IFEND} end; procedure TfdRGBA4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGBA4us1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfRGBX4us1; fOpenGLFormat := tfRGBA4us1; fRGBInverted := tfBGRA4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub(12, 8, 4, 0); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; procedure TfdARGB4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfARGB4us1; fWithAlpha := tfARGB4us1; fWithoutAlpha := tfXRGB4us1; fRGBInverted := tfABGR4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 8, 4, 0, 12); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfARGB4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdRGB5A1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGB5A1us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfRGB5X1us1; fOpenGLFormat := tfRGB5A1us1; fRGBInverted := tfBGR5A1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub(11, 6, 1, 0); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; procedure TfdA1RGB5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfA1RGB5us1; fWithAlpha := tfA1RGB5us1; fWithoutAlpha := tfX1RGB5us1; fRGBInverted := tfA1BGR5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub(10, 5, 0, 15); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA1RGB5us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdRGBA8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBA8ui1; fWithAlpha := tfRGBA8ui1; fWithoutAlpha := tfRGBX8ui1; fRGBInverted := tfBGRA8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(24, 16, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBA8ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdARGB8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfARGB8ui1; fWithAlpha := tfARGB8ui1; fWithoutAlpha := tfXRGB8ui1; fRGBInverted := tfABGR8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(16, 8, 0, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfARGB8ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdRGBA8ub4.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBA8ub4; fWithAlpha := tfRGBA8ub4; fWithoutAlpha := tfRGB8ub3; fOpenGLFormat := tfRGBA8ub4; fRGBInverted := tfBGRA8ub4; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 0, 8, 16, 24); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdRGB10A2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGB10A2ui1; fWithAlpha := tfRGB10A2ui1; fWithoutAlpha := tfRGB10X2ui1; fRGBInverted := tfBGR10A2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub(22, 12, 2, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB10A2ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdA2RGB10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfA2RGB10ui1; fWithAlpha := tfA2RGB10ui1; fWithoutAlpha := tfX2RGB10ui1; fRGBInverted := tfA2BGR10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub(20, 10, 0, 30); {$IF NOT DEFINED(OPENGL_ES)} fOpenGLFormat := tfA2RGB10ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSEIF DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfA2RGB10ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGBA8ui1; {$IFEND} end; procedure TfdRGBA16us4.SetValues; begin inherited SetValues; fBitsPerPixel := 64; fFormat := tfRGBA16us4; fWithAlpha := tfRGBA16us4; fWithoutAlpha := tfRGB16us3; fRGBInverted := tfBGRA16us4; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 16, 32, 48); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfRGBA16us4; fglFormat := GL_RGBA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF}; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$IFEND} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRX4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGRX4us1; fWithAlpha := tfBGRA4us1; fWithoutAlpha := tfBGRX4us1; fRGBInverted := tfRGBX4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub( 4, 8, 12, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRX4us1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdXBGR4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfXBGR4us1; fWithAlpha := tfABGR4us1; fWithoutAlpha := tfXBGR4us1; fRGBInverted := tfXRGB4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub( 0, 4, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXBGR4us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdB5G6R5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfB5G6R5us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfB5G6R5us1; fRGBInverted := tfR5G6B5us1; fPrecision := glBitmapRec4ub( 5, 6, 5, 0); fShift := glBitmapRec4ub( 0, 5, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfB5G6R5us1; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdBGR5X1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGR5X1us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfBGR5X1us1; fRGBInverted := tfRGB5X1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub( 1, 6, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR5X1us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdX1BGR5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfX1BGR5us1; fWithAlpha := tfA1BGR5us1; fWithoutAlpha := tfX1BGR5us1; fRGBInverted := tfX1RGB5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub( 0, 5, 10, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX1BGR5us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdBGR8ub3.SetValues; begin inherited SetValues; fBitsPerPixel := 24; fFormat := tfBGR8ub3; fWithAlpha := tfBGRA8ub4; fWithoutAlpha := tfBGR8ub3; fRGBInverted := tfRGB8ub3; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(16, 8, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR8ub3; fglFormat := GL_BGR; fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdBGRX8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRX8ui1; fWithAlpha := tfBGRA8ui1; fWithoutAlpha := tfBGRX8ui1; fRGBInverted := tfRGBX8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub( 8, 16, 24, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRX8ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdXBGR8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfXBGR8ui1; fWithAlpha := tfABGR8ui1; fWithoutAlpha := tfXBGR8ui1; fRGBInverted := tfXRGB8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub( 0, 8, 16, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXBGR8ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdBGR10X2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGR10X2ui1; fWithAlpha := tfBGR10A2ui1; fWithoutAlpha := tfBGR10X2ui1; fRGBInverted := tfRGB10X2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub( 2, 12, 22, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR10X2ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdX2BGR10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfX2BGR10ui1; fWithAlpha := tfA2BGR10ui1; fWithoutAlpha := tfX2BGR10ui1; fRGBInverted := tfX2RGB10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub( 0, 10, 20, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX2BGR10ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdBGR16us3.SetValues; begin inherited SetValues; fBitsPerPixel := 48; fFormat := tfBGR16us3; fWithAlpha := tfBGRA16us4; fWithoutAlpha := tfBGR16us3; fRGBInverted := tfRGB16us3; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub(32, 16, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR16us3; fglFormat := GL_BGR; fglInternalFormat := GL_RGB16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdBGRA4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGRA4us1; fWithAlpha := tfBGRA4us1; fWithoutAlpha := tfBGRX4us1; fRGBInverted := tfRGBA4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 4, 8, 12, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdABGR4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfABGR4us1; fWithAlpha := tfABGR4us1; fWithoutAlpha := tfXBGR4us1; fRGBInverted := tfARGB4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 0, 4, 8, 12); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfABGR4us1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdBGR5A1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGR5A1us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfBGR5X1us1; fRGBInverted := tfRGB5A1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub( 1, 6, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR5A1us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdA1BGR5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfA1BGR5us1; fWithAlpha := tfA1BGR5us1; fWithoutAlpha := tfX1BGR5us1; fRGBInverted := tfA1RGB5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub( 0, 5, 10, 15); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA1BGR5us1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdBGRA8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRA8ui1; fWithAlpha := tfBGRA8ui1; fWithoutAlpha := tfBGRX8ui1; fRGBInverted := tfRGBA8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 8, 16, 24, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA8ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdABGR8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfABGR8ui1; fWithAlpha := tfABGR8ui1; fWithoutAlpha := tfXBGR8ui1; fRGBInverted := tfARGB8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 0, 8, 16, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfABGR8ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGBA8ub4 {$ENDIF} end; procedure TfdBGRA8ub4.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRA8ub4; fWithAlpha := tfBGRA8ub4; fWithoutAlpha := tfBGR8ub3; fRGBInverted := tfRGBA8ub4; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(16, 8, 0, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA8ub4; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdBGR10A2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGR10A2ui1; fWithAlpha := tfBGR10A2ui1; fWithoutAlpha := tfBGR10X2ui1; fRGBInverted := tfRGB10A2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub( 2, 12, 22, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR10A2ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdA2BGR10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfA2BGR10ui1; fWithAlpha := tfA2BGR10ui1; fWithoutAlpha := tfX2BGR10ui1; fRGBInverted := tfA2RGB10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub( 0, 10, 20, 30); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA2BGR10ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdBGRA16us4.SetValues; begin inherited SetValues; fBitsPerPixel := 64; fFormat := tfBGRA16us4; fWithAlpha := tfBGRA16us4; fWithoutAlpha := tfBGR16us3; fRGBInverted := tfRGBA16us4; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub(32, 16, 0, 48); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA16us4; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGBA16us4; {$ENDIF} end; procedure TfdDepth16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfDepth16us1; fWithoutAlpha := tfDepth16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfDepth16us1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT16; fglDataFormat := GL_UNSIGNED_SHORT; {$IFEND} end; procedure TfdDepth24ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfDepth24ui1; fWithoutAlpha := tfDepth24ui1; fOpenGLFormat := tfDepth24ui1; fPrecision := glBitmapRec4ub(32, 32, 32, 32); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfDepth24ui1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT24; fglDataFormat := GL_UNSIGNED_INT; {$IFEND} end; procedure TfdDepth32ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfDepth32ui1; fWithoutAlpha := tfDepth32ui1; fPrecision := glBitmapRec4ub(32, 32, 32, 32); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED(OPENGL_ES)} fOpenGLFormat := tfDepth32ui1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT32; fglDataFormat := GL_UNSIGNED_INT; {$ELSEIF DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfDepth24ui1; {$ELSEIF DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfDepth16us1; {$IFEND} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx1RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx1RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx1RGBA; fWithAlpha := tfS3tcDtx1RGBA; fUncompressed := tfRGB5A1us1; fBitsPerPixel := 4; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx1RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx3RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx3RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8ub4; fBitsPerPixel := 8; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx3RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx5RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx5RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8ub4; fBitsPerPixel := 8; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx3RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmapFormatDescriptor.GetHasRed: Boolean; begin result := (fPrecision.r > 0); end; function TglBitmapFormatDescriptor.GetHasGreen: Boolean; begin result := (fPrecision.g > 0); end; function TglBitmapFormatDescriptor.GetHasBlue: Boolean; begin result := (fPrecision.b > 0); end; function TglBitmapFormatDescriptor.GetHasAlpha: Boolean; begin result := (fPrecision.a > 0); end; function TglBitmapFormatDescriptor.GetHasColor: Boolean; begin result := HasRed or HasGreen or HasBlue; end; function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean; begin result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapFormatDescriptor.SetValues; begin fFormat := tfEmpty; fWithAlpha := tfEmpty; fWithoutAlpha := tfEmpty; fOpenGLFormat := tfEmpty; fRGBInverted := tfEmpty; fUncompressed := tfEmpty; fBitsPerPixel := 0; fIsCompressed := false; fglFormat := 0; fglInternalFormat := 0; fglDataFormat := 0; FillChar(fPrecision, 0, SizeOf(fPrecision)); FillChar(fShift, 0, SizeOf(fShift)); end; procedure TglBitmapFormatDescriptor.CalcValues; var i: Integer; begin fBytesPerPixel := fBitsPerPixel / 8; fChannelCount := 0; for i := 0 to 3 do begin if (fPrecision.arr[i] > 0) then inc(fChannelCount); fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1; fMask.arr[i] := fRange.arr[i] shl fShift.arr[i]; end; end; constructor TglBitmapFormatDescriptor.Create; begin inherited Create; SetValues; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; var f: TglBitmapFormat; begin for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin result := TFormatDescriptor.Get(f); if (result.glInternalFormat = aInternalFormat) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Init; begin if not Assigned(FormatDescriptorCS) then FormatDescriptorCS := TCriticalSection.Create; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor; begin FormatDescriptorCS.Enter; try result := FormatDescriptors[aFormat]; if not Assigned(result) then begin result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create; FormatDescriptors[aFormat] := result; end; finally FormatDescriptorCS.Leave; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor; begin result := Get(Get(aFormat).WithAlpha); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor; var ft: TglBitmapFormat; begin // find matching format with OpenGL support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if (result.MaskMatch(aMask)) and (result.glFormat <> 0) and (result.glInternalFormat <> 0) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; // find matching format without OpenGL Support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor; var ft: TglBitmapFormat; begin // find matching format with OpenGL support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if glBitmapRec4ubCompare(result.Shift, aShift) and glBitmapRec4ubCompare(result.Precision, aPrec) and (result.glFormat <> 0) and (result.glInternalFormat <> 0) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; // find matching format without OpenGL Support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if glBitmapRec4ubCompare(result.Shift, aShift) and glBitmapRec4ubCompare(result.Precision, aPrec) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Clear; var f: TglBitmapFormat; begin FormatDescriptorCS.Enter; try for f := low(FormatDescriptors) to high(FormatDescriptors) do FreeAndNil(FormatDescriptors[f]); finally FormatDescriptorCS.Leave; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Finalize; begin Clear; FreeAndNil(FormatDescriptorCS); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TBitfieldFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); var i: Integer; begin for i := 0 to 3 do begin fShift.arr[i] := 0; while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin aMask.arr[i] := aMask.arr[i] shr 1; inc(fShift.arr[i]); end; fPrecision.arr[i] := CountSetBits(aMask.arr[i]); end; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); begin fBitsPerPixel := aBBP; fPrecision := aPrec; fShift := aShift; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var data: QWord; begin data := ((aPixel.Data.r and Range.r) shl Shift.r) or ((aPixel.Data.g and Range.g) shl Shift.g) or ((aPixel.Data.b and Range.b) shl Shift.b) or ((aPixel.Data.a and Range.a) shl Shift.a); case BitsPerPixel of 8: aData^ := data; 16: PWord(aData)^ := data; 32: PCardinal(aData)^ := data; 64: PQWord(aData)^ := data; else raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]); end; inc(aData, Round(BytesPerPixel)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var data: QWord; i: Integer; begin case BitsPerPixel of 8: data := aData^; 16: data := PWord(aData)^; 32: data := PCardinal(aData)^; 64: data := PQWord(aData)^; else raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]); end; for i := 0 to 3 do aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i]; inc(aData, Round(BytesPerPixel)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TColorTableFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.SetValues; begin inherited SetValues; fShift := glBitmapRec4ub(8, 8, 8, 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); begin fFormat := aFormat; fBitsPerPixel := aBPP; fPrecision := aPrec; fShift := aShift; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.CalcValues; begin inherited CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.CreateColorTable; var i: Integer; begin SetLength(fColorTable, 256); if not HasColor then begin // alpha for i := 0 to High(fColorTable) do begin fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].a := 0; end; end else begin // normal for i := 0 to High(fColorTable) do begin fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255); fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255); fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255); fColorTable[i].a := 0; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin if (BitsPerPixel <> 8) then raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats'); if not HasColor then // alpha aData^ := aPixel.Data.a else // normal aData^ := Round( ((aPixel.Data.r and Range.r) shl Shift.r) or ((aPixel.Data.g and Range.g) shl Shift.g) or ((aPixel.Data.b and Range.b) shl Shift.b)); inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin if (BitsPerPixel <> 8) then raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats'); with fColorTable[aData^] do begin aPixel.Data.r := r; aPixel.Data.g := g; aPixel.Data.b := b; aPixel.Data.a := a; end; inc(aData, 1); end; destructor TbmpColorTableFormat.Destroy; begin SetLength(fColorTable, 0); inherited Destroy; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor); var i: Integer; begin for i := 0 to 3 do begin if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin if (aSourceFD.Range.arr[i] > 0) then aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i]) else aPixel.Data.arr[i] := 0; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin if (Source.Range.r > 0) then Dest.Data.r := Source.Data.r; if (Source.Range.g > 0) then Dest.Data.g := Source.Data.g; if (Source.Range.b > 0) then Dest.Data.b := Source.Data.b; if (Source.Range.a > 0) then Dest.Data.a := Source.Data.a; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do begin for i := 0 to 3 do if (Source.Range.arr[i] > 0) then Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]); end; end; type TShiftData = packed record case Integer of 0: (r, g, b, a: SmallInt); 1: (arr: array[0..3] of SmallInt); end; PShiftData = ^TShiftData; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do for i := 0 to 3 do if (Source.Range.arr[i] > 0) then Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i]; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin Dest.Data := Source.Data; if ({%H-}PtrUInt(Args) and $1 > 0) then begin Dest.Data.r := Dest.Data.r xor Dest.Range.r; Dest.Data.g := Dest.Data.g xor Dest.Range.g; Dest.Data.b := Dest.Data.b xor Dest.Range.b; end; if ({%H-}PtrUInt(Args) and $2 > 0) then begin Dest.Data.a := Dest.Data.a xor Dest.Range.a; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do begin for i := 0 to 3 do Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i]; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec); var Temp: Single; begin with FuncRec do begin if (FuncRec.Args = nil) then begin //source has no alpha Temp := Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R + Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G + Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B; Dest.Data.a := Round(Dest.Range.a * Temp); end else Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec); type PglBitmapPixelData = ^TglBitmapPixelData; begin with FuncRec do begin Dest.Data.r := Source.Data.r; Dest.Data.g := Source.Data.g; Dest.Data.b := Source.Data.b; with PglBitmapPixelData(Args)^ do if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then Dest.Data.a := 0 else Dest.Data.a := Dest.Range.a; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec); begin with FuncRec do begin Dest.Data.r := Source.Data.r; Dest.Data.g := Source.Data.g; Dest.Data.b := Source.Data.b; Dest.Data.a := PCardinal(Args)^; 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/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor; begin result := TFormatDescriptor.Get(Format); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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.SetFreeDataOnDestroy(const aValue: Boolean); begin if fFreeDataOnDestroy = aValue then exit; fFreeDataOnDestroy := 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 TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then raise EglBitmapUnsupportedFormat.Create(Format); SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method 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); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)} var MaxAnisotropic: Integer; {$IFEND} begin fAnisotropic := aValue; if (ID > 0) then begin {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)} 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; {$ELSE} fAnisotropic := 0; {$IFEND} end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.CreateID; begin if (ID <> 0) then glDeleteTextures(1, @fID); glGenTextures(1, @fID); Bind(false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF}); begin // Set Up Parameters SetWrap(fWrapS, fWrapT, fWrapR); SetFilter(fFilterMin, fFilterMag); SetAnisotropic(fAnisotropic); {$IFNDEF OPENGL_ES} SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]); if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]); {$ENDIF} {$IFNDEF OPENGL_ES} // 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; {$ELSE} if (MipMap = mmMipmap) then glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE); {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDataPointer(var 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; if not Assigned(fData) then begin fPixelSize := 0; fRowSize := 0; end else begin FillChar(fDimension, SizeOf(fDimension), 0); 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 := TFormatDescriptor.Get(aFormat).BytesPerPixel; 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; {$IFNDEF OPENGL_ES} fIsResident := false; {$ENDIF} fMipMap := glBitmapDefaultMipmap; fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture; fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree; glBitmapGetDefaultFilter (fFilterMin, fFilterMag); glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR); {$IFNDEF OPENGL_ES} glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]); {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.BeforeDestruction; var NewData: PByte; begin if fFreeDataOnDestroy then begin NewData := nil; SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method end; if (fID > 0) and fDeleteTextureOnFree then glDeleteTextures(1, @fID); inherited BeforeDestruction; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar); var TempPos: Integer; begin if not Assigned(aResType) then begin TempPos := Pos('.', aResource); aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos))); aResource := UpperCase(Copy(aResource, 0, TempPos -1)); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromFile(const aFilename: String); var fs: TFileStream; begin if not FileExists(aFilename) then raise EglBitmap.Create('file does not exist: ' + aFilename); 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 if not LoadRAW(aStream) then raise EglBitmap.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: Pointer); var tmpData: PByte; size: Integer; begin size := TFormatDescriptor.Get(aFormat).GetSize(aSize); GetMem(tmpData, size); try FillChar(tmpData^, size, #$FF); SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method except if Assigned(tmpData) then FreeMem(tmpData); raise; end; AddFunc(Self, aFunc, false, aFormat, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar); var rs: TResourceStream; begin PrepareResType(aResource, aResType); rs := TResourceStream.Create(aInstance, aResource, aResType); try LoadFromStream(rs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); var rs: TResourceStream; begin rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType); try LoadFromStream(rs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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); ftRAW: SaveRAW(aStream); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): 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: Pointer): Boolean; var DestData, TmpData, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TFormatDescriptor; SourceMD, DestMD: Pointer; 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 := TFormatDescriptor.Get(aSource.Format); DestFD := TFormatDescriptor.Get(aFormat); if (SourceFD.IsCompressed) then raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format); if (DestFD.IsCompressed) then raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format); // inkompatible Formats so CreateTemp if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) 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, DestFD.GetSize(TempWidth, TempHeight)); DestData := TmpData; end else DestData := Data; try SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); SourceMD := SourceFD.CreateMappingData; DestMD := DestFD.CreateMappingData; FuncRec.Size := aSource.Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; try 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, SourceMD); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData, DestMD); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; // Updating Image or InternalFormat if aCreateTemp then SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method else if (aFormat <> fFormat) then Format := aFormat; result := true; finally SourceFD.FreeMappingData(SourceMD); DestFD.FreeMappingData(DestMD); end; except if aCreateTemp and Assigned(TmpData) 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; FormatDesc: TFormatDescriptor; function GetRowPointer(Row: Integer): pByte; begin result := aSurface.pixels; Inc(result, Row * RowSize); end; begin result := false; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed then raise EglBitmapUnsupportedFormat.Create(Format); if Assigned(Data) then begin case Trunc(FormatDesc.PixelSize) of 1: TempDepth := 8; 2: TempDepth := 16; 3: TempDepth := 24; 4: TempDepth := 32; else raise EglBitmapUnsupportedFormat.Create(Format); end; aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask); SourceData := Data; RowSize := FormatDesc.GetSize(FileWidth, 1); 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: TglBitmapFormat; fd: TFormatDescriptor; Mask: TglBitmapMask; function GetRowPointer(Row: Integer): pByte; begin result := aSurface^.pixels; Inc(result, Row * RowSize); end; begin result := false; if (Assigned(aSurface)) then begin with aSurface^.format^ do begin Mask.r := RMask; Mask.g := GMask; Mask.b := BMask; Mask.a := AMask; IntFormat := TFormatDescriptor.GetFromMask(Mask).Format; if (IntFormat = tfEmpty) then raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.'); end; fd := TFormatDescriptor.Get(IntFormat); TempWidth := aSurface^.w; TempHeight := aSurface^.h; RowSize := fd.GetSize(TempWidth, 1); 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); //be careful, Data could be freed by this method result := true; except if Assigned(pData) then 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 [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0); AlphaInterleave := 0; case Format of tfLuminance8Alpha8ub2: AlphaInterleave := 1; tfBGRA8ub4, tfRGBA8ub4: 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 = nil; const aArgs: Pointer = nil): Boolean; var bmp: TglBitmap2D; begin bmp := TglBitmap2D.Create; try bmp.AssignFromSurface(aSurface); result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs); finally bmp.Free; end; end; {$ENDIF} {$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; for Idx := 0 to Pal.palNumEntries - 1 do begin Pal.palPalEntry[Idx].peRed := Idx; Pal.palPalEntry[Idx].peGreen := Idx; Pal.palPalEntry[Idx].peBlue := Idx; Pal.palPalEntry[Idx].peFlags := 0; end; Result := CreatePalette(Pal^); FreeMem(Pal); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 tfAlpha8ub1, tfLuminance8ub1: begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; end; tfRGB5A1us1: aBitmap.PixelFormat := pf15bit; tfR5G6B5us1: aBitmap.PixelFormat := pf16bit; tfRGB8ub3, tfBGR8ub3: aBitmap.PixelFormat := pf24bit; tfRGBA8ub4, tfBGRA8ub4: aBitmap.PixelFormat := pf32bit; else raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.'); end; pSource := Data; for Row := 0 to FileHeight -1 do begin pData := aBitmap.Scanline[Row]; Move(pSource^, pData^, fRowSize); Inc(pSource, fRowSize); if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A) SwapRGB(pData, FileWidth, Format = tfRGBA8ub4); end; result := true; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; IntFormat: TglBitmapFormat; begin result := false; if (Assigned(aBitmap)) then begin case aBitmap.PixelFormat of pf8bit: IntFormat := tfLuminance8ub1; pf15bit: IntFormat := tfRGB5A1us1; pf16bit: IntFormat := tfR5G6B5us1; pf24bit: IntFormat := tfBGR8ub3; pf32bit: IntFormat := tfBGRA8ub4; else raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.'); end; TempWidth := aBitmap.Width; TempHeight := aBitmap.Height; RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1); GetMem(pData, TempHeight * RowSize); try pTempData := pData; for Row := 0 to TempHeight -1 do begin pSource := aBitmap.Scanline[Row]; if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(pData) then 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 (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin if Assigned(aBitmap) then begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; aBitmap.Width := Width; aBitmap.Height := Height; case Format of tfLuminance8Alpha8ub2: AlphaInterleave := 1; tfRGBA8ub4, tfBGRA8ub4: AlphaInterleave := 3; else AlphaInterleave := 0; end; // Copy Data pSource := Data; for Row := 0 to Height -1 do begin pDest := aBitmap.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: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try tex.AssignFromBitmap(ABitmap); result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; {$ENDIF} {$IFDEF GLB_LAZARUS} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean; var rid: TRawImageDescription; FormatDesc: TFormatDescriptor; begin if not Assigned(Data) then raise EglBitmap.Create('no pixel data assigned. load data before save'); result := false; if not Assigned(aImage) or (Format = tfEmpty) then exit; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed then exit; FillChar(rid{%H-}, SizeOf(rid), 0); if FormatDesc.IsGrayscale then rid.Format := ricfGray else rid.Format := ricfRGBA; rid.Width := Width; rid.Height := Height; rid.Depth := FormatDesc.BitsPerPixel; rid.BitOrder := riboBitsInOrder; rid.ByteOrder := riboLSBFirst; rid.LineOrder := riloTopToBottom; rid.LineEnd := rileTight; rid.BitsPerPixel := FormatDesc.BitsPerPixel; rid.RedPrec := CountSetBits(FormatDesc.Range.r); rid.GreenPrec := CountSetBits(FormatDesc.Range.g); rid.BluePrec := CountSetBits(FormatDesc.Range.b); rid.AlphaPrec := CountSetBits(FormatDesc.Range.a); rid.RedShift := FormatDesc.Shift.r; rid.GreenShift := FormatDesc.Shift.g; rid.BlueShift := FormatDesc.Shift.b; rid.AlphaShift := FormatDesc.Shift.a; rid.MaskBitsPerPixel := 0; rid.PaletteColorCount := 0; aImage.DataDescription := rid; aImage.CreateData; if not Assigned(aImage.PixelData) then raise EglBitmap.Create('error while creating LazIntfImage'); Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension)); result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean; var f: TglBitmapFormat; FormatDesc: TFormatDescriptor; ImageData: PByte; ImageSize: Integer; CanCopy: Boolean; Mask: TglBitmapRec4ul; procedure CopyConvert; var bfFormat: TbmpBitfieldFormat; pSourceLine, pDestLine: PByte; pSourceMD, pDestMD: Pointer; Shift, Prec: TglBitmapRec4ub; x, y: Integer; pixel: TglBitmapPixelData; begin bfFormat := TbmpBitfieldFormat.Create; with aImage.DataDescription do begin Prec.r := RedPrec; Prec.g := GreenPrec; Prec.b := BluePrec; Prec.a := AlphaPrec; Shift.r := RedShift; Shift.g := GreenShift; Shift.b := BlueShift; Shift.a := AlphaShift; bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift); end; pSourceMD := bfFormat.CreateMappingData; pDestMD := FormatDesc.CreateMappingData; try for y := 0 to aImage.Height-1 do begin pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine; pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width); for x := 0 to aImage.Width-1 do begin bfFormat.Unmap(pSourceLine, pixel, pSourceMD); FormatDesc.Map(pixel, pDestLine, pDestMD); end; end; finally FormatDesc.FreeMappingData(pDestMD); bfFormat.FreeMappingData(pSourceMD); bfFormat.Free; end; end; begin result := false; if not Assigned(aImage) then exit; with aImage.DataDescription do begin Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift; Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift; Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift; Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift; end; FormatDesc := TFormatDescriptor.GetFromMask(Mask); f := FormatDesc.Format; if (f = tfEmpty) then exit; CanCopy := (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth); ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height); ImageData := GetMem(ImageSize); try if CanCopy then Move(aImage.PixelData^, ImageData^, ImageSize) else CopyConvert; SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method except if Assigned(ImageData) then FreeMem(ImageData); raise; end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean; var rid: TRawImageDescription; FormatDesc: TFormatDescriptor; Pixel: TglBitmapPixelData; x, y: Integer; srcMD: Pointer; src, dst: PByte; begin result := false; if not Assigned(aImage) or (Format = tfEmpty) then exit; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then exit; FillChar(rid{%H-}, SizeOf(rid), 0); rid.Format := ricfGray; rid.Width := Width; rid.Height := Height; rid.Depth := CountSetBits(FormatDesc.Range.a); rid.BitOrder := riboBitsInOrder; rid.ByteOrder := riboLSBFirst; rid.LineOrder := riloTopToBottom; rid.LineEnd := rileTight; rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8); rid.RedPrec := CountSetBits(FormatDesc.Range.a); rid.GreenPrec := 0; rid.BluePrec := 0; rid.AlphaPrec := 0; rid.RedShift := 0; rid.GreenShift := 0; rid.BlueShift := 0; rid.AlphaShift := 0; rid.MaskBitsPerPixel := 0; rid.PaletteColorCount := 0; aImage.DataDescription := rid; aImage.CreateData; srcMD := FormatDesc.CreateMappingData; try FormatDesc.PreparePixel(Pixel); src := Data; dst := aImage.PixelData; for y := 0 to Height-1 do for x := 0 to Width-1 do begin FormatDesc.Unmap(src, Pixel, srcMD); case rid.BitsPerPixel of 8: begin dst^ := Pixel.Data.a; inc(dst); end; 16: begin PWord(dst)^ := Pixel.Data.a; inc(dst, 2); end; 24: begin PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0]; PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1]; PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2]; inc(dst, 3); end; 32: begin PCardinal(dst)^ := Pixel.Data.a; inc(dst, 4); end; else raise EglBitmapUnsupportedFormat.Create(Format); end; end; finally FormatDesc.FreeMappingData(srcMD); end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try tex.AssignFromLazIntfImage(aImage); result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var rs: TResourceStream; begin PrepareResType(aResource, aResType); rs := TResourceStream.Create(aInstance, aResource, aResType); try result := AddAlphaFromStream(rs, aFunc, aArgs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var rs: TResourceStream; begin rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType); try result := AddAlphaFromStream(rs, aFunc, aArgs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; begin if TFormatDescriptor.Get(Format).IsCompressed then raise EglBitmapUnsupportedFormat.Create(Format); result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var FS: TFileStream; begin FS := TFileStream.Create(aFileName, fmOpenRead); try result := AddAlphaFromStream(FS, aFunc, aArgs); finally FS.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): 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: Pointer): Boolean; var DestData, DestData2, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TFormatDescriptor; SourceMD, DestMD, DestMD2: Pointer; 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(TFormatDescriptor.Get(Format).WithAlpha); SourceFD := TFormatDescriptor.Get(aBitmap.Format); DestFD := TFormatDescriptor.Get(Format); if not Assigned(aFunc) then begin aFunc := glBitmapAlphaFunc; FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha); end else FuncRec.Args := aArgs; // Values TempHeight := aBitmap.FileHeight; TempWidth := aBitmap.FileWidth; FuncRec.Sender := Self; FuncRec.Size := Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; DestData := Data; DestData2 := Data; SourceData := aBitmap.Data; // Mapping SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); SourceMD := SourceFD.CreateMappingData; DestMD := DestFD.CreateMappingData; DestMD2 := DestFD.CreateMappingData; try 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, SourceMD); DestFD.Unmap (DestData, FuncRec.Dest, DestMD); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData2, DestMD2); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; finally SourceFD.FreeMappingData(SourceMD); DestFD.FreeMappingData(DestMD); DestFD.FreeMappingData(DestMD2); 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 TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); result := AddAlphaFromColorKeyFloat( aRed / PixelData.Range.r, aGreen / PixelData.Range.g, aBlue / PixelData.Range.b, aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b))); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean; var values: array[0..2] of Single; tmp: Cardinal; i: Integer; PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); with PixelData do begin values[0] := aRed; values[1] := aGreen; values[2] := aBlue; for i := 0 to 2 do begin tmp := Trunc(Range.arr[i] * aDeviation); Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp)); Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp)); end; Data.a := 0; Range.a := 0; end; result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @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 TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean; var PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); with PixelData do Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha))); result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.RemoveAlpha: Boolean; var FormatDesc: TFormatDescriptor; begin result := false; FormatDesc := TFormatDescriptor.Get(Format); if Assigned(Data) then begin if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then raise EglBitmapUnsupportedFormat.Create(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 := TFormatDescriptor.Get(Format).GetSize(fDimension); GetMem(TempPtr, Size); try Move(Data^, TempPtr^, Size); Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method except if Assigned(TempPtr) then FreeMem(TempPtr); raise; end; end else begin TempPtr := nil; Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method end; // 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: TFormatDescriptor; SourcePD, DestPD: TglBitmapPixelData; ShiftData: TShiftData; function DataIsIdentical: Boolean; begin result := SourceFD.MaskMatch(DestFD.Mask); end; function CanCopyDirect: Boolean; begin result := ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0)); end; function CanShift: Boolean; begin result := ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 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) and (aFormat <> tfEmpty) then begin SourceFD := TFormatDescriptor.Get(Format); DestFD := TFormatDescriptor.Get(aFormat); if DataIsIdentical then begin result := true; Format := aFormat; exit; end; SourceFD.PreparePixel(SourcePD); DestFD.PreparePixel (DestPD); if CanCopyDirect then result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat) else if CanShift then begin ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r); ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g); ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b); ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a); result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData); 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, {%H-}Pointer( ((Byte(aUseAlpha) and 1) shl 1) or (Byte(aUseRGB) and 1) )); end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FreeData; var TempPtr: PByte; begin TempPtr := nil; SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method 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 TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); FillWithColorFloat( aRed / PixelData.Range.r, aGreen / PixelData.Range.g, aBlue / PixelData.Range.b, aAlpha / PixelData.Range.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single); var PixelData: TglBitmapPixelData; begin TFormatDescriptor.Get(Format).PreparePixel(PixelData); with PixelData do begin Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed))); Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen))); Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue))); Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha))); end; AddFunc(glBitmapFillWithColorFunc, false, @PixelData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFilter(const aMin, aMag: GLenum); 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 EglBitmap.Create('SetFilter - Unknow MIN filter.'); end; //check MAG filter case aMag of GL_NEAREST: fFilterMag := GL_NEAREST; GL_LINEAR: fFilterMag := GL_LINEAR; else raise EglBitmap.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) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} 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: GLenum; const T: GLenum; const R: GLenum); procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal); begin case aValue of {$IFNDEF OPENGL_ES} GL_CLAMP: aTarget := GL_CLAMP; {$ENDIF} GL_REPEAT: aTarget := GL_REPEAT; GL_CLAMP_TO_EDGE: begin {$IFNDEF OPENGL_ES} if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then aTarget := GL_CLAMP else {$ENDIF} aTarget := GL_CLAMP_TO_EDGE; end; {$IFNDEF OPENGL_ES} 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; {$ENDIF} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} GL_MIRRORED_REPEAT: begin {$IFNDEF OPENGL_ES} if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then {$ELSE} if GL_VERSION_2_0 then {$ENDIF} aTarget := GL_MIRRORED_REPEAT else raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).'); end; {$IFEND} else raise EglBitmap.Create('SetWrap - Unknow Texturewrap'); 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); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF} glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR); {$IFEND} end; end; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum); procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer); begin if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then fSwizzle[aIndex] := aValue else raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value'); end; begin {$IFNDEF OPENGL_ES} if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then raise EglBitmapNotSupported.Create('texture swizzle is not supported'); {$ELSE} if not GL_VERSION_3_0 then raise EglBitmapNotSupported.Create('texture swizzle is not supported'); {$ENDIF} CheckAndSetValue(r, 0); CheckAndSetValue(g, 1); CheckAndSetValue(b, 2); CheckAndSetValue(a, 3); if (ID > 0) then begin Bind(false); {$IFNDEF OPENGL_ES} glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0])); {$ELSE} glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3])); {$ENDIF} end; end; {$IFEND} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 if (ClassType = TglBitmap) then raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.'); {$IFDEF GLB_NATIVE_OGL} glbReadOpenGLExtensions; {$ENDIF} inherited Create; fFormat := glBitmapGetDefaultFormat; fFreeDataOnDestroy := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aFileName: String); begin Create; LoadFromFile(aFileName); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aStream: TStream); begin Create; LoadFromStream(aStream); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte); var ImageSize: Integer; begin Create; if not Assigned(aData) then begin ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize); GetMem(aData, ImageSize); try FillChar(aData^, ImageSize, #$FF); SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method except if Assigned(aData) then FreeMem(aData); raise; end; end else begin SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method fFreeDataOnDestroy := false; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer); begin Create; LoadFromFunc(aSize, aFunc, aFormat, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; {$IFDEF GLB_SUPPORT_PNG_READ} {$IF DEFINED(GLB_LAZ_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //PNG///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; const MAGIC_LEN = 8; PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A; var reader: TLazReaderPNG; intf: TLazIntfImage; StreamPos: Int64; magic: String[MAGIC_LEN]; begin result := true; StreamPos := aStream.Position; SetLength(magic, MAGIC_LEN); aStream.Read(magic[1], MAGIC_LEN); aStream.Position := StreamPos; if (magic <> PNG_MAGIC) then begin result := false; exit; end; intf := TLazIntfImage.Create(0, 0); reader := TLazReaderPNG.Create; try try reader.UpdateDescription := true; reader.ImageRead(aStream, intf); AssignFromLazIntfImage(intf); except result := false; aStream.Position := StreamPos; exit; end; finally reader.Free; intf.Free; end; end; {$ELSEIF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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); result := 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: TglBitmapFormat; 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 := aStream.Position; aStream.Read(signature{%H-}, 8); aStream.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, aStream, 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 := tfLuminance8ub1; PNG_COLOR_TYPE_GRAY_ALPHA: Format := tfLuminance8Alpha8us1; PNG_COLOR_TYPE_RGB: Format := tfRGB8ub3; PNG_COLOR_TYPE_RGB_ALPHA: Format := tfRGBA8ub4; 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); //be careful, Data could be freed by this method result := true; except if Assigned(png_data) then 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: String[8]; Row, Col, PixSize, LineSize: Integer; NewImage, pSource, pDest, pAlpha: pByte; PngFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; const PngHeader: String[8] = #137#80#78#71#13#10#26#10; begin result := false; StreamPos := aStream.Position; aStream.Read(Header[0], SizeOf(Header)); aStream.Position := StreamPos; {Test if the header matches} if Header = PngHeader then begin Png := TPNGObject.Create; try Png.LoadFromStream(aStream); case Png.Header.ColorType of COLOR_GRAYSCALE: PngFormat := tfLuminance8ub1; COLOR_GRAYSCALEALPHA: PngFormat := tfLuminance8Alpha8us1; COLOR_RGB: PngFormat := tfBGR8ub3; COLOR_RGBALPHA: PngFormat := tfBGRA8ub4; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; FormatDesc := TFormatDescriptor.Get(PngFormat); PixSize := Round(FormatDesc.PixelSize); LineSize := FormatDesc.GetSize(Png.Header.Width, 1); 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, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method result := true; except if Assigned(NewImage) then 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_LAZ_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var png: TPortableNetworkGraphic; intf: TLazIntfImage; raw: TRawImage; begin png := TPortableNetworkGraphic.Create; intf := TLazIntfImage.Create(0, 0); try if not AssignToLazIntfImage(intf) then raise EglBitmap.Create('unable to create LazIntfImage from glBitmap'); intf.GetRawImage(raw); png.LoadFromRawImage(raw, false); png.SaveToStream(aStream); finally png.Free; intf.Free; end; end; {$ELSEIF 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; FormatDesc: TFormatDescriptor; begin if not (ftPNG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); if not init_libPNG then raise Exception.Create('unable to initialize libPNG.'); try case Format of tfAlpha8ub1, tfLuminance8ub1: ColorType := PNG_COLOR_TYPE_GRAY; tfLuminance8Alpha8us1: ColorType := PNG_COLOR_TYPE_GRAY_ALPHA; tfBGR8ub3, tfRGB8ub3: ColorType := PNG_COLOR_TYPE_RGB; tfBGRA8ub4, tfRGBA8ub4: ColorType := PNG_COLOR_TYPE_RGBA; else raise EglBitmapUnsupportedFormat.Create(Format); end; FormatDesc := TFormatDescriptor.Get(Format); LineSize := FormatDesc.GetSize(Width, 1); // 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, aStream, glBitmap_libPNG_write_func, nil); // set compression png_set_compression_level(png, 6); if Format in [tfBGR8ub3, tfBGRA8ub4] 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 (Format)) then raise EglBitmapUnsupportedFormat.Create(Format); case Format of tfAlpha8ub1, tfLuminance8ub1: begin ColorType := COLOR_GRAYSCALE; PixSize := 1; Alpha := false; end; tfLuminance8Alpha8us1: begin ColorType := COLOR_GRAYSCALEALPHA; PixSize := 1; Alpha := true; end; tfBGR8ub3, tfRGB8ub3: begin ColorType := COLOR_RGB; PixSize := 3; Alpha := false; end; tfBGRA8ub4, tfRGBA8ub4: begin ColorType := COLOR_RGBALPHA; PixSize := 3; Alpha := true end; else raise EglBitmapUnsupportedFormat.Create(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 Format in [tfRGB8ub3, tfRGBA8ub4] 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(aStream); 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; begin //DUMMY end; procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl; begin //DUMMY 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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_LAZ_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; const MAGIC_LEN = 2; JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8; var intf: TLazIntfImage; reader: TFPReaderJPEG; StreamPos: Int64; magic: String[MAGIC_LEN]; begin result := true; StreamPos := aStream.Position; SetLength(magic, MAGIC_LEN); aStream.Read(magic[1], MAGIC_LEN); aStream.Position := StreamPos; if (magic <> JPEG_MAGIC) then begin result := false; exit; end; reader := TFPReaderJPEG.Create; intf := TLazIntfImage.Create(0, 0); try try intf.DataDescription := GetDescriptionFromDevice(0, 0, 0); reader.ImageRead(aStream, intf); AssignFromLazIntfImage(intf); except result := false; aStream.Position := StreamPos; exit; end; finally reader.Free; intf.Free; end; end; {$ELSEIF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var Surface: PSDL_Surface; RWops: PSDL_RWops; begin result := false; RWops := glBitmapCreateRWops(aStream); 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: TglBitmapFormat; pImage: pByte; TempHeight, TempWidth: Integer; pTemp: pByte; Row: Integer; FormatDesc: TFormatDescriptor; 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 := aStream.Position; aStream.Read({%H-}Temp[0], 2); aStream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00); FillChar(jpeg_err{%H-}, 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 := aStream; 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 := tfLuminance8ub1; end; else jpeg.out_color_space := JCS_RGB; IntFormat := tfRGB8ub3; end; // reading image jpeg_start_decompress(@jpeg); TempHeight := jpeg.output_height; TempWidth := jpeg.output_width; FormatDesc := TFormatDescriptor.Get(IntFormat); // creating new image GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight)); try pTemp := pImage; for Row := 0 to TempHeight -1 do begin jpeg_read_scanlines(@jpeg, @pTemp, 1); Inc(pTemp, FormatDesc.GetSize(TempWidth, 1)); end; // finish decompression jpeg_finish_decompress(@jpeg); // destroy decompression jpeg_destroy_decompress(@jpeg); SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(pImage) then 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 := aStream.Position; aStream.Read(Temp[0], 2); aStream.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(aStream); bmp.Assign(jpg); result := AssignFromBitmap(bmp); finally jpg.Free; end; finally bmp.Free; end; end; end; {$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} {$IF DEFINED(GLB_LAZ_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(const aStream: TStream); var jpeg: TJPEGImage; intf: TLazIntfImage; raw: TRawImage; begin jpeg := TJPEGImage.Create; intf := TLazIntfImage.Create(0, 0); try if not AssignToLazIntfImage(intf) then raise EglBitmap.Create('unable to create LazIntfImage from glBitmap'); intf.GetRawImage(raw); jpeg.LoadFromRawImage(raw, false); jpeg.SaveToStream(aStream); finally intf.Free; jpeg.Free; end; end; {$ELSEIF DEFINED(GLB_LIB_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(const aStream: 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 EglBitmapUnsupportedFormat.Create(Format); if not init_libJPEG then raise Exception.Create('SaveJPG - unable to initialize libJPEG.'); try FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00); FillChar(jpeg_err{%H-}, 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 := aStream; end; // very important state jpeg.global_state := CSTATE_START; jpeg.image_width := Width; jpeg.image_height := Height; case Format of tfAlpha8ub1, tfLuminance8ub1: begin jpeg.input_components := 1; jpeg.in_color_space := JCS_GRAYSCALE; end; tfRGB8ub3, tfBGR8ub3: 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 Format = tfBGR8ub3 then GetMem(pTemp2, fRowSize) else pTemp2 := pTemp; try for Row := 0 to jpeg.image_height -1 do begin // prepare row if Format = tfBGR8ub3 then CopyRow(pTemp2, pTemp) else pTemp2 := pTemp; // write row jpeg_write_scanlines(@jpeg, @pTemp2, 1); inc(pTemp, fRowSize); end; finally // free memory if Format = tfBGR8ub3 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(const aStream: TStream); var Bmp: TBitmap; Jpg: TJPEGImage; begin if not (ftJPEG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); Bmp := TBitmap.Create; try Jpg := TJPEGImage.Create; try AssignToBitmap(Bmp); if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin Jpg.Grayscale := true; Jpg.PixelFormat := jf8Bit; end; Jpg.Assign(Bmp); Jpg.SaveToStream(aStream); finally FreeAndNil(Jpg); end; finally FreeAndNil(Bmp); end; end; {$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //RAW///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type RawHeader = packed record Magic: String[5]; Version: Byte; Width: Integer; Height: Integer; DataSize: Integer; BitsPerPixel: Integer; Precision: TglBitmapRec4ub; Shift: TglBitmapRec4ub; end; function TglBitmap.LoadRAW(const aStream: TStream): Boolean; var header: RawHeader; StartPos: Int64; fd: TFormatDescriptor; buf: PByte; begin result := false; StartPos := aStream.Position; aStream.Read(header{%H-}, SizeOf(header)); if (header.Magic <> 'glBMP') then begin aStream.Position := StartPos; exit; end; fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel); if (fd.Format = tfEmpty) then raise EglBitmapUnsupportedFormat.Create('no supported format found'); buf := GetMemory(header.DataSize); aStream.Read(buf^, header.DataSize); SetDataPointer(buf, fd.Format, header.Width, header.Height); result := true; end; procedure TglBitmap.SaveRAW(const aStream: TStream); var header: RawHeader; fd: TFormatDescriptor; begin fd := TFormatDescriptor.Get(Format); header.Magic := 'glBMP'; header.Version := 1; header.Width := Width; header.Height := Height; header.DataSize := fd.GetSize(fDimension); header.BitsPerPixel := fd.BitsPerPixel; header.Precision := fd.Precision; header.Shift := fd.Shift; aStream.Write(header, SizeOf(header)); aStream.Write(Data^, header.DataSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadBMP(const aStream: TStream): Boolean; ////////////////////////////////////////////////////////////////////////////////////////////////// function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat; begin result := tfEmpty; aStream.Read(aInfo{%H-}, SizeOf(aInfo)); FillChar(aMask{%H-}, SizeOf(aMask), 0); //Read Compression case aInfo.biCompression of BMP_COMP_RLE4, BMP_COMP_RLE8: begin raise EglBitmap.Create('RLE compression is not supported'); end; BMP_COMP_BITFIELDS: begin if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin aStream.Read(aMask.r, SizeOf(aMask.r)); aStream.Read(aMask.g, SizeOf(aMask.g)); aStream.Read(aMask.b, SizeOf(aMask.b)); aStream.Read(aMask.a, SizeOf(aMask.a)); end else raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats'); end; end; //get suitable format case aInfo.biBitCount of 8: result := tfLuminance8ub1; 16: result := tfX1RGB5us1; 24: result := tfBGR8ub3; 32: result := tfXRGB8ui1; end; end; function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat; var i, c: Integer; ColorTable: TbmpColorTable; begin result := nil; if (aInfo.biBitCount >= 16) then exit; aFormat := tfLuminance8ub1; c := aInfo.biClrUsed; if (c = 0) then c := 1 shl aInfo.biBitCount; SetLength(ColorTable, c); for i := 0 to c-1 do begin aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty)); if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then aFormat := tfRGB8ub3; end; result := TbmpColorTableFormat.Create; result.BitsPerPixel := aInfo.biBitCount; result.ColorTable := ColorTable; result.CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////// function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat; var FormatDesc: TFormatDescriptor; begin result := nil; if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin FormatDesc := TFormatDescriptor.GetFromMask(aMask); if (FormatDesc.Format = tfEmpty) then exit; aFormat := FormatDesc.Format; if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha; if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then aFormat := TFormatDescriptor.Get(aFormat).WithAlpha; result := TbmpBitfieldFormat.Create; result.SetCustomValues(aInfo.biBitCount, aMask); end; end; var //simple types StartPos: Int64; ImageSize, rbLineSize, wbLineSize, Padding, i: Integer; PaddingBuff: Cardinal; LineBuf, ImageData, TmpData: PByte; SourceMD, DestMD: Pointer; BmpFormat: TglBitmapFormat; //records Mask: TglBitmapRec4ul; Header: TBMPHeader; Info: TBMPInfo; //classes SpecialFormat: TFormatDescriptor; FormatDesc: TFormatDescriptor; ////////////////////////////////////////////////////////////////////////////////////////////////// procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte); var i: Integer; Pixel: TglBitmapPixelData; begin aStream.Read(aLineBuf^, rbLineSize); SpecialFormat.PreparePixel(Pixel); for i := 0 to Info.biWidth-1 do begin SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD); glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc); FormatDesc.Map(Pixel, aData, DestMD); end; end; begin result := false; BmpFormat := tfEmpty; SpecialFormat := nil; LineBuf := nil; SourceMD := nil; DestMD := nil; // Header StartPos := aStream.Position; aStream.Read(Header{%H-}, SizeOf(Header)); if Header.bfType = BMP_MAGIC then begin try try BmpFormat := ReadInfo(Info, Mask); SpecialFormat := ReadColorTable(BmpFormat, Info); if not Assigned(SpecialFormat) then SpecialFormat := CheckBitfields(BmpFormat, Mask, Info); aStream.Position := StartPos + Header.bfOffBits; if (BmpFormat <> tfEmpty) then begin FormatDesc := TFormatDescriptor.Get(BmpFormat); rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel); Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize; //get Memory DestMD := FormatDesc.CreateMappingData; ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight)); GetMem(ImageData, ImageSize); if Assigned(SpecialFormat) then begin GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields SourceMD := SpecialFormat.CreateMappingData; end; //read Data try try FillChar(ImageData^, ImageSize, $FF); TmpData := ImageData; if (Info.biHeight > 0) then Inc(TmpData, wbLineSize * (Info.biHeight-1)); for i := 0 to Abs(Info.biHeight)-1 do begin if Assigned(SpecialFormat) then SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data else aStream.Read(TmpData^, wbLineSize); //else only read data if (Info.biHeight > 0) then dec(TmpData, wbLineSize) else inc(TmpData, wbLineSize); aStream.Read(PaddingBuff{%H-}, Padding); end; SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method result := true; finally if Assigned(LineBuf) then FreeMem(LineBuf); if Assigned(SourceMD) then SpecialFormat.FreeMappingData(SourceMD); FormatDesc.FreeMappingData(DestMD); end; except if Assigned(ImageData) then FreeMem(ImageData); raise; end; end else raise EglBitmap.Create('LoadBMP - No suitable format found'); except aStream.Position := StartPos; raise; end; finally FreeAndNil(SpecialFormat); end; end else aStream.Position := StartPos; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveBMP(const aStream: TStream); var Header: TBMPHeader; Info: TBMPInfo; Converter: TFormatDescriptor; FormatDesc: TFormatDescriptor; SourceFD, DestFD: Pointer; pData, srcData, dstData, ConvertBuffer: pByte; Pixel: TglBitmapPixelData; ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer; 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 EglBitmapUnsupportedFormat.Create(Format); Converter := nil; FormatDesc := TFormatDescriptor.Get(Format); ImageSize := FormatDesc.GetSize(Dimension); FillChar(Header{%H-}, SizeOf(Header), 0); 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{%H-}, SizeOf(Info), 0); Info.biSize := SizeOf(Info); Info.biWidth := Width; Info.biHeight := Height; Info.biPlanes := 1; Info.biCompression := BMP_COMP_RGB; Info.biSizeImage := ImageSize; try case Format of tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1: begin Info.biBitCount := 8; Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries Converter := TbmpColorTableFormat.Create; with (Converter as TbmpColorTableFormat) do begin SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift); CreateColorTable; end; end; tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1, tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1: begin Info.biBitCount := 16; Info.biCompression := BMP_COMP_BITFIELDS; end; tfBGR8ub3, tfRGB8ub3: begin Info.biBitCount := 24; if (Format = tfRGB8ub3) then Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values end; tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1, tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1: begin Info.biBitCount := 32; Info.biCompression := BMP_COMP_BITFIELDS; end; else raise EglBitmapUnsupportedFormat.Create(Format); end; Info.biXPelsPerMeter := 2835; Info.biYPelsPerMeter := 2835; // prepare bitmasks if Info.biCompression = BMP_COMP_BITFIELDS then begin Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal); RedMask := FormatDesc.Mask.r; GreenMask := FormatDesc.Mask.g; BlueMask := FormatDesc.Mask.b; AlphaMask := FormatDesc.Mask.a; end; // headers aStream.Write(Header, SizeOf(Header)); aStream.Write(Info, SizeOf(Info)); // colortable if Assigned(Converter) and (Converter is TbmpColorTableFormat) then with (Converter as TbmpColorTableFormat) do aStream.Write(ColorTable[0].b, SizeOf(TbmpColorTableEnty) * Length(ColorTable)); // 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 rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel); wbLineSize := Round(Info.biWidth * Info.biBitCount / 8); Padding := GetLineWidth - wbLineSize; PaddingBuff := 0; pData := Data; inc(pData, (Height-1) * rbLineSize); // prepare row buffer. But only for RGB because RGBA supports color masks // so it's possible to change color within the image. if Assigned(Converter) then begin FormatDesc.PreparePixel(Pixel); GetMem(ConvertBuffer, wbLineSize); SourceFD := FormatDesc.CreateMappingData; DestFD := Converter.CreateMappingData; end else ConvertBuffer := nil; try for LineIdx := 0 to Height - 1 do begin // preparing row if Assigned(Converter) then begin srcData := pData; dstData := ConvertBuffer; for PixelIdx := 0 to Info.biWidth-1 do begin FormatDesc.Unmap(srcData, Pixel, SourceFD); glBitmapConvertPixel(Pixel, FormatDesc, Converter); Converter.Map(Pixel, dstData, DestFD); end; aStream.Write(ConvertBuffer^, wbLineSize); end else begin aStream.Write(pData^, rbLineSize); end; dec(pData, rbLineSize); if (Padding > 0) then aStream.Write(PaddingBuff, Padding); end; finally // destroy row buffer if Assigned(ConvertBuffer) then begin FormatDesc.FreeMappingData(SourceFD); Converter.FreeMappingData(DestFD); FreeMem(ConvertBuffer); end; end; finally if Assigned(Converter) then Converter.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TGA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TTGAHeader = packed record ImageID: Byte; ColorMapType: Byte; ImageType: Byte; //ColorMapSpec: Array[0..4] of Byte; ColorMapStart: Word; ColorMapLength: Word; ColorMapEntrySize: Byte; OrigX: Word; OrigY: Word; Width: Word; Height: Word; Bpp: Byte; ImageDesc: Byte; end; const TGA_UNCOMPRESSED_RGB = 2; TGA_UNCOMPRESSED_GRAY = 3; TGA_COMPRESSED_RGB = 10; TGA_COMPRESSED_GRAY = 11; TGA_NONE_COLOR_TABLE = 0; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadTGA(const aStream: TStream): Boolean; var Header: TTGAHeader; ImageData: System.PByte; StartPosition: Int64; PixelSize, LineSize: Integer; tgaFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; Counter: packed record X, Y: packed record low, high, dir: Integer; end; end; const CACHE_SIZE = $4000; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadUncompressed; var i, j: Integer; buf, tmp1, tmp2: System.PByte; begin buf := nil; if (Counter.X.dir < 0) then GetMem(buf, LineSize); try while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin tmp1 := ImageData; inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart if (Counter.X.dir < 0) then begin //flip X aStream.Read(buf^, LineSize); tmp2 := buf; inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line for i := 0 to Header.Width-1 do begin //for all pixels in line for j := 0 to PixelSize-1 do begin //for all bytes in pixel tmp1^ := tmp2^; inc(tmp1); inc(tmp2); end; dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward end; end else aStream.Read(tmp1^, LineSize); inc(Counter.Y.low, Counter.Y.dir); //move to next line index end; finally if Assigned(buf) then FreeMem(buf); end; end; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadCompressed; ///////////////////////////////////////////////////////////////// var TmpData: System.PByte; LinePixelsRead: Integer; procedure CheckLine; begin if (LinePixelsRead >= Header.Width) then begin LinePixelsRead := 0; inc(Counter.Y.low, Counter.Y.dir); //next line index TmpData := ImageData; inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then inc(TmpData, LineSize - PixelSize); //set last pixel end; end; ///////////////////////////////////////////////////////////////// var Cache: PByte; CacheSize, CachePos: Integer; procedure CachedRead(out Buffer; Count: Integer); var BytesRead: Integer; begin if (CachePos + Count > CacheSize) then begin //if buffer overflow save non read bytes BytesRead := 0; if (CacheSize - CachePos > 0) then begin BytesRead := CacheSize - CachePos; Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead); inc(CachePos, BytesRead); end; //load cache from file CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position); aStream.Read(Cache^, CacheSize); CachePos := 0; //read rest of requested bytes if (Count - BytesRead > 0) then begin Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead); inc(CachePos, Count - BytesRead); end; end else begin //if no buffer overflow just read the data Move(PByteArray(Cache)^[CachePos], Buffer, Count); inc(CachePos, Count); end; end; procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte); begin case PixelSize of 1: begin aBuffer^ := aData^; inc(aBuffer, Counter.X.dir); end; 2: begin PWord(aBuffer)^ := PWord(aData)^; inc(aBuffer, 2 * Counter.X.dir); end; 3: begin PByteArray(aBuffer)^[0] := PByteArray(aData)^[0]; PByteArray(aBuffer)^[1] := PByteArray(aData)^[1]; PByteArray(aBuffer)^[2] := PByteArray(aData)^[2]; inc(aBuffer, 3 * Counter.X.dir); end; 4: begin PCardinal(aBuffer)^ := PCardinal(aData)^; inc(aBuffer, 4 * Counter.X.dir); end; end; end; var TotalPixelsToRead, TotalPixelsRead: Integer; Temp: Byte; buf: array [0..3] of Byte; //1 pixel is max 32bit long PixelRepeat: Boolean; PixelsToRead, PixelCount: Integer; begin CacheSize := 0; CachePos := 0; TotalPixelsToRead := Header.Width * Header.Height; TotalPixelsRead := 0; LinePixelsRead := 0; GetMem(Cache, CACHE_SIZE); try TmpData := ImageData; inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then inc(TmpData, LineSize - PixelSize); //set last pixel repeat //read CommandByte CachedRead(Temp, 1); PixelRepeat := (Temp and $80) > 0; PixelsToRead := (Temp and $7F) + 1; inc(TotalPixelsRead, PixelsToRead); if PixelRepeat then CachedRead(buf[0], PixelSize); while (PixelsToRead > 0) do begin CheckLine; PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF while (PixelCount > 0) do begin if not PixelRepeat then CachedRead(buf[0], PixelSize); PixelToBuffer(@buf[0], TmpData); inc(LinePixelsRead); dec(PixelsToRead); dec(PixelCount); end; end; until (TotalPixelsRead >= TotalPixelsToRead); finally FreeMem(Cache); end; end; function IsGrayFormat: Boolean; begin result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY]; end; begin result := false; // reading header to test file and set cursor back to begin StartPosition := aStream.Position; aStream.Read(Header{%H-}, SizeOf(Header)); // no colormapped files if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [ TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then begin try if Header.ImageID <> 0 then // skip image ID aStream.Position := aStream.Position + Header.ImageID; tgaFormat := tfEmpty; case Header.Bpp of 8: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance8ub1; 8: tgaFormat := tfAlpha8ub1; end; 16: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance16us1; 8: tgaFormat := tfLuminance8Alpha8ub2; end else case (Header.ImageDesc and $F) of 0: tgaFormat := tfX1RGB5us1; 1: tgaFormat := tfA1RGB5us1; 4: tgaFormat := tfARGB4us1; end; 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfBGR8ub3; end; 32: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfDepth32ui1; end else case (Header.ImageDesc and $F) of 0: tgaFormat := tfX2RGB10ui1; 2: tgaFormat := tfA2RGB10ui1; 8: tgaFormat := tfARGB8ui1; end; end; if (tgaFormat = tfEmpty) then raise EglBitmap.Create('LoadTga - unsupported format'); FormatDesc := TFormatDescriptor.Get(tgaFormat); PixelSize := FormatDesc.GetSize(1, 1); LineSize := FormatDesc.GetSize(Header.Width, 1); GetMem(ImageData, LineSize * Header.Height); try //column direction if ((Header.ImageDesc and (1 shl 4)) > 0) then begin Counter.X.low := Header.Height-1;; Counter.X.high := 0; Counter.X.dir := -1; end else begin Counter.X.low := 0; Counter.X.high := Header.Height-1; Counter.X.dir := 1; end; // Row direction if ((Header.ImageDesc and (1 shl 5)) > 0) then begin Counter.Y.low := 0; Counter.Y.high := Header.Height-1; Counter.Y.dir := 1; end else begin Counter.Y.low := Header.Height-1;; Counter.Y.high := 0; Counter.Y.dir := -1; end; // Read Image case Header.ImageType of TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY: ReadUncompressed; TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY: ReadCompressed; end; SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method result := true; except if Assigned(ImageData) then FreeMem(ImageData); raise; end; finally aStream.Position := StartPosition; end; end else aStream.Position := StartPosition; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveTGA(const aStream: TStream); var Header: TTGAHeader; Size: Integer; FormatDesc: TFormatDescriptor; begin if not (ftTGA in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); //prepare header FormatDesc := TFormatDescriptor.Get(Format); FillChar(Header{%H-}, SizeOf(Header), 0); Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F; Header.Bpp := FormatDesc.BitsPerPixel; Header.Width := Width; Header.Height := Height; Header.ImageDesc := Header.ImageDesc or $20; //flip y if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then Header.ImageType := TGA_UNCOMPRESSED_GRAY else Header.ImageType := TGA_UNCOMPRESSED_RGB; aStream.Write(Header, SizeOf(Header)); // write Data Size := FormatDesc.GetSize(Dimension); aStream.Write(Data^, Size); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //DDS///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// const DDS_MAGIC: Cardinal = $20534444; // DDS_header.dwFlags DDSD_CAPS = $00000001; DDSD_HEIGHT = $00000002; DDSD_WIDTH = $00000004; DDSD_PIXELFORMAT = $00001000; // DDS_header.sPixelFormat.dwFlags DDPF_ALPHAPIXELS = $00000001; DDPF_ALPHA = $00000002; DDPF_FOURCC = $00000004; DDPF_RGB = $00000040; DDPF_LUMINANCE = $00020000; // DDS_header.sCaps.dwCaps1 DDSCAPS_TEXTURE = $00001000; // DDS_header.sCaps.dwCaps2 DDSCAPS2_CUBEMAP = $00000200; 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; dwABitMask: Cardinal; end; TDDSCaps = packed record dwCaps1: Cardinal; dwCaps2: Cardinal; dwDDSX: Cardinal; dwReserved: Cardinal; end; TDDSHeader = packed record 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; Converter: TbmpBitfieldFormat; function GetDDSFormat: TglBitmapFormat; var fd: TFormatDescriptor; i: Integer; Mask: TglBitmapRec4ul; Range: TglBitmapRec4ui; match: Boolean; begin result := tfEmpty; with Header.PixelFormat do begin // Compresses if ((dwFlags and DDPF_FOURCC) > 0) then begin case Header.PixelFormat.dwFourCC of D3DFMT_DXT1: result := tfS3tcDtx1RGBA; D3DFMT_DXT3: result := tfS3tcDtx3RGBA; D3DFMT_DXT5: result := tfS3tcDtx5RGBA; end; end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin // prepare masks if ((dwFlags and DDPF_LUMINANCE) = 0) then begin Mask.r := dwRBitMask; Mask.g := dwGBitMask; Mask.b := dwBBitMask; end else begin Mask.r := dwRBitMask; Mask.g := dwRBitMask; Mask.b := dwRBitMask; end; if (dwFlags and DDPF_ALPHAPIXELS > 0) then Mask.a := dwABitMask else Mask.a := 0;; //find matching format fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount); result := fd.Format; if (result <> tfEmpty) then exit; //find format with same Range for i := 0 to 3 do Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1; for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin fd := TFormatDescriptor.Get(result); match := true; for i := 0 to 3 do if (fd.Range.arr[i] <> Range.arr[i]) then begin match := false; break; end; if match then break; end; //no format with same range found -> use default if (result = tfEmpty) then begin if (dwABitMask > 0) then result := tfRGBA8ui1 else result := tfRGB8ub3; end; Converter := TbmpBitfieldFormat.Create; Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask)); end; end; end; var StreamPos: Int64; x, y, LineSize, RowSize, Magic: Cardinal; NewImage, TmpData, RowData, SrcData: System.PByte; SourceMD, DestMD: Pointer; Pixel: TglBitmapPixelData; ddsFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; begin result := false; Converter := nil; StreamPos := aStream.Position; // Magic aStream.Read(Magic{%H-}, sizeof(Magic)); if (Magic <> DDS_MAGIC) then begin aStream.Position := StreamPos; exit; end; //Header aStream.Read(Header{%H-}, sizeof(Header)); if (Header.dwSize <> SizeOf(Header)) or ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <> (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then begin aStream.Position := StreamPos; exit; end; if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then raise EglBitmap.Create('LoadDDS - CubeMaps are not supported'); ddsFormat := GetDDSFormat; try if (ddsFormat = tfEmpty) then raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.'); FormatDesc := TFormatDescriptor.Get(ddsFormat); LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel); GetMem(NewImage, Header.dwHeight * LineSize); try TmpData := NewImage; //Converter needed if Assigned(Converter) then begin RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8); GetMem(RowData, RowSize); SourceMD := Converter.CreateMappingData; DestMD := FormatDesc.CreateMappingData; try for y := 0 to Header.dwHeight-1 do begin TmpData := NewImage; inc(TmpData, y * LineSize); SrcData := RowData; aStream.Read(SrcData^, RowSize); for x := 0 to Header.dwWidth-1 do begin Converter.Unmap(SrcData, Pixel, SourceMD); glBitmapConvertPixel(Pixel, Converter, FormatDesc); FormatDesc.Map(Pixel, TmpData, DestMD); end; end; finally Converter.FreeMappingData(SourceMD); FormatDesc.FreeMappingData(DestMD); FreeMem(RowData); end; end else // 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(TmpData^, RowSize); Inc(TmpData, LineSize); end; end else // Uncompressed if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3; for Y := 0 to Header.dwHeight-1 do begin aStream.Read(TmpData^, RowSize); Inc(TmpData, LineSize); end; end else raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.'); SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method result := true; except if Assigned(NewImage) then FreeMem(NewImage); raise; end; finally FreeAndNil(Converter); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveDDS(const aStream: TStream); var Header: TDDSHeader; FormatDesc: TFormatDescriptor; begin if not (ftDDS in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); FormatDesc := TFormatDescriptor.Get(Format); // Generell FillChar(Header{%H-}, SizeOf(Header), 0); Header.dwSize := SizeOf(Header); Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT; Header.dwWidth := Max(1, Width); Header.dwHeight := Max(1, Height); // Caps Header.Caps.dwCaps1 := DDSCAPS_TEXTURE; // Pixelformat Header.PixelFormat.dwSize := sizeof(Header); if (FormatDesc.IsCompressed) then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC; case Format of tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1; tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3; tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5; end; end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end else if FormatDesc.IsGrayscale then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end else begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r; Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g; Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end; if (FormatDesc.HasAlpha) then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS; aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC)); aStream.Write(Header, SizeOf(Header)); aStream.Write(Data^, FormatDesc.GetSize(Dimension)); end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap1D///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var pTemp: pByte; Size: Integer; begin if (aHeight > 1) then begin Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1); GetMem(pTemp, Size); try Move(aData^, pTemp^, Size); FreeMem(aData); aData := nil; except FreeMem(pTemp); raise; end; end else pTemp := aData; inherited SetDataPointer(pTemp, aFormat, aWidth); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap1D.FlipHorz: Boolean; var Col: Integer; pTempDest, pDest, pSource: PByte; begin result := inherited FlipHorz; if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin pSource := Data; GetMem(pDest, fRowSize); try pTempDest := pDest; Inc(pTempDest, fRowSize); for Col := 0 to Width-1 do begin dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data Move(pSource^, pTempDest^, fPixelSize); Inc(pSource, fPixelSize); end; SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method result := true; except if Assigned(pDest) then FreeMem(pDest); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean); var FormatDesc: TFormatDescriptor; begin // Upload data FormatDesc := TFormatDescriptor.Get(Format); if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data'); if FormatDesc.IsCompressed then begin if not Assigned(glCompressedTexImage1D) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data) end else if aBuildWithGlu then gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data) else glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data); // Free Data if (FreeDataAfterGenTexture) then FreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean); var BuildWithGlu, TexRec: Boolean; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if (Width > TexSize) then raise EglBitmapSizeToLarge.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); if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.'); end; CreateId; SetupParameters(BuildWithGlu); UploadData(BuildWithGlu); glAreTexturesResident(1, @fID, @fIsResident); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.AfterConstruction; begin inherited; Target := GL_TEXTURE_1D; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //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(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var Idx, LineWidth: Integer; begin inherited SetDataPointer(aData, aFormat, aWidth, aHeight); if not TFormatDescriptor.Get(aFormat).IsCompressed then begin // Assigning Data if Assigned(Data) then begin SetLength(fLines, GetHeight); LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel); 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); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF}); var FormatDesc: TFormatDescriptor; begin FormatDesc := TFormatDescriptor.Get(Format); if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data'); glPixelStorei(GL_UNPACK_ALIGNMENT, 1); if FormatDesc.IsCompressed then begin if not Assigned(glCompressedTexImage2D) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data) {$IFNDEF OPENGL_ES} end else if aBuildWithGlu then begin gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height, FormatDesc.glFormat, FormatDesc.glDataFormat, Data) {$ENDIF} end else begin glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data); end; // 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: TFormatDescriptor; begin FormatDesc := TFormatDescriptor.Get(aFormat); if FormatDesc.IsCompressed then raise EglBitmapUnsupportedFormat.Create(aFormat); w := aRight - aLeft; h := aBottom - aTop; Size := FormatDesc.GetSize(w, h); GetMem(Temp, Size); try glPixelStorei(GL_PACK_ALIGNMENT, 1); glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp); SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method FlipVert; except if Assigned(Temp) then FreeMem(Temp); raise; end; end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GetDataFromTexture; var Temp: PByte; TempWidth, TempHeight: Integer; TempIntFormat: GLint; IntFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; 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); FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor); IntFormat := FormatDesc.Format; // Getting data from OpenGL FormatDesc := TFormatDescriptor.Get(IntFormat); GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight)); try if FormatDesc.IsCompressed then begin if not Assigned(glGetCompressedTexImage) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glGetCompressedTexImage(Target, 0, Temp) end else glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp); SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method except if Assigned(Temp) then FreeMem(Temp); raise; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean); var {$IFNDEF OPENGL_ES} BuildWithGlu, TexRec: Boolean; {$ENDIF} PotTex: 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 EglBitmapSizeToLarge.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); {$IF NOT DEFINED(OPENGL_ES)} TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE); if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$ELSEIF DEFINED(OPENGL_ES_EXT)} if not PotTex and not GL_OES_texture_npot then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$ELSE} if not PotTex then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$IFEND} end; CreateId; SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF}); UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF}); {$IFNDEF OPENGL_ES} glAreTexturesResident(1, @fID, @fIsResident); {$ENDIF} 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, Width, Height); //be careful, Data could be freed by this method result := true; except if Assigned(DestData) then 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, Width, Height); //be careful, Data could be freed by this method result := true; except if Assigned(DestData) then 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 ONE_OVER_255 = 1 / 255; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec); var Val: Single; begin with FuncRec do begin Val := Source.Data.r * LUMINANCE_WEIGHT_R + Source.Data.g * LUMINANCE_WEIGHT_G + Source.Data.b * LUMINANCE_WEIGHT_B; PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec); begin with FuncRec do PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255; 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.Data.r := Trunc((Vec[0] + 1) * 127.5); Dest.Data.g := Trunc((Vec[1] + 1) * 127.5); Dest.Data.b := 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 if TFormatDescriptor.Get(Format).IsCompressed then raise EglBitmapUnsupportedFormat.Create(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 TFormatDescriptor.Get(Format).HasAlpha then AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec) else AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec); AddFunc(glBitmapToNormalMapFunc, false, @Rec); finally SetLength(Rec.Heights, 0); end; end; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapCubeMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean); begin Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.'); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.AfterConstruction; begin inherited; {$IFNDEF OPENGL_ES} if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); {$ELSE} if not (GL_VERSION_2_0) then raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); {$ENDIF} SetWrap; Target := GL_TEXTURE_CUBE_MAP; {$IFNDEF OPENGL_ES} fGenMode := GL_REFLECTION_MAP; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean); var {$IFNDEF OPENGL_ES} BuildWithGlu: Boolean; {$ENDIF} TexSize: Integer; begin if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize); if (Height > TexSize) or (Width > TexSize) then raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.'); {$IF NOT DEFINED(OPENGL_ES)} if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$ELSEIF DEFINED(OPENGL_ES_EXT)} if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$ELSE} if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$IFEND} end; if (ID = 0) then CreateID; SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF}); UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF}); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean); begin inherited Bind (aEnableTextureUnit); {$IFNDEF OPENGL_ES} if aEnableTexCoordsGen 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; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean); begin inherited Unbind(aDisableTextureUnit); {$IFNDEF OPENGL_ES} if aDisableTexCoordsGen then begin glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); glDisable(GL_TEXTURE_GEN_R); end; {$ENDIF} end; {$IFEND} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapNormalMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TVec = Array[0..2] of Single; TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); PglBitmapNormalMapRec = ^TglBitmapNormalMapRec; TglBitmapNormalMapRec = record HalfSize : Integer; Func: TglBitmapNormalMapGetVectorFunc; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := - (aPosition.X + 0.5 - aHalfSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := - aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := aPosition.X + 0.5 - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := aHalfSize; aVec[2] := aPosition.Y + 0.5 - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := - aHalfSize; aVec[2] := - (aPosition.Y + 0.5 - aHalfSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := - (aPosition.X + 0.5 - aHalfSize); aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec); var i: Integer; Vec: TVec; Len: Single; begin with FuncRec do begin with PglBitmapNormalMapRec(Args)^ 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 for i := 0 to 2 do Dest.Data.arr[i] := Round(Vec[i] * 255); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapNormalMap.AfterConstruction; begin inherited; {$IFNDEF OPENGL_ES} fGenMode := GL_NORMAL_MAP; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean); var Rec: TglBitmapNormalMapRec; SizeRec: TglBitmapPixelPosition; begin Rec.HalfSize := aSize div 2; FreeDataAfterGenTexture := false; SizeRec.Fields := [ffX, ffY]; SizeRec.X := aSize; SizeRec.Y := aSize; // Positive X Rec.Func := glBitmapNormalMapPosX; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize); // Negative X Rec.Func := glBitmapNormalMapNegX; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize); // Positive Y Rec.Func := glBitmapNormalMapPosY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize); // Negative Y Rec.Func := glBitmapNormalMapNegY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize); // Positive Z Rec.Func := glBitmapNormalMapPosZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize); // Negative Z Rec.Func := glBitmapNormalMapNegZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize); end; {$IFEND} 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); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA); {$IFEND} glBitmapSetDefaultFreeDataAfterGenTexture(true); glBitmapSetDefaultDeleteTextureOnFree (true); TFormatDescriptor.Init; {$IFDEF GLB_NATIVE_OGL_DYNAMIC} OpenGLInitialized := false; InitOpenGLCS := TCriticalSection.Create; {$ENDIF} finalization TFormatDescriptor.Finalize; {$IFDEF GLB_NATIVE_OGL} if Assigned(GL_LibHandle) then glbFreeLibrary(GL_LibHandle); {$IFDEF GLB_NATIVE_OGL_DYNAMIC} if Assigned(GLU_LibHandle) then glbFreeLibrary(GLU_LibHandle); FreeAndNil(InitOpenGLCS); {$ENDIF} {$ENDIF} end.