{*********************************************************** 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 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // 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} // native OpenGL Support {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)} {$DEFINE GLB_NATIVE_OGL} {$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} dglOpenGL, {$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 //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapFormat = ( tfEmpty = 0, //must be smallest value! tfAlpha4, tfAlpha8, tfAlpha16, tfLuminance4, tfLuminance8, tfLuminance16, tfLuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16, tfR3G3B2, tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGB8, tfRGBX8, tfXRGB8, tfRGB10X2, tfX2RGB10, tfRGB16, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5, tfRGBA8, tfARGB8, tfRGB10A2, tfA2RGB10, tfRGBA16, tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGR8, tfBGRX8, tfXBGR8, tfBGR10X2, tfX2BGR10, tfBGR16, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5, tfBGRA8, tfABGR8, tfBGR10A2, tfA2BGR10, tfBGRA16, tfDepth16, tfDepth24, tfDepth32, tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA ); TglBitmapFileType = ( {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} ftDDS, ftTGA, ftBMP); TglBitmapFileTypes = set of TglBitmapFileType; TglBitmapMipMap = ( mmNone, mmMipmap, mmMipmapGlu); TglBitmapNormalMapFunc = ( nm4Samples, nmSobel, nm3x3, nm5x5); //////////////////////////////////////////////////////////////////////////////////////////////////// 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; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapColorRec = packed record case Integer of 0: (r, g, b, a: Cardinal); 1: (arr: array[0..3] of Cardinal); end; TglBitmapPixelData = packed record Data, Range: TglBitmapColorRec; Format: TglBitmapFormat; end; PglBitmapPixelData = ^TglBitmapPixelData; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapPixelPositionFields = set of (ffX, ffY); TglBitmapPixelPosition = record Fields : TglBitmapPixelPositionFields; X : Word; Y : Word; end; TglBitmapFormatDescriptor = class(TObject) protected function GetIsCompressed: Boolean; virtual; abstract; function GetHasRed: Boolean; virtual; abstract; function GetHasGreen: Boolean; virtual; abstract; function GetHasBlue: Boolean; virtual; abstract; function GetHasAlpha: Boolean; virtual; abstract; function GetRGBInverted: TglBitmapFormat; virtual; abstract; function GetWithAlpha: TglBitmapFormat; virtual; abstract; function GetWithoutAlpha: TglBitmapFormat; virtual; abstract; function GetOpenGLFormat: TglBitmapFormat; virtual; abstract; function GetUncompressed: TglBitmapFormat; virtual; abstract; function GetglDataFormat: GLenum; virtual; abstract; function GetglFormat: GLenum; virtual; abstract; function GetglInternalFormat: GLenum; virtual; abstract; public property IsCompressed: Boolean read GetIsCompressed; property HasRed: Boolean read GetHasRed; property HasGreen: Boolean read GetHasGreen; property HasBlue: Boolean read GetHasBlue; property HasAlpha: Boolean read GetHasAlpha; property RGBInverted: TglBitmapFormat read GetRGBInverted; property WithAlpha: TglBitmapFormat read GetWithAlpha; property WithoutAlpha: TglBitmapFormat read GetWithoutAlpha; property OpenGLFormat: TglBitmapFormat read GetOpenGLFormat; property Uncompressed: TglBitmapFormat read GetUncompressed; property glFormat: GLenum read GetglFormat; property glInternalFormat: GLenum read GetglInternalFormat; property glDataFormat: GLenum read GetglDataFormat; public class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; 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; fIsResident: GLboolean; 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; //Swizzle fSwizzle: array[0..3] of GLenum; // 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(out aBuildWithGlu: Boolean); 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; property IsResident: GLboolean read fIsResident; 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); procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); procedure FreeData; //ColorFill procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255); procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF); procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1); //TexParameters procedure SetFilter(const aMin, aMag: GLenum); procedure SetWrap( const S: GLenum = GL_CLAMP_TO_EDGE; const T: GLenum = GL_CLAMP_TO_EDGE; const R: GLenum = GL_CLAMP_TO_EDGE); procedure SetSwizzle(const r, g, b, a: GLenum); 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 LoadBMP(const aStream: TStream): Boolean; virtual; procedure SaveBMP(const aStream: TStream); virtual; function LoadTGA(const aStream: TStream): Boolean; virtual; procedure SaveTGA(const aStream: TStream); virtual; function LoadDDS(const aStream: TStream): Boolean; virtual; procedure SaveDDS(const aStream: TStream); virtual; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; const aBuildWithGlu: Boolean); public property Width; property Height; property Scanline[const aIndex: Integer]: Pointer read GetScanline; procedure AfterConstruction; override; procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat); procedure GetDataFromTexture; procedure GenTexture(const aTestTextureSize: Boolean = true); override; function FlipHorz: Boolean; override; function FlipVert: Boolean; override; procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3; const aScale: Single = 2; const aUseAlpha: Boolean = false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapCubeMap = class(TglBitmap2D) protected fGenMode: Integer; procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce; public procedure AfterConstruction; override; procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true); procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual; procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmapNormalMap = class(TglBitmapCubeMap) public procedure AfterConstruction; override; procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true); end; const NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0); procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean); procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean); procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap); procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat); procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer); procedure glBitmapSetDefaultWrap( const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); function glBitmapGetDefaultDeleteTextureOnFree: Boolean; function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean; function glBitmapGetDefaultMipmap: TglBitmapMipMap; function glBitmapGetDefaultFormat: TglBitmapFormat; procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal); procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal); function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition; function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec; function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean; 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 {$IFNDEF fpc} QWord = System.UInt64; PQWord = ^QWord; PtrInt = Longint; PtrUInt = DWord; {$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////// TShiftRec = packed record case Integer of 0: (r, g, b, a: Byte); 1: (arr: array[0..3] of Byte); end; TFormatDescriptor = class(TglBitmapFormatDescriptor) private function GetRedMask: QWord; function GetGreenMask: QWord; function GetBlueMask: QWord; function GetAlphaMask: QWord; protected fFormat: TglBitmapFormat; fWithAlpha: TglBitmapFormat; fWithoutAlpha: TglBitmapFormat; fOpenGLFormat: TglBitmapFormat; fRGBInverted: TglBitmapFormat; fUncompressed: TglBitmapFormat; fPixelSize: Single; fIsCompressed: Boolean; fRange: TglBitmapColorRec; fShift: TShiftRec; fglFormat: GLenum; fglInternalFormat: GLenum; fglDataFormat: GLenum; function GetIsCompressed: Boolean; override; function GetHasRed: Boolean; override; function GetHasGreen: Boolean; override; function GetHasBlue: Boolean; override; function GetHasAlpha: Boolean; override; function GetRGBInverted: TglBitmapFormat; override; function GetWithAlpha: TglBitmapFormat; override; function GetWithoutAlpha: TglBitmapFormat; override; function GetOpenGLFormat: TglBitmapFormat; override; function GetUncompressed: TglBitmapFormat; override; function GetglFormat: GLenum; override; function GetglInternalFormat: GLenum; override; function GetglDataFormat: GLenum; override; function GetComponents: Integer; virtual; public property Format: TglBitmapFormat read fFormat; property Components: Integer read GetComponents; property PixelSize: Single read fPixelSize; property Range: TglBitmapColorRec read fRange; property Shift: TShiftRec read fShift; property RedMask: QWord read GetRedMask; property GreenMask: QWord read GetGreenMask; property BlueMask: QWord read GetBlueMask; property AlphaMask: QWord read GetAlphaMask; 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 aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): 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 procedure Clear; class procedure Finalize; end; TFormatDescriptorClass = class of TFormatDescriptor; TfdEmpty = class(TFormatDescriptor); ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlpha_UB1 = 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; TfdLuminance_UB1 = 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; TfdUniversal_UB1 = 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; TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //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; TfdRGB_UB3 = 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; TfdBGR_UB3 = 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlpha_US1 = 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; TfdLuminance_US1 = 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; TfdUniversal_US1 = 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; TfdDepth_US1 = 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; TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //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; TfdRGB_US3 = 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; TfdBGR_US3 = 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; TfdRGBA_US4 = class(TfdRGB_US3) //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; TfdARGB_US4 = class(TfdRGB_US3) //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; TfdBGRA_US4 = class(TfdBGR_US3) //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; TfdABGR_US4 = class(TfdBGR_US3) //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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdUniversal_UI1 = 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; TfdDepth_UI1 = 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlpha4 = class(TfdAlpha_UB1) constructor Create; override; end; TfdAlpha8 = class(TfdAlpha_UB1) constructor Create; override; end; TfdAlpha16 = class(TfdAlpha_US1) constructor Create; override; end; TfdLuminance4 = class(TfdLuminance_UB1) constructor Create; override; end; TfdLuminance8 = class(TfdLuminance_UB1) constructor Create; override; end; TfdLuminance16 = class(TfdLuminance_US1) constructor Create; override; end; TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2) constructor Create; override; end; TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2) constructor Create; override; end; TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2) constructor Create; override; end; TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2) constructor Create; override; end; TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2) constructor Create; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdR3G3B2 = class(TfdUniversal_UB1) constructor Create; override; end; TfdRGBX4 = class(TfdUniversal_US1) constructor Create; override; end; TfdXRGB4 = class(TfdUniversal_US1) constructor Create; override; end; TfdR5G6B5 = class(TfdUniversal_US1) constructor Create; override; end; TfdRGB5X1 = class(TfdUniversal_US1) constructor Create; override; end; TfdX1RGB5 = class(TfdUniversal_US1) constructor Create; override; end; TfdRGB8 = class(TfdRGB_UB3) constructor Create; override; end; TfdRGBX8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdXRGB8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdRGB10X2 = class(TfdUniversal_UI1) constructor Create; override; end; TfdX2RGB10 = class(TfdUniversal_UI1) constructor Create; override; end; TfdRGB16 = class(TfdRGB_US3) constructor Create; override; end; TfdRGBA4 = class(TfdUniversal_US1) constructor Create; override; end; TfdARGB4 = class(TfdUniversal_US1) constructor Create; override; end; TfdRGB5A1 = class(TfdUniversal_US1) constructor Create; override; end; TfdA1RGB5 = class(TfdUniversal_US1) constructor Create; override; end; TfdRGBA8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdARGB8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdRGB10A2 = class(TfdUniversal_UI1) constructor Create; override; end; TfdA2RGB10 = class(TfdUniversal_UI1) constructor Create; override; end; TfdRGBA16 = class(TfdUniversal_UI1) constructor Create; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdBGRX4 = class(TfdUniversal_US1) constructor Create; override; end; TfdXBGR4 = class(TfdUniversal_US1) constructor Create; override; end; TfdB5G6R5 = class(TfdUniversal_US1) constructor Create; override; end; TfdBGR5X1 = class(TfdUniversal_US1) constructor Create; override; end; TfdX1BGR5 = class(TfdUniversal_US1) constructor Create; override; end; TfdBGR8 = class(TfdBGR_UB3) constructor Create; override; end; TfdBGRX8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdXBGR8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdBGR10X2 = class(TfdUniversal_UI1) constructor Create; override; end; TfdX2BGR10 = class(TfdUniversal_UI1) constructor Create; override; end; TfdBGR16 = class(TfdBGR_US3) constructor Create; override; end; TfdBGRA4 = class(TfdUniversal_US1) constructor Create; override; end; TfdABGR4 = class(TfdUniversal_US1) constructor Create; override; end; TfdBGR5A1 = class(TfdUniversal_US1) constructor Create; override; end; TfdA1BGR5 = class(TfdUniversal_US1) constructor Create; override; end; TfdBGRA8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdABGR8 = class(TfdUniversal_UI1) constructor Create; override; end; TfdBGR10A2 = class(TfdUniversal_UI1) constructor Create; override; end; TfdA2BGR10 = class(TfdUniversal_UI1) constructor Create; override; end; TfdBGRA16 = class(TfdBGRA_US4) constructor Create; override; end; TfdDepth16 = class(TfdDepth_US1) constructor Create; override; end; TfdDepth24 = class(TfdDepth_UI1) constructor Create; override; end; TfdDepth32 = class(TfdDepth_UI1) constructor Create; 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; constructor Create; 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; constructor Create; 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; constructor Create; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TbmpBitfieldFormat = class(TFormatDescriptor) private procedure SetRedMask (const aValue: QWord); procedure SetGreenMask(const aValue: QWord); procedure SetBlueMask (const aValue: QWord); procedure SetAlphaMask(const aValue: QWord); procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte); public property RedMask: QWord read GetRedMask write SetRedMask; property GreenMask: QWord read GetGreenMask write SetGreenMask; property BlueMask: QWord read GetBlueMask write SetBlueMask; property AlphaMask: QWord read GetAlphaMask write SetAlphaMask; property PixelSize: Single read fPixelSize write fPixelSize; 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 fColorTable: TbmpColorTable; public property PixelSize: Single read fPixelSize write fPixelSize; property ColorTable: TbmpColorTable read fColorTable write fColorTable; property Range: TglBitmapColorRec read fRange write fRange; property Shift: TShiftRec read fShift write fShift; property Format: TglBitmapFormat read fFormat write fFormat; 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; UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.'; FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = ( TfdEmpty, TfdAlpha4, TfdAlpha8, TfdAlpha16, TfdLuminance4, TfdLuminance8, TfdLuminance16, TfdLuminance4Alpha4, TfdLuminance6Alpha2, TfdLuminance8Alpha8, TfdLuminance12Alpha4, TfdLuminance16Alpha16, TfdR3G3B2, TfdRGBX4, TfdXRGB4, TfdR5G6B5, TfdRGB5X1, TfdX1RGB5, TfdRGB8, TfdRGBX8, TfdXRGB8, TfdRGB10X2, TfdX2RGB10, TfdRGB16, TfdRGBA4, TfdARGB4, TfdRGB5A1, TfdA1RGB5, TfdRGBA8, TfdARGB8, TfdRGB10A2, TfdA2RGB10, TfdRGBA16, TfdBGRX4, TfdXBGR4, TfdB5G6R5, TfdBGR5X1, TfdX1BGR5, TfdBGR8, TfdBGRX8, TfdXBGR8, TfdBGR10X2, TfdX2BGR10, TfdBGR16, TfdBGRA4, TfdABGR4, TfdBGR5A1, TfdA1BGR5, TfdBGRA8, TfdABGR8, TfdBGR10A2, TfdA2BGR10, TfdBGRA16, TfdDepth16, TfdDepth24, TfdDepth32, 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, 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 glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): 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 glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec; 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 [ //4 bbp tfLuminance4, //8bpp tfR3G3B2, tfLuminance8, //16bpp tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4, tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4, //24bpp tfBGR8, tfRGB8, //32bpp tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8, tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8]) then result := result + [ftBMP]; if (aFormat in [ //8 bpp tfLuminance8, tfAlpha8, //16 bpp tfLuminance16, tfLuminance8Alpha8, tfRGB5X1, tfX1RGB5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4, tfBGR5X1, tfX1BGR5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4, //24 bpp tfRGB8, tfBGR8, //32 bpp tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then result := result + [ftTGA]; if (aFormat in [ //8 bpp tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2, tfR3G3B2, //16 bpp tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4, tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5, tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5, //24 bpp tfRGB8, tfBGR8, //32 bbp tfLuminance16Alpha16, tfRGBA8, tfRGB10A2, tfBGRA8, tfBGR10A2, //compressed tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then result := result + [ftDDS]; {$IFDEF GLB_SUPPORT_PNG_WRITE} if aFormat in [ tfAlpha8, tfLuminance8, tfLuminance8Alpha8, tfRGB8, tfRGBA8, tfBGR8, tfBGRA8] then result := result + [ftPNG]; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] 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 EglBitmapException.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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: GLenum); begin aMin := glBitmapDefaultFilterMin; aMag := glBitmapDefaultFilterMag; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum); begin S := glBitmapDefaultWrapS; T := glBitmapDefaultWrapT; R := glBitmapDefaultWrapR; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum); begin r := glDefaultSwizzle[0]; g := glDefaultSwizzle[1]; b := glDefaultSwizzle[2]; a := glDefaultSwizzle[3]; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetRedMask: QWord; begin result := fRange.r shl fShift.r; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetGreenMask: QWord; begin result := fRange.g shl fShift.g; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetBlueMask: QWord; begin result := fRange.b shl fShift.b; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetAlphaMask: QWord; begin result := fRange.a shl fShift.a; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetIsCompressed: Boolean; begin result := fIsCompressed; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetHasRed: Boolean; begin result := (fRange.r > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetHasGreen: Boolean; begin result := (fRange.g > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetHasBlue: Boolean; begin result := (fRange.b > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetHasAlpha: Boolean; begin result := (fRange.a > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetRGBInverted: TglBitmapFormat; begin result := fRGBInverted; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetWithAlpha: TglBitmapFormat; begin result := fWithAlpha; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat; begin result := fWithoutAlpha; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat; begin result := fOpenGLFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetUncompressed: TglBitmapFormat; begin result := fUncompressed; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetglFormat: GLenum; begin result := fglFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetglInternalFormat: GLenum; begin result := fglInternalFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetglDataFormat: GLenum; begin result := fglDataFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetComponents: Integer; var i: Integer; begin result := 0; for i := 0 to 3 do if (fRange.arr[i] > 0) then inc(result); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 * fPixelSize); 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 aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; begin result := false; if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then raise EglBitmap.Create('FormatCheckFormat - All Masks are 0'); if (aRedMask <> RedMask) then exit; if (aGreenMask <> GreenMask) then exit; if (aBlueMask <> BlueMask) then exit; if (aAlphaMask <> AlphaMask) then exit; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData); begin FillChar(aPixel{%H-}, SizeOf(aPixel), 0); aPixel.Data := fRange; aPixel.Range := fRange; aPixel.Format := fFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TFormatDescriptor.Create; begin inherited Create; fFormat := tfEmpty; fWithAlpha := tfEmpty; fWithoutAlpha := tfEmpty; fOpenGLFormat := tfEmpty; fRGBInverted := tfEmpty; fUncompressed := tfEmpty; fPixelSize := 0.0; fIsCompressed := false; fglFormat := 0; fglInternalFormat := 0; fglDataFormat := 0; FillChar(fRange, 0, SizeOf(fRange)); FillChar(fShift, 0, SizeOf(fShift)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.a; inc(aData); end; procedure TfdAlpha_UB1.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 TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := LuminanceWeight(aPixel); inc(aData); end; procedure TfdLuminance_UB1.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 TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin aData^ := 0; for i := 0 to 3 do if (fRange.arr[i] > 0) then aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]); inc(aData); end; procedure TfdUniversal_UB1.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 fRange.arr[i]; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminanceAlpha_UB2/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdLuminanceAlpha_UB2.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 TfdRGB_UB3.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 TfdRGB_UB3.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_UB3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGR_UB3.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 TfdBGR_UB3.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdAlpha_US1.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 TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := LuminanceWeight(aPixel); inc(aData, 2); end; procedure TfdLuminance_US1.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 TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PWord(aData)^ := 0; for i := 0 to 3 do if (fRange.arr[i] > 0) then PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]); inc(aData, 2); end; procedure TfdUniversal_US1.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 fRange.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := DepthWeight(aPixel); inc(aData, 2); end; procedure TfdDepth_US1.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 TfdLuminanceAlpha_US2.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 TfdLuminanceAlpha_US2.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 TfdRGB_US3.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 TfdRGB_US3.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_US3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGR_US3.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 TfdBGR_US3.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBA_US4.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 TfdRGBA_US4.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdARGB_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdARGB_US4.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 TfdARGB_US4.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRA_US4.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 TfdBGRA_US4.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdABGR_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdABGR_US4.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 TfdABGR_US4.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PCardinal(aData)^ := 0; for i := 0 to 3 do if (fRange.arr[i] > 0) then PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]); inc(aData, 4); end; procedure TfdUniversal_UI1.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 fRange.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PCardinal(aData)^ := DepthWeight(aPixel); inc(aData, 4); end; procedure TfdDepth_UI1.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 := 0; inc(aData, 4); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TfdAlpha4.Create; begin inherited Create; fPixelSize := 1.0; fFormat := tfAlpha4; fWithAlpha := tfAlpha4; fOpenGLFormat := tfAlpha4; fRange.a := $FF; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdAlpha8.Create; begin inherited Create; fPixelSize := 1.0; fFormat := tfAlpha8; fWithAlpha := tfAlpha8; fOpenGLFormat := tfAlpha8; fRange.a := $FF; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA8; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdAlpha16.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfAlpha16; fWithAlpha := tfAlpha16; fOpenGLFormat := tfAlpha16; fRange.a := $FFFF; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdLuminance4.Create; begin inherited Create; fPixelSize := 1.0; fFormat := tfLuminance4; fWithAlpha := tfLuminance4Alpha4; fWithoutAlpha := tfLuminance4; fOpenGLFormat := tfLuminance4; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE4; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdLuminance8.Create; begin inherited Create; fPixelSize := 1.0; fFormat := tfLuminance8; fWithAlpha := tfLuminance8Alpha8; fWithoutAlpha := tfLuminance8; fOpenGLFormat := tfLuminance8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE8; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdLuminance16.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfLuminance16; fWithAlpha := tfLuminance16Alpha16; fWithoutAlpha := tfLuminance16; fOpenGLFormat := tfLuminance16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE16; fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdLuminance4Alpha4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfLuminance4Alpha4; fWithAlpha := tfLuminance4Alpha4; fWithoutAlpha := tfLuminance4; fOpenGLFormat := tfLuminance4Alpha4; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 0; fShift.g := 0; fShift.b := 0; fShift.a := 8; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE4_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdLuminance6Alpha2.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfLuminance6Alpha2; fWithAlpha := tfLuminance6Alpha2; fWithoutAlpha := tfLuminance8; fOpenGLFormat := tfLuminance6Alpha2; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 0; fShift.g := 0; fShift.b := 0; fShift.a := 8; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE6_ALPHA2; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdLuminance8Alpha8.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfLuminance8Alpha8; fWithAlpha := tfLuminance8Alpha8; fWithoutAlpha := tfLuminance8; fOpenGLFormat := tfLuminance8Alpha8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 0; fShift.g := 0; fShift.b := 0; fShift.a := 8; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE8_ALPHA8; fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdLuminance12Alpha4.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfLuminance12Alpha4; fWithAlpha := tfLuminance12Alpha4; fWithoutAlpha := tfLuminance16; fOpenGLFormat := tfLuminance12Alpha4; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fRange.a := $FFFF; fShift.r := 0; fShift.g := 0; fShift.b := 0; fShift.a := 16; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE12_ALPHA4; fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdLuminance16Alpha16.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfLuminance16Alpha16; fWithAlpha := tfLuminance16Alpha16; fWithoutAlpha := tfLuminance16; fOpenGLFormat := tfLuminance16Alpha16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fRange.a := $FFFF; fShift.r := 0; fShift.g := 0; fShift.b := 0; fShift.a := 16; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE16_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdR3G3B2.Create; begin inherited Create; fPixelSize := 1.0; fFormat := tfR3G3B2; fWithAlpha := tfRGBA4; fWithoutAlpha := tfR3G3B2; fOpenGLFormat := tfR3G3B2; fRGBInverted := tfEmpty; fRange.r := $07; fRange.g := $07; fRange.b := $04; fShift.r := 5; fShift.g := 2; fShift.b := 0; fglFormat := GL_RGB; fglInternalFormat := GL_R3_G3_B2; fglDataFormat := GL_UNSIGNED_BYTE_3_3_2; end; constructor TfdRGBX4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfRGBX4; fWithAlpha := tfRGBA4; fWithoutAlpha := tfRGBX4; fOpenGLFormat := tfRGBX4; fRGBInverted := tfBGRX4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $00; fShift.r := 12; fShift.g := 8; fShift.b := 4; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; constructor TfdXRGB4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfXRGB4; fWithAlpha := tfARGB4; fWithoutAlpha := tfXRGB4; fOpenGLFormat := tfXRGB4; fRGBInverted := tfXBGR4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fShift.r := 8; fShift.g := 4; fShift.b := 0; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; end; constructor TfdR5G6B5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfR5G6B5; fWithAlpha := tfRGB5A1; fWithoutAlpha := tfR5G6B5; fOpenGLFormat := tfR5G6B5; fRGBInverted := tfB5G6R5; fRange.r := $1F; fRange.g := $3F; fRange.b := $1F; fShift.r := 11; fShift.g := 5; fShift.b := 0; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5; end; constructor TfdRGB5X1.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfRGB5X1; fWithAlpha := tfRGB5A1; fWithoutAlpha := tfRGB5X1; fOpenGLFormat := tfRGB5X1; fRGBInverted := tfBGR5X1; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fShift.r := 11; fShift.g := 6; fShift.b := 1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; constructor TfdX1RGB5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfX1RGB5; fWithAlpha := tfA1RGB5; fWithoutAlpha := tfX1RGB5; fOpenGLFormat := tfX1RGB5; fRGBInverted := tfX1BGR5; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fShift.r := 10; fShift.g := 5; fShift.b := 0; 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; end; constructor TfdRGB8.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfRGB8; fWithAlpha := tfRGBA8; fWithoutAlpha := tfRGB8; fOpenGLFormat := tfRGB8; fRGBInverted := tfBGR8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 16; fShift.g := 8; fShift.b := 0; fglFormat := GL_BGR; // reverse byte order to match little endianess fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdRGBX8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfRGBX8; fWithAlpha := tfRGBA8; fWithoutAlpha := tfRGBX8; fOpenGLFormat := tfRGB8; fRGBInverted := tfBGRX8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 24; fShift.g := 16; fShift.b := 8; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; end; constructor TfdXRGB8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfXRGB8; fWithAlpha := tfXRGB8; fWithoutAlpha := tfXRGB8; fOpenGLFormat := tfRGB8; fRGBInverted := tfXBGR8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 16; fShift.g := 8; fShift.b := 0; 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; end; constructor TfdRGB10X2.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfRGB10X2; fWithAlpha := tfRGB10A2; fWithoutAlpha := tfRGB10X2; fOpenGLFormat := tfRGB10X2; fRGBInverted := tfBGR10X2; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fShift.r := 22; fShift.g := 12; fShift.b := 2; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; end; constructor TfdX2RGB10.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfX2RGB10; fWithAlpha := tfA2RGB10; fWithoutAlpha := tfX2RGB10; fOpenGLFormat := tfX2RGB10; fRGBInverted := tfX2BGR10; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fShift.r := 20; fShift.g := 10; fShift.b := 0; 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; end; constructor TfdRGB16.Create; begin inherited Create; fPixelSize := 6.0; fFormat := tfRGB16; fWithAlpha := tfRGBA16; fWithoutAlpha := tfRGB16; fOpenGLFormat := tfRGB16; fRGBInverted := tfBGR16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fShift.r := 32; fShift.g := 16; fShift.b := 0; fglFormat := GL_BGR; // reverse byte order to match little endianess fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdRGBA4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfRGBA4; fWithAlpha := tfRGBA4; fWithoutAlpha := tfRGBX4; fOpenGLFormat := tfRGBA4; fRGBInverted := tfBGRA4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $0F; fShift.r := 12; fShift.g := 8; fShift.b := 4; fShift.a := 0; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; constructor TfdARGB4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfARGB4; fWithAlpha := tfARGB4; fWithoutAlpha := tfXRGB4; fOpenGLFormat := tfARGB4; fRGBInverted := tfABGR4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $0F; fShift.r := 8; fShift.g := 4; fShift.b := 0; fShift.a := 12; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; end; constructor TfdRGB5A1.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfRGB5A1; fWithAlpha := tfRGB5A1; fWithoutAlpha := tfRGB5X1; fOpenGLFormat := tfRGB5A1; fRGBInverted := tfBGR5A1; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fRange.a := $01; fShift.r := 11; fShift.g := 6; fShift.b := 1; fShift.a := 0; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; constructor TfdA1RGB5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfA1RGB5; fWithAlpha := tfA1RGB5; fWithoutAlpha := tfX1RGB5; fOpenGLFormat := tfA1RGB5; fRGBInverted := tfA1BGR5; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fRange.a := $01; fShift.r := 10; fShift.g := 5; fShift.b := 0; fShift.a := 15; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; end; constructor TfdRGBA8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfRGBA8; fWithAlpha := tfRGBA8; fWithoutAlpha := tfRGB8; fOpenGLFormat := tfRGBA8; fRGBInverted := tfBGRA8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 24; fShift.g := 16; fShift.b := 8; fShift.a := 0; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; end; constructor TfdARGB8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfARGB8; fWithAlpha := tfARGB8; fWithoutAlpha := tfRGB8; fOpenGLFormat := tfARGB8; fRGBInverted := tfABGR8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 16; fShift.g := 8; fShift.b := 0; fShift.a := 24; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; end; constructor TfdRGB10A2.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfRGB10A2; fWithAlpha := tfRGB10A2; fWithoutAlpha := tfRGB10X2; fOpenGLFormat := tfRGB10A2; fRGBInverted := tfBGR10A2; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fRange.a := $0003; fShift.r := 22; fShift.g := 12; fShift.b := 2; fShift.a := 0; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; end; constructor TfdA2RGB10.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfA2RGB10; fWithAlpha := tfA2RGB10; fWithoutAlpha := tfX2RGB10; fOpenGLFormat := tfA2RGB10; fRGBInverted := tfA2BGR10; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fRange.a := $0003; fShift.r := 20; fShift.g := 10; fShift.b := 0; fShift.a := 30; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; end; constructor TfdRGBA16.Create; begin inherited Create; fPixelSize := 8.0; fFormat := tfRGBA16; fWithAlpha := tfRGBA16; fWithoutAlpha := tfRGB16; fOpenGLFormat := tfRGBA16; fRGBInverted := tfBGRA16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fRange.a := $FFFF; fShift.r := 48; fShift.g := 32; fShift.b := 16; fShift.a := 0; fglFormat := GL_BGRA; // reverse byte order to match little endianess fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_SHORT; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TfdBGRX4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfBGRX4; fWithAlpha := tfBGRA4; fWithoutAlpha := tfBGRX4; fOpenGLFormat := tfBGRX4; fRGBInverted := tfRGBX4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fShift.r := 4; fShift.g := 8; fShift.b := 12; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; constructor TfdXBGR4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfXBGR4; fWithAlpha := tfABGR4; fWithoutAlpha := tfXBGR4; fOpenGLFormat := tfXBGR4; fRGBInverted := tfXRGB4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $0F; fShift.r := 0; fShift.g := 4; fShift.b := 8; 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; end; constructor TfdB5G6R5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfB5G6R5; fWithAlpha := tfBGR5A1; fWithoutAlpha := tfB5G6R5; fOpenGLFormat := tfB5G6R5; fRGBInverted := tfR5G6B5; fRange.r := $1F; fRange.g := $3F; fRange.b := $1F; fShift.r := 0; fShift.g := 5; fShift.b := 11; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV; end; constructor TfdBGR5X1.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfBGR5X1; fWithAlpha := tfBGR5A1; fWithoutAlpha := tfBGR5X1; fOpenGLFormat := tfBGR5X1; fRGBInverted := tfRGB5X1; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fShift.r := 1; fShift.g := 6; fShift.b := 11; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; constructor TfdX1BGR5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfX1BGR5; fWithAlpha := tfA1BGR5; fWithoutAlpha := tfX1BGR5; fOpenGLFormat := tfX1BGR5; fRGBInverted := tfX1RGB5; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fShift.r := 0; fShift.g := 5; fShift.b := 10; 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; end; constructor TfdBGR8.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfBGR8; fWithAlpha := tfBGRA8; fWithoutAlpha := tfBGR8; fOpenGLFormat := tfBGR8; fRGBInverted := tfRGB8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 0; fShift.g := 8; fShift.b := 16; fglFormat := GL_RGB; // reverse byte order to match little endianess fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_BYTE; end; constructor TfdBGRX8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfBGRX8; fWithAlpha := tfBGRA8; fWithoutAlpha := tfBGRX8; fOpenGLFormat := tfBGRX8; fRGBInverted := tfRGBX8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 8; fShift.g := 16; fShift.b := 24; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; end; constructor TfdXBGR8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfXBGR8; fWithAlpha := tfABGR8; fWithoutAlpha := tfXBGR8; fOpenGLFormat := tfXBGR8; fRGBInverted := tfXRGB8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fShift.r := 0; fShift.g := 8; fShift.b := 16; 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; end; constructor TfdBGR10X2.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfBGR10X2; fWithAlpha := tfBGR10A2; fWithoutAlpha := tfBGR10X2; fOpenGLFormat := tfBGR10X2; fRGBInverted := tfRGB10X2; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fShift.r := 2; fShift.g := 12; fShift.b := 22; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; end; constructor TfdX2BGR10.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfX2BGR10; fWithAlpha := tfA2BGR10; fWithoutAlpha := tfX2BGR10; fOpenGLFormat := tfX2BGR10; fRGBInverted := tfX2RGB10; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fShift.r := 0; fShift.g := 10; fShift.b := 20; 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; end; constructor TfdBGR16.Create; begin inherited Create; fPixelSize := 6.0; fFormat := tfBGR16; fWithAlpha := tfBGRA16; fWithoutAlpha := tfBGR16; fOpenGLFormat := tfBGR16; fRGBInverted := tfRGB16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fShift.r := 0; fShift.g := 16; fShift.b := 32; fglFormat := GL_RGB; // reverse byte order to match little endianess fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdBGRA4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfBGRA4; fWithAlpha := tfBGRA4; fWithoutAlpha := tfBGRX4; fOpenGLFormat := tfBGRA4; fRGBInverted := tfRGBA4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $0F; fShift.r := 4; fShift.g := 8; fShift.b := 12; fShift.a := 0; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; constructor TfdABGR4.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfABGR4; fWithAlpha := tfABGR4; fWithoutAlpha := tfXBGR4; fOpenGLFormat := tfABGR4; fRGBInverted := tfARGB4; fRange.r := $0F; fRange.g := $0F; fRange.b := $0F; fRange.a := $0F; fShift.r := 0; fShift.g := 4; fShift.b := 8; fShift.a := 12; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; end; constructor TfdBGR5A1.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfBGR5A1; fWithAlpha := tfBGR5A1; fWithoutAlpha := tfBGR5X1; fOpenGLFormat := tfBGR5A1; fRGBInverted := tfRGB5A1; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fRange.a := $01; fShift.r := 1; fShift.g := 6; fShift.b := 11; fShift.a := 0; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; constructor TfdA1BGR5.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfA1BGR5; fWithAlpha := tfA1BGR5; fWithoutAlpha := tfX1BGR5; fOpenGLFormat := tfA1BGR5; fRGBInverted := tfA1RGB5; fRange.r := $1F; fRange.g := $1F; fRange.b := $1F; fRange.a := $01; fShift.r := 0; fShift.g := 5; fShift.b := 10; fShift.a := 15; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; end; constructor TfdBGRA8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfBGRA8; fWithAlpha := tfBGRA8; fWithoutAlpha := tfBGR8; fOpenGLFormat := tfBGRA8; fRGBInverted := tfRGBA8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 8; fShift.g := 16; fShift.b := 24; fShift.a := 0; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; end; constructor TfdABGR8.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfABGR8; fWithAlpha := tfABGR8; fWithoutAlpha := tfBGR8; fOpenGLFormat := tfABGR8; fRGBInverted := tfARGB8; fRange.r := $FF; fRange.g := $FF; fRange.b := $FF; fRange.a := $FF; fShift.r := 0; fShift.g := 8; fShift.b := 16; fShift.a := 24; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; end; constructor TfdBGR10A2.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfBGR10A2; fWithAlpha := tfBGR10A2; fWithoutAlpha := tfBGR10X2; fOpenGLFormat := tfBGR10A2; fRGBInverted := tfRGB10A2; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fRange.a := $0003; fShift.r := 2; fShift.g := 12; fShift.b := 22; fShift.a := 0; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; end; constructor TfdA2BGR10.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfA2BGR10; fWithAlpha := tfA2BGR10; fWithoutAlpha := tfX2BGR10; fOpenGLFormat := tfA2BGR10; fRGBInverted := tfA2RGB10; fRange.r := $03FF; fRange.g := $03FF; fRange.b := $03FF; fRange.a := $0003; fShift.r := 0; fShift.g := 10; fShift.b := 20; fShift.a := 30; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; end; constructor TfdBGRA16.Create; begin inherited Create; fPixelSize := 8.0; fFormat := tfBGRA16; fWithAlpha := tfBGRA16; fWithoutAlpha := tfBGR16; fOpenGLFormat := tfBGRA16; fRGBInverted := tfRGBA16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fRange.a := $FFFF; fShift.r := 16; fShift.g := 32; fShift.b := 48; fShift.a := 0; fglFormat := GL_RGBA; // reverse byte order to match little endianess fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdDepth16.Create; begin inherited Create; fPixelSize := 2.0; fFormat := tfDepth16; fWithoutAlpha := tfDepth16; fOpenGLFormat := tfDepth16; fRange.r := $FFFF; fRange.g := $FFFF; fRange.b := $FFFF; fRange.a := $FFFF; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT16; fglDataFormat := GL_UNSIGNED_SHORT; end; constructor TfdDepth24.Create; begin inherited Create; fPixelSize := 3.0; fFormat := tfDepth24; fWithoutAlpha := tfDepth24; fOpenGLFormat := tfDepth24; fRange.r := $FFFFFF; fRange.g := $FFFFFF; fRange.b := $FFFFFF; fRange.a := $FFFFFF; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT24; fglDataFormat := GL_UNSIGNED_INT; end; constructor TfdDepth32.Create; begin inherited Create; fPixelSize := 4.0; fFormat := tfDepth32; fWithoutAlpha := tfDepth32; fOpenGLFormat := tfDepth32; fRange.r := $FFFFFFFF; fRange.g := $FFFFFFFF; fRange.b := $FFFFFFFF; fRange.a := $FFFFFFFF; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT32; fglDataFormat := GL_UNSIGNED_INT; 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; constructor TfdS3tcDtx1RGBA.Create; begin inherited Create; fFormat := tfS3tcDtx1RGBA; fWithAlpha := tfS3tcDtx1RGBA; fOpenGLFormat := tfS3tcDtx1RGBA; fUncompressed := tfRGB5A1; fPixelSize := 0.5; fIsCompressed := true; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; fglDataFormat := GL_UNSIGNED_BYTE; 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; constructor TfdS3tcDtx3RGBA.Create; begin inherited Create; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fOpenGLFormat := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8; fPixelSize := 1.0; fIsCompressed := true; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; fglDataFormat := GL_UNSIGNED_BYTE; 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; constructor TfdS3tcDtx5RGBA.Create; begin inherited Create; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fOpenGLFormat := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8; fPixelSize := 1.0; fIsCompressed := true; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; fglDataFormat := GL_UNSIGNED_BYTE; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 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.SetRedMask(const aValue: QWord); begin Update(aValue, fRange.r, fShift.r); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord); begin Update(aValue, fRange.g, fShift.g); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord); begin Update(aValue, fRange.b, fShift.b); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord); begin Update(aValue, fRange.a, fShift.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte); begin aShift := 0; aRange := 0; if (aMask = 0) then exit; while (aMask > 0) and ((aMask and 1) = 0) do begin inc(aShift); aMask := aMask shr 1; end; aRange := 1; while (aMask > 0) do begin aRange := aRange shl 1; aMask := aMask shr 1; end; dec(aRange); fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var data: QWord; s: Integer; begin data := ((aPixel.Data.r and fRange.r) shl fShift.r) or ((aPixel.Data.g and fRange.g) shl fShift.g) or ((aPixel.Data.b and fRange.b) shl fShift.b) or ((aPixel.Data.a and fRange.a) shl fShift.a); s := Round(fPixelSize); case s of 1: aData^ := data; 2: PWord(aData)^ := data; 4: PCardinal(aData)^ := data; 8: PQWord(aData)^ := data; else raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]); end; inc(aData, s); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var data: QWord; s, i: Integer; begin s := Round(fPixelSize); case s of 1: data := aData^; 2: data := PWord(aData)^; 4: data := PCardinal(aData)^; 8: data := PQWord(aData)^; else raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]); end; for i := 0 to 3 do aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i]; inc(aData, s); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TColorTableFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.CreateColorTable; var i: Integer; begin if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then raise EglBitmap.Create(UNSUPPORTED_FORMAT); if (Format = tfLuminance4) then SetLength(fColorTable, 16) else SetLength(fColorTable, 256); case Format of tfLuminance4: begin for i := 0 to High(fColorTable) do begin fColorTable[i].r := 16 * i; fColorTable[i].g := 16 * i; fColorTable[i].b := 16 * i; fColorTable[i].a := 0; end; end; tfLuminance8: begin for i := 0 to High(fColorTable) do begin fColorTable[i].r := i; fColorTable[i].g := i; fColorTable[i].b := i; fColorTable[i].a := 0; end; end; tfR3G3B2: begin 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; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var d: Byte; begin if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then raise EglBitmap.Create(UNSUPPORTED_FORMAT); case Format of tfLuminance4: begin if (aMapData = nil) then aData^ := 0; d := LuminanceWeight(aPixel) and Range.r; aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData))); inc(PByte(aMapData), 4); if ({%H-}PtrUInt(aMapData) >= 8) then begin inc(aData); aMapData := nil; end; end; tfLuminance8: begin aData^ := LuminanceWeight(aPixel) and Range.r; inc(aData); end; tfR3G3B2: begin 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; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var idx: QWord; s: Integer; bits: Byte; f: Single; begin s := Trunc(fPixelSize); f := fPixelSize - s; bits := Round(8 * f); case s of 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1); 1: idx := aData^; 2: idx := PWord(aData)^; 4: idx := PCardinal(aData)^; 8: idx := PQWord(aData)^; else raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]); end; if (idx >= Length(fColorTable)) then raise EglBitmap.CreateFmt('invalid color index: %d', [idx]); with fColorTable[idx] do begin aPixel.Data.r := r; aPixel.Data.g := g; aPixel.Data.b := b; aPixel.Data.a := a; end; inc(PByte(aMapData), bits); if ({%H-}PtrUInt(aMapData) >= 8) then begin inc(aData, 1); dec(PByte(aMapData), 8); end; inc(aData, s); 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).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize 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); var MaxAnisotropic: Integer; begin fAnisotropic := aValue; if (ID > 0) then begin if GL_EXT_texture_filter_anisotropic then begin if fAnisotropic > 0 then begin Bind(false); glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic); if aValue > MaxAnisotropic then fAnisotropic := MaxAnisotropic; glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic); end; end else begin fAnisotropic := 0; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.CreateID; begin if (ID <> 0) then glDeleteTextures(1, @fID); glGenTextures(1, @fID); Bind(false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean); begin // Set Up Parameters SetWrap(fWrapS, fWrapT, fWrapR); SetFilter(fFilterMin, fFilterMag); SetAnisotropic(fAnisotropic); 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]); // Mip Maps Generation Mode aBuildWithGlu := false; if (MipMap = mmMipmap) then begin if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE) else aBuildWithGlu := true; end else if (MipMap = mmMipmapGlu) then aBuildWithGlu := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDataPointer(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).PixelSize; fFormat := aFormat; fPixelSize := Ceil(s); fRowSize := Ceil(s * aWidth); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipHorz: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipVert: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - PUBLIC////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.AfterConstruction; begin inherited AfterConstruction; fID := 0; fTarget := 0; fIsResident := false; fMipMap := glBitmapDefaultMipmap; fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture; fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree; glBitmapGetDefaultFilter (fFilterMin, fFilterMag); glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR); glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]); 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 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); 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.PixelSize <> DestFD.PixelSize) 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; FormatDesc: TFormatDescriptor; 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 for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin FormatDesc := TFormatDescriptor.Get(IntFormat); if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then break; end; if (IntFormat = tfEmpty) then raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.'); end; TempWidth := aSurface^.w; TempHeight := aSurface^.h; RowSize := FormatDesc.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 [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0); AlphaInterleave := 0; case Format of tfLuminance8Alpha8: AlphaInterleave := 1; tfBGRA8, tfRGBA8: 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 tfAlpha8, tfLuminance8: begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; end; tfRGB5A1: aBitmap.PixelFormat := pf15bit; tfR5G6B5: aBitmap.PixelFormat := pf16bit; tfRGB8, tfBGR8: aBitmap.PixelFormat := pf24bit; tfRGBA8, tfBGRA8: 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 [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A) SwapRGB(pData, FileWidth, Format = tfRGBA8); 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 := tfLuminance8; pf15bit: IntFormat := tfRGB5A1; pf16bit: IntFormat := tfR5G6B5; pf24bit: IntFormat := tfBGR8; pf32bit: IntFormat := tfBGRA8; 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 [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin if Assigned(aBitmap) then begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; aBitmap.Width := Width; aBitmap.Height := Height; case Format of tfLuminance8Alpha8: AlphaInterleave := 1; tfRGBA8, tfBGRA8: 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 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 (Format in [ tfAlpha4, tfAlpha8, tfAlpha16, tfLuminance4, tfLuminance8, tfLuminance16, tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16]) then rid.Format := ricfGray else rid.Format := ricfRGBA; rid.Width := Width; rid.Height := Height; rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask); rid.BitOrder := riboBitsInOrder; rid.ByteOrder := riboLSBFirst; rid.LineOrder := riloTopToBottom; rid.LineEnd := rileTight; rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize); 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; 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; procedure CopyConvert; var bfFormat: TbmpBitfieldFormat; pSourceLine, pDestLine: PByte; pSourceMD, pDestMD: Pointer; x, y: Integer; pixel: TglBitmapPixelData; begin bfFormat := TbmpBitfieldFormat.Create; with aImage.DataDescription do begin bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift; bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift; bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift; bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift; bfFormat.PixelSize := BitsPerPixel / 8; 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.PixelSize * 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; for f := High(f) downto Low(f) do begin FormatDesc := TFormatDescriptor.Get(f); with aImage.DataDescription do if FormatDesc.MaskMatch( (QWord(1 shl RedPrec )-1) shl RedShift, (QWord(1 shl GreenPrec)-1) shl GreenShift, (QWord(1 shl BluePrec )-1) shl BlueShift, (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then break; end; if (f = tfEmpty) then exit; CanCopy := (Round(FormatDesc.PixelSize * 8) = 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.RedMask = DestFD.RedMask) and (SourceFD.GreenMask = DestFD.GreenMask) and (SourceFD.BlueMask = DestFD.BlueMask) and (SourceFD.AlphaMask = DestFD.AlphaMask); 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); begin fBorderColor[0] := aRed; fBorderColor[1] := aGreen; fBorderColor[2] := aBlue; fBorderColor[3] := aAlpha; if (ID > 0) then begin Bind(false); glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FreeData; 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) or (Target = GL_TEXTURE_RECTANGLE) then begin case fFilterMin of GL_NEAREST, GL_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST); GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR); end; end else glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum); procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal); begin case aValue of GL_CLAMP: aTarget := GL_CLAMP; GL_REPEAT: aTarget := GL_REPEAT; GL_CLAMP_TO_EDGE: begin if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then aTarget := GL_CLAMP_TO_EDGE else aTarget := GL_CLAMP; end; GL_CLAMP_TO_BORDER: begin if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then aTarget := GL_CLAMP_TO_BORDER else aTarget := GL_CLAMP; end; GL_MIRRORED_REPEAT: begin if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then aTarget := GL_MIRRORED_REPEAT else raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).'); end; 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); glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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 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'); CheckAndSetValue(r, 0); CheckAndSetValue(g, 1); CheckAndSetValue(b, 2); CheckAndSetValue(a, 3); if (ID > 0) then begin Bind(false); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0])); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean); begin if aEnableTextureUnit then glEnable(Target); if (ID > 0) then glBindTexture(Target, ID); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean); begin if aDisableTextureUnit then glDisable(Target); glBindTexture(Target, 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create; begin 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 := tfLuminance8; PNG_COLOR_TYPE_GRAY_ALPHA: Format := tfLuminance8Alpha8; PNG_COLOR_TYPE_RGB: Format := tfRGB8; PNG_COLOR_TYPE_RGB_ALPHA: Format := tfRGBA8; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; // cut upper 8 bit from 16 bit formats if png_get_bit_depth(png, png_info) > 8 then png_set_strip_16(png); // expand bitdepth smaller than 8 if png_get_bit_depth(png, png_info) < 8 then png_set_expand(png); // allocating mem for scanlines LineSize := png_get_rowbytes(png, png_info); GetMem(png_data, TempHeight * LineSize); try SetLength(png_rows, TempHeight); for Row := Low(png_rows) to High(png_rows) do begin png_rows[Row] := png_data; Inc(png_rows[Row], Row * LineSize); end; // read complete image into scanlines png_read_image(png, @png_rows[0]); // read end png_read_end(png, png_info); // destroy read struct png_destroy_read_struct(@png, @png_info, nil); SetLength(png_rows, 0); // set new data SetDataPointer(png_data, Format, TempWidth, TempHeight); //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 := tfLuminance8; COLOR_GRAYSCALEALPHA: PngFormat := tfLuminance8Alpha8; COLOR_RGB: PngFormat := tfBGR8; COLOR_RGBALPHA: PngFormat := tfBGRA8; 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 tfAlpha8, tfLuminance8: ColorType := PNG_COLOR_TYPE_GRAY; tfLuminance8Alpha8: ColorType := PNG_COLOR_TYPE_GRAY_ALPHA; tfBGR8, tfRGB8: ColorType := PNG_COLOR_TYPE_RGB; tfBGRA8, tfRGBA8: 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 [tfBGR8, tfBGRA8] 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 tfAlpha8, tfLuminance8: begin ColorType := COLOR_GRAYSCALE; PixSize := 1; Alpha := false; end; tfLuminance8Alpha8: begin ColorType := COLOR_GRAYSCALEALPHA; PixSize := 1; Alpha := true; end; tfBGR8, tfRGB8: begin ColorType := COLOR_RGB; PixSize := 3; Alpha := false; end; tfBGRA8, tfRGBA8: 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 [tfRGB8, tfRGBA8] 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 := tfLuminance8; end; else jpeg.out_color_space := JCS_RGB; IntFormat := tfRGB8; 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 tfAlpha8, tfLuminance8: begin jpeg.input_components := 1; jpeg.in_color_space := JCS_GRAYSCALE; end; tfRGB8, tfBGR8: 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 = tfBGR8 then GetMem(pTemp2, fRowSize) else pTemp2 := pTemp; try for Row := 0 to jpeg.image_height -1 do begin // prepare row if Format = tfBGR8 then CopyRow(pTemp2, pTemp) else pTemp2 := pTemp; // write row jpeg_write_scanlines(@jpeg, @pTemp2, 1); inc(pTemp, fRowSize); end; finally // free memory if Format = tfBGR8 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 [tfAlpha8, tfLuminance8]) 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} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //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: TglBitmapColorRec): 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 := tfLuminance8; 16: result := tfX1RGB5; 24: result := tfRGB8; 32: result := tfXRGB8; 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 := tfLuminance8; 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 := tfRGB8; end; result := TbmpColorTableFormat.Create; result.PixelSize := aInfo.biBitCount / 8; result.ColorTable := ColorTable; result.Range := glBitmapColorRec($FF, $FF, $FF, $00); end; ////////////////////////////////////////////////////////////////////////////////////////////////// function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec; const aInfo: TBMPInfo): TbmpBitfieldFormat; var TmpFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; begin result := nil; if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin FormatDesc := TFormatDescriptor.Get(TmpFormat); if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin aFormat := FormatDesc.Format; exit; end; end; 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.PixelSize := aInfo.biBitCount / 8; result.RedMask := aMask.r; result.GreenMask := aMask.g; result.BlueMask := aMask.b; result.AlphaMask := aMask.a; 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: TglBitmapColorRec; 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.PixelSize); 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 tfLuminance4: begin Info.biBitCount := 4; Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries Converter := TbmpColorTableFormat.Create; with (Converter as TbmpColorTableFormat) do begin PixelSize := 0.5; Format := Format; Range := glBitmapColorRec($F, $F, $F, $0); CreateColorTable; end; end; tfR3G3B2, tfLuminance8: 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 PixelSize := 1; Format := Format; if (Format = tfR3G3B2) then begin Range := glBitmapColorRec($7, $7, $3, $0); Shift := glBitmapShiftRec(0, 3, 6, 0); end else Range := glBitmapColorRec($FF, $FF, $FF, $0); CreateColorTable; end; end; tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4, tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4: begin Info.biBitCount := 16; Info.biCompression := BMP_COMP_BITFIELDS; end; tfBGR8, tfRGB8: begin Info.biBitCount := 24; if (Format = tfRGB8) then Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values end; tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8, tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8: 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.RedMask; GreenMask := FormatDesc.GreenMask; BlueMask := FormatDesc.BlueMask; AlphaMask := FormatDesc.AlphaMask; 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.PixelSize); 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 := tfLuminance8; 8: tgaFormat := tfAlpha8; end; 16: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance16; 8: tgaFormat := tfLuminance8Alpha8; end else case (Header.ImageDesc and $F) of 0: tgaFormat := tfX1RGB5; 1: tgaFormat := tfA1RGB5; 4: tgaFormat := tfARGB4; end; 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfRGB8; end; 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of 2: tgaFormat := tfA2RGB10; 8: tgaFormat := tfARGB8; 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; LineSize, Size, x, y: Integer; Pixel: TglBitmapPixelData; LineBuf, SourceData, DestData: PByte; SourceMD, DestMD: Pointer; FormatDesc: TFormatDescriptor; Converter: TFormatDescriptor; begin if not (ftTGA in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); //prepare header FillChar(Header{%H-}, SizeOf(Header), 0); //set ImageType if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8, tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then Header.ImageType := TGA_UNCOMPRESSED_GRAY else Header.ImageType := TGA_UNCOMPRESSED_RGB; //set BitsPerPixel if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then Header.Bpp := 8 else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8, tfRGB5X1, tfBGR5X1, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then Header.Bpp := 16 else if (Format in [tfBGR8, tfRGB8]) then Header.Bpp := 24 else Header.Bpp := 32; //set AlphaBitCount case Format of tfRGB5A1, tfBGR5A1: Header.ImageDesc := 1 and $F; tfRGB10A2, tfBGR10A2: Header.ImageDesc := 2 and $F; tfRGBA4, tfBGRA4: Header.ImageDesc := 4 and $F; tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8: Header.ImageDesc := 8 and $F; end; Header.Width := Width; Header.Height := Height; Header.ImageDesc := Header.ImageDesc or $20; //flip y aStream.Write(Header, SizeOf(Header)); // convert RGB(A) to BGR(A) Converter := nil; FormatDesc := TFormatDescriptor.Get(Format); Size := FormatDesc.GetSize(Dimension); if Format in [tfRGB5X1, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin if (FormatDesc.RGBInverted = tfEmpty) then raise EglBitmap.Create('inverted RGB format is empty'); Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted); if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or (Converter.PixelSize <> FormatDesc.PixelSize) then raise EglBitmap.Create('invalid inverted RGB format'); end; if Assigned(Converter) then begin LineSize := FormatDesc.GetSize(Width, 1); GetMem(LineBuf, LineSize); SourceMD := FormatDesc.CreateMappingData; DestMD := Converter.CreateMappingData; try SourceData := Data; for y := 0 to Height-1 do begin DestData := LineBuf; for x := 0 to Width-1 do begin FormatDesc.Unmap(SourceData, Pixel, SourceMD); Converter.Map(Pixel, DestData, DestMD); end; aStream.Write(LineBuf^, LineSize); end; finally FreeMem(LineBuf); FormatDesc.FreeMappingData(SourceMD); FormatDesc.FreeMappingData(DestMD); end; end else 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; Range: TglBitmapColorRec; 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)) > 0) then begin // prepare masks if ((dwFlags and DDPF_LUMINANCE) = 0) then begin Range.r := dwRBitMask; Range.g := dwGBitMask; Range.b := dwBBitMask; end else begin Range.r := dwRBitMask; Range.g := dwRBitMask; Range.b := dwRBitMask; end; Range.a := dwABitMask; //find matching format for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin fd := TFormatDescriptor.Get(result); if fd.MaskMatch(Range.r, Range.g, Range.b, Range.a) and (8 * fd.PixelSize = dwRGBBitCount) then exit; end; //find format with same Range for i := 0 to 3 do begin while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do Range.arr[i] := Range.arr[i] shr 1; end; 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 := tfRGBA8 else result := tfRGB8; end; Converter := TbmpBitfieldFormat.Create; Converter.RedMask := dwRBitMask; Converter.GreenMask := dwGBitMask; Converter.BlueMask := dwBBitMask; Converter.AlphaMask := dwABitMask; Converter.PixelSize := dwRGBBitCount / 8; 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.PixelSize); 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 (Format in [tfAlpha8, tfAlpha16]) then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA; Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8); Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask; end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE; Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8); Header.PixelFormat.dwRBitMask := FormatDesc.RedMask; Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask; end else begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB; Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8); Header.PixelFormat.dwRBitMask := FormatDesc.RedMask; Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask; Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask; Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask; 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //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.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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //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).PixelSize); 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; const aBuildWithGlu: Boolean); var FormatDesc: TFormatDescriptor; begin glPixelStorei(GL_UNPACK_ALIGNMENT, 1); FormatDesc := TFormatDescriptor.Get(Format); 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) end else if aBuildWithGlu then begin gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height, FormatDesc.glFormat, FormatDesc.glDataFormat, Data) 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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); IntFormat := tfEmpty; 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean); var BuildWithGlu, PotTex, TexRec: Boolean; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if ((Height > TexSize) or (Width > TexSize)) then raise 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); 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.'); end; CreateId; SetupParameters(BuildWithGlu); UploadData(Target, BuildWithGlu); glAreTexturesResident(1, @fID, @fIsResident); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.FlipHorz: Boolean; var Col, Row: Integer; TempDestData, DestData, SourceData: PByte; ImgSize: Integer; begin result := inherited FlipHorz; if Assigned(Data) then begin SourceData := Data; ImgSize := Height * fRowSize; GetMem(DestData, ImgSize); try TempDestData := DestData; Dec(TempDestData, fRowSize + fPixelSize); for Row := 0 to Height -1 do begin Inc(TempDestData, fRowSize * 2); for Col := 0 to Width -1 do begin Move(SourceData^, TempDestData^, fPixelSize); Inc(SourceData, fPixelSize); Dec(TempDestData, fPixelSize); end; end; SetDataPointer(DestData, Format, 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; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapCubeMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean); begin Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.'); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.AfterConstruction; begin inherited; if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); SetWrap; Target := GL_TEXTURE_CUBE_MAP; fGenMode := GL_REFLECTION_MAP; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean); var BuildWithGlu: Boolean; 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.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.'); if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.'); end; if (ID = 0) then CreateID; SetupParameters(BuildWithGlu); UploadData(aCubeTarget, BuildWithGlu); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean); begin inherited Bind (aEnableTextureUnit); 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; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean); begin inherited Unbind(aDisableTextureUnit); if aDisableTexCoordsGen then begin glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); glDisable(GL_TEXTURE_GEN_R); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapNormalMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TVec = Array[0..2] of Single; TglBitmapNormalMapGetVectorFunc = procedure (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; fGenMode := GL_NORMAL_MAP; 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, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize); // Negative X Rec.Func := glBitmapNormalMapNegX; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize); // Positive Y Rec.Func := glBitmapNormalMapPosY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize); // Negative Y Rec.Func := glBitmapNormalMapNegY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize); // Positive Z Rec.Func := glBitmapNormalMapPosZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize); // Negative Z Rec.Func := glBitmapNormalMapNegZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize); end; initialization glBitmapSetDefaultFormat (tfEmpty); glBitmapSetDefaultMipmap (mmMipmap); glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR); glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE); glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA); 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.