glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/)
   6
   7
   8 ------------------------------------------------------------
   9 The contents of this file are used with permission, subject to
  10 the Mozilla Public License Version 1.1 (the "License"); you may
  11 not use this file except in compliance with the License. You may
  12 obtain a copy of the License at
  13 http://www.mozilla.org/MPL/MPL-1.1.html
  14 ------------------------------------------------------------
  15 Version 2.0.3
  16 ------------------------------------------------------------
  17 History
  18 21-03-2010
  19 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  20   then it's your problem if that isn't true. This prevents the unit for incompatibility
  21   with newer versions of Delphi.
  22 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  23 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  24 10-08-2008
  25 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  26 - Additional Datapointer for functioninterface now has the name CustomData
  27 24-07-2008
  28 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  29 - If you load an texture from an file the property Filename will be set to the name of the file
  30 - Three new properties to attach custom data to the Texture objects
  31   - CustomName  (free for use string)
  32   - CustomNameW (free for use widestring)
  33   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  34 27-05-2008
  35 - RLE TGAs loaded much faster
  36 26-05-2008
  37 - fixed some problem with reading RLE TGAs.
  38 21-05-2008
  39 - function clone now only copys data if it's assigned and now it also copies the ID
  40 - it seems that lazarus dont like comments in comments.
  41 01-05-2008
  42 - It's possible to set the id of the texture
  43 - define GLB_NO_NATIVE_GL deactivated by default
  44 27-04-2008
  45 - Now supports the following libraries
  46   - SDL and SDL_image
  47   - libPNG
  48   - libJPEG
  49 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  50 - BMPs now loaded manuel
  51 - Large restructuring
  52 - Property DataPtr now has the name Data
  53 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  54 - Unused Depth removed
  55 - Function FreeData to freeing image data added
  56 24-10-2007
  57 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  58 15-11-2006
  59 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  60 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  61 - Function ReadOpenGLExtension is now only intern
  62 29-06-2006
  63 - pngimage now disabled by default like all other versions.
  64 26-06-2006
  65 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  66 22-06-2006
  67 - Fixed some Problem with Delphi 5
  68 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  69 22-03-2006
  70 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  71 09-03-2006
  72 - Internal Format ifDepth8 added
  73 - function GrabScreen now supports all uncompressed formats
  74 31-01-2006
  75 - AddAlphaFromglBitmap implemented
  76 29-12-2005
  77 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  78 28-12-2005
  79 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  80   property Width, Height, Depth are still existing and new property Dimension are avail
  81 11-12-2005
  82 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  83 19-10-2005
  84 - Added function GrabScreen to class TglBitmap2D
  85 18-10-2005
  86 - Added support to Save images
  87 - Added function Clone to Clone Instance
  88 11-10-2005
  89 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  90   Usefull for Future
  91 - Several speed optimizations
  92 09-10-2005
  93 - Internal structure change. Loading of TGA, PNG and DDS improved.
  94   Data, format and size will now set directly with SetDataPtr.
  95 - AddFunc now works with all Types of Images and Formats
  96 - Some Funtions moved to Baseclass TglBitmap
  97 06-10-2005
  98 - Added Support to decompress DXT3 and DXT5 compressed Images.
  99 - Added Mapping to convert data from one format into an other.
 100 05-10-2005
 101 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 102   supported Input format (supported by GetPixel) into any uncompresed Format
 103 - Added Support to decompress DXT1 compressed Images.
 104 - SwapColors replaced by ConvertTo
 105 04-10-2005
 106 - Added Support for compressed DDSs
 107 - Added new internal formats (DXT1, DXT3, DXT5)
 108 29-09-2005
 109 - Parameter Components renamed to InternalFormat
 110 23-09-2005
 111 - Some AllocMem replaced with GetMem (little speed change)
 112 - better exception handling. Better protection from memory leaks.
 113 22-09-2005
 114 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 115 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 116 07-09-2005
 117 - Added support for Grayscale textures
 118 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 119 10-07-2005
 120 - Added support for GL_VERSION_2_0
 121 - Added support for GL_EXT_texture_filter_anisotropic
 122 04-07-2005
 123 - Function FillWithColor fills the Image with one Color
 124 - Function LoadNormalMap added
 125 30-06-2005
 126 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 127 - ToNormalMap now supports Sobel (nmSobel) function.
 128 29-06-2005
 129 - support for RLE Compressed RGB TGAs added
 130 28-06-2005
 131 - Class TglBitmapNormalMap added to support Normalmap generation
 132 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 133   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 134 16-06-2005
 135 - Method LoadCubeMapClass removed
 136 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 137 - virtual abstract method GenTexture in class TglBitmap now is protected
 138 12-06-2005
 139 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 140 10-06-2005
 141 - little enhancement for IsPowerOfTwo
 142 - TglBitmap1D.GenTexture now tests NPOT Textures
 143 06-06-2005
 144 - some little name changes. All properties or function with Texture in name are
 145   now without texture in name. We have allways texture so we dosn't name it.
 146 03-06-2005
 147 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 148   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 149 02-06-2005
 150 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 151 25-04-2005
 152 - Function Unbind added
 153 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 154 21-04-2005
 155 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 156 29-03-2005
 157 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 158   To Enable png's use the define pngimage
 159 22-03-2005
 160 - New Functioninterface added
 161 - Function GetPixel added
 162 27-11-2004
 163 - Property BuildMipMaps renamed to MipMap
 164 21-11-2004
 165 - property Name removed.
 166 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 167 22-05-2004
 168 - property name added. Only used in glForms!
 169 26-11-2003
 170 - property FreeDataAfterGenTexture is now available as default (default = true)
 171 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 172 - function MoveMemory replaced with function Move (little speed change)
 173 - several calculations stored in variables (little speed change)
 174 29-09-2003
 175 - property BuildMipsMaps added (default = true)
 176   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 177 - property FreeDataAfterGenTexture added (default = true)
 178   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 179 - parameter DisableOtherTextureUnits of Bind removed
 180 - parameter FreeDataAfterGeneration of GenTextures removed
 181 12-09-2003
 182 - TglBitmap dosn't delete data if class was destroyed (fixed)
 183 09-09-2003
 184 - Bind now enables TextureUnits (by params)
 185 - GenTextures can leave data (by param)
 186 - LoadTextures now optimal
 187 03-09-2003
 188 - Performance optimization in AddFunc
 189 - procedure Bind moved to subclasses
 190 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 191 19-08-2003
 192 - Texturefilter and texturewrap now also as defaults
 193   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 194   Magfilter = GL_LINEAR
 195   Wrap(str) = GL_CLAMP_TO_EDGE
 196 - Added new format tfCompressed to create a compressed texture.
 197 - propertys IsCompressed, TextureSize and IsResident added
 198   IsCompressed and TextureSize only contains data from level 0
 199 18-08-2003
 200 - Added function AddFunc to add PerPixelEffects to Image
 201 - LoadFromFunc now based on AddFunc
 202 - Invert now based on AddFunc
 203 - SwapColors now based on AddFunc
 204 16-08-2003
 205 - Added function FlipHorz
 206 15-08-2003
 207 - Added function LaodFromFunc to create images with function
 208 - Added function FlipVert
 209 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 210 29-07-2003
 211 - Added Alphafunctions to calculate alpha per function
 212 - Added Alpha from ColorKey using alphafunctions
 213 28-07-2003
 214 - First full functionally Version of glBitmap
 215 - Support for 24Bit and 32Bit TGA Pictures added
 216 25-07-2003
 217 - begin of programming
 218 ***********************************************************}
 219 unit glBitmap;
 220
 221 // Please uncomment the defines below to configure the glBitmap to your preferences.
 222 // If you have configured the unit you can uncomment the warning above.
 223 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 224
 225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 // activate to enable build-in OpenGL support with statically linked methods
 229 // use dglOpenGL.pas if not enabled
 230 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 231
 232 // activate to enable build-in OpenGL support with dynamically linked methods
 233 // use dglOpenGL.pas if not enabled
 234 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 235
 236
 237 // activate to enable the support for SDL_surfaces
 238 {.$DEFINE GLB_SDL}
 239
 240 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 241 {.$DEFINE GLB_DELPHI}
 242
 243 // activate to enable the support for TLazIntfImage from Lazarus
 244 {.$DEFINE GLB_LAZARUS}
 245
 246
 247 // activate to enable the support of SDL_image to load files. (READ ONLY)
 248 // If you enable SDL_image all other libraries will be ignored!
 249 {.$DEFINE GLB_SDL_IMAGE}
 250
 251
 252
 253 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 254 // if you enable pngimage the libPNG will be ignored
 255 {.$DEFINE GLB_PNGIMAGE}
 256
 257 // activate to use the libPNG -> http://www.libpng.org/
 258 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 259 {.$DEFINE GLB_LIB_PNG}
 260
 261
 262
 263 // if you enable delphi jpegs the libJPEG will be ignored
 264 {.$DEFINE GLB_DELPHI_JPEG}
 265
 266 // activate to use the libJPEG -> http://www.ijg.org/
 267 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 268 {.$DEFINE GLB_LIB_JPEG}
 269
 270
 271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 272 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 274 // Delphi Versions
 275 {$IFDEF fpc}
 276   {$MODE Delphi}
 277
 278   {$IFDEF CPUI386}
 279     {$DEFINE CPU386}
 280     {$ASMMODE INTEL}
 281   {$ENDIF}
 282
 283   {$IFNDEF WINDOWS}
 284     {$linklib c}
 285   {$ENDIF}
 286 {$ENDIF}
 287
 288 // Operation System
 289 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 290   {$DEFINE GLB_WIN}
 291 {$ELSEIF DEFINED(LINUX)}
 292   {$DEFINE GLB_LINUX}
 293 {$IFEND}
 294
 295 // native OpenGL Support
 296 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 297   {$DEFINE GLB_NATIVE_OGL}
 298 {$IFEND}
 299
 300 // checking define combinations
 301 //SDL Image
 302 {$IFDEF GLB_SDL_IMAGE}
 303   {$IFNDEF GLB_SDL}
 304     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 305     {$DEFINE GLB_SDL}
 306   {$ENDIF}
 307   {$IFDEF GLB_PNGIMAGE}
 308     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 309     {$undef GLB_PNGIMAGE}
 310   {$ENDIF}
 311   {$IFDEF GLB_DELPHI_JPEG}
 312     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 313     {$undef GLB_DELPHI_JPEG}
 314   {$ENDIF}
 315   {$IFDEF GLB_LIB_PNG}
 316     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 317     {$undef GLB_LIB_PNG}
 318   {$ENDIF}
 319   {$IFDEF GLB_LIB_JPEG}
 320     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 321     {$undef GLB_LIB_JPEG}
 322   {$ENDIF}
 323
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_JPEG_READ}
 326 {$ENDIF}
 327
 328 // PNG Image
 329 {$IFDEF GLB_PNGIMAGE}
 330   {$IFDEF GLB_LIB_PNG}
 331     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 332     {$undef GLB_LIB_PNG}
 333   {$ENDIF}
 334
 335   {$DEFINE GLB_SUPPORT_PNG_READ}
 336   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 337 {$ENDIF}
 338
 339 // libPNG
 340 {$IFDEF GLB_LIB_PNG}
 341   {$DEFINE GLB_SUPPORT_PNG_READ}
 342   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 343 {$ENDIF}
 344
 345 // JPEG Image
 346 {$IFDEF GLB_DELPHI_JPEG}
 347   {$IFDEF GLB_LIB_JPEG}
 348     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 349     {$undef GLB_LIB_JPEG}
 350   {$ENDIF}
 351
 352   {$DEFINE GLB_SUPPORT_JPEG_READ}
 353   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 354 {$ENDIF}
 355
 356 // libJPEG
 357 {$IFDEF GLB_LIB_JPEG}
 358   {$DEFINE GLB_SUPPORT_JPEG_READ}
 359   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 360 {$ENDIF}
 361
 362 // native OpenGL
 363 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 364   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 365 {$IFEND}
 366
 367 // general options
 368 {$EXTENDEDSYNTAX ON}
 369 {$LONGSTRINGS ON}
 370 {$ALIGN ON}
 371 {$IFNDEF FPC}
 372   {$OPTIMIZATION ON}
 373 {$ENDIF}
 374
 375 interface
 376
 377 uses
 378   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,          {$ENDIF}
 379   {$IF DEFINED(GLB_WIN) AND
 380        DEFINED(GLB_NATIVE_OGL)} windows,            {$IFEND}
 381
 382   {$IFDEF GLB_SDL}              SDL,                {$ENDIF}
 383   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,       {$ENDIF}
 384   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,  {$ENDIF}
 385
 386   {$IFDEF GLB_SDL_IMAGE}        SDL_image,          {$ENDIF}
 387
 388   {$IFDEF GLB_PNGIMAGE}         pngimage,           {$ENDIF}
 389   {$IFDEF GLB_LIB_PNG}          libPNG,             {$ENDIF}
 390
 391   {$IFDEF GLB_DELPHI_JPEG}      JPEG,               {$ENDIF}
 392   {$IFDEF GLB_LIB_JPEG}         libJPEG,            {$ENDIF}
 393
 394   Classes, SysUtils;
 395
 396 {$IFDEF GLB_NATIVE_OGL}
 397 const
 398   GL_TRUE   = 1;
 399   GL_FALSE  = 0;
 400
 401   GL_VERSION    = $1F02;
 402   GL_EXTENSIONS = $1F03;
 403
 404   GL_TEXTURE_1D         = $0DE0;
 405   GL_TEXTURE_2D         = $0DE1;
 406   GL_TEXTURE_RECTANGLE  = $84F5;
 407
 408   GL_TEXTURE_WIDTH            = $1000;
 409   GL_TEXTURE_HEIGHT           = $1001;
 410   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 411
 412   GL_ALPHA    = $1906;
 413   GL_ALPHA4   = $803B;
 414   GL_ALPHA8   = $803C;
 415   GL_ALPHA12  = $803D;
 416   GL_ALPHA16  = $803E;
 417
 418   GL_LUMINANCE    = $1909;
 419   GL_LUMINANCE4   = $803F;
 420   GL_LUMINANCE8   = $8040;
 421   GL_LUMINANCE12  = $8041;
 422   GL_LUMINANCE16  = $8042;
 423
 424   GL_LUMINANCE_ALPHA      = $190A;
 425   GL_LUMINANCE4_ALPHA4    = $8043;
 426   GL_LUMINANCE6_ALPHA2    = $8044;
 427   GL_LUMINANCE8_ALPHA8    = $8045;
 428   GL_LUMINANCE12_ALPHA4   = $8046;
 429   GL_LUMINANCE12_ALPHA12  = $8047;
 430   GL_LUMINANCE16_ALPHA16  = $8048;
 431
 432   GL_RGB      = $1907;
 433   GL_BGR      = $80E0;
 434   GL_R3_G3_B2 = $2A10;
 435   GL_RGB4     = $804F;
 436   GL_RGB5     = $8050;
 437   GL_RGB565   = $8D62;
 438   GL_RGB8     = $8051;
 439   GL_RGB10    = $8052;
 440   GL_RGB12    = $8053;
 441   GL_RGB16    = $8054;
 442
 443   GL_RGBA     = $1908;
 444   GL_BGRA     = $80E1;
 445   GL_RGBA2    = $8055;
 446   GL_RGBA4    = $8056;
 447   GL_RGB5_A1  = $8057;
 448   GL_RGBA8    = $8058;
 449   GL_RGB10_A2 = $8059;
 450   GL_RGBA12   = $805A;
 451   GL_RGBA16   = $805B;
 452
 453   GL_DEPTH_COMPONENT    = $1902;
 454   GL_DEPTH_COMPONENT16  = $81A5;
 455   GL_DEPTH_COMPONENT24  = $81A6;
 456   GL_DEPTH_COMPONENT32  = $81A7;
 457
 458   GL_COMPRESSED_RGB                 = $84ED;
 459   GL_COMPRESSED_RGBA                = $84EE;
 460   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 461   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 462   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 463   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 464
 465   GL_UNSIGNED_BYTE            = $1401;
 466   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 467   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 468
 469   GL_UNSIGNED_SHORT             = $1403;
 470   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 471   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 472   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 473   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 474   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 475   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 476
 477   GL_UNSIGNED_INT                 = $1405;
 478   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 479   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 480   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 481   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 482
 483   { Texture Filter }
 484   GL_TEXTURE_MAG_FILTER     = $2800;
 485   GL_TEXTURE_MIN_FILTER     = $2801;
 486   GL_NEAREST                = $2600;
 487   GL_NEAREST_MIPMAP_NEAREST = $2700;
 488   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 489   GL_LINEAR                 = $2601;
 490   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 491   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 492
 493   { Texture Wrap }
 494   GL_TEXTURE_WRAP_S   = $2802;
 495   GL_TEXTURE_WRAP_T   = $2803;
 496   GL_TEXTURE_WRAP_R   = $8072;
 497   GL_CLAMP            = $2900;
 498   GL_REPEAT           = $2901;
 499   GL_CLAMP_TO_EDGE    = $812F;
 500   GL_CLAMP_TO_BORDER  = $812D;
 501   GL_MIRRORED_REPEAT  = $8370;
 502
 503   { Other }
 504   GL_GENERATE_MIPMAP      = $8191;
 505   GL_TEXTURE_BORDER_COLOR = $1004;
 506   GL_MAX_TEXTURE_SIZE     = $0D33;
 507   GL_PACK_ALIGNMENT       = $0D05;
 508   GL_UNPACK_ALIGNMENT     = $0CF5;
 509
 510   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 511   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 512
 513 {$IF DEFINED(GLB_WIN)}
 514   libglu    = 'glu32.dll';
 515   libopengl = 'opengl32.dll';
 516 {$ELSEIF DEFINED(GLB_LINUX)}
 517   libglu    = 'libGLU.so.1';
 518   libopengl = 'libGL.so.1';
 519 {$IFEND}
 520
 521 type
 522   GLboolean = BYTEBOOL;
 523   GLint     = Integer;
 524   GLsizei   = Integer;
 525   GLuint    = Cardinal;
 526   GLfloat   = Single;
 527   GLenum    = Cardinal;
 528
 529   PGLvoid    = Pointer;
 530   PGLboolean = ^GLboolean;
 531   PGLint     = ^GLint;
 532   PGLuint    = ^GLuint;
 533   PGLfloat   = ^GLfloat;
 534
 535   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 536   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}
 537   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 538
 539 {$IF DEFINED(GLB_WIN)}
 540   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 541 {$ELSEIF DEFINED(GLB_LINUX)}
 542   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 543   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 544 {$IFEND}
 545
 546 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 547   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 548   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549
 550   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 551   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552
 553   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 554   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 557   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559
 560   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 561   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563
 564   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 565   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 567
 568   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}
 569   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}
 570   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 571
 572   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 573   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 574
 575 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 576   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 577   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 578
 579   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 580   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 581
 582   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 583   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 585   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 586   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588
 589   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 592
 593   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   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;
 595   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 596
 597   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;
 598   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;
 599   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 600
 601   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 602   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 603 {$IFEND}
 604
 605 var
 606   GL_VERSION_1_2,
 607   GL_VERSION_1_3,
 608   GL_VERSION_1_4,
 609   GL_VERSION_2_0,
 610
 611   GL_SGIS_generate_mipmap,
 612
 613   GL_ARB_texture_border_clamp,
 614   GL_ARB_texture_mirrored_repeat,
 615   GL_ARB_texture_rectangle,
 616   GL_ARB_texture_non_power_of_two,
 617
 618   GL_IBM_texture_mirrored_repeat,
 619
 620   GL_NV_texture_rectangle,
 621
 622   GL_EXT_texture_edge_clamp,
 623   GL_EXT_texture_rectangle,
 624   GL_EXT_texture_filter_anisotropic: Boolean;
 625
 626   glCompressedTexImage1D: TglCompressedTexImage1D;
 627   glCompressedTexImage2D: TglCompressedTexImage2D;
 628   glGetCompressedTexImage: TglGetCompressedTexImage;
 629
 630 {$IF DEFINED(GLB_WIN)}
 631   wglGetProcAddress: TwglGetProcAddress;
 632 {$ELSEIF DEFINED(GLB_LINUX)}
 633   glXGetProcAddress: TglXGetProcAddress;
 634   glXGetProcAddressARB: TglXGetProcAddress;
 635 {$IFEND}
 636
 637 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 638   glEnable: TglEnable;
 639   glDisable: TglDisable;
 640
 641   glGetString: TglGetString;
 642   glGetIntegerv: TglGetIntegerv;
 643
 644   glTexParameteri: TglTexParameteri;
 645   glTexParameterfv: TglTexParameterfv;
 646   glGetTexParameteriv: TglGetTexParameteriv;
 647   glGetTexParameterfv: TglGetTexParameterfv;
 648   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 649   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 650
 651   glGenTextures: TglGenTextures;
 652   glBindTexture: TglBindTexture;
 653   glDeleteTextures: TglDeleteTextures;
 654
 655   glAreTexturesResident: TglAreTexturesResident;
 656   glReadPixels: TglReadPixels;
 657   glPixelStorei: TglPixelStorei;
 658
 659   glTexImage1D: TglTexImage1D;
 660   glTexImage2D: TglTexImage2D;
 661   glGetTexImage: TglGetTexImage;
 662
 663   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 664   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 665 {$ENDIF}
 666 {$ENDIF}
 667
 668 type
 669 ////////////////////////////////////////////////////////////////////////////////////////////////////
 670   TglBitmapFormat = (
 671     tfEmpty = 0, //must be smallest value!
 672
 673     tfAlpha4,
 674     tfAlpha8,
 675     tfAlpha12,
 676     tfAlpha16,
 677
 678     tfLuminance4,
 679     tfLuminance8,
 680     tfLuminance12,
 681     tfLuminance16,
 682
 683     tfLuminance4Alpha4,
 684     tfLuminance6Alpha2,
 685     tfLuminance8Alpha8,
 686     tfLuminance12Alpha4,
 687     tfLuminance12Alpha12,
 688     tfLuminance16Alpha16,
 689
 690     tfR3G3B2,
 691     tfRGB4,
 692     tfR5G6B5,
 693     tfRGB5,
 694     tfRGB8,
 695     tfRGB10,
 696     tfRGB12,
 697     tfRGB16,
 698
 699     tfRGBA2,
 700     tfRGBA4,
 701     tfRGB5A1,
 702     tfRGBA8,
 703     tfRGB10A2,
 704     tfRGBA12,
 705     tfRGBA16,
 706
 707     tfBGR4,
 708     tfB5G6R5,
 709     tfBGR5,
 710     tfBGR8,
 711     tfBGR10,
 712     tfBGR12,
 713     tfBGR16,
 714
 715     tfBGRA2,
 716     tfBGRA4,
 717     tfBGR5A1,
 718     tfBGRA8,
 719     tfBGR10A2,
 720     tfBGRA12,
 721     tfBGRA16,
 722
 723     tfDepth16,
 724     tfDepth24,
 725     tfDepth32,
 726
 727     tfS3tcDtx1RGBA,
 728     tfS3tcDtx3RGBA,
 729     tfS3tcDtx5RGBA
 730   );
 731
 732   TglBitmapFileType = (
 733      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 734      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 735      ftDDS,
 736      ftTGA,
 737      ftBMP);
 738    TglBitmapFileTypes = set of TglBitmapFileType;
 739
 740    TglBitmapMipMap = (
 741      mmNone,
 742      mmMipmap,
 743      mmMipmapGlu);
 744
 745    TglBitmapNormalMapFunc = (
 746      nm4Samples,
 747      nmSobel,
 748      nm3x3,
 749      nm5x5);
 750
 751  ////////////////////////////////////////////////////////////////////////////////////////////////////
 752    EglBitmapException               = class(Exception);
 753    EglBitmapSizeToLargeException    = class(EglBitmapException);
 754    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 755    EglBitmapUnsupportedFormat       = class(EglBitmapException)
 756      constructor Create(const aFormat: TglBitmapFormat); overload;
 757      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 758    end;
 759
 760 ////////////////////////////////////////////////////////////////////////////////////////////////////
 761   TglBitmapColorRec = packed record
 762   case Integer of
 763     0: (r, g, b, a: Cardinal);
 764     1: (arr: array[0..3] of Cardinal);
 765   end;
 766
 767   TglBitmapPixelData = packed record
 768     Data, Range: TglBitmapColorRec;
 769     Format: TglBitmapFormat;
 770   end;
 771   PglBitmapPixelData = ^TglBitmapPixelData;
 772
 773 ////////////////////////////////////////////////////////////////////////////////////////////////////
 774   TglBitmapPixelPositionFields = set of (ffX, ffY);
 775   TglBitmapPixelPosition = record
 776     Fields : TglBitmapPixelPositionFields;
 777     X : Word;
 778     Y : Word;
 779   end;
 780
 781 ////////////////////////////////////////////////////////////////////////////////////////////////////
 782   TglBitmap = class;
 783   TglBitmapFunctionRec = record
 784     Sender:   TglBitmap;
 785     Size:     TglBitmapPixelPosition;
 786     Position: TglBitmapPixelPosition;
 787     Source:   TglBitmapPixelData;
 788     Dest:     TglBitmapPixelData;
 789     Args:     Pointer;
 790   end;
 791   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 792
 793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 794   TglBitmap = class
 795   protected
 796     fID: GLuint;
 797     fTarget: GLuint;
 798     fAnisotropic: Integer;
 799     fDeleteTextureOnFree: Boolean;
 800     fFreeDataAfterGenTexture: Boolean;
 801     fData: PByte;
 802     fIsResident: Boolean;
 803     fBorderColor: array[0..3] of Single;
 804
 805     fDimension: TglBitmapPixelPosition;
 806     fMipMap: TglBitmapMipMap;
 807     fFormat: TglBitmapFormat;
 808
 809     // Mapping
 810     fPixelSize: Integer;
 811     fRowSize: Integer;
 812
 813     // Filtering
 814     fFilterMin: Cardinal;
 815     fFilterMag: Cardinal;
 816
 817     // TexturWarp
 818     fWrapS: Cardinal;
 819     fWrapT: Cardinal;
 820     fWrapR: Cardinal;
 821
 822     // CustomData
 823     fFilename: String;
 824     fCustomName: String;
 825     fCustomNameW: WideString;
 826     fCustomData: Pointer;
 827
 828     //Getter
 829     function GetWidth:  Integer; virtual;
 830     function GetHeight: Integer; virtual;
 831
 832     function GetFileWidth:  Integer; virtual;
 833     function GetFileHeight: Integer; virtual;
 834
 835     //Setter
 836     procedure SetCustomData(const aValue: Pointer);
 837     procedure SetCustomName(const aValue: String);
 838     procedure SetCustomNameW(const aValue: WideString);
 839     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 840     procedure SetFormat(const aValue: TglBitmapFormat);
 841     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 842     procedure SetID(const aValue: Cardinal);
 843     procedure SetMipMap(const aValue: TglBitmapMipMap);
 844     procedure SetTarget(const aValue: Cardinal);
 845     procedure SetAnisotropic(const aValue: Integer);
 846
 847     procedure CreateID;
 848     procedure SetupParameters(out aBuildWithGlu: Boolean);
 849     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 850       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 851     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 852
 853     function FlipHorz: Boolean; virtual;
 854     function FlipVert: Boolean; virtual;
 855
 856     property Width:  Integer read GetWidth;
 857     property Height: Integer read GetHeight;
 858
 859     property FileWidth:  Integer read GetFileWidth;
 860     property FileHeight: Integer read GetFileHeight;
 861   public
 862     //Properties
 863     property ID:           Cardinal        read fID          write SetID;
 864     property Target:       Cardinal        read fTarget      write SetTarget;
 865     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 866     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 867     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 868
 869     property Filename:    String     read fFilename;
 870     property CustomName:  String     read fCustomName  write SetCustomName;
 871     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 872     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 873
 874     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 875     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 876
 877     property Dimension:  TglBitmapPixelPosition  read fDimension;
 878     property Data:       PByte                   read fData;
 879     property IsResident: Boolean                 read fIsResident;
 880
 881     procedure AfterConstruction; override;
 882     procedure BeforeDestruction; override;
 883
 884     procedure PrepareResType(var aResource: String; var aResType: PChar);
 885
 886     //Load
 887     procedure LoadFromFile(const aFilename: String);
 888     procedure LoadFromStream(const aStream: TStream); virtual;
 889     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 890       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 891     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 892     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 893
 894     //Save
 895     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 896     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 897
 898     //Convert
 899     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 900     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 901       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 902   public
 903     //Alpha & Co
 904     {$IFDEF GLB_SDL}
 905     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 906     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 907     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 908     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 909       const aArgs: Pointer = nil): Boolean;
 910     {$ENDIF}
 911
 912     {$IFDEF GLB_DELPHI}
 913     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 914     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 915     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 916     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 917       const aArgs: Pointer = nil): Boolean;
 918     {$ENDIF}
 919
 920     {$IFDEF GLB_LAZARUS}
 921     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 922     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 923     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 924     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 925       const aArgs: Pointer = nil): Boolean;
 926     {$ENDIF}
 927
 928     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 929       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 930     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 931       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 932
 933     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 934     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 935     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 936     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 937
 938     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 939     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 940     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 941
 942     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 943     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 944     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 945
 946     function RemoveAlpha: Boolean; virtual;
 947   public
 948     //Common
 949     function Clone: TglBitmap;
 950     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 951     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 952     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 953     procedure FreeData;
 954
 955     //ColorFill
 956     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 957     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 958     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 959
 960     //TexParameters
 961     procedure SetFilter(const aMin, aMag: Cardinal);
 962     procedure SetWrap(
 963       const S: Cardinal = GL_CLAMP_TO_EDGE;
 964       const T: Cardinal = GL_CLAMP_TO_EDGE;
 965       const R: Cardinal = GL_CLAMP_TO_EDGE);
 966
 967     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 968     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 969
 970     //Constructors
 971     constructor Create; overload;
 972     constructor Create(const aFileName: String); overload;
 973     constructor Create(const aStream: TStream); overload;
 974     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 975     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 976     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 977     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 978   private
 979     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 980     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
 981
 982     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 983     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
 984
 985     function LoadBMP(const aStream: TStream): Boolean; virtual;
 986     procedure SaveBMP(const aStream: TStream); virtual;
 987
 988     function LoadTGA(const aStream: TStream): Boolean; virtual;
 989     procedure SaveTGA(const aStream: TStream); virtual;
 990
 991     function LoadDDS(const aStream: TStream): Boolean; virtual;
 992     procedure SaveDDS(const aStream: TStream); virtual;
 993   end;
 994
 995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 996   TglBitmap2D = class(TglBitmap)
 997   protected
 998     // Bildeinstellungen
 999     fLines: array of PByte;
1000
1001     function GetScanline(const aIndex: Integer): Pointer;
1002     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1003       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1004     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1005   public
1006     property Width;
1007     property Height;
1008     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1009
1010     procedure AfterConstruction; override;
1011
1012     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1013     procedure GetDataFromTexture;
1014     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1015
1016     function FlipHorz: Boolean; override;
1017     function FlipVert: Boolean; override;
1018
1019     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1020       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1021   end;
1022
1023 (* TODO
1024   TglBitmapCubeMap = class(TglBitmap2D)
1025   protected
1026     fGenMode: Integer;
1027
1028     // Hide GenTexture
1029     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1030   public
1031     procedure AfterConstruction; override;
1032
1033     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1034
1035     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1036     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1037   end;
1038
1039
1040   TglBitmapNormalMap = class(TglBitmapCubeMap)
1041   public
1042     procedure AfterConstruction; override;
1043
1044     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1045   end;
1046
1047
1048   TglBitmap1D = class(TglBitmap)
1049   protected
1050     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1051
1052     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1053     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1054   public
1055     // propertys
1056     property Width;
1057
1058     procedure AfterConstruction; override;
1059
1060     // Other
1061     function FlipHorz: Boolean; override;
1062
1063     // Generation
1064     procedure GenTexture(TestTextureSize: Boolean = true); override;
1065   end;
1066 *)
1067
1068 const
1069   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1070
1071 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1072 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1073 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1074 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1075 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1076 procedure glBitmapSetDefaultWrap(
1077   const S: Cardinal = GL_CLAMP_TO_EDGE;
1078   const T: Cardinal = GL_CLAMP_TO_EDGE;
1079   const R: Cardinal = GL_CLAMP_TO_EDGE);
1080
1081 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1082 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1083 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1084 function glBitmapGetDefaultFormat: TglBitmapFormat;
1085 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1086 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1087
1088 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1089 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1090 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1091
1092 var
1093   glBitmapDefaultDeleteTextureOnFree: Boolean;
1094   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1095   glBitmapDefaultFormat: TglBitmapFormat;
1096   glBitmapDefaultMipmap: TglBitmapMipMap;
1097   glBitmapDefaultFilterMin: Cardinal;
1098   glBitmapDefaultFilterMag: Cardinal;
1099   glBitmapDefaultWrapS: Cardinal;
1100   glBitmapDefaultWrapT: Cardinal;
1101   glBitmapDefaultWrapR: Cardinal;
1102
1103 {$IFDEF GLB_DELPHI}
1104 function CreateGrayPalette: HPALETTE;
1105 {$ENDIF}
1106
1107 implementation
1108
1109 uses
1110   Math, syncobjs, typinfo;
1111
1112 type
1113 {$IFNDEF fpc}
1114   QWord   = System.UInt64;
1115   PQWord  = ^QWord;
1116
1117   PtrInt  = Longint;
1118   PtrUInt = DWord;
1119 {$ENDIF}
1120
1121 ////////////////////////////////////////////////////////////////////////////////////////////////////
1122   TShiftRec = packed record
1123   case Integer of
1124     0: (r, g, b, a: Byte);
1125     1: (arr: array[0..3] of Byte);
1126   end;
1127
1128   TFormatDescriptor = class(TObject)
1129   private
1130     function GetRedMask: QWord;
1131     function GetGreenMask: QWord;
1132     function GetBlueMask: QWord;
1133     function GetAlphaMask: QWord;
1134   protected
1135     fFormat: TglBitmapFormat;
1136     fWithAlpha: TglBitmapFormat;
1137     fWithoutAlpha: TglBitmapFormat;
1138     fRGBInverted: TglBitmapFormat;
1139     fUncompressed: TglBitmapFormat;
1140     fPixelSize: Single;
1141     fIsCompressed: Boolean;
1142
1143     fRange: TglBitmapColorRec;
1144     fShift: TShiftRec;
1145
1146     fglFormat:         Cardinal;
1147     fglInternalFormat: Cardinal;
1148     fglDataFormat:     Cardinal;
1149
1150     function GetComponents: Integer; virtual;
1151   public
1152     property Format:       TglBitmapFormat read fFormat;
1153     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1154     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1155     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1156     property Components:   Integer         read GetComponents;
1157     property PixelSize:    Single          read fPixelSize;
1158     property IsCompressed: Boolean         read fIsCompressed;
1159
1160     property glFormat:         Cardinal read fglFormat;
1161     property glInternalFormat: Cardinal read fglInternalFormat;
1162     property glDataFormat:     Cardinal read fglDataFormat;
1163
1164     property Range: TglBitmapColorRec read fRange;
1165     property Shift: TShiftRec         read fShift;
1166
1167     property RedMask:   QWord read GetRedMask;
1168     property GreenMask: QWord read GetGreenMask;
1169     property BlueMask:  QWord read GetBlueMask;
1170     property AlphaMask: QWord read GetAlphaMask;
1171
1172     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1173     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1174
1175     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1176     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1177
1178     function CreateMappingData: Pointer; virtual;
1179     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1180
1181     function IsEmpty:  Boolean; virtual;
1182     function HasAlpha: Boolean; virtual;
1183     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1184
1185     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1186
1187     constructor Create; virtual;
1188   public
1189     class procedure Init;
1190     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1191     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1192     class procedure Clear;
1193     class procedure Finalize;
1194   end;
1195   TFormatDescriptorClass = class of TFormatDescriptor;
1196
1197   TfdEmpty = class(TFormatDescriptor);
1198
1199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1200   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1201     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1202     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1203     constructor Create; override;
1204   end;
1205
1206   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1207     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1208     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1209     constructor Create; override;
1210   end;
1211
1212   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1213     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1214     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1215     constructor Create; override;
1216   end;
1217
1218   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1219     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1220     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1221     constructor Create; override;
1222   end;
1223
1224   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1225     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1226     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1227     constructor Create; override;
1228   end;
1229
1230   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1231     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1232     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1233     constructor Create; override;
1234   end;
1235
1236   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1237     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1238     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1239     constructor Create; override;
1240   end;
1241
1242   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1243     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1244     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1245     constructor Create; override;
1246   end;
1247
1248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1249   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1250     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1251     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1252     constructor Create; override;
1253   end;
1254
1255   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1256     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1257     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1258     constructor Create; override;
1259   end;
1260
1261   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1262     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1263     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1264     constructor Create; override;
1265   end;
1266
1267   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1268     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1269     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1270     constructor Create; override;
1271   end;
1272
1273   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1274     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1275     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1276     constructor Create; override;
1277   end;
1278
1279   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1280     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1281     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1282     constructor Create; override;
1283   end;
1284
1285   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1286     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1287     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1288     constructor Create; override;
1289   end;
1290
1291   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1292     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1293     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1294     constructor Create; override;
1295   end;
1296
1297   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1298     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1299     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1300     constructor Create; override;
1301   end;
1302
1303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1304   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1305     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1306     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1307     constructor Create; override;
1308   end;
1309
1310   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1311     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1312     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1313     constructor Create; override;
1314   end;
1315
1316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1317   TfdAlpha4 = class(TfdAlpha_UB1)
1318     constructor Create; override;
1319   end;
1320
1321   TfdAlpha8 = class(TfdAlpha_UB1)
1322     constructor Create; override;
1323   end;
1324
1325   TfdAlpha12 = class(TfdAlpha_US1)
1326     constructor Create; override;
1327   end;
1328
1329   TfdAlpha16 = class(TfdAlpha_US1)
1330     constructor Create; override;
1331   end;
1332
1333   TfdLuminance4 = class(TfdLuminance_UB1)
1334     constructor Create; override;
1335   end;
1336
1337   TfdLuminance8 = class(TfdLuminance_UB1)
1338     constructor Create; override;
1339   end;
1340
1341   TfdLuminance12 = class(TfdLuminance_US1)
1342     constructor Create; override;
1343   end;
1344
1345   TfdLuminance16 = class(TfdLuminance_US1)
1346     constructor Create; override;
1347   end;
1348
1349   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1350     constructor Create; override;
1351   end;
1352
1353   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1354     constructor Create; override;
1355   end;
1356
1357   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1358     constructor Create; override;
1359   end;
1360
1361   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1362     constructor Create; override;
1363   end;
1364
1365   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1366     constructor Create; override;
1367   end;
1368
1369   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1370     constructor Create; override;
1371   end;
1372
1373   TfdR3G3B2 = class(TfdUniversal_UB1)
1374     constructor Create; override;
1375   end;
1376
1377   TfdRGB4 = class(TfdUniversal_US1)
1378     constructor Create; override;
1379   end;
1380
1381   TfdR5G6B5 = class(TfdUniversal_US1)
1382     constructor Create; override;
1383   end;
1384
1385   TfdRGB5 = class(TfdUniversal_US1)
1386     constructor Create; override;
1387   end;
1388
1389   TfdRGB8 = class(TfdRGB_UB3)
1390     constructor Create; override;
1391   end;
1392
1393   TfdRGB10 = class(TfdUniversal_UI1)
1394     constructor Create; override;
1395   end;
1396
1397   TfdRGB12 = class(TfdRGB_US3)
1398     constructor Create; override;
1399   end;
1400
1401   TfdRGB16 = class(TfdRGB_US3)
1402     constructor Create; override;
1403   end;
1404
1405   TfdRGBA2 = class(TfdRGBA_UB4)
1406     constructor Create; override;
1407   end;
1408
1409   TfdRGBA4 = class(TfdUniversal_US1)
1410     constructor Create; override;
1411   end;
1412
1413   TfdRGB5A1 = class(TfdUniversal_US1)
1414     constructor Create; override;
1415   end;
1416
1417   TfdRGBA8 = class(TfdRGBA_UB4)
1418     constructor Create; override;
1419   end;
1420
1421   TfdRGB10A2 = class(TfdUniversal_UI1)
1422     constructor Create; override;
1423   end;
1424
1425   TfdRGBA12 = class(TfdRGBA_US4)
1426     constructor Create; override;
1427   end;
1428
1429   TfdRGBA16 = class(TfdRGBA_US4)
1430     constructor Create; override;
1431   end;
1432
1433   TfdBGR4 = class(TfdUniversal_US1)
1434     constructor Create; override;
1435   end;
1436
1437   TfdB5G6R5 = class(TfdUniversal_US1)
1438     constructor Create; override;
1439   end;
1440
1441   TfdBGR5 = class(TfdUniversal_US1)
1442     constructor Create; override;
1443   end;
1444
1445   TfdBGR8 = class(TfdBGR_UB3)
1446     constructor Create; override;
1447   end;
1448
1449   TfdBGR10 = class(TfdUniversal_UI1)
1450     constructor Create; override;
1451   end;
1452
1453   TfdBGR12 = class(TfdBGR_US3)
1454     constructor Create; override;
1455   end;
1456
1457   TfdBGR16 = class(TfdBGR_US3)
1458     constructor Create; override;
1459   end;
1460
1461   TfdBGRA2 = class(TfdBGRA_UB4)
1462     constructor Create; override;
1463   end;
1464
1465   TfdBGRA4 = class(TfdUniversal_US1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdBGR5A1 = class(TfdUniversal_US1)
1470     constructor Create; override;
1471   end;
1472
1473   TfdBGRA8 = class(TfdBGRA_UB4)
1474     constructor Create; override;
1475   end;
1476
1477   TfdBGR10A2 = class(TfdUniversal_UI1)
1478     constructor Create; override;
1479   end;
1480
1481   TfdBGRA12 = class(TfdBGRA_US4)
1482     constructor Create; override;
1483   end;
1484
1485   TfdBGRA16 = class(TfdBGRA_US4)
1486     constructor Create; override;
1487   end;
1488
1489   TfdDepth16 = class(TfdDepth_US1)
1490     constructor Create; override;
1491   end;
1492
1493   TfdDepth24 = class(TfdDepth_UI1)
1494     constructor Create; override;
1495   end;
1496
1497   TfdDepth32 = class(TfdDepth_UI1)
1498     constructor Create; override;
1499   end;
1500
1501   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1502     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1503     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1504     constructor Create; override;
1505   end;
1506
1507   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1508     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1509     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1510     constructor Create; override;
1511   end;
1512
1513   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1514     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1515     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1516     constructor Create; override;
1517   end;
1518
1519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1520   TbmpBitfieldFormat = class(TFormatDescriptor)
1521   private
1522     procedure SetRedMask  (const aValue: QWord);
1523     procedure SetGreenMask(const aValue: QWord);
1524     procedure SetBlueMask (const aValue: QWord);
1525     procedure SetAlphaMask(const aValue: QWord);
1526
1527     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1528   public
1529     property RedMask:   QWord read GetRedMask   write SetRedMask;
1530     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1531     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1532     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1533
1534     property PixelSize: Single read fPixelSize write fPixelSize;
1535
1536     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1537     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1538   end;
1539
1540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1541   TbmpColorTableEnty = packed record
1542     b, g, r, a: Byte;
1543   end;
1544   TbmpColorTable = array of TbmpColorTableEnty;
1545   TbmpColorTableFormat = class(TFormatDescriptor)
1546   private
1547     fColorTable: TbmpColorTable;
1548   public
1549     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1550     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1551     property Range:      TglBitmapColorRec read fRange      write fRange;
1552     property Shift:      TShiftRec         read fShift      write fShift;
1553     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1554
1555     procedure CreateColorTable;
1556
1557     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1558     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1559     destructor Destroy; override;
1560   end;
1561
1562 const
1563   LUMINANCE_WEIGHT_R = 0.30;
1564   LUMINANCE_WEIGHT_G = 0.59;
1565   LUMINANCE_WEIGHT_B = 0.11;
1566
1567   ALPHA_WEIGHT_R = 0.30;
1568   ALPHA_WEIGHT_G = 0.59;
1569   ALPHA_WEIGHT_B = 0.11;
1570
1571   DEPTH_WEIGHT_R = 0.333333333;
1572   DEPTH_WEIGHT_G = 0.333333333;
1573   DEPTH_WEIGHT_B = 0.333333333;
1574
1575   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1576
1577   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1578     TfdEmpty,
1579
1580     TfdAlpha4,
1581     TfdAlpha8,
1582     TfdAlpha12,
1583     TfdAlpha16,
1584
1585     TfdLuminance4,
1586     TfdLuminance8,
1587     TfdLuminance12,
1588     TfdLuminance16,
1589
1590     TfdLuminance4Alpha4,
1591     TfdLuminance6Alpha2,
1592     TfdLuminance8Alpha8,
1593     TfdLuminance12Alpha4,
1594     TfdLuminance12Alpha12,
1595     TfdLuminance16Alpha16,
1596
1597     TfdR3G3B2,
1598     TfdRGB4,
1599     TfdR5G6B5,
1600     TfdRGB5,
1601     TfdRGB8,
1602     TfdRGB10,
1603     TfdRGB12,
1604     TfdRGB16,
1605
1606     TfdRGBA2,
1607     TfdRGBA4,
1608     TfdRGB5A1,
1609     TfdRGBA8,
1610     TfdRGB10A2,
1611     TfdRGBA12,
1612     TfdRGBA16,
1613
1614     TfdBGR4,
1615     TfdB5G6R5,
1616     TfdBGR5,
1617     TfdBGR8,
1618     TfdBGR10,
1619     TfdBGR12,
1620     TfdBGR16,
1621
1622     TfdBGRA2,
1623     TfdBGRA4,
1624     TfdBGR5A1,
1625     TfdBGRA8,
1626     TfdBGR10A2,
1627     TfdBGRA12,
1628     TfdBGRA16,
1629
1630     TfdDepth16,
1631     TfdDepth24,
1632     TfdDepth32,
1633
1634     TfdS3tcDtx1RGBA,
1635     TfdS3tcDtx3RGBA,
1636     TfdS3tcDtx5RGBA
1637   );
1638
1639 var
1640   FormatDescriptorCS: TCriticalSection;
1641   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1642
1643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1644 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1645 begin
1646   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1647 end;
1648
1649 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1650 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1651 begin
1652   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1653 end;
1654
1655 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1656 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1657 begin
1658   result.Fields := [];
1659
1660   if X >= 0 then
1661     result.Fields := result.Fields + [ffX];
1662   if Y >= 0 then
1663     result.Fields := result.Fields + [ffY];
1664
1665   result.X := Max(0, X);
1666   result.Y := Max(0, Y);
1667 end;
1668
1669 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1670 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1671 begin
1672   result.r := r;
1673   result.g := g;
1674   result.b := b;
1675   result.a := a;
1676 end;
1677
1678 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1679 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1680 var
1681   i: Integer;
1682 begin
1683   result := false;
1684   for i := 0 to high(r1.arr) do
1685     if (r1.arr[i] <> r2.arr[i]) then
1686       exit;
1687   result := true;
1688 end;
1689
1690 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1691 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1692 begin
1693   result.r := r;
1694   result.g := g;
1695   result.b := b;
1696   result.a := a;
1697 end;
1698
1699 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1700 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1701 begin
1702   result := [];
1703
1704   if (aFormat in [
1705         //4 bbp
1706         tfLuminance4,
1707
1708         //8bpp
1709         tfR3G3B2, tfLuminance8,
1710
1711         //16bpp
1712         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1713         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1714
1715         //24bpp
1716         tfBGR8, tfRGB8,
1717
1718         //32bpp
1719         tfRGB10, tfRGB10A2, tfRGBA8,
1720         tfBGR10, tfBGR10A2, tfBGRA8]) then
1721     result := result + [ftBMP];
1722
1723   if (aFormat in [
1724         //8 bpp
1725         tfLuminance8, tfAlpha8,
1726
1727         //16 bpp
1728         tfLuminance16, tfLuminance8Alpha8,
1729         tfRGB5, tfRGB5A1, tfRGBA4,
1730         tfBGR5, tfBGR5A1, tfBGRA4,
1731
1732         //24 bpp
1733         tfRGB8, tfBGR8,
1734
1735         //32 bpp
1736         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1737     result := result + [ftTGA];
1738
1739   if (aFormat in [
1740         //8 bpp
1741         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1742         tfR3G3B2, tfRGBA2, tfBGRA2,
1743
1744         //16 bpp
1745         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1746         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1747         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1748
1749         //24 bpp
1750         tfRGB8, tfBGR8,
1751
1752         //32 bbp
1753         tfLuminance16Alpha16,
1754         tfRGBA8, tfRGB10A2,
1755         tfBGRA8, tfBGR10A2,
1756
1757         //compressed
1758         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1759     result := result + [ftDDS];
1760
1761   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1762   if aFormat in [
1763       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1764       tfRGB8, tfRGBA8,
1765       tfBGR8, tfBGRA8] then
1766     result := result + [ftPNG];
1767   {$ENDIF}
1768
1769   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1770   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1771     result := result + [ftJPEG];
1772   {$ENDIF}
1773 end;
1774
1775 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1776 function IsPowerOfTwo(aNumber: Integer): Boolean;
1777 begin
1778   while (aNumber and 1) = 0 do
1779     aNumber := aNumber shr 1;
1780   result := aNumber = 1;
1781 end;
1782
1783 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1784 function GetTopMostBit(aBitSet: QWord): Integer;
1785 begin
1786   result := 0;
1787   while aBitSet > 0 do begin
1788     inc(result);
1789     aBitSet := aBitSet shr 1;
1790   end;
1791 end;
1792
1793 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1794 function CountSetBits(aBitSet: QWord): Integer;
1795 begin
1796   result := 0;
1797   while aBitSet > 0 do begin
1798     if (aBitSet and 1) = 1 then
1799       inc(result);
1800     aBitSet := aBitSet shr 1;
1801   end;
1802 end;
1803
1804 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1805 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1806 begin
1807   result := Trunc(
1808     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1809     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1810     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1811 end;
1812
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1815 begin
1816   result := Trunc(
1817     DEPTH_WEIGHT_R * aPixel.Data.r +
1818     DEPTH_WEIGHT_G * aPixel.Data.g +
1819     DEPTH_WEIGHT_B * aPixel.Data.b);
1820 end;
1821
1822 {$IFDEF GLB_NATIVE_OGL}
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1826 var
1827   GL_LibHandle: Pointer = nil;
1828
1829 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1830 begin
1831   if not Assigned(aLibHandle) then
1832     aLibHandle := GL_LibHandle;
1833
1834 {$IF DEFINED(GLB_WIN)}
1835   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1836   if Assigned(result) then
1837     exit;
1838
1839   if Assigned(wglGetProcAddress) then
1840     result := wglGetProcAddress(aProcName);
1841 {$ELSEIF DEFINED(GLB_LINUX)}
1842   if Assigned(glXGetProcAddress) then begin
1843     result := glXGetProcAddress(aProcName);
1844     if Assigned(result) then
1845       exit;
1846   end;
1847
1848   if Assigned(glXGetProcAddressARB) then begin
1849     result := glXGetProcAddressARB(aProcName);
1850     if Assigned(result) then
1851       exit;
1852   end;
1853
1854   result := dlsym(aLibHandle, aProcName);
1855 {$IFEND}
1856   if not Assigned(result) then
1857     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1858 end;
1859
1860 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1861 var
1862   GLU_LibHandle: Pointer = nil;
1863   OpenGLInitialized: Boolean;
1864   InitOpenGLCS: TCriticalSection;
1865
1866 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1867 procedure glbInitOpenGL;
1868
1869   ////////////////////////////////////////////////////////////////////////////////
1870   function glbLoadLibrary(const aName: PChar): Pointer;
1871   begin
1872     {$IF DEFINED(GLB_WIN)}
1873     result := {%H-}Pointer(LoadLibrary(aName));
1874     {$ELSEIF DEFINED(GLB_LINUX)}
1875     result := dlopen(Name, RTLD_LAZY);
1876     {$ELSE}
1877     result := nil;
1878     {$IFEND}
1879   end;
1880
1881   ////////////////////////////////////////////////////////////////////////////////
1882   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1883   begin
1884     result := false;
1885     if not Assigned(aLibHandle) then
1886       exit;
1887
1888     {$IF DEFINED(GLB_WIN)}
1889     Result := FreeLibrary({%H-}HINST(aLibHandle));
1890     {$ELSEIF DEFINED(GLB_LINUX)}
1891     Result := dlclose(aLibHandle) = 0;
1892     {$IFEND}
1893   end;
1894
1895 begin
1896   if Assigned(GL_LibHandle) then
1897     glbFreeLibrary(GL_LibHandle);
1898
1899   if Assigned(GLU_LibHandle) then
1900     glbFreeLibrary(GLU_LibHandle);
1901
1902   GL_LibHandle := glbLoadLibrary(libopengl);
1903   if not Assigned(GL_LibHandle) then
1904     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1905
1906   GLU_LibHandle := glbLoadLibrary(libglu);
1907   if not Assigned(GLU_LibHandle) then
1908     raise EglBitmapException.Create('unable to load library: ' + libglu);
1909
1910   try
1911   {$IF DEFINED(GLB_WIN)}
1912     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1913   {$ELSEIF DEFINED(GLB_LINUX)}
1914     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1915     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
1916   {$IFEND}
1917
1918     glEnable := glbGetProcAddress('glEnable');
1919     glDisable := glbGetProcAddress('glDisable');
1920     glGetString := glbGetProcAddress('glGetString');
1921     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1922     glTexParameteri := glbGetProcAddress('glTexParameteri');
1923     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1924     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1925     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1926     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1927     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1928     glGenTextures := glbGetProcAddress('glGenTextures');
1929     glBindTexture := glbGetProcAddress('glBindTexture');
1930     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1931     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1932     glReadPixels := glbGetProcAddress('glReadPixels');
1933     glPixelStorei := glbGetProcAddress('glPixelStorei');
1934     glTexImage1D := glbGetProcAddress('glTexImage1D');
1935     glTexImage2D := glbGetProcAddress('glTexImage2D');
1936     glGetTexImage := glbGetProcAddress('glGetTexImage');
1937
1938     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1939     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1940   finally
1941     glbFreeLibrary(GL_LibHandle);
1942     glbFreeLibrary(GLU_LibHandle);
1943   end;
1944 end;
1945 {$ENDIF}
1946
1947 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1948 procedure glbReadOpenGLExtensions;
1949 var
1950   Buffer: AnsiString;
1951   MajorVersion, MinorVersion: Integer;
1952
1953   ///////////////////////////////////////////////////////////////////////////////////////////
1954   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1955   var
1956     Separator: Integer;
1957   begin
1958     aMinor := 0;
1959     aMajor := 0;
1960
1961     Separator := Pos(AnsiString('.'), aBuffer);
1962     if (Separator > 1) and (Separator < Length(aBuffer)) and
1963        (aBuffer[Separator - 1] in ['0'..'9']) and
1964        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1965
1966       Dec(Separator);
1967       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1968         Dec(Separator);
1969
1970       Delete(aBuffer, 1, Separator);
1971       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1972
1973       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1974         Inc(Separator);
1975
1976       Delete(aBuffer, Separator, 255);
1977       Separator := Pos(AnsiString('.'), aBuffer);
1978
1979       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1980       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
1981     end;
1982   end;
1983
1984   ///////////////////////////////////////////////////////////////////////////////////////////
1985   function CheckExtension(const Extension: AnsiString): Boolean;
1986   var
1987     ExtPos: Integer;
1988   begin
1989     ExtPos := Pos(Extension, Buffer);
1990     result := ExtPos > 0;
1991     if result then
1992       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1993   end;
1994
1995 begin
1996 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1997   InitOpenGLCS.Enter;
1998   try
1999     if not OpenGLInitialized then begin
2000       glbInitOpenGL;
2001       OpenGLInitialized := true;
2002     end;
2003   finally
2004     InitOpenGLCS.Leave;
2005   end;
2006 {$ENDIF}
2007
2008   // Version
2009   Buffer := glGetString(GL_VERSION);
2010   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2011
2012   GL_VERSION_1_2 := false;
2013   GL_VERSION_1_3 := false;
2014   GL_VERSION_1_4 := false;
2015   GL_VERSION_2_0 := false;
2016   if MajorVersion = 1 then begin
2017     if MinorVersion >= 2 then
2018       GL_VERSION_1_2 := true;
2019
2020     if MinorVersion >= 3 then
2021       GL_VERSION_1_3 := true;
2022
2023     if MinorVersion >= 4 then
2024       GL_VERSION_1_4 := true;
2025   end else if MajorVersion >= 2 then begin
2026     GL_VERSION_1_2 := true;
2027     GL_VERSION_1_3 := true;
2028     GL_VERSION_1_4 := true;
2029     GL_VERSION_2_0 := true;
2030   end;
2031
2032   // Extensions
2033   Buffer := glGetString(GL_EXTENSIONS);
2034   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2035   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2036   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2037   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2038   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2039   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2040   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2041   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2042   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2043   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2044
2045   if GL_VERSION_1_3 then begin
2046     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2047     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2048     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2049   end else begin
2050     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2051     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2052     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2053   end;
2054 end;
2055 {$ENDIF}
2056
2057 (* TODO GLB_DELPHI
2058 {$IFDEF GLB_DELPHI}
2059 function CreateGrayPalette: HPALETTE;
2060 var
2061   Idx: Integer;
2062   Pal: PLogPalette;
2063 begin
2064   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2065
2066   Pal.palVersion := $300;
2067   Pal.palNumEntries := 256;
2068
2069   {$IFOPT R+}
2070     {$DEFINE GLB_TEMPRANGECHECK}
2071     {$R-}
2072   {$ENDIF}
2073
2074   for Idx := 0 to 256 - 1 do begin
2075     Pal.palPalEntry[Idx].peRed   := Idx;
2076     Pal.palPalEntry[Idx].peGreen := Idx;
2077     Pal.palPalEntry[Idx].peBlue  := Idx;
2078     Pal.palPalEntry[Idx].peFlags := 0;
2079   end;
2080
2081   {$IFDEF GLB_TEMPRANGECHECK}
2082     {$UNDEF GLB_TEMPRANGECHECK}
2083     {$R+}
2084   {$ENDIF}
2085
2086   result := CreatePalette(Pal^);
2087
2088   FreeMem(Pal);
2089 end;
2090 {$ENDIF}
2091 *)
2092
2093 {$IFDEF GLB_SDL_IMAGE}
2094 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2095 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2096 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2097 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2098 begin
2099   result := TStream(context^.unknown.data1).Seek(offset, whence);
2100 end;
2101
2102 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2103 begin
2104   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2105 end;
2106
2107 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2108 begin
2109   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2110 end;
2111
2112 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2113 begin
2114   result := 0;
2115 end;
2116
2117 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2118 begin
2119   result := SDL_AllocRW;
2120
2121   if result = nil then
2122     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2123
2124   result^.seek := glBitmapRWseek;
2125   result^.read := glBitmapRWread;
2126   result^.write := glBitmapRWwrite;
2127   result^.close := glBitmapRWclose;
2128   result^.unknown.data1 := Stream;
2129 end;
2130 {$ENDIF}
2131
2132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2133 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2134 begin
2135   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2136 end;
2137
2138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2139 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2140 begin
2141   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2142 end;
2143
2144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2145 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2146 begin
2147   glBitmapDefaultMipmap := aValue;
2148 end;
2149
2150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2151 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2152 begin
2153   glBitmapDefaultFormat := aFormat;
2154 end;
2155
2156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2157 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2158 begin
2159   glBitmapDefaultFilterMin := aMin;
2160   glBitmapDefaultFilterMag := aMag;
2161 end;
2162
2163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2164 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2165 begin
2166   glBitmapDefaultWrapS := S;
2167   glBitmapDefaultWrapT := T;
2168   glBitmapDefaultWrapR := R;
2169 end;
2170
2171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2173 begin
2174   result := glBitmapDefaultDeleteTextureOnFree;
2175 end;
2176
2177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2178 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2179 begin
2180   result := glBitmapDefaultFreeDataAfterGenTextures;
2181 end;
2182
2183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2184 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2185 begin
2186   result := glBitmapDefaultMipmap;
2187 end;
2188
2189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2190 function glBitmapGetDefaultFormat: TglBitmapFormat;
2191 begin
2192   result := glBitmapDefaultFormat;
2193 end;
2194
2195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2196 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2197 begin
2198   aMin := glBitmapDefaultFilterMin;
2199   aMag := glBitmapDefaultFilterMag;
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2204 begin
2205   S := glBitmapDefaultWrapS;
2206   T := glBitmapDefaultWrapT;
2207   R := glBitmapDefaultWrapR;
2208 end;
2209
2210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2211 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 function TFormatDescriptor.GetRedMask: QWord;
2214 begin
2215   result := fRange.r shl fShift.r;
2216 end;
2217
2218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2219 function TFormatDescriptor.GetGreenMask: QWord;
2220 begin
2221   result := fRange.g shl fShift.g;
2222 end;
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 function TFormatDescriptor.GetBlueMask: QWord;
2226 begin
2227   result := fRange.b shl fShift.b;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 function TFormatDescriptor.GetAlphaMask: QWord;
2232 begin
2233   result := fRange.a shl fShift.a;
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 function TFormatDescriptor.GetComponents: Integer;
2238 var
2239   i: Integer;
2240 begin
2241   result := 0;
2242   for i := 0 to 3 do
2243     if (fRange.arr[i] > 0) then
2244       inc(result);
2245 end;
2246
2247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2249 var
2250   w, h: Integer;
2251 begin
2252   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2253     w := Max(1, aSize.X);
2254     h := Max(1, aSize.Y);
2255     result := GetSize(w, h);
2256   end else
2257     result := 0;
2258 end;
2259
2260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2261 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2262 begin
2263   result := 0;
2264   if (aWidth <= 0) or (aHeight <= 0) then
2265     exit;
2266   result := Ceil(aWidth * aHeight * fPixelSize);
2267 end;
2268
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 function TFormatDescriptor.CreateMappingData: Pointer;
2271 begin
2272   result := nil;
2273 end;
2274
2275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2276 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2277 begin
2278   //DUMMY
2279 end;
2280
2281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2282 function TFormatDescriptor.IsEmpty: Boolean;
2283 begin
2284   result := (fFormat = tfEmpty);
2285 end;
2286
2287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2288 function TFormatDescriptor.HasAlpha: Boolean;
2289 begin
2290   result := (fRange.a > 0);
2291 end;
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2295 begin
2296   result := false;
2297   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2298     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2299   if (aRedMask   <> RedMask) then
2300     exit;
2301   if (aGreenMask <> GreenMask) then
2302     exit;
2303   if (aBlueMask  <> BlueMask) then
2304     exit;
2305   if (aAlphaMask <> AlphaMask) then
2306     exit;
2307   result := true;
2308 end;
2309
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2312 begin
2313   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2314   aPixel.Data   := fRange;
2315   aPixel.Range  := fRange;
2316   aPixel.Format := fFormat;
2317 end;
2318
2319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 constructor TFormatDescriptor.Create;
2321 begin
2322   inherited Create;
2323
2324   fFormat       := tfEmpty;
2325   fWithAlpha    := tfEmpty;
2326   fWithoutAlpha := tfEmpty;
2327   fRGBInverted  := tfEmpty;
2328   fUncompressed := tfEmpty;
2329   fPixelSize    := 0.0;
2330   fIsCompressed := false;
2331
2332   fglFormat         := 0;
2333   fglInternalFormat := 0;
2334   fglDataFormat     := 0;
2335
2336   FillChar(fRange, 0, SizeOf(fRange));
2337   FillChar(fShift, 0, SizeOf(fShift));
2338 end;
2339
2340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2341 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2343 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2344 begin
2345   aData^ := aPixel.Data.a;
2346   inc(aData);
2347 end;
2348
2349 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2350 begin
2351   aPixel.Data.r := 0;
2352   aPixel.Data.g := 0;
2353   aPixel.Data.b := 0;
2354   aPixel.Data.a := aData^;
2355   inc(aData);
2356 end;
2357
2358 constructor TfdAlpha_UB1.Create;
2359 begin
2360   inherited Create;
2361   fPixelSize        := 1.0;
2362   fRange.a          := $FF;
2363   fglFormat         := GL_ALPHA;
2364   fglDataFormat     := GL_UNSIGNED_BYTE;
2365 end;
2366
2367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2368 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2371 begin
2372   aData^ := LuminanceWeight(aPixel);
2373   inc(aData);
2374 end;
2375
2376 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2377 begin
2378   aPixel.Data.r := aData^;
2379   aPixel.Data.g := aData^;
2380   aPixel.Data.b := aData^;
2381   aPixel.Data.a := 0;
2382   inc(aData);
2383 end;
2384
2385 constructor TfdLuminance_UB1.Create;
2386 begin
2387   inherited Create;
2388   fPixelSize        := 1.0;
2389   fRange.r          := $FF;
2390   fRange.g          := $FF;
2391   fRange.b          := $FF;
2392   fglFormat         := GL_LUMINANCE;
2393   fglDataFormat     := GL_UNSIGNED_BYTE;
2394 end;
2395
2396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2397 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2400 var
2401   i: Integer;
2402 begin
2403   aData^ := 0;
2404   for i := 0 to 3 do
2405     if (fRange.arr[i] > 0) then
2406       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2407   inc(aData);
2408 end;
2409
2410 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2411 var
2412   i: Integer;
2413 begin
2414   for i := 0 to 3 do
2415     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2416   inc(aData);
2417 end;
2418
2419 constructor TfdUniversal_UB1.Create;
2420 begin
2421   inherited Create;
2422   fPixelSize := 1.0;
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2429 begin
2430   inherited Map(aPixel, aData, aMapData);
2431   aData^ := aPixel.Data.a;
2432   inc(aData);
2433 end;
2434
2435 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2436 begin
2437   inherited Unmap(aData, aPixel, aMapData);
2438   aPixel.Data.a := aData^;
2439   inc(aData);
2440 end;
2441
2442 constructor TfdLuminanceAlpha_UB2.Create;
2443 begin
2444   inherited Create;
2445   fPixelSize        := 2.0;
2446   fRange.a          := $FF;
2447   fShift.a          :=   8;
2448   fglFormat         := GL_LUMINANCE_ALPHA;
2449   fglDataFormat     := GL_UNSIGNED_BYTE;
2450 end;
2451
2452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2456 begin
2457   aData^ := aPixel.Data.r;
2458   inc(aData);
2459   aData^ := aPixel.Data.g;
2460   inc(aData);
2461   aData^ := aPixel.Data.b;
2462   inc(aData);
2463 end;
2464
2465 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2466 begin
2467   aPixel.Data.r := aData^;
2468   inc(aData);
2469   aPixel.Data.g := aData^;
2470   inc(aData);
2471   aPixel.Data.b := aData^;
2472   inc(aData);
2473   aPixel.Data.a := 0;
2474 end;
2475
2476 constructor TfdRGB_UB3.Create;
2477 begin
2478   inherited Create;
2479   fPixelSize        := 3.0;
2480   fRange.r          := $FF;
2481   fRange.g          := $FF;
2482   fRange.b          := $FF;
2483   fShift.r          :=   0;
2484   fShift.g          :=   8;
2485   fShift.b          :=  16;
2486   fglFormat         := GL_RGB;
2487   fglDataFormat     := GL_UNSIGNED_BYTE;
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   aData^ := aPixel.Data.b;
2496   inc(aData);
2497   aData^ := aPixel.Data.g;
2498   inc(aData);
2499   aData^ := aPixel.Data.r;
2500   inc(aData);
2501 end;
2502
2503 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2504 begin
2505   aPixel.Data.b := aData^;
2506   inc(aData);
2507   aPixel.Data.g := aData^;
2508   inc(aData);
2509   aPixel.Data.r := aData^;
2510   inc(aData);
2511   aPixel.Data.a := 0;
2512 end;
2513
2514 constructor TfdBGR_UB3.Create;
2515 begin
2516   fPixelSize        := 3.0;
2517   fRange.r          := $FF;
2518   fRange.g          := $FF;
2519   fRange.b          := $FF;
2520   fShift.r          :=  16;
2521   fShift.g          :=   8;
2522   fShift.b          :=   0;
2523   fglFormat         := GL_BGR;
2524   fglDataFormat     := GL_UNSIGNED_BYTE;
2525 end;
2526
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2531 begin
2532   inherited Map(aPixel, aData, aMapData);
2533   aData^ := aPixel.Data.a;
2534   inc(aData);
2535 end;
2536
2537 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2538 begin
2539   inherited Unmap(aData, aPixel, aMapData);
2540   aPixel.Data.a := aData^;
2541   inc(aData);
2542 end;
2543
2544 constructor TfdRGBA_UB4.Create;
2545 begin
2546   inherited Create;
2547   fPixelSize        := 4.0;
2548   fRange.a          := $FF;
2549   fShift.a          :=  24;
2550   fglFormat         := GL_RGBA;
2551   fglDataFormat     := GL_UNSIGNED_BYTE;
2552 end;
2553
2554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2558 begin
2559   inherited Map(aPixel, aData, aMapData);
2560   aData^ := aPixel.Data.a;
2561   inc(aData);
2562 end;
2563
2564 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2565 begin
2566   inherited Unmap(aData, aPixel, aMapData);
2567   aPixel.Data.a := aData^;
2568   inc(aData);
2569 end;
2570
2571 constructor TfdBGRA_UB4.Create;
2572 begin
2573   inherited Create;
2574   fPixelSize        := 4.0;
2575   fRange.a          := $FF;
2576   fShift.a          :=  24;
2577   fglFormat         := GL_BGRA;
2578   fglDataFormat     := GL_UNSIGNED_BYTE;
2579 end;
2580
2581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2582 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2585 begin
2586   PWord(aData)^ := aPixel.Data.a;
2587   inc(aData, 2);
2588 end;
2589
2590 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2591 begin
2592   aPixel.Data.r := 0;
2593   aPixel.Data.g := 0;
2594   aPixel.Data.b := 0;
2595   aPixel.Data.a := PWord(aData)^;
2596   inc(aData, 2);
2597 end;
2598
2599 constructor TfdAlpha_US1.Create;
2600 begin
2601   inherited Create;
2602   fPixelSize        := 2.0;
2603   fRange.a          := $FFFF;
2604   fglFormat         := GL_ALPHA;
2605   fglDataFormat     := GL_UNSIGNED_SHORT;
2606 end;
2607
2608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2609 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2612 begin
2613   PWord(aData)^ := LuminanceWeight(aPixel);
2614   inc(aData, 2);
2615 end;
2616
2617 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2618 begin
2619   aPixel.Data.r := PWord(aData)^;
2620   aPixel.Data.g := PWord(aData)^;
2621   aPixel.Data.b := PWord(aData)^;
2622   aPixel.Data.a := 0;
2623   inc(aData, 2);
2624 end;
2625
2626 constructor TfdLuminance_US1.Create;
2627 begin
2628   inherited Create;
2629   fPixelSize        := 2.0;
2630   fRange.r          := $FFFF;
2631   fRange.g          := $FFFF;
2632   fRange.b          := $FFFF;
2633   fglFormat         := GL_LUMINANCE;
2634   fglDataFormat     := GL_UNSIGNED_SHORT;
2635 end;
2636
2637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2638 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2641 var
2642   i: Integer;
2643 begin
2644   PWord(aData)^ := 0;
2645   for i := 0 to 3 do
2646     if (fRange.arr[i] > 0) then
2647       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2648   inc(aData, 2);
2649 end;
2650
2651 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2652 var
2653   i: Integer;
2654 begin
2655   for i := 0 to 3 do
2656     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2657   inc(aData, 2);
2658 end;
2659
2660 constructor TfdUniversal_US1.Create;
2661 begin
2662   inherited Create;
2663   fPixelSize := 2.0;
2664 end;
2665
2666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2669 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2670 begin
2671   PWord(aData)^ := DepthWeight(aPixel);
2672   inc(aData, 2);
2673 end;
2674
2675 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2676 begin
2677   aPixel.Data.r := PWord(aData)^;
2678   aPixel.Data.g := PWord(aData)^;
2679   aPixel.Data.b := PWord(aData)^;
2680   aPixel.Data.a := 0;
2681   inc(aData, 2);
2682 end;
2683
2684 constructor TfdDepth_US1.Create;
2685 begin
2686   inherited Create;
2687   fPixelSize        := 2.0;
2688   fRange.r          := $FFFF;
2689   fRange.g          := $FFFF;
2690   fRange.b          := $FFFF;
2691   fglFormat         := GL_DEPTH_COMPONENT;
2692   fglDataFormat     := GL_UNSIGNED_SHORT;
2693 end;
2694
2695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2698 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2699 begin
2700   inherited Map(aPixel, aData, aMapData);
2701   PWord(aData)^ := aPixel.Data.a;
2702   inc(aData, 2);
2703 end;
2704
2705 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2706 begin
2707   inherited Unmap(aData, aPixel, aMapData);
2708   aPixel.Data.a := PWord(aData)^;
2709   inc(aData, 2);
2710 end;
2711
2712 constructor TfdLuminanceAlpha_US2.Create;
2713 begin
2714   inherited Create;
2715   fPixelSize        :=   4.0;
2716   fRange.a          := $FFFF;
2717   fShift.a          :=    16;
2718   fglFormat         := GL_LUMINANCE_ALPHA;
2719   fglDataFormat     := GL_UNSIGNED_SHORT;
2720 end;
2721
2722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2723 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2726 begin
2727   PWord(aData)^ := aPixel.Data.r;
2728   inc(aData, 2);
2729   PWord(aData)^ := aPixel.Data.g;
2730   inc(aData, 2);
2731   PWord(aData)^ := aPixel.Data.b;
2732   inc(aData, 2);
2733 end;
2734
2735 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2736 begin
2737   aPixel.Data.r := PWord(aData)^;
2738   inc(aData, 2);
2739   aPixel.Data.g := PWord(aData)^;
2740   inc(aData, 2);
2741   aPixel.Data.b := PWord(aData)^;
2742   inc(aData, 2);
2743   aPixel.Data.a := 0;
2744 end;
2745
2746 constructor TfdRGB_US3.Create;
2747 begin
2748   inherited Create;
2749   fPixelSize        :=   6.0;
2750   fRange.r          := $FFFF;
2751   fRange.g          := $FFFF;
2752   fRange.b          := $FFFF;
2753   fShift.r          :=     0;
2754   fShift.g          :=    16;
2755   fShift.b          :=    32;
2756   fglFormat         := GL_RGB;
2757   fglDataFormat     := GL_UNSIGNED_SHORT;
2758 end;
2759
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2764 begin
2765   PWord(aData)^ := aPixel.Data.b;
2766   inc(aData, 2);
2767   PWord(aData)^ := aPixel.Data.g;
2768   inc(aData, 2);
2769   PWord(aData)^ := aPixel.Data.r;
2770   inc(aData, 2);
2771 end;
2772
2773 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2774 begin
2775   aPixel.Data.b := PWord(aData)^;
2776   inc(aData, 2);
2777   aPixel.Data.g := PWord(aData)^;
2778   inc(aData, 2);
2779   aPixel.Data.r := PWord(aData)^;
2780   inc(aData, 2);
2781   aPixel.Data.a := 0;
2782 end;
2783
2784 constructor TfdBGR_US3.Create;
2785 begin
2786   inherited Create;
2787   fPixelSize        :=   6.0;
2788   fRange.r          := $FFFF;
2789   fRange.g          := $FFFF;
2790   fRange.b          := $FFFF;
2791   fShift.r          :=    32;
2792   fShift.g          :=    16;
2793   fShift.b          :=     0;
2794   fglFormat         := GL_BGR;
2795   fglDataFormat     := GL_UNSIGNED_SHORT;
2796 end;
2797
2798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2801 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2802 begin
2803   inherited Map(aPixel, aData, aMapData);
2804   PWord(aData)^ := aPixel.Data.a;
2805   inc(aData, 2);
2806 end;
2807
2808 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2809 begin
2810   inherited Unmap(aData, aPixel, aMapData);
2811   aPixel.Data.a := PWord(aData)^;
2812   inc(aData, 2);
2813 end;
2814
2815 constructor TfdRGBA_US4.Create;
2816 begin
2817   inherited Create;
2818   fPixelSize        :=   8.0;
2819   fRange.a          := $FFFF;
2820   fShift.a          :=    48;
2821   fglFormat         := GL_RGBA;
2822   fglDataFormat     := GL_UNSIGNED_SHORT;
2823 end;
2824
2825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2828 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2829 begin
2830   inherited Map(aPixel, aData, aMapData);
2831   PWord(aData)^ := aPixel.Data.a;
2832   inc(aData, 2);
2833 end;
2834
2835 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2836 begin
2837   inherited Unmap(aData, aPixel, aMapData);
2838   aPixel.Data.a := PWord(aData)^;
2839   inc(aData, 2);
2840 end;
2841
2842 constructor TfdBGRA_US4.Create;
2843 begin
2844   inherited Create;
2845   fPixelSize        :=   8.0;
2846   fRange.a          := $FFFF;
2847   fShift.a          :=    48;
2848   fglFormat         := GL_BGRA;
2849   fglDataFormat     := GL_UNSIGNED_SHORT;
2850 end;
2851
2852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2856 var
2857   i: Integer;
2858 begin
2859   PCardinal(aData)^ := 0;
2860   for i := 0 to 3 do
2861     if (fRange.arr[i] > 0) then
2862       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2863   inc(aData, 4);
2864 end;
2865
2866 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2867 var
2868   i: Integer;
2869 begin
2870   for i := 0 to 3 do
2871     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2872   inc(aData, 2);
2873 end;
2874
2875 constructor TfdUniversal_UI1.Create;
2876 begin
2877   inherited Create;
2878   fPixelSize := 4.0;
2879 end;
2880
2881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2885 begin
2886   PCardinal(aData)^ := DepthWeight(aPixel);
2887   inc(aData, 4);
2888 end;
2889
2890 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2891 begin
2892   aPixel.Data.r := PCardinal(aData)^;
2893   aPixel.Data.g := PCardinal(aData)^;
2894   aPixel.Data.b := PCardinal(aData)^;
2895   aPixel.Data.a := 0;
2896   inc(aData, 4);
2897 end;
2898
2899 constructor TfdDepth_UI1.Create;
2900 begin
2901   inherited Create;
2902   fPixelSize        := 4.0;
2903   fRange.r          := $FFFFFFFF;
2904   fRange.g          := $FFFFFFFF;
2905   fRange.b          := $FFFFFFFF;
2906   fglFormat         := GL_DEPTH_COMPONENT;
2907   fglDataFormat     := GL_UNSIGNED_INT;
2908 end;
2909
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 constructor TfdAlpha4.Create;
2914 begin
2915   inherited Create;
2916   fFormat           := tfAlpha4;
2917   fWithAlpha        := tfAlpha4;
2918   fglInternalFormat := GL_ALPHA4;
2919 end;
2920
2921 constructor TfdAlpha8.Create;
2922 begin
2923   inherited Create;
2924   fFormat           := tfAlpha8;
2925   fWithAlpha        := tfAlpha8;
2926   fglInternalFormat := GL_ALPHA8;
2927 end;
2928
2929 constructor TfdAlpha12.Create;
2930 begin
2931   inherited Create;
2932   fFormat           := tfAlpha12;
2933   fWithAlpha        := tfAlpha12;
2934   fglInternalFormat := GL_ALPHA12;
2935 end;
2936
2937 constructor TfdAlpha16.Create;
2938 begin
2939   inherited Create;
2940   fFormat           := tfAlpha16;
2941   fWithAlpha        := tfAlpha16;
2942   fglInternalFormat := GL_ALPHA16;
2943 end;
2944
2945 constructor TfdLuminance4.Create;
2946 begin
2947   inherited Create;
2948   fFormat           := tfLuminance4;
2949   fWithAlpha        := tfLuminance4Alpha4;
2950   fWithoutAlpha     := tfLuminance4;
2951   fglInternalFormat := GL_LUMINANCE4;
2952 end;
2953
2954 constructor TfdLuminance8.Create;
2955 begin
2956   inherited Create;
2957   fFormat           := tfLuminance8;
2958   fWithAlpha        := tfLuminance8Alpha8;
2959   fWithoutAlpha     := tfLuminance8;
2960   fglInternalFormat := GL_LUMINANCE8;
2961 end;
2962
2963 constructor TfdLuminance12.Create;
2964 begin
2965   inherited Create;
2966   fFormat           := tfLuminance12;
2967   fWithAlpha        := tfLuminance12Alpha12;
2968   fWithoutAlpha     := tfLuminance12;
2969   fglInternalFormat := GL_LUMINANCE12;
2970 end;
2971
2972 constructor TfdLuminance16.Create;
2973 begin
2974   inherited Create;
2975   fFormat           := tfLuminance16;
2976   fWithAlpha        := tfLuminance16Alpha16;
2977   fWithoutAlpha     := tfLuminance16;
2978   fglInternalFormat := GL_LUMINANCE16;
2979 end;
2980
2981 constructor TfdLuminance4Alpha4.Create;
2982 begin
2983   inherited Create;
2984   fFormat           := tfLuminance4Alpha4;
2985   fWithAlpha        := tfLuminance4Alpha4;
2986   fWithoutAlpha     := tfLuminance4;
2987   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2988 end;
2989
2990 constructor TfdLuminance6Alpha2.Create;
2991 begin
2992   inherited Create;
2993   fFormat           := tfLuminance6Alpha2;
2994   fWithAlpha        := tfLuminance6Alpha2;
2995   fWithoutAlpha     := tfLuminance8;
2996   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2997 end;
2998
2999 constructor TfdLuminance8Alpha8.Create;
3000 begin
3001   inherited Create;
3002   fFormat           := tfLuminance8Alpha8;
3003   fWithAlpha        := tfLuminance8Alpha8;
3004   fWithoutAlpha     := tfLuminance8;
3005   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3006 end;
3007
3008 constructor TfdLuminance12Alpha4.Create;
3009 begin
3010   inherited Create;
3011   fFormat           := tfLuminance12Alpha4;
3012   fWithAlpha        := tfLuminance12Alpha4;
3013   fWithoutAlpha     := tfLuminance12;
3014   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3015 end;
3016
3017 constructor TfdLuminance12Alpha12.Create;
3018 begin
3019   inherited Create;
3020   fFormat           := tfLuminance12Alpha12;
3021   fWithAlpha        := tfLuminance12Alpha12;
3022   fWithoutAlpha     := tfLuminance12;
3023   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3024 end;
3025
3026 constructor TfdLuminance16Alpha16.Create;
3027 begin
3028   inherited Create;
3029   fFormat           := tfLuminance16Alpha16;
3030   fWithAlpha        := tfLuminance16Alpha16;
3031   fWithoutAlpha     := tfLuminance16;
3032   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3033 end;
3034
3035 constructor TfdR3G3B2.Create;
3036 begin
3037   inherited Create;
3038   fFormat           := tfR3G3B2;
3039   fWithAlpha        := tfRGBA2;
3040   fWithoutAlpha     := tfR3G3B2;
3041   fRange.r          := $7;
3042   fRange.g          := $7;
3043   fRange.b          := $3;
3044   fShift.r          :=  0;
3045   fShift.g          :=  3;
3046   fShift.b          :=  6;
3047   fglFormat         := GL_RGB;
3048   fglInternalFormat := GL_R3_G3_B2;
3049   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3050 end;
3051
3052 constructor TfdRGB4.Create;
3053 begin
3054   inherited Create;
3055   fFormat           := tfRGB4;
3056   fWithAlpha        := tfRGBA4;
3057   fWithoutAlpha     := tfRGB4;
3058   fRGBInverted      := tfBGR4;
3059   fRange.r          := $F;
3060   fRange.g          := $F;
3061   fRange.b          := $F;
3062   fShift.r          :=  0;
3063   fShift.g          :=  4;
3064   fShift.b          :=  8;
3065   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3066   fglInternalFormat := GL_RGB4;
3067   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3068 end;
3069
3070 constructor TfdR5G6B5.Create;
3071 begin
3072   inherited Create;
3073   fFormat           := tfR5G6B5;
3074   fWithAlpha        := tfRGBA4;
3075   fWithoutAlpha     := tfR5G6B5;
3076   fRGBInverted      := tfB5G6R5;
3077   fRange.r          := $1F;
3078   fRange.g          := $3F;
3079   fRange.b          := $1F;
3080   fShift.r          :=   0;
3081   fShift.g          :=   5;
3082   fShift.b          :=  11;
3083   fglFormat         := GL_RGB;
3084   fglInternalFormat := GL_RGB565;
3085   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3086 end;
3087
3088 constructor TfdRGB5.Create;
3089 begin
3090   inherited Create;
3091   fFormat           := tfRGB5;
3092   fWithAlpha        := tfRGB5A1;
3093   fWithoutAlpha     := tfRGB5;
3094   fRGBInverted      := tfBGR5;
3095   fRange.r          := $1F;
3096   fRange.g          := $1F;
3097   fRange.b          := $1F;
3098   fShift.r          :=   0;
3099   fShift.g          :=   5;
3100   fShift.b          :=  10;
3101   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3102   fglInternalFormat := GL_RGB5;
3103   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3104 end;
3105
3106 constructor TfdRGB8.Create;
3107 begin
3108   inherited Create;
3109   fFormat           := tfRGB8;
3110   fWithAlpha        := tfRGBA8;
3111   fWithoutAlpha     := tfRGB8;
3112   fRGBInverted      := tfBGR8;
3113   fglInternalFormat := GL_RGB8;
3114 end;
3115
3116 constructor TfdRGB10.Create;
3117 begin
3118   inherited Create;
3119   fFormat           := tfRGB10;
3120   fWithAlpha        := tfRGB10A2;
3121   fWithoutAlpha     := tfRGB10;
3122   fRGBInverted      := tfBGR10;
3123   fRange.r          := $3FF;
3124   fRange.g          := $3FF;
3125   fRange.b          := $3FF;
3126   fShift.r          :=    0;
3127   fShift.g          :=   10;
3128   fShift.b          :=   20;
3129   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3130   fglInternalFormat := GL_RGB10;
3131   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3132 end;
3133
3134 constructor TfdRGB12.Create;
3135 begin
3136   inherited Create;
3137   fFormat           := tfRGB12;
3138   fWithAlpha        := tfRGBA12;
3139   fWithoutAlpha     := tfRGB12;
3140   fRGBInverted      := tfBGR12;
3141   fglInternalFormat := GL_RGB12;
3142 end;
3143
3144 constructor TfdRGB16.Create;
3145 begin
3146   inherited Create;
3147   fFormat           := tfRGB16;
3148   fWithAlpha        := tfRGBA16;
3149   fWithoutAlpha     := tfRGB16;
3150   fRGBInverted      := tfBGR16;
3151   fglInternalFormat := GL_RGB16;
3152 end;
3153
3154 constructor TfdRGBA2.Create;
3155 begin
3156   inherited Create;
3157   fFormat           := tfRGBA2;
3158   fWithAlpha        := tfRGBA2;
3159   fWithoutAlpha     := tfR3G3B2;
3160   fRGBInverted      := tfBGRA2;
3161   fglInternalFormat := GL_RGBA2;
3162 end;
3163
3164 constructor TfdRGBA4.Create;
3165 begin
3166   inherited Create;
3167   fFormat           := tfRGBA4;
3168   fWithAlpha        := tfRGBA4;
3169   fWithoutAlpha     := tfRGB4;
3170   fRGBInverted      := tfBGRA4;
3171   fRange.r          := $F;
3172   fRange.g          := $F;
3173   fRange.b          := $F;
3174   fRange.a          := $F;
3175   fShift.r          :=  0;
3176   fShift.g          :=  4;
3177   fShift.b          :=  8;
3178   fShift.a          := 12;
3179   fglFormat         := GL_RGBA;
3180   fglInternalFormat := GL_RGBA4;
3181   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3182 end;
3183
3184 constructor TfdRGB5A1.Create;
3185 begin
3186   inherited Create;
3187   fFormat           := tfRGB5A1;
3188   fWithAlpha        := tfRGB5A1;
3189   fWithoutAlpha     := tfRGB5;
3190   fRGBInverted      := tfBGR5A1;
3191   fRange.r          := $1F;
3192   fRange.g          := $1F;
3193   fRange.b          := $1F;
3194   fRange.a          := $01;
3195   fShift.r          :=   0;
3196   fShift.g          :=   5;
3197   fShift.b          :=  10;
3198   fShift.a          :=  15;
3199   fglFormat         := GL_RGBA;
3200   fglInternalFormat := GL_RGB5_A1;
3201   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3202 end;
3203
3204 constructor TfdRGBA8.Create;
3205 begin
3206   inherited Create;
3207   fFormat           := tfRGBA8;
3208   fWithAlpha        := tfRGBA8;
3209   fWithoutAlpha     := tfRGB8;
3210   fRGBInverted      := tfBGRA8;
3211   fglInternalFormat := GL_RGBA8;
3212 end;
3213
3214 constructor TfdRGB10A2.Create;
3215 begin
3216   inherited Create;
3217   fFormat           := tfRGB10A2;
3218   fWithAlpha        := tfRGB10A2;
3219   fWithoutAlpha     := tfRGB10;
3220   fRGBInverted      := tfBGR10A2;
3221   fRange.r          := $3FF;
3222   fRange.g          := $3FF;
3223   fRange.b          := $3FF;
3224   fRange.a          := $003;
3225   fShift.r          :=    0;
3226   fShift.g          :=   10;
3227   fShift.b          :=   20;
3228   fShift.a          :=   30;
3229   fglFormat         := GL_RGBA;
3230   fglInternalFormat := GL_RGB10_A2;
3231   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3232 end;
3233
3234 constructor TfdRGBA12.Create;
3235 begin
3236   inherited Create;
3237   fFormat           := tfRGBA12;
3238   fWithAlpha        := tfRGBA12;
3239   fWithoutAlpha     := tfRGB12;
3240   fRGBInverted      := tfBGRA12;
3241   fglInternalFormat := GL_RGBA12;
3242 end;
3243
3244 constructor TfdRGBA16.Create;
3245 begin
3246   inherited Create;
3247   fFormat           := tfRGBA16;
3248   fWithAlpha        := tfRGBA16;
3249   fWithoutAlpha     := tfRGB16;
3250   fRGBInverted      := tfBGRA16;
3251   fglInternalFormat := GL_RGBA16;
3252 end;
3253
3254 constructor TfdBGR4.Create;
3255 begin
3256   inherited Create;
3257   fPixelSize        := 2.0;
3258   fFormat           := tfBGR4;
3259   fWithAlpha        := tfBGRA4;
3260   fWithoutAlpha     := tfBGR4;
3261   fRGBInverted      := tfRGB4;
3262   fRange.r          := $F;
3263   fRange.g          := $F;
3264   fRange.b          := $F;
3265   fRange.a          := $0;
3266   fShift.r          :=  8;
3267   fShift.g          :=  4;
3268   fShift.b          :=  0;
3269   fShift.a          :=  0;
3270   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3271   fglInternalFormat := GL_RGB4;
3272   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3273 end;
3274
3275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3278 constructor TfdB5G6R5.Create;
3279 begin
3280   inherited Create;
3281   fFormat           := tfB5G6R5;
3282   fWithAlpha        := tfBGRA4;
3283   fWithoutAlpha     := tfB5G6R5;
3284   fRGBInverted      := tfR5G6B5;
3285   fRange.r          := $1F;
3286   fRange.g          := $3F;
3287   fRange.b          := $1F;
3288   fShift.r          :=  11;
3289   fShift.g          :=   5;
3290   fShift.b          :=   0;
3291   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3292   fglInternalFormat := GL_RGB8;
3293   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3294 end;
3295
3296 constructor TfdBGR5.Create;
3297 begin
3298   inherited Create;
3299   fPixelSize        := 2.0;
3300   fFormat           := tfBGR5;
3301   fWithAlpha        := tfBGR5A1;
3302   fWithoutAlpha     := tfBGR5;
3303   fRGBInverted      := tfRGB5;
3304   fRange.r          := $1F;
3305   fRange.g          := $1F;
3306   fRange.b          := $1F;
3307   fRange.a          := $00;
3308   fShift.r          :=  10;
3309   fShift.g          :=   5;
3310   fShift.b          :=   0;
3311   fShift.a          :=   0;
3312   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3313   fglInternalFormat := GL_RGB5;
3314   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3315 end;
3316
3317 constructor TfdBGR8.Create;
3318 begin
3319   inherited Create;
3320   fFormat           := tfBGR8;
3321   fWithAlpha        := tfBGRA8;
3322   fWithoutAlpha     := tfBGR8;
3323   fRGBInverted      := tfRGB8;
3324   fglInternalFormat := GL_RGB8;
3325 end;
3326
3327 constructor TfdBGR10.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfBGR10;
3331   fWithAlpha        := tfBGR10A2;
3332   fWithoutAlpha     := tfBGR10;
3333   fRGBInverted      := tfRGB10;
3334   fRange.r          := $3FF;
3335   fRange.g          := $3FF;
3336   fRange.b          := $3FF;
3337   fRange.a          := $000;
3338   fShift.r          :=   20;
3339   fShift.g          :=   10;
3340   fShift.b          :=    0;
3341   fShift.a          :=    0;
3342   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3343   fglInternalFormat := GL_RGB10;
3344   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3345 end;
3346
3347 constructor TfdBGR12.Create;
3348 begin
3349   inherited Create;
3350   fFormat           := tfBGR12;
3351   fWithAlpha        := tfBGRA12;
3352   fWithoutAlpha     := tfBGR12;
3353   fRGBInverted      := tfRGB12;
3354   fglInternalFormat := GL_RGB12;
3355 end;
3356
3357 constructor TfdBGR16.Create;
3358 begin
3359   inherited Create;
3360   fFormat           := tfBGR16;
3361   fWithAlpha        := tfBGRA16;
3362   fWithoutAlpha     := tfBGR16;
3363   fRGBInverted      := tfRGB16;
3364   fglInternalFormat := GL_RGB16;
3365 end;
3366
3367 constructor TfdBGRA2.Create;
3368 begin
3369   inherited Create;
3370   fFormat           := tfBGRA2;
3371   fWithAlpha        := tfBGRA4;
3372   fWithoutAlpha     := tfBGR4;
3373   fRGBInverted      := tfRGBA2;
3374   fglInternalFormat := GL_RGBA2;
3375 end;
3376
3377 constructor TfdBGRA4.Create;
3378 begin
3379   inherited Create;
3380   fFormat           := tfBGRA4;
3381   fWithAlpha        := tfBGRA4;
3382   fWithoutAlpha     := tfBGR4;
3383   fRGBInverted      := tfRGBA4;
3384   fRange.r          := $F;
3385   fRange.g          := $F;
3386   fRange.b          := $F;
3387   fRange.a          := $F;
3388   fShift.r          :=  8;
3389   fShift.g          :=  4;
3390   fShift.b          :=  0;
3391   fShift.a          := 12;
3392   fglFormat         := GL_BGRA;
3393   fglInternalFormat := GL_RGBA4;
3394   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3395 end;
3396
3397 constructor TfdBGR5A1.Create;
3398 begin
3399   inherited Create;
3400   fFormat           := tfBGR5A1;
3401   fWithAlpha        := tfBGR5A1;
3402   fWithoutAlpha     := tfBGR5;
3403   fRGBInverted      := tfRGB5A1;
3404   fRange.r          := $1F;
3405   fRange.g          := $1F;
3406   fRange.b          := $1F;
3407   fRange.a          := $01;
3408   fShift.r          :=  10;
3409   fShift.g          :=   5;
3410   fShift.b          :=   0;
3411   fShift.a          :=  15;
3412   fglFormat         := GL_BGRA;
3413   fglInternalFormat := GL_RGB5_A1;
3414   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3415 end;
3416
3417 constructor TfdBGRA8.Create;
3418 begin
3419   inherited Create;
3420   fFormat           := tfBGRA8;
3421   fWithAlpha        := tfBGRA8;
3422   fWithoutAlpha     := tfBGR8;
3423   fRGBInverted      := tfRGBA8;
3424   fglInternalFormat := GL_RGBA8;
3425 end;
3426
3427 constructor TfdBGR10A2.Create;
3428 begin
3429   inherited Create;
3430   fFormat           := tfBGR10A2;
3431   fWithAlpha        := tfBGR10A2;
3432   fWithoutAlpha     := tfBGR10;
3433   fRGBInverted      := tfRGB10A2;
3434   fRange.r          := $3FF;
3435   fRange.g          := $3FF;
3436   fRange.b          := $3FF;
3437   fRange.a          := $003;
3438   fShift.r          :=   20;
3439   fShift.g          :=   10;
3440   fShift.b          :=    0;
3441   fShift.a          :=   30;
3442   fglFormat         := GL_BGRA;
3443   fglInternalFormat := GL_RGB10_A2;
3444   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3445 end;
3446
3447 constructor TfdBGRA12.Create;
3448 begin
3449   inherited Create;
3450   fFormat           := tfBGRA12;
3451   fWithAlpha        := tfBGRA12;
3452   fWithoutAlpha     := tfBGR12;
3453   fRGBInverted      := tfRGBA12;
3454   fglInternalFormat := GL_RGBA12;
3455 end;
3456
3457 constructor TfdBGRA16.Create;
3458 begin
3459   inherited Create;
3460   fFormat           := tfBGRA16;
3461   fWithAlpha        := tfBGRA16;
3462   fWithoutAlpha     := tfBGR16;
3463   fRGBInverted      := tfRGBA16;
3464   fglInternalFormat := GL_RGBA16;
3465 end;
3466
3467 constructor TfdDepth16.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfDepth16;
3471   fWithAlpha        := tfEmpty;
3472   fWithoutAlpha     := tfDepth16;
3473   fglInternalFormat := GL_DEPTH_COMPONENT16;
3474 end;
3475
3476 constructor TfdDepth24.Create;
3477 begin
3478   inherited Create;
3479   fFormat           := tfDepth24;
3480   fWithAlpha        := tfEmpty;
3481   fWithoutAlpha     := tfDepth24;
3482   fglInternalFormat := GL_DEPTH_COMPONENT24;
3483 end;
3484
3485 constructor TfdDepth32.Create;
3486 begin
3487   inherited Create;
3488   fFormat           := tfDepth32;
3489   fWithAlpha        := tfEmpty;
3490   fWithoutAlpha     := tfDepth32;
3491   fglInternalFormat := GL_DEPTH_COMPONENT32;
3492 end;
3493
3494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3495 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3497 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3498 begin
3499   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3500 end;
3501
3502 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3503 begin
3504   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3505 end;
3506
3507 constructor TfdS3tcDtx1RGBA.Create;
3508 begin
3509   inherited Create;
3510   fFormat           := tfS3tcDtx1RGBA;
3511   fWithAlpha        := tfS3tcDtx1RGBA;
3512   fUncompressed     := tfRGB5A1;
3513   fPixelSize        := 0.5;
3514   fIsCompressed     := true;
3515   fglFormat         := GL_COMPRESSED_RGBA;
3516   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3517   fglDataFormat     := GL_UNSIGNED_BYTE;
3518 end;
3519
3520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3521 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3523 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3524 begin
3525   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3526 end;
3527
3528 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3529 begin
3530   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3531 end;
3532
3533 constructor TfdS3tcDtx3RGBA.Create;
3534 begin
3535   inherited Create;
3536   fFormat           := tfS3tcDtx3RGBA;
3537   fWithAlpha        := tfS3tcDtx3RGBA;
3538   fUncompressed     := tfRGBA8;
3539   fPixelSize        := 1.0;
3540   fIsCompressed     := true;
3541   fglFormat         := GL_COMPRESSED_RGBA;
3542   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3543   fglDataFormat     := GL_UNSIGNED_BYTE;
3544 end;
3545
3546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3547 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3549 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3550 begin
3551   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3552 end;
3553
3554 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3555 begin
3556   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3557 end;
3558
3559 constructor TfdS3tcDtx5RGBA.Create;
3560 begin
3561   inherited Create;
3562   fFormat           := tfS3tcDtx3RGBA;
3563   fWithAlpha        := tfS3tcDtx3RGBA;
3564   fUncompressed     := tfRGBA8;
3565   fPixelSize        := 1.0;
3566   fIsCompressed     := true;
3567   fglFormat         := GL_COMPRESSED_RGBA;
3568   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3569   fglDataFormat     := GL_UNSIGNED_BYTE;
3570 end;
3571
3572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3573 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3575 class procedure TFormatDescriptor.Init;
3576 begin
3577   if not Assigned(FormatDescriptorCS) then
3578     FormatDescriptorCS := TCriticalSection.Create;
3579 end;
3580
3581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3582 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3583 begin
3584   FormatDescriptorCS.Enter;
3585   try
3586     result := FormatDescriptors[aFormat];
3587     if not Assigned(result) then begin
3588       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3589       FormatDescriptors[aFormat] := result;
3590     end;
3591   finally
3592     FormatDescriptorCS.Leave;
3593   end;
3594 end;
3595
3596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3597 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3598 begin
3599   result := Get(Get(aFormat).WithAlpha);
3600 end;
3601
3602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3603 class procedure TFormatDescriptor.Clear;
3604 var
3605   f: TglBitmapFormat;
3606 begin
3607   FormatDescriptorCS.Enter;
3608   try
3609     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3610       FreeAndNil(FormatDescriptors[f]);
3611   finally
3612     FormatDescriptorCS.Leave;
3613   end;
3614 end;
3615
3616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3617 class procedure TFormatDescriptor.Finalize;
3618 begin
3619   Clear;
3620   FreeAndNil(FormatDescriptorCS);
3621 end;
3622
3623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3624 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3626 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3627 begin
3628   Update(aValue, fRange.r, fShift.r);
3629 end;
3630
3631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3632 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3633 begin
3634   Update(aValue, fRange.g, fShift.g);
3635 end;
3636
3637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3638 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3639 begin
3640   Update(aValue, fRange.b, fShift.b);
3641 end;
3642
3643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3645 begin
3646   Update(aValue, fRange.a, fShift.a);
3647 end;
3648
3649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3650 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3651   aShift: Byte);
3652 begin
3653   aShift := 0;
3654   aRange := 0;
3655   if (aMask = 0) then
3656     exit;
3657   while (aMask > 0) and ((aMask and 1) = 0) do begin
3658     inc(aShift);
3659     aMask := aMask shr 1;
3660   end;
3661   aRange := 1;
3662   while (aMask > 0) do begin
3663     aRange := aRange shl 1;
3664     aMask  := aMask  shr 1;
3665   end;
3666   dec(aRange);
3667
3668   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3669 end;
3670
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3673 var
3674   data: QWord;
3675   s: Integer;
3676 begin
3677   data :=
3678     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3679     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3680     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3681     ((aPixel.Data.a and fRange.a) shl fShift.a);
3682   s := Round(fPixelSize);
3683   case s of
3684     1:           aData^  := data;
3685     2:     PWord(aData)^ := data;
3686     4: PCardinal(aData)^ := data;
3687     8:    PQWord(aData)^ := data;
3688   else
3689     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3690   end;
3691   inc(aData, s);
3692 end;
3693
3694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3695 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3696 var
3697   data: QWord;
3698   s, i: Integer;
3699 begin
3700   s := Round(fPixelSize);
3701   case s of
3702     1: data :=           aData^;
3703     2: data :=     PWord(aData)^;
3704     4: data := PCardinal(aData)^;
3705     8: data :=    PQWord(aData)^;
3706   else
3707     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3708   end;
3709   for i := 0 to 3 do
3710     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3711   inc(aData, s);
3712 end;
3713
3714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3715 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3717 procedure TbmpColorTableFormat.CreateColorTable;
3718 var
3719   i: Integer;
3720 begin
3721   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3722     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3723
3724   if (Format = tfLuminance4) then
3725     SetLength(fColorTable, 16)
3726   else
3727     SetLength(fColorTable, 256);
3728
3729   case Format of
3730     tfLuminance4: begin
3731       for i := 0 to High(fColorTable) do begin
3732         fColorTable[i].r := 16 * i;
3733         fColorTable[i].g := 16 * i;
3734         fColorTable[i].b := 16 * i;
3735         fColorTable[i].a := 0;
3736       end;
3737     end;
3738
3739     tfLuminance8: begin
3740       for i := 0 to High(fColorTable) do begin
3741         fColorTable[i].r := i;
3742         fColorTable[i].g := i;
3743         fColorTable[i].b := i;
3744         fColorTable[i].a := 0;
3745       end;
3746     end;
3747
3748     tfR3G3B2: begin
3749       for i := 0 to High(fColorTable) do begin
3750         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3751         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3752         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3753         fColorTable[i].a := 0;
3754       end;
3755     end;
3756   end;
3757 end;
3758
3759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3760 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3761 var
3762   d: Byte;
3763 begin
3764   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3765     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3766
3767   case Format of
3768     tfLuminance4: begin
3769       if (aMapData = nil) then
3770         aData^ := 0;
3771       d := LuminanceWeight(aPixel) and Range.r;
3772       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3773       inc(PByte(aMapData), 4);
3774       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3775         inc(aData);
3776         aMapData := nil;
3777       end;
3778     end;
3779
3780     tfLuminance8: begin
3781       aData^ := LuminanceWeight(aPixel) and Range.r;
3782       inc(aData);
3783     end;
3784
3785     tfR3G3B2: begin
3786       aData^ := Round(
3787         ((aPixel.Data.r and Range.r) shl Shift.r) or
3788         ((aPixel.Data.g and Range.g) shl Shift.g) or
3789         ((aPixel.Data.b and Range.b) shl Shift.b));
3790       inc(aData);
3791     end;
3792   end;
3793 end;
3794
3795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3796 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3797 var
3798   idx: QWord;
3799   s: Integer;
3800   bits: Byte;
3801   f: Single;
3802 begin
3803   s    := Trunc(fPixelSize);
3804   f    := fPixelSize - s;
3805   bits := Round(8 * f);
3806   case s of
3807     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3808     1: idx :=           aData^;
3809     2: idx :=     PWord(aData)^;
3810     4: idx := PCardinal(aData)^;
3811     8: idx :=    PQWord(aData)^;
3812   else
3813     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3814   end;
3815   if (idx >= Length(fColorTable)) then
3816     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3817   with fColorTable[idx] do begin
3818     aPixel.Data.r := r;
3819     aPixel.Data.g := g;
3820     aPixel.Data.b := b;
3821     aPixel.Data.a := a;
3822   end;
3823   inc(PByte(aMapData), bits);
3824   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3825     inc(aData, 1);
3826     dec(PByte(aMapData), 8);
3827   end;
3828   inc(aData, s);
3829 end;
3830
3831 destructor TbmpColorTableFormat.Destroy;
3832 begin
3833   SetLength(fColorTable, 0);
3834   inherited Destroy;
3835 end;
3836
3837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3838 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3840 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3841 var
3842   i: Integer;
3843 begin
3844   for i := 0 to 3 do begin
3845     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3846       if (aSourceFD.Range.arr[i] > 0) then
3847         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3848       else
3849         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3850     end;
3851   end;
3852 end;
3853
3854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3855 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3856 begin
3857   with aFuncRec do begin
3858     if (Source.Range.r   > 0) then
3859       Dest.Data.r := Source.Data.r;
3860     if (Source.Range.g > 0) then
3861       Dest.Data.g := Source.Data.g;
3862     if (Source.Range.b  > 0) then
3863       Dest.Data.b := Source.Data.b;
3864     if (Source.Range.a > 0) then
3865       Dest.Data.a := Source.Data.a;
3866   end;
3867 end;
3868
3869 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3870 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3871 var
3872   i: Integer;
3873 begin
3874   with aFuncRec do begin
3875     for i := 0 to 3 do
3876       if (Source.Range.arr[i] > 0) then
3877         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3878   end;
3879 end;
3880
3881 type
3882   TShiftData = packed record
3883     case Integer of
3884       0: (r, g, b, a: SmallInt);
3885       1: (arr: array[0..3] of SmallInt);
3886   end;
3887   PShiftData = ^TShiftData;
3888
3889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3890 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3891 var
3892   i: Integer;
3893 begin
3894   with aFuncRec do
3895     for i := 0 to 3 do
3896       if (Source.Range.arr[i] > 0) then
3897         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3898 end;
3899
3900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3901 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3902 begin
3903   with aFuncRec do begin
3904     Dest.Data := Source.Data;
3905     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3906       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3907       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3908       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3909     end;
3910     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3911       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3912     end;
3913   end;
3914 end;
3915
3916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3917 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3918 var
3919   i: Integer;
3920 begin
3921   with aFuncRec do begin
3922     for i := 0 to 3 do
3923       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3924   end;
3925 end;
3926
3927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3928 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3929 var
3930   Temp: Single;
3931 begin
3932   with FuncRec do begin
3933     if (FuncRec.Args = nil) then begin //source has no alpha
3934       Temp :=
3935         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3936         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3937         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3938       Dest.Data.a := Round(Dest.Range.a * Temp);
3939     end else
3940       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3941   end;
3942 end;
3943
3944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3945 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3946 type
3947   PglBitmapPixelData = ^TglBitmapPixelData;
3948 begin
3949   with FuncRec do begin
3950     Dest.Data.r := Source.Data.r;
3951     Dest.Data.g := Source.Data.g;
3952     Dest.Data.b := Source.Data.b;
3953
3954     with PglBitmapPixelData(Args)^ do
3955       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3956           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3957           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3958         Dest.Data.a := 0
3959       else
3960         Dest.Data.a := Dest.Range.a;
3961   end;
3962 end;
3963
3964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3965 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3966 begin
3967   with FuncRec do begin
3968     Dest.Data.r := Source.Data.r;
3969     Dest.Data.g := Source.Data.g;
3970     Dest.Data.b := Source.Data.b;
3971     Dest.Data.a := PCardinal(Args)^;
3972   end;
3973 end;
3974
3975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3976 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3977 type
3978   PRGBPix = ^TRGBPix;
3979   TRGBPix = array [0..2] of byte;
3980 var
3981   Temp: Byte;
3982 begin
3983   while aWidth > 0 do begin
3984     Temp := PRGBPix(aData)^[0];
3985     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3986     PRGBPix(aData)^[2] := Temp;
3987
3988     if aHasAlpha then
3989       Inc(aData, 4)
3990     else
3991       Inc(aData, 3);
3992     dec(aWidth);
3993   end;
3994 end;
3995
3996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3997 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3999 function TglBitmap.GetWidth: Integer;
4000 begin
4001   if (ffX in fDimension.Fields) then
4002     result := fDimension.X
4003   else
4004     result := -1;
4005 end;
4006
4007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4008 function TglBitmap.GetHeight: Integer;
4009 begin
4010   if (ffY in fDimension.Fields) then
4011     result := fDimension.Y
4012   else
4013     result := -1;
4014 end;
4015
4016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4017 function TglBitmap.GetFileWidth: Integer;
4018 begin
4019   result := Max(1, Width);
4020 end;
4021
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 function TglBitmap.GetFileHeight: Integer;
4024 begin
4025   result := Max(1, Height);
4026 end;
4027
4028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4029 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4030 begin
4031   if fCustomData = aValue then
4032     exit;
4033   fCustomData := aValue;
4034 end;
4035
4036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4037 procedure TglBitmap.SetCustomName(const aValue: String);
4038 begin
4039   if fCustomName = aValue then
4040     exit;
4041   fCustomName := aValue;
4042 end;
4043
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4046 begin
4047   if fCustomNameW = aValue then
4048     exit;
4049   fCustomNameW := aValue;
4050 end;
4051
4052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4053 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4054 begin
4055   if fDeleteTextureOnFree = aValue then
4056     exit;
4057   fDeleteTextureOnFree := aValue;
4058 end;
4059
4060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4061 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4062 begin
4063   if fFormat = aValue then
4064     exit;
4065   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4066     raise EglBitmapUnsupportedFormat.Create(Format);
4067   SetDataPointer(Data, aValue, Width, Height);
4068 end;
4069
4070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4071 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4072 begin
4073   if fFreeDataAfterGenTexture = aValue then
4074     exit;
4075   fFreeDataAfterGenTexture := aValue;
4076 end;
4077
4078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4079 procedure TglBitmap.SetID(const aValue: Cardinal);
4080 begin
4081   if fID = aValue then
4082     exit;
4083   fID := aValue;
4084 end;
4085
4086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4087 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4088 begin
4089   if fMipMap = aValue then
4090     exit;
4091   fMipMap := aValue;
4092 end;
4093
4094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4095 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4096 begin
4097   if fTarget = aValue then
4098     exit;
4099   fTarget := aValue;
4100 end;
4101
4102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4103 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4104 var
4105   MaxAnisotropic: Integer;
4106 begin
4107   fAnisotropic := aValue;
4108   if (ID > 0) then begin
4109     if GL_EXT_texture_filter_anisotropic then begin
4110       if fAnisotropic > 0 then begin
4111         Bind(false);
4112         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4113         if aValue > MaxAnisotropic then
4114           fAnisotropic := MaxAnisotropic;
4115         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4116       end;
4117     end else begin
4118       fAnisotropic := 0;
4119     end;
4120   end;
4121 end;
4122
4123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4124 procedure TglBitmap.CreateID;
4125 begin
4126   if (ID <> 0) then
4127     glDeleteTextures(1, @fID);
4128   glGenTextures(1, @fID);
4129   Bind(false);
4130 end;
4131
4132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4133 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4134 begin
4135   // Set Up Parameters
4136   SetWrap(fWrapS, fWrapT, fWrapR);
4137   SetFilter(fFilterMin, fFilterMag);
4138   SetAnisotropic(fAnisotropic);
4139   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4140
4141   // Mip Maps Generation Mode
4142   aBuildWithGlu := false;
4143   if (MipMap = mmMipmap) then begin
4144     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4145       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4146     else
4147       aBuildWithGlu := true;
4148   end else if (MipMap = mmMipmapGlu) then
4149     aBuildWithGlu := true;
4150 end;
4151
4152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4153 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4154   const aWidth: Integer; const aHeight: Integer);
4155 var
4156   s: Single;
4157 begin
4158   if (Data <> aData) then begin
4159     if (Assigned(Data)) then
4160       FreeMem(Data);
4161     fData := aData;
4162   end;
4163
4164   FillChar(fDimension, SizeOf(fDimension), 0);
4165   if not Assigned(fData) then begin
4166     fFormat    := tfEmpty;
4167     fPixelSize := 0;
4168     fRowSize   := 0;
4169   end else begin
4170     if aWidth <> -1 then begin
4171       fDimension.Fields := fDimension.Fields + [ffX];
4172       fDimension.X := aWidth;
4173     end;
4174
4175     if aHeight <> -1 then begin
4176       fDimension.Fields := fDimension.Fields + [ffY];
4177       fDimension.Y := aHeight;
4178     end;
4179
4180     s := TFormatDescriptor.Get(aFormat).PixelSize;
4181     fFormat    := aFormat;
4182     fPixelSize := Ceil(s);
4183     fRowSize   := Ceil(s * aWidth);
4184   end;
4185 end;
4186
4187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4188 function TglBitmap.FlipHorz: Boolean;
4189 begin
4190   result := false;
4191 end;
4192
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 function TglBitmap.FlipVert: Boolean;
4195 begin
4196   result := false;
4197 end;
4198
4199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4200 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.AfterConstruction;
4203 begin
4204   inherited AfterConstruction;
4205
4206   fID         := 0;
4207   fTarget     := 0;
4208   fIsResident := false;
4209
4210   fFormat                  := glBitmapGetDefaultFormat;
4211   fMipMap                  := glBitmapDefaultMipmap;
4212   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4213   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4214
4215   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4216   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4217 end;
4218
4219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4220 procedure TglBitmap.BeforeDestruction;
4221 begin
4222   SetDataPointer(nil, tfEmpty);
4223   if (fID > 0) and fDeleteTextureOnFree then
4224     glDeleteTextures(1, @fID);
4225   inherited BeforeDestruction;
4226 end;
4227
4228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4229 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4230 var
4231   TempPos: Integer;
4232 begin
4233   if not Assigned(aResType) then begin
4234     TempPos   := Pos('.', aResource);
4235     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4236     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4237   end;
4238 end;
4239
4240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4241 procedure TglBitmap.LoadFromFile(const aFilename: String);
4242 var
4243   fs: TFileStream;
4244 begin
4245   if not FileExists(aFilename) then
4246     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4247   fFilename := aFilename;
4248   fs := TFileStream.Create(fFilename, fmOpenRead);
4249   try
4250     fs.Position := 0;
4251     LoadFromStream(fs);
4252   finally
4253     fs.Free;
4254   end;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4259 begin
4260   {$IFDEF GLB_SUPPORT_PNG_READ}
4261   if not LoadPNG(aStream) then
4262   {$ENDIF}
4263   {$IFDEF GLB_SUPPORT_JPEG_READ}
4264   if not LoadJPEG(aStream) then
4265   {$ENDIF}
4266   if not LoadDDS(aStream) then
4267   if not LoadTGA(aStream) then
4268   if not LoadBMP(aStream) then
4269     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4270 end;
4271
4272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4273 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4274   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4275 var
4276   tmpData: PByte;
4277   size: Integer;
4278 begin
4279   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4280   GetMem(tmpData, size);
4281   try
4282     FillChar(tmpData^, size, #$FF);
4283     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4284   except
4285     FreeMem(tmpData);
4286     raise;
4287   end;
4288   AddFunc(Self, aFunc, false, Format, aArgs);
4289 end;
4290
4291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4292 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4293 var
4294   rs: TResourceStream;
4295 begin
4296   PrepareResType(aResource, aResType);
4297   rs := TResourceStream.Create(aInstance, aResource, aResType);
4298   try
4299     LoadFromStream(rs);
4300   finally
4301     rs.Free;
4302   end;
4303 end;
4304
4305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4306 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4307 var
4308   rs: TResourceStream;
4309 begin
4310   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4311   try
4312     LoadFromStream(rs);
4313   finally
4314     rs.Free;
4315   end;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4320 var
4321   fs: TFileStream;
4322 begin
4323   fs := TFileStream.Create(aFileName, fmCreate);
4324   try
4325     fs.Position := 0;
4326     SaveToStream(fs, aFileType);
4327   finally
4328     fs.Free;
4329   end;
4330 end;
4331
4332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4333 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4334 begin
4335   case aFileType of
4336     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4337     ftPNG:  SavePNG(aStream);
4338     {$ENDIF}
4339     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4340     ftJPEG: SaveJPEG(aStream);
4341     {$ENDIF}
4342     ftDDS:  SaveDDS(aStream);
4343     ftTGA:  SaveTGA(aStream);
4344     ftBMP:  SaveBMP(aStream);
4345   end;
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4350 begin
4351   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4352 end;
4353
4354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4355 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4356   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4357 var
4358   DestData, TmpData, SourceData: pByte;
4359   TempHeight, TempWidth: Integer;
4360   SourceFD, DestFD: TFormatDescriptor;
4361   SourceMD, DestMD: Pointer;
4362
4363   FuncRec: TglBitmapFunctionRec;
4364 begin
4365   Assert(Assigned(Data));
4366   Assert(Assigned(aSource));
4367   Assert(Assigned(aSource.Data));
4368
4369   result := false;
4370   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4371     SourceFD := TFormatDescriptor.Get(aSource.Format);
4372     DestFD   := TFormatDescriptor.Get(aFormat);
4373
4374     if (SourceFD.IsCompressed) then
4375       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4376     if (DestFD.IsCompressed) then
4377       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4378
4379     // inkompatible Formats so CreateTemp
4380     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4381       aCreateTemp := true;
4382
4383     // Values
4384     TempHeight := Max(1, aSource.Height);
4385     TempWidth  := Max(1, aSource.Width);
4386
4387     FuncRec.Sender := Self;
4388     FuncRec.Args   := aArgs;
4389
4390     TmpData := nil;
4391     if aCreateTemp then begin
4392       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4393       DestData := TmpData;
4394     end else
4395       DestData := Data;
4396
4397     try
4398       SourceFD.PreparePixel(FuncRec.Source);
4399       DestFD.PreparePixel  (FuncRec.Dest);
4400
4401       SourceMD := SourceFD.CreateMappingData;
4402       DestMD   := DestFD.CreateMappingData;
4403
4404       FuncRec.Size            := aSource.Dimension;
4405       FuncRec.Position.Fields := FuncRec.Size.Fields;
4406
4407       try
4408         SourceData := aSource.Data;
4409         FuncRec.Position.Y := 0;
4410         while FuncRec.Position.Y < TempHeight do begin
4411           FuncRec.Position.X := 0;
4412           while FuncRec.Position.X < TempWidth do begin
4413             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4414             aFunc(FuncRec);
4415             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4416             inc(FuncRec.Position.X);
4417           end;
4418           inc(FuncRec.Position.Y);
4419         end;
4420
4421         // Updating Image or InternalFormat
4422         if aCreateTemp then
4423           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4424         else if (aFormat <> fFormat) then
4425           Format := aFormat;
4426
4427         result := true;
4428       finally
4429         SourceFD.FreeMappingData(SourceMD);
4430         DestFD.FreeMappingData(DestMD);
4431       end;
4432     except
4433       if aCreateTemp then
4434         FreeMem(TmpData);
4435       raise;
4436     end;
4437   end;
4438 end;
4439
4440 {$IFDEF GLB_SDL}
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4443 var
4444   Row, RowSize: Integer;
4445   SourceData, TmpData: PByte;
4446   TempDepth: Integer;
4447   FormatDesc: TFormatDescriptor;
4448
4449   function GetRowPointer(Row: Integer): pByte;
4450   begin
4451     result := aSurface.pixels;
4452     Inc(result, Row * RowSize);
4453   end;
4454
4455 begin
4456   result := false;
4457
4458   FormatDesc := TFormatDescriptor.Get(Format);
4459   if FormatDesc.IsCompressed then
4460     raise EglBitmapUnsupportedFormat.Create(Format);
4461
4462   if Assigned(Data) then begin
4463     case Trunc(FormatDesc.PixelSize) of
4464       1: TempDepth :=  8;
4465       2: TempDepth := 16;
4466       3: TempDepth := 24;
4467       4: TempDepth := 32;
4468     else
4469       raise EglBitmapUnsupportedFormat.Create(Format);
4470     end;
4471
4472     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4473       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4474     SourceData := Data;
4475     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4476
4477     for Row := 0 to FileHeight-1 do begin
4478       TmpData := GetRowPointer(Row);
4479       if Assigned(TmpData) then begin
4480         Move(SourceData^, TmpData^, RowSize);
4481         inc(SourceData, RowSize);
4482       end;
4483     end;
4484     result := true;
4485   end;
4486 end;
4487
4488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4489 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4490 var
4491   pSource, pData, pTempData: PByte;
4492   Row, RowSize, TempWidth, TempHeight: Integer;
4493   IntFormat: TglBitmapFormat;
4494   FormatDesc: TFormatDescriptor;
4495
4496   function GetRowPointer(Row: Integer): pByte;
4497   begin
4498     result := aSurface^.pixels;
4499     Inc(result, Row * RowSize);
4500   end;
4501
4502 begin
4503   result := false;
4504   if (Assigned(aSurface)) then begin
4505     with aSurface^.format^ do begin
4506       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4507         FormatDesc := TFormatDescriptor.Get(IntFormat);
4508         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4509           break;
4510       end;
4511       if (IntFormat = tfEmpty) then
4512         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4513     end;
4514
4515     TempWidth  := aSurface^.w;
4516     TempHeight := aSurface^.h;
4517     RowSize := FormatDesc.GetSize(TempWidth, 1);
4518     GetMem(pData, TempHeight * RowSize);
4519     try
4520       pTempData := pData;
4521       for Row := 0 to TempHeight -1 do begin
4522         pSource := GetRowPointer(Row);
4523         if (Assigned(pSource)) then begin
4524           Move(pSource^, pTempData^, RowSize);
4525           Inc(pTempData, RowSize);
4526         end;
4527       end;
4528       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4529       result := true;
4530     except
4531       FreeMem(pData);
4532       raise;
4533     end;
4534   end;
4535 end;
4536
4537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4538 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4539 var
4540   Row, Col, AlphaInterleave: Integer;
4541   pSource, pDest: PByte;
4542
4543   function GetRowPointer(Row: Integer): pByte;
4544   begin
4545     result := aSurface.pixels;
4546     Inc(result, Row * Width);
4547   end;
4548
4549 begin
4550   result := false;
4551   if Assigned(Data) then begin
4552     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4553       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4554
4555       AlphaInterleave := 0;
4556       case Format of
4557         tfLuminance8Alpha8:
4558           AlphaInterleave := 1;
4559         tfBGRA8, tfRGBA8:
4560           AlphaInterleave := 3;
4561       end;
4562
4563       pSource := Data;
4564       for Row := 0 to Height -1 do begin
4565         pDest := GetRowPointer(Row);
4566         if Assigned(pDest) then begin
4567           for Col := 0 to Width -1 do begin
4568             Inc(pSource, AlphaInterleave);
4569             pDest^ := pSource^;
4570             Inc(pDest);
4571             Inc(pSource);
4572           end;
4573         end;
4574       end;
4575       result := true;
4576     end;
4577   end;
4578 end;
4579
4580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4581 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4582 var
4583   bmp: TglBitmap2D;
4584 begin
4585   bmp := TglBitmap2D.Create;
4586   try
4587     bmp.AssignFromSurface(aSurface);
4588     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4589   finally
4590     bmp.Free;
4591   end;
4592 end;
4593 {$ENDIF}
4594
4595 {$IFDEF GLB_DELPHI}
4596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4597 function CreateGrayPalette: HPALETTE;
4598 var
4599   Idx: Integer;
4600   Pal: PLogPalette;
4601 begin
4602   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4603
4604   Pal.palVersion := $300;
4605   Pal.palNumEntries := 256;
4606
4607   for Idx := 0 to Pal.palNumEntries - 1 do begin
4608     Pal.palPalEntry[Idx].peRed   := Idx;
4609     Pal.palPalEntry[Idx].peGreen := Idx;
4610     Pal.palPalEntry[Idx].peBlue  := Idx;
4611     Pal.palPalEntry[Idx].peFlags := 0;
4612   end;
4613   Result := CreatePalette(Pal^);
4614   FreeMem(Pal);
4615 end;
4616
4617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4618 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4619 var
4620   Row: Integer;
4621   pSource, pData: PByte;
4622 begin
4623   result := false;
4624   if Assigned(Data) then begin
4625     if Assigned(aBitmap) then begin
4626       aBitmap.Width  := Width;
4627       aBitmap.Height := Height;
4628
4629       case Format of
4630         tfAlpha8, tfLuminance8: begin
4631           aBitmap.PixelFormat := pf8bit;
4632           aBitmap.Palette     := CreateGrayPalette;
4633         end;
4634         tfRGB5A1:
4635           aBitmap.PixelFormat := pf15bit;
4636         tfR5G6B5:
4637           aBitmap.PixelFormat := pf16bit;
4638         tfRGB8, tfBGR8:
4639           aBitmap.PixelFormat := pf24bit;
4640         tfRGBA8, tfBGRA8:
4641           aBitmap.PixelFormat := pf32bit;
4642       else
4643         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4644       end;
4645
4646       pSource := Data;
4647       for Row := 0 to FileHeight -1 do begin
4648         pData := aBitmap.Scanline[Row];
4649         Move(pSource^, pData^, fRowSize);
4650         Inc(pSource, fRowSize);
4651         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4652           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4653       end;
4654       result := true;
4655     end;
4656   end;
4657 end;
4658
4659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4660 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4661 var
4662   pSource, pData, pTempData: PByte;
4663   Row, RowSize, TempWidth, TempHeight: Integer;
4664   IntFormat: TglBitmapFormat;
4665 begin
4666   result := false;
4667
4668   if (Assigned(aBitmap)) then begin
4669     case aBitmap.PixelFormat of
4670       pf8bit:
4671         IntFormat := tfLuminance8;
4672       pf15bit:
4673         IntFormat := tfRGB5A1;
4674       pf16bit:
4675         IntFormat := tfR5G6B5;
4676       pf24bit:
4677         IntFormat := tfBGR8;
4678       pf32bit:
4679         IntFormat := tfBGRA8;
4680     else
4681       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4682     end;
4683
4684     TempWidth  := aBitmap.Width;
4685     TempHeight := aBitmap.Height;
4686     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4687     GetMem(pData, TempHeight * RowSize);
4688     try
4689       pTempData := pData;
4690       for Row := 0 to TempHeight -1 do begin
4691         pSource := aBitmap.Scanline[Row];
4692         if (Assigned(pSource)) then begin
4693           Move(pSource^, pTempData^, RowSize);
4694           Inc(pTempData, RowSize);
4695         end;
4696       end;
4697       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4698       result := true;
4699     except
4700       FreeMem(pData);
4701       raise;
4702     end;
4703   end;
4704 end;
4705
4706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4707 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4708 var
4709   Row, Col, AlphaInterleave: Integer;
4710   pSource, pDest: PByte;
4711 begin
4712   result := false;
4713
4714   if Assigned(Data) then begin
4715     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4716       if Assigned(aBitmap) then begin
4717         aBitmap.PixelFormat := pf8bit;
4718         aBitmap.Palette     := CreateGrayPalette;
4719         aBitmap.Width       := Width;
4720         aBitmap.Height      := Height;
4721
4722         case Format of
4723           tfLuminance8Alpha8:
4724             AlphaInterleave := 1;
4725           tfRGBA8, tfBGRA8:
4726             AlphaInterleave := 3;
4727           else
4728             AlphaInterleave := 0;
4729         end;
4730
4731         // Copy Data
4732         pSource := Data;
4733
4734         for Row := 0 to Height -1 do begin
4735           pDest := aBitmap.Scanline[Row];
4736           if Assigned(pDest) then begin
4737             for Col := 0 to Width -1 do begin
4738               Inc(pSource, AlphaInterleave);
4739               pDest^ := pSource^;
4740               Inc(pDest);
4741               Inc(pSource);
4742             end;
4743           end;
4744         end;
4745         result := true;
4746       end;
4747     end;
4748   end;
4749 end;
4750
4751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4752 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4753 var
4754   tex: TglBitmap2D;
4755 begin
4756   tex := TglBitmap2D.Create;
4757   try
4758     tex.AssignFromBitmap(ABitmap);
4759     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4760   finally
4761     tex.Free;
4762   end;
4763 end;
4764 {$ENDIF}
4765
4766 {$IFDEF GLB_LAZARUS}
4767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4768 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4769 var
4770   rid: TRawImageDescription;
4771   FormatDesc: TFormatDescriptor;
4772 begin
4773   result := false;
4774   if not Assigned(aImage) or (Format = tfEmpty) then
4775     exit;
4776   FormatDesc := TFormatDescriptor.Get(Format);
4777   if FormatDesc.IsCompressed then
4778     exit;
4779
4780   FillChar(rid{%H-}, SizeOf(rid), 0);
4781   if (Format in [
4782        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4783        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4784        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4785     rid.Format := ricfGray
4786   else
4787     rid.Format := ricfRGBA;
4788
4789   rid.Width        := Width;
4790   rid.Height       := Height;
4791   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4792   rid.BitOrder     := riboBitsInOrder;
4793   rid.ByteOrder    := riboLSBFirst;
4794   rid.LineOrder    := riloTopToBottom;
4795   rid.LineEnd      := rileTight;
4796   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4797   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4798   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4799   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4800   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4801   rid.RedShift     := FormatDesc.Shift.r;
4802   rid.GreenShift   := FormatDesc.Shift.g;
4803   rid.BlueShift    := FormatDesc.Shift.b;
4804   rid.AlphaShift   := FormatDesc.Shift.a;
4805
4806   rid.MaskBitsPerPixel  := 0;
4807   rid.PaletteColorCount := 0;
4808
4809   aImage.DataDescription := rid;
4810   aImage.CreateData;
4811
4812   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4813
4814   result := true;
4815 end;
4816
4817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4818 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4819 var
4820   f: TglBitmapFormat;
4821   FormatDesc: TFormatDescriptor;
4822   ImageData: PByte;
4823   ImageSize: Integer;
4824 begin
4825   result := false;
4826   if not Assigned(aImage) then
4827     exit;
4828   for f := High(f) downto Low(f) do begin
4829     FormatDesc := TFormatDescriptor.Get(f);
4830     with aImage.DataDescription do
4831       if FormatDesc.MaskMatch(
4832         (QWord(1 shl RedPrec  )-1) shl RedShift,
4833         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4834         (QWord(1 shl BluePrec )-1) shl BlueShift,
4835         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4836         break;
4837   end;
4838
4839   if (f = tfEmpty) then
4840     exit;
4841
4842   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4843   ImageData := GetMem(ImageSize);
4844   try
4845     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4846     SetDataPointer(ImageData, f, aImage.Width, aImage.Height);
4847   except
4848     FreeMem(ImageData);
4849     raise;
4850   end;
4851
4852   result := true;
4853 end;
4854
4855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4856 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4857 var
4858   rid: TRawImageDescription;
4859   FormatDesc: TFormatDescriptor;
4860   Pixel: TglBitmapPixelData;
4861   x, y: Integer;
4862   srcMD: Pointer;
4863   src, dst: PByte;
4864 begin
4865   result := false;
4866   if not Assigned(aImage) or (Format = tfEmpty) then
4867     exit;
4868   FormatDesc := TFormatDescriptor.Get(Format);
4869   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4870     exit;
4871
4872   FillChar(rid{%H-}, SizeOf(rid), 0);
4873   rid.Format       := ricfGray;
4874   rid.Width        := Width;
4875   rid.Height       := Height;
4876   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4877   rid.BitOrder     := riboBitsInOrder;
4878   rid.ByteOrder    := riboLSBFirst;
4879   rid.LineOrder    := riloTopToBottom;
4880   rid.LineEnd      := rileTight;
4881   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4882   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4883   rid.GreenPrec    := 0;
4884   rid.BluePrec     := 0;
4885   rid.AlphaPrec    := 0;
4886   rid.RedShift     := 0;
4887   rid.GreenShift   := 0;
4888   rid.BlueShift    := 0;
4889   rid.AlphaShift   := 0;
4890
4891   rid.MaskBitsPerPixel  := 0;
4892   rid.PaletteColorCount := 0;
4893
4894   aImage.DataDescription := rid;
4895   aImage.CreateData;
4896
4897   srcMD := FormatDesc.CreateMappingData;
4898   try
4899     FormatDesc.PreparePixel(Pixel);
4900     src := Data;
4901     dst := aImage.PixelData;
4902     for y := 0 to Height-1 do
4903       for x := 0 to Width-1 do begin
4904         FormatDesc.Unmap(src, Pixel, srcMD);
4905         case rid.BitsPerPixel of
4906            8: begin
4907             dst^ := Pixel.Data.a;
4908             inc(dst);
4909           end;
4910           16: begin
4911             PWord(dst)^ := Pixel.Data.a;
4912             inc(dst, 2);
4913           end;
4914           24: begin
4915             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4916             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4917             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4918             inc(dst, 3);
4919           end;
4920           32: begin
4921             PCardinal(dst)^ := Pixel.Data.a;
4922             inc(dst, 4);
4923           end;
4924         else
4925           raise EglBitmapUnsupportedFormat.Create(Format);
4926         end;
4927       end;
4928   finally
4929     FormatDesc.FreeMappingData(srcMD);
4930   end;
4931   result := true;
4932 end;
4933
4934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4935 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4936 var
4937   tex: TglBitmap2D;
4938 begin
4939   tex := TglBitmap2D.Create;
4940   try
4941     tex.AssignFromLazIntfImage(aImage);
4942     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4943   finally
4944     tex.Free;
4945   end;
4946 end;
4947 {$ENDIF}
4948
4949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4950 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4951   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4952 var
4953   rs: TResourceStream;
4954 begin
4955   PrepareResType(aResource, aResType);
4956   rs := TResourceStream.Create(aInstance, aResource, aResType);
4957   try
4958     result := AddAlphaFromStream(rs, aFunc, aArgs);
4959   finally
4960     rs.Free;
4961   end;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4966   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4967 var
4968   rs: TResourceStream;
4969 begin
4970   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4971   try
4972     result := AddAlphaFromStream(rs, aFunc, aArgs);
4973   finally
4974     rs.Free;
4975   end;
4976 end;
4977
4978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4979 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4980 begin
4981   if TFormatDescriptor.Get(Format).IsCompressed then
4982     raise EglBitmapUnsupportedFormat.Create(Format);
4983   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4984 end;
4985
4986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4987 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4988 var
4989   FS: TFileStream;
4990 begin
4991   FS := TFileStream.Create(FileName, fmOpenRead);
4992   try
4993     result := AddAlphaFromStream(FS, aFunc, aArgs);
4994   finally
4995     FS.Free;
4996   end;
4997 end;
4998
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5001 var
5002   tex: TglBitmap2D;
5003 begin
5004   tex := TglBitmap2D.Create(aStream);
5005   try
5006     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5007   finally
5008     tex.Free;
5009   end;
5010 end;
5011
5012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5013 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5014 var
5015   DestData, DestData2, SourceData: pByte;
5016   TempHeight, TempWidth: Integer;
5017   SourceFD, DestFD: TFormatDescriptor;
5018   SourceMD, DestMD, DestMD2: Pointer;
5019
5020   FuncRec: TglBitmapFunctionRec;
5021 begin
5022   result := false;
5023
5024   Assert(Assigned(Data));
5025   Assert(Assigned(aBitmap));
5026   Assert(Assigned(aBitmap.Data));
5027
5028   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5029     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5030
5031     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5032     DestFD   := TFormatDescriptor.Get(Format);
5033
5034     if not Assigned(aFunc) then begin
5035       aFunc        := glBitmapAlphaFunc;
5036       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5037     end else
5038       FuncRec.Args := aArgs;
5039
5040     // Values
5041     TempHeight := aBitmap.FileHeight;
5042     TempWidth  := aBitmap.FileWidth;
5043
5044     FuncRec.Sender          := Self;
5045     FuncRec.Size            := Dimension;
5046     FuncRec.Position.Fields := FuncRec.Size.Fields;
5047
5048     DestData   := Data;
5049     DestData2  := Data;
5050     SourceData := aBitmap.Data;
5051
5052     // Mapping
5053     SourceFD.PreparePixel(FuncRec.Source);
5054     DestFD.PreparePixel  (FuncRec.Dest);
5055
5056     SourceMD := SourceFD.CreateMappingData;
5057     DestMD   := DestFD.CreateMappingData;
5058     DestMD2  := DestFD.CreateMappingData;
5059     try
5060       FuncRec.Position.Y := 0;
5061       while FuncRec.Position.Y < TempHeight do begin
5062         FuncRec.Position.X := 0;
5063         while FuncRec.Position.X < TempWidth do begin
5064           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5065           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5066           aFunc(FuncRec);
5067           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5068           inc(FuncRec.Position.X);
5069         end;
5070         inc(FuncRec.Position.Y);
5071       end;
5072     finally
5073       SourceFD.FreeMappingData(SourceMD);
5074       DestFD.FreeMappingData(DestMD);
5075       DestFD.FreeMappingData(DestMD2);
5076     end;
5077   end;
5078 end;
5079
5080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5081 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5082 begin
5083   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5084 end;
5085
5086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5087 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5088 var
5089   PixelData: TglBitmapPixelData;
5090 begin
5091   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5092   result := AddAlphaFromColorKeyFloat(
5093     aRed   / PixelData.Range.r,
5094     aGreen / PixelData.Range.g,
5095     aBlue  / PixelData.Range.b,
5096     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5097 end;
5098
5099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5100 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5101 var
5102   values: array[0..2] of Single;
5103   tmp: Cardinal;
5104   i: Integer;
5105   PixelData: TglBitmapPixelData;
5106 begin
5107   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5108   with PixelData do begin
5109     values[0] := aRed;
5110     values[1] := aGreen;
5111     values[2] := aBlue;
5112
5113     for i := 0 to 2 do begin
5114       tmp          := Trunc(Range.arr[i] * aDeviation);
5115       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5116       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5117     end;
5118     Data.a  := 0;
5119     Range.a := 0;
5120   end;
5121   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5122 end;
5123
5124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5125 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5126 begin
5127   result := AddAlphaFromValueFloat(aAlpha / $FF);
5128 end;
5129
5130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5131 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5132 var
5133   PixelData: TglBitmapPixelData;
5134 begin
5135   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5136   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5137 end;
5138
5139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5140 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5141 var
5142   PixelData: TglBitmapPixelData;
5143 begin
5144   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5145   with PixelData do
5146     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5147   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5148 end;
5149
5150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5151 function TglBitmap.RemoveAlpha: Boolean;
5152 var
5153   FormatDesc: TFormatDescriptor;
5154 begin
5155   result := false;
5156   FormatDesc := TFormatDescriptor.Get(Format);
5157   if Assigned(Data) then begin
5158     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5159       raise EglBitmapUnsupportedFormat.Create(Format);
5160     result := ConvertTo(FormatDesc.WithoutAlpha);
5161   end;
5162 end;
5163
5164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5165 function TglBitmap.Clone: TglBitmap;
5166 var
5167   Temp: TglBitmap;
5168   TempPtr: PByte;
5169   Size: Integer;
5170 begin
5171   result := nil;
5172   Temp := (ClassType.Create as TglBitmap);
5173   try
5174     // copy texture data if assigned
5175     if Assigned(Data) then begin
5176       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5177       GetMem(TempPtr, Size);
5178       try
5179         Move(Data^, TempPtr^, Size);
5180         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5181       except
5182         FreeMem(TempPtr);
5183         raise;
5184       end;
5185     end else
5186       Temp.SetDataPointer(nil, Format, Width, Height);
5187
5188         // copy properties
5189     Temp.fID                      := ID;
5190     Temp.fTarget                  := Target;
5191     Temp.fFormat                  := Format;
5192     Temp.fMipMap                  := MipMap;
5193     Temp.fAnisotropic             := Anisotropic;
5194     Temp.fBorderColor             := fBorderColor;
5195     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5196     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5197     Temp.fFilterMin               := fFilterMin;
5198     Temp.fFilterMag               := fFilterMag;
5199     Temp.fWrapS                   := fWrapS;
5200     Temp.fWrapT                   := fWrapT;
5201     Temp.fWrapR                   := fWrapR;
5202     Temp.fFilename                := fFilename;
5203     Temp.fCustomName              := fCustomName;
5204     Temp.fCustomNameW             := fCustomNameW;
5205     Temp.fCustomData              := fCustomData;
5206
5207     result := Temp;
5208   except
5209     FreeAndNil(Temp);
5210     raise;
5211   end;
5212 end;
5213
5214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5215 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5216 var
5217   SourceFD, DestFD: TFormatDescriptor;
5218   SourcePD, DestPD: TglBitmapPixelData;
5219   ShiftData: TShiftData;
5220
5221   function CanCopyDirect: Boolean;
5222   begin
5223     result :=
5224       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5225       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5226       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5227       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5228   end;
5229
5230   function CanShift: Boolean;
5231   begin
5232     result :=
5233       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5234       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5235       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5236       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5237   end;
5238
5239   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5240   begin
5241     result := 0;
5242     while (aSource > aDest) and (aSource > 0) do begin
5243       inc(result);
5244       aSource := aSource shr 1;
5245     end;
5246   end;
5247
5248 begin
5249   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5250     SourceFD := TFormatDescriptor.Get(Format);
5251     DestFD   := TFormatDescriptor.Get(aFormat);
5252
5253     SourceFD.PreparePixel(SourcePD);
5254     DestFD.PreparePixel  (DestPD);
5255
5256     if CanCopyDirect then
5257       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5258     else if CanShift then begin
5259       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5260       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5261       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5262       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5263       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5264     end else
5265       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5266   end else
5267     result := true;
5268 end;
5269
5270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5271 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5272 begin
5273   if aUseRGB or aUseAlpha then
5274     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5275       ((PtrInt(aUseAlpha) and 1) shl 1) or
5276        (PtrInt(aUseRGB)   and 1)      ));
5277 end;
5278
5279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5280 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5281 begin
5282   fBorderColor[0] := aRed;
5283   fBorderColor[1] := aGreen;
5284   fBorderColor[2] := aBlue;
5285   fBorderColor[3] := aAlpha;
5286   if (ID > 0) then begin
5287     Bind(false);
5288     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5289   end;
5290 end;
5291
5292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5293 procedure TglBitmap.FreeData;
5294 begin
5295   SetDataPointer(nil, tfEmpty);
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5300   const aAlpha: Byte);
5301 begin
5302   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5303 end;
5304
5305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5306 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5307 var
5308   PixelData: TglBitmapPixelData;
5309 begin
5310   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5311   FillWithColorFloat(
5312     aRed   / PixelData.Range.r,
5313     aGreen / PixelData.Range.g,
5314     aBlue  / PixelData.Range.b,
5315     aAlpha / PixelData.Range.a);
5316 end;
5317
5318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5319 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5320 var
5321   PixelData: TglBitmapPixelData;
5322 begin
5323   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5324   with PixelData do begin
5325     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5326     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5327     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5328     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5329   end;
5330   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5331 end;
5332
5333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5334 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5335 begin
5336   //check MIN filter
5337   case aMin of
5338     GL_NEAREST:
5339       fFilterMin := GL_NEAREST;
5340     GL_LINEAR:
5341       fFilterMin := GL_LINEAR;
5342     GL_NEAREST_MIPMAP_NEAREST:
5343       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5344     GL_LINEAR_MIPMAP_NEAREST:
5345       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5346     GL_NEAREST_MIPMAP_LINEAR:
5347       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5348     GL_LINEAR_MIPMAP_LINEAR:
5349       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5350     else
5351       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5352   end;
5353
5354   //check MAG filter
5355   case aMag of
5356     GL_NEAREST:
5357       fFilterMag := GL_NEAREST;
5358     GL_LINEAR:
5359       fFilterMag := GL_LINEAR;
5360     else
5361       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5362   end;
5363
5364   //apply filter
5365   if (ID > 0) then begin
5366     Bind(false);
5367     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5368
5369     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5370       case fFilterMin of
5371         GL_NEAREST, GL_LINEAR:
5372           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5373         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5374           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5375         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5376           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5377       end;
5378     end else
5379       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5380   end;
5381 end;
5382
5383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5384 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5385
5386   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5387   begin
5388     case aValue of
5389       GL_CLAMP:
5390         aTarget := GL_CLAMP;
5391
5392       GL_REPEAT:
5393         aTarget := GL_REPEAT;
5394
5395       GL_CLAMP_TO_EDGE: begin
5396         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5397           aTarget := GL_CLAMP_TO_EDGE
5398         else
5399           aTarget := GL_CLAMP;
5400       end;
5401
5402       GL_CLAMP_TO_BORDER: begin
5403         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5404           aTarget := GL_CLAMP_TO_BORDER
5405         else
5406           aTarget := GL_CLAMP;
5407       end;
5408
5409       GL_MIRRORED_REPEAT: begin
5410         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5411           aTarget := GL_MIRRORED_REPEAT
5412         else
5413           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5414       end;
5415     else
5416       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5417     end;
5418   end;
5419
5420 begin
5421   CheckAndSetWrap(S, fWrapS);
5422   CheckAndSetWrap(T, fWrapT);
5423   CheckAndSetWrap(R, fWrapR);
5424
5425   if (ID > 0) then begin
5426     Bind(false);
5427     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5428     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5429     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5430   end;
5431 end;
5432
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5435 begin
5436   if aEnableTextureUnit then
5437     glEnable(Target);
5438   if (ID > 0) then
5439     glBindTexture(Target, ID);
5440 end;
5441
5442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5443 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5444 begin
5445   if aDisableTextureUnit then
5446     glDisable(Target);
5447   glBindTexture(Target, 0);
5448 end;
5449
5450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5451 constructor TglBitmap.Create;
5452 begin
5453 {$IFDEF GLB_NATIVE_OGL}
5454   glbReadOpenGLExtensions;
5455 {$ENDIF}
5456   if (ClassType = TglBitmap) then
5457     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5458   inherited Create;
5459 end;
5460
5461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5462 constructor TglBitmap.Create(const aFileName: String);
5463 begin
5464   Create;
5465   LoadFromFile(FileName);
5466 end;
5467
5468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5469 constructor TglBitmap.Create(const aStream: TStream);
5470 begin
5471   Create;
5472   LoadFromStream(aStream);
5473 end;
5474
5475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5476 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5477 var
5478   Image: PByte;
5479   ImageSize: Integer;
5480 begin
5481   Create;
5482   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5483   GetMem(Image, ImageSize);
5484   try
5485     FillChar(Image^, ImageSize, #$FF);
5486     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5487   except
5488     FreeMem(Image);
5489     raise;
5490   end;
5491 end;
5492
5493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5494 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5495   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5496 begin
5497   Create;
5498   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5499 end;
5500
5501 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5502 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5503 begin
5504   Create;
5505   LoadFromResource(aInstance, aResource, aResType);
5506 end;
5507
5508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5509 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5510 begin
5511   Create;
5512   LoadFromResourceID(aInstance, aResourceID, aResType);
5513 end;
5514
5515 {$IFDEF GLB_SUPPORT_PNG_READ}
5516 {$IF DEFINED(GLB_SDL_IMAGE)}
5517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5518 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5520 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5521 var
5522   Surface: PSDL_Surface;
5523   RWops: PSDL_RWops;
5524 begin
5525   result := false;
5526   RWops := glBitmapCreateRWops(aStream);
5527   try
5528     if IMG_isPNG(RWops) > 0 then begin
5529       Surface := IMG_LoadPNG_RW(RWops);
5530       try
5531         AssignFromSurface(Surface);
5532         result := true;
5533       finally
5534         SDL_FreeSurface(Surface);
5535       end;
5536     end;
5537   finally
5538     SDL_FreeRW(RWops);
5539   end;
5540 end;
5541
5542 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5544 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5545 begin
5546   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5547 end;
5548
5549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5550 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5551 var
5552   StreamPos: Int64;
5553   signature: array [0..7] of byte;
5554   png: png_structp;
5555   png_info: png_infop;
5556
5557   TempHeight, TempWidth: Integer;
5558   Format: TglBitmapFormat;
5559
5560   png_data: pByte;
5561   png_rows: array of pByte;
5562   Row, LineSize: Integer;
5563 begin
5564   result := false;
5565
5566   if not init_libPNG then
5567     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5568
5569   try
5570     // signature
5571     StreamPos := aStream.Position;
5572     aStream.Read(signature{%H-}, 8);
5573     aStream.Position := StreamPos;
5574
5575     if png_check_sig(@signature, 8) <> 0 then begin
5576       // png read struct
5577       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5578       if png = nil then
5579         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5580
5581       // png info
5582       png_info := png_create_info_struct(png);
5583       if png_info = nil then begin
5584         png_destroy_read_struct(@png, nil, nil);
5585         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5586       end;
5587
5588       // set read callback
5589       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5590
5591       // read informations
5592       png_read_info(png, png_info);
5593
5594       // size
5595       TempHeight := png_get_image_height(png, png_info);
5596       TempWidth := png_get_image_width(png, png_info);
5597
5598       // format
5599       case png_get_color_type(png, png_info) of
5600         PNG_COLOR_TYPE_GRAY:
5601           Format := tfLuminance8;
5602         PNG_COLOR_TYPE_GRAY_ALPHA:
5603           Format := tfLuminance8Alpha8;
5604         PNG_COLOR_TYPE_RGB:
5605           Format := tfRGB8;
5606         PNG_COLOR_TYPE_RGB_ALPHA:
5607           Format := tfRGBA8;
5608         else
5609           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5610       end;
5611
5612       // cut upper 8 bit from 16 bit formats
5613       if png_get_bit_depth(png, png_info) > 8 then
5614         png_set_strip_16(png);
5615
5616       // expand bitdepth smaller than 8
5617       if png_get_bit_depth(png, png_info) < 8 then
5618         png_set_expand(png);
5619
5620       // allocating mem for scanlines
5621       LineSize := png_get_rowbytes(png, png_info);
5622       GetMem(png_data, TempHeight * LineSize);
5623       try
5624         SetLength(png_rows, TempHeight);
5625         for Row := Low(png_rows) to High(png_rows) do begin
5626           png_rows[Row] := png_data;
5627           Inc(png_rows[Row], Row * LineSize);
5628         end;
5629
5630         // read complete image into scanlines
5631         png_read_image(png, @png_rows[0]);
5632
5633         // read end
5634         png_read_end(png, png_info);
5635
5636         // destroy read struct
5637         png_destroy_read_struct(@png, @png_info, nil);
5638
5639         SetLength(png_rows, 0);
5640
5641         // set new data
5642         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5643
5644         result := true;
5645       except
5646         FreeMem(png_data);
5647         raise;
5648       end;
5649     end;
5650   finally
5651     quit_libPNG;
5652   end;
5653 end;
5654
5655 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5657 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5658 var
5659   StreamPos: Int64;
5660   Png: TPNGObject;
5661   Header: String[8];
5662   Row, Col, PixSize, LineSize: Integer;
5663   NewImage, pSource, pDest, pAlpha: pByte;
5664   PngFormat: TglBitmapFormat;
5665   FormatDesc: TFormatDescriptor;
5666
5667 const
5668   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5669
5670 begin
5671   result := false;
5672
5673   StreamPos := aStream.Position;
5674   aStream.Read(Header[0], SizeOf(Header));
5675   aStream.Position := StreamPos;
5676
5677   {Test if the header matches}
5678   if Header = PngHeader then begin
5679     Png := TPNGObject.Create;
5680     try
5681       Png.LoadFromStream(aStream);
5682
5683       case Png.Header.ColorType of
5684         COLOR_GRAYSCALE:
5685           PngFormat := tfLuminance8;
5686         COLOR_GRAYSCALEALPHA:
5687           PngFormat := tfLuminance8Alpha8;
5688         COLOR_RGB:
5689           PngFormat := tfBGR8;
5690         COLOR_RGBALPHA:
5691           PngFormat := tfBGRA8;
5692         else
5693           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5694       end;
5695
5696       FormatDesc := TFormatDescriptor.Get(PngFormat);
5697       PixSize    := Round(FormatDesc.PixelSize);
5698       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5699
5700       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5701       try
5702         pDest := NewImage;
5703
5704         case Png.Header.ColorType of
5705           COLOR_RGB, COLOR_GRAYSCALE:
5706             begin
5707               for Row := 0 to Png.Height -1 do begin
5708                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5709                 Inc(pDest, LineSize);
5710               end;
5711             end;
5712           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5713             begin
5714               PixSize := PixSize -1;
5715
5716               for Row := 0 to Png.Height -1 do begin
5717                 pSource := Png.Scanline[Row];
5718                 pAlpha := pByte(Png.AlphaScanline[Row]);
5719
5720                 for Col := 0 to Png.Width -1 do begin
5721                   Move (pSource^, pDest^, PixSize);
5722                   Inc(pSource, PixSize);
5723                   Inc(pDest, PixSize);
5724
5725                   pDest^ := pAlpha^;
5726                   inc(pAlpha);
5727                   Inc(pDest);
5728                 end;
5729               end;
5730             end;
5731           else
5732             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5733         end;
5734
5735         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
5736
5737         result := true;
5738       except
5739         FreeMem(NewImage);
5740         raise;
5741       end;
5742     finally
5743       Png.Free;
5744     end;
5745   end;
5746 end;
5747 {$IFEND}
5748 {$ENDIF}
5749
5750 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5751 {$IFDEF GLB_LIB_PNG}
5752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5753 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5754 begin
5755   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5756 end;
5757 {$ENDIF}
5758
5759 {$IF DEFINED(GLB_LIB_PNG)}
5760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5761 procedure TglBitmap.SavePNG(const aStream: TStream);
5762 var
5763   png: png_structp;
5764   png_info: png_infop;
5765   png_rows: array of pByte;
5766   LineSize: Integer;
5767   ColorType: Integer;
5768   Row: Integer;
5769   FormatDesc: TFormatDescriptor;
5770 begin
5771   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5772     raise EglBitmapUnsupportedFormat.Create(Format);
5773
5774   if not init_libPNG then
5775     raise Exception.Create('unable to initialize libPNG.');
5776
5777   try
5778     case Format of
5779       tfAlpha8, tfLuminance8:
5780         ColorType := PNG_COLOR_TYPE_GRAY;
5781       tfLuminance8Alpha8:
5782         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5783       tfBGR8, tfRGB8:
5784         ColorType := PNG_COLOR_TYPE_RGB;
5785       tfBGRA8, tfRGBA8:
5786         ColorType := PNG_COLOR_TYPE_RGBA;
5787       else
5788         raise EglBitmapUnsupportedFormat.Create(Format);
5789     end;
5790
5791     FormatDesc := TFormatDescriptor.Get(Format);
5792     LineSize := FormatDesc.GetSize(Width, 1);
5793
5794     // creating array for scanline
5795     SetLength(png_rows, Height);
5796     try
5797       for Row := 0 to Height - 1 do begin
5798         png_rows[Row] := Data;
5799         Inc(png_rows[Row], Row * LineSize)
5800       end;
5801
5802       // write struct
5803       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5804       if png = nil then
5805         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5806
5807       // create png info
5808       png_info := png_create_info_struct(png);
5809       if png_info = nil then begin
5810         png_destroy_write_struct(@png, nil);
5811         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5812       end;
5813
5814       // set read callback
5815       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5816
5817       // set compression
5818       png_set_compression_level(png, 6);
5819
5820       if Format in [tfBGR8, tfBGRA8] then
5821         png_set_bgr(png);
5822
5823       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5824       png_write_info(png, png_info);
5825       png_write_image(png, @png_rows[0]);
5826       png_write_end(png, png_info);
5827       png_destroy_write_struct(@png, @png_info);
5828     finally
5829       SetLength(png_rows, 0);
5830     end;
5831   finally
5832     quit_libPNG;
5833   end;
5834 end;
5835
5836 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5838 procedure TglBitmap.SavePNG(const aStream: TStream);
5839 var
5840   Png: TPNGObject;
5841
5842   pSource, pDest: pByte;
5843   X, Y, PixSize: Integer;
5844   ColorType: Cardinal;
5845   Alpha: Boolean;
5846
5847   pTemp: pByte;
5848   Temp: Byte;
5849 begin
5850   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5851     raise EglBitmapUnsupportedFormat.Create(Format);
5852
5853   case Format of
5854     tfAlpha8, tfLuminance8: begin
5855       ColorType := COLOR_GRAYSCALE;
5856       PixSize   := 1;
5857       Alpha     := false;
5858     end;
5859     tfLuminance8Alpha8: begin
5860       ColorType := COLOR_GRAYSCALEALPHA;
5861       PixSize   := 1;
5862       Alpha     := true;
5863     end;
5864     tfBGR8, tfRGB8: begin
5865       ColorType := COLOR_RGB;
5866       PixSize   := 3;
5867       Alpha     := false;
5868     end;
5869     tfBGRA8, tfRGBA8: begin
5870       ColorType := COLOR_RGBALPHA;
5871       PixSize   := 3;
5872       Alpha     := true
5873     end;
5874   else
5875     raise EglBitmapUnsupportedFormat.Create(Format);
5876   end;
5877
5878   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5879   try
5880     // Copy ImageData
5881     pSource := Data;
5882     for Y := 0 to Height -1 do begin
5883       pDest := png.ScanLine[Y];
5884       for X := 0 to Width -1 do begin
5885         Move(pSource^, pDest^, PixSize);
5886         Inc(pDest, PixSize);
5887         Inc(pSource, PixSize);
5888         if Alpha then begin
5889           png.AlphaScanline[Y]^[X] := pSource^;
5890           Inc(pSource);
5891         end;
5892       end;
5893
5894       // convert RGB line to BGR
5895       if Format in [tfRGB8, tfRGBA8] then begin
5896         pTemp := png.ScanLine[Y];
5897         for X := 0 to Width -1 do begin
5898           Temp := pByteArray(pTemp)^[0];
5899           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5900           pByteArray(pTemp)^[2] := Temp;
5901           Inc(pTemp, 3);
5902         end;
5903       end;
5904     end;
5905
5906     // Save to Stream
5907     Png.CompressionLevel := 6;
5908     Png.SaveToStream(aStream);
5909   finally
5910     FreeAndNil(Png);
5911   end;
5912 end;
5913 {$IFEND}
5914 {$ENDIF}
5915
5916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5917 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5919 {$IFDEF GLB_LIB_JPEG}
5920 type
5921   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5922   glBitmap_libJPEG_source_mgr = record
5923     pub: jpeg_source_mgr;
5924
5925     SrcStream: TStream;
5926     SrcBuffer: array [1..4096] of byte;
5927   end;
5928
5929   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5930   glBitmap_libJPEG_dest_mgr = record
5931     pub: jpeg_destination_mgr;
5932
5933     DestStream: TStream;
5934     DestBuffer: array [1..4096] of byte;
5935   end;
5936
5937 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5938 begin
5939   //DUMMY
5940 end;
5941
5942
5943 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5944 begin
5945   //DUMMY
5946 end;
5947
5948
5949 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5950 begin
5951   //DUMMY
5952 end;
5953
5954 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5955 begin
5956   //DUMMY
5957 end;
5958
5959
5960 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5961 begin
5962   //DUMMY
5963 end;
5964
5965
5966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5967 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5968 var
5969   src: glBitmap_libJPEG_source_mgr_ptr;
5970   bytes: integer;
5971 begin
5972   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5973
5974   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5975         if (bytes <= 0) then begin
5976                 src^.SrcBuffer[1] := $FF;
5977                 src^.SrcBuffer[2] := JPEG_EOI;
5978                 bytes := 2;
5979         end;
5980
5981         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5982         src^.pub.bytes_in_buffer := bytes;
5983
5984   result := true;
5985 end;
5986
5987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5988 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5989 var
5990   src: glBitmap_libJPEG_source_mgr_ptr;
5991 begin
5992   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5993
5994   if num_bytes > 0 then begin
5995     // wanted byte isn't in buffer so set stream position and read buffer
5996     if num_bytes > src^.pub.bytes_in_buffer then begin
5997       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5998       src^.pub.fill_input_buffer(cinfo);
5999     end else begin
6000       // wanted byte is in buffer so only skip
6001                 inc(src^.pub.next_input_byte, num_bytes);
6002                 dec(src^.pub.bytes_in_buffer, num_bytes);
6003     end;
6004   end;
6005 end;
6006
6007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6008 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6009 var
6010   dest: glBitmap_libJPEG_dest_mgr_ptr;
6011 begin
6012   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6013
6014   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6015     // write complete buffer
6016     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6017
6018     // reset buffer
6019     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6020     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6021   end;
6022
6023   result := true;
6024 end;
6025
6026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6027 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6028 var
6029   Idx: Integer;
6030   dest: glBitmap_libJPEG_dest_mgr_ptr;
6031 begin
6032   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6033
6034   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6035     // check for endblock
6036     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6037       // write endblock
6038       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6039
6040       // leave
6041       break;
6042     end else
6043       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6044   end;
6045 end;
6046 {$ENDIF}
6047
6048 {$IFDEF GLB_SUPPORT_JPEG_READ}
6049 {$IF DEFINED(GLB_SDL_IMAGE)}
6050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6051 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6052 var
6053   Surface: PSDL_Surface;
6054   RWops: PSDL_RWops;
6055 begin
6056   result := false;
6057
6058   RWops := glBitmapCreateRWops(aStream);
6059   try
6060     if IMG_isJPG(RWops) > 0 then begin
6061       Surface := IMG_LoadJPG_RW(RWops);
6062       try
6063         AssignFromSurface(Surface);
6064         result := true;
6065       finally
6066         SDL_FreeSurface(Surface);
6067       end;
6068     end;
6069   finally
6070     SDL_FreeRW(RWops);
6071   end;
6072 end;
6073
6074 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6076 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6077 var
6078   StreamPos: Int64;
6079   Temp: array[0..1]of Byte;
6080
6081   jpeg: jpeg_decompress_struct;
6082   jpeg_err: jpeg_error_mgr;
6083
6084   IntFormat: TglBitmapFormat;
6085   pImage: pByte;
6086   TempHeight, TempWidth: Integer;
6087
6088   pTemp: pByte;
6089   Row: Integer;
6090
6091   FormatDesc: TFormatDescriptor;
6092 begin
6093   result := false;
6094
6095   if not init_libJPEG then
6096     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6097
6098   try
6099     // reading first two bytes to test file and set cursor back to begin
6100     StreamPos := aStream.Position;
6101     aStream.Read({%H-}Temp[0], 2);
6102     aStream.Position := StreamPos;
6103
6104     // if Bitmap then read file.
6105     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6106       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6107       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6108
6109       // error managment
6110       jpeg.err := jpeg_std_error(@jpeg_err);
6111       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6112       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6113
6114       // decompression struct
6115       jpeg_create_decompress(@jpeg);
6116
6117       // allocation space for streaming methods
6118       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6119
6120       // seeting up custom functions
6121       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6122         pub.init_source       := glBitmap_libJPEG_init_source;
6123         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6124         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6125         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6126         pub.term_source       := glBitmap_libJPEG_term_source;
6127
6128         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6129         pub.next_input_byte := nil;   // until buffer loaded
6130
6131         SrcStream := aStream;
6132       end;
6133
6134       // set global decoding state
6135       jpeg.global_state := DSTATE_START;
6136
6137       // read header of jpeg
6138       jpeg_read_header(@jpeg, false);
6139
6140       // setting output parameter
6141       case jpeg.jpeg_color_space of
6142         JCS_GRAYSCALE:
6143           begin
6144             jpeg.out_color_space := JCS_GRAYSCALE;
6145             IntFormat := tfLuminance8;
6146           end;
6147         else
6148           jpeg.out_color_space := JCS_RGB;
6149           IntFormat := tfRGB8;
6150       end;
6151
6152       // reading image
6153       jpeg_start_decompress(@jpeg);
6154
6155       TempHeight := jpeg.output_height;
6156       TempWidth := jpeg.output_width;
6157
6158       FormatDesc := TFormatDescriptor.Get(IntFormat);
6159
6160       // creating new image
6161       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6162       try
6163         pTemp := pImage;
6164
6165         for Row := 0 to TempHeight -1 do begin
6166           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6167           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6168         end;
6169
6170         // finish decompression
6171         jpeg_finish_decompress(@jpeg);
6172
6173         // destroy decompression
6174         jpeg_destroy_decompress(@jpeg);
6175
6176         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6177
6178         result := true;
6179       except
6180         FreeMem(pImage);
6181         raise;
6182       end;
6183     end;
6184   finally
6185     quit_libJPEG;
6186   end;
6187 end;
6188
6189 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6191 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6192 var
6193   bmp: TBitmap;
6194   jpg: TJPEGImage;
6195   StreamPos: Int64;
6196   Temp: array[0..1]of Byte;
6197 begin
6198   result := false;
6199
6200   // reading first two bytes to test file and set cursor back to begin
6201   StreamPos := aStream.Position;
6202   aStream.Read(Temp[0], 2);
6203   aStream.Position := StreamPos;
6204
6205   // if Bitmap then read file.
6206   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6207     bmp := TBitmap.Create;
6208     try
6209       jpg := TJPEGImage.Create;
6210       try
6211         jpg.LoadFromStream(aStream);
6212         bmp.Assign(jpg);
6213         result := AssignFromBitmap(bmp);
6214       finally
6215         jpg.Free;
6216       end;
6217     finally
6218       bmp.Free;
6219     end;
6220   end;
6221 end;
6222 {$IFEND}
6223 {$ENDIF}
6224
6225 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6226 {$IF DEFINED(GLB_LIB_JPEG)}
6227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6228 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6229 var
6230   jpeg: jpeg_compress_struct;
6231   jpeg_err: jpeg_error_mgr;
6232   Row: Integer;
6233   pTemp, pTemp2: pByte;
6234
6235   procedure CopyRow(pDest, pSource: pByte);
6236   var
6237     X: Integer;
6238   begin
6239     for X := 0 to Width - 1 do begin
6240       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6241       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6242       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6243       Inc(pDest, 3);
6244       Inc(pSource, 3);
6245     end;
6246   end;
6247
6248 begin
6249   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6250     raise EglBitmapUnsupportedFormat.Create(Format);
6251
6252   if not init_libJPEG then
6253     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6254
6255   try
6256     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6257     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6258
6259     // error managment
6260     jpeg.err := jpeg_std_error(@jpeg_err);
6261     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6262     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6263
6264     // compression struct
6265     jpeg_create_compress(@jpeg);
6266
6267     // allocation space for streaming methods
6268     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6269
6270     // seeting up custom functions
6271     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6272       pub.init_destination    := glBitmap_libJPEG_init_destination;
6273       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6274       pub.term_destination    := glBitmap_libJPEG_term_destination;
6275
6276       pub.next_output_byte  := @DestBuffer[1];
6277       pub.free_in_buffer    := Length(DestBuffer);
6278
6279       DestStream := aStream;
6280     end;
6281
6282     // very important state
6283     jpeg.global_state := CSTATE_START;
6284     jpeg.image_width  := Width;
6285     jpeg.image_height := Height;
6286     case Format of
6287       tfAlpha8, tfLuminance8: begin
6288         jpeg.input_components := 1;
6289         jpeg.in_color_space   := JCS_GRAYSCALE;
6290       end;
6291       tfRGB8, tfBGR8: begin
6292         jpeg.input_components := 3;
6293         jpeg.in_color_space   := JCS_RGB;
6294       end;
6295     end;
6296
6297     jpeg_set_defaults(@jpeg);
6298     jpeg_set_quality(@jpeg, 95, true);
6299     jpeg_start_compress(@jpeg, true);
6300     pTemp := Data;
6301
6302     if Format = tfBGR8 then
6303       GetMem(pTemp2, fRowSize)
6304     else
6305       pTemp2 := pTemp;
6306
6307     try
6308       for Row := 0 to jpeg.image_height -1 do begin
6309         // prepare row
6310         if Format = tfBGR8 then
6311           CopyRow(pTemp2, pTemp)
6312         else
6313           pTemp2 := pTemp;
6314
6315         // write row
6316         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6317         inc(pTemp, fRowSize);
6318       end;
6319     finally
6320       // free memory
6321       if Format = tfBGR8 then
6322         FreeMem(pTemp2);
6323     end;
6324     jpeg_finish_compress(@jpeg);
6325     jpeg_destroy_compress(@jpeg);
6326   finally
6327     quit_libJPEG;
6328   end;
6329 end;
6330
6331 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6333 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6334 var
6335   Bmp: TBitmap;
6336   Jpg: TJPEGImage;
6337 begin
6338   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6339     raise EglBitmapUnsupportedFormat.Create(Format);
6340
6341   Bmp := TBitmap.Create;
6342   try
6343     Jpg := TJPEGImage.Create;
6344     try
6345       AssignToBitmap(Bmp);
6346       if (Format in [tfAlpha8, tfLuminance8]) then begin
6347         Jpg.Grayscale   := true;
6348         Jpg.PixelFormat := jf8Bit;
6349       end;
6350       Jpg.Assign(Bmp);
6351       Jpg.SaveToStream(aStream);
6352     finally
6353       FreeAndNil(Jpg);
6354     end;
6355   finally
6356     FreeAndNil(Bmp);
6357   end;
6358 end;
6359 {$IFEND}
6360 {$ENDIF}
6361
6362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6363 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6365 const
6366   BMP_MAGIC          = $4D42;
6367
6368   BMP_COMP_RGB       = 0;
6369   BMP_COMP_RLE8      = 1;
6370   BMP_COMP_RLE4      = 2;
6371   BMP_COMP_BITFIELDS = 3;
6372
6373 type
6374   TBMPHeader = packed record
6375     bfType: Word;
6376     bfSize: Cardinal;
6377     bfReserved1: Word;
6378     bfReserved2: Word;
6379     bfOffBits: Cardinal;
6380   end;
6381
6382   TBMPInfo = packed record
6383     biSize: Cardinal;
6384     biWidth: Longint;
6385     biHeight: Longint;
6386     biPlanes: Word;
6387     biBitCount: Word;
6388     biCompression: Cardinal;
6389     biSizeImage: Cardinal;
6390     biXPelsPerMeter: Longint;
6391     biYPelsPerMeter: Longint;
6392     biClrUsed: Cardinal;
6393     biClrImportant: Cardinal;
6394   end;
6395
6396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6397 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6398
6399   //////////////////////////////////////////////////////////////////////////////////////////////////
6400   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6401   begin
6402     result := tfEmpty;
6403     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6404     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6405
6406     //Read Compression
6407     case aInfo.biCompression of
6408       BMP_COMP_RLE4,
6409       BMP_COMP_RLE8: begin
6410         raise EglBitmapException.Create('RLE compression is not supported');
6411       end;
6412       BMP_COMP_BITFIELDS: begin
6413         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6414           aStream.Read(aMask.r, SizeOf(aMask.r));
6415           aStream.Read(aMask.g, SizeOf(aMask.g));
6416           aStream.Read(aMask.b, SizeOf(aMask.b));
6417           aStream.Read(aMask.a, SizeOf(aMask.a));
6418         end else
6419           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6420       end;
6421     end;
6422
6423     //get suitable format
6424     case aInfo.biBitCount of
6425        8: result := tfLuminance8;
6426       16: result := tfBGR5;
6427       24: result := tfBGR8;
6428       32: result := tfBGRA8;
6429     end;
6430   end;
6431
6432   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6433   var
6434     i, c: Integer;
6435     ColorTable: TbmpColorTable;
6436   begin
6437     result := nil;
6438     if (aInfo.biBitCount >= 16) then
6439       exit;
6440     aFormat := tfLuminance8;
6441     c := aInfo.biClrUsed;
6442     if (c = 0) then
6443       c := 1 shl aInfo.biBitCount;
6444     SetLength(ColorTable, c);
6445     for i := 0 to c-1 do begin
6446       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6447       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6448         aFormat := tfRGB8;
6449     end;
6450
6451     result := TbmpColorTableFormat.Create;
6452     result.PixelSize  := aInfo.biBitCount / 8;
6453     result.ColorTable := ColorTable;
6454     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6455   end;
6456
6457   //////////////////////////////////////////////////////////////////////////////////////////////////
6458   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6459     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6460   var
6461     TmpFormat: TglBitmapFormat;
6462     FormatDesc: TFormatDescriptor;
6463   begin
6464     result := nil;
6465     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6466       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6467         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6468         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6469           aFormat := FormatDesc.Format;
6470           exit;
6471         end;
6472       end;
6473
6474       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6475         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6476       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6477         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6478
6479       result := TbmpBitfieldFormat.Create;
6480       result.PixelSize := aInfo.biBitCount / 8;
6481       result.RedMask   := aMask.r;
6482       result.GreenMask := aMask.g;
6483       result.BlueMask  := aMask.b;
6484       result.AlphaMask := aMask.a;
6485     end;
6486   end;
6487
6488 var
6489   //simple types
6490   StartPos: Int64;
6491   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6492   PaddingBuff: Cardinal;
6493   LineBuf, ImageData, TmpData: PByte;
6494   SourceMD, DestMD: Pointer;
6495   BmpFormat: TglBitmapFormat;
6496
6497   //records
6498   Mask: TglBitmapColorRec;
6499   Header: TBMPHeader;
6500   Info: TBMPInfo;
6501
6502   //classes
6503   SpecialFormat: TFormatDescriptor;
6504   FormatDesc: TFormatDescriptor;
6505
6506   //////////////////////////////////////////////////////////////////////////////////////////////////
6507   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6508   var
6509     i: Integer;
6510     Pixel: TglBitmapPixelData;
6511   begin
6512     aStream.Read(aLineBuf^, rbLineSize);
6513     SpecialFormat.PreparePixel(Pixel);
6514     for i := 0 to Info.biWidth-1 do begin
6515       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6516       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6517       FormatDesc.Map(Pixel, aData, DestMD);
6518     end;
6519   end;
6520
6521 begin
6522   result        := false;
6523   BmpFormat     := tfEmpty;
6524   SpecialFormat := nil;
6525   LineBuf       := nil;
6526   SourceMD      := nil;
6527   DestMD        := nil;
6528
6529   // Header
6530   StartPos := aStream.Position;
6531   aStream.Read(Header{%H-}, SizeOf(Header));
6532
6533   if Header.bfType = BMP_MAGIC then begin
6534     try try
6535       BmpFormat        := ReadInfo(Info, Mask);
6536       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6537       if not Assigned(SpecialFormat) then
6538         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6539       aStream.Position := StartPos + Header.bfOffBits;
6540
6541       if (BmpFormat <> tfEmpty) then begin
6542         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6543         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6544         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6545         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6546
6547         //get Memory
6548         DestMD    := FormatDesc.CreateMappingData;
6549         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6550         GetMem(ImageData, ImageSize);
6551         if Assigned(SpecialFormat) then begin
6552           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6553           SourceMD := SpecialFormat.CreateMappingData;
6554         end;
6555
6556         //read Data
6557         try try
6558           FillChar(ImageData^, ImageSize, $FF);
6559           TmpData := ImageData;
6560           if (Info.biHeight > 0) then
6561             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6562           for i := 0 to Abs(Info.biHeight)-1 do begin
6563             if Assigned(SpecialFormat) then
6564               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6565             else
6566               aStream.Read(TmpData^, wbLineSize);   //else only read data
6567             if (Info.biHeight > 0) then
6568               dec(TmpData, wbLineSize)
6569             else
6570               inc(TmpData, wbLineSize);
6571             aStream.Read(PaddingBuff{%H-}, Padding);
6572           end;
6573           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6574           result := true;
6575         finally
6576           if Assigned(LineBuf) then
6577             FreeMem(LineBuf);
6578           if Assigned(SourceMD) then
6579             SpecialFormat.FreeMappingData(SourceMD);
6580           FormatDesc.FreeMappingData(DestMD);
6581         end;
6582         except
6583           FreeMem(ImageData);
6584           raise;
6585         end;
6586       end else
6587         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6588     except
6589       aStream.Position := StartPos;
6590       raise;
6591     end;
6592     finally
6593       FreeAndNil(SpecialFormat);
6594     end;
6595   end
6596     else aStream.Position := StartPos;
6597 end;
6598
6599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6600 procedure TglBitmap.SaveBMP(const aStream: TStream);
6601 var
6602   Header: TBMPHeader;
6603   Info: TBMPInfo;
6604   Converter: TbmpColorTableFormat;
6605   FormatDesc: TFormatDescriptor;
6606   SourceFD, DestFD: Pointer;
6607   pData, srcData, dstData, ConvertBuffer: pByte;
6608
6609   Pixel: TglBitmapPixelData;
6610   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6611   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6612
6613   PaddingBuff: Cardinal;
6614
6615   function GetLineWidth : Integer;
6616   begin
6617     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6618   end;
6619
6620 begin
6621   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6622     raise EglBitmapUnsupportedFormat.Create(Format);
6623
6624   Converter  := nil;
6625   FormatDesc := TFormatDescriptor.Get(Format);
6626   ImageSize  := FormatDesc.GetSize(Dimension);
6627
6628   FillChar(Header{%H-}, SizeOf(Header), 0);
6629   Header.bfType      := BMP_MAGIC;
6630   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6631   Header.bfReserved1 := 0;
6632   Header.bfReserved2 := 0;
6633   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6634
6635   FillChar(Info{%H-}, SizeOf(Info), 0);
6636   Info.biSize        := SizeOf(Info);
6637   Info.biWidth       := Width;
6638   Info.biHeight      := Height;
6639   Info.biPlanes      := 1;
6640   Info.biCompression := BMP_COMP_RGB;
6641   Info.biSizeImage   := ImageSize;
6642
6643   try
6644     case Format of
6645       tfLuminance4: begin
6646         Info.biBitCount  := 4;
6647         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6648         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6649         Converter           := TbmpColorTableFormat.Create;
6650         Converter.PixelSize := 0.5;
6651         Converter.Format    := Format;
6652         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6653         Converter.CreateColorTable;
6654       end;
6655
6656       tfR3G3B2, tfLuminance8: begin
6657         Info.biBitCount  :=  8;
6658         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6659         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6660         Converter           := TbmpColorTableFormat.Create;
6661         Converter.PixelSize := 1;
6662         Converter.Format    := Format;
6663         if (Format = tfR3G3B2) then begin
6664           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6665           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6666         end else
6667           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6668         Converter.CreateColorTable;
6669       end;
6670
6671       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6672       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6673         Info.biBitCount    := 16;
6674         Info.biCompression := BMP_COMP_BITFIELDS;
6675       end;
6676
6677       tfBGR8, tfRGB8: begin
6678         Info.biBitCount := 24;
6679       end;
6680
6681       tfRGB10, tfRGB10A2, tfRGBA8,
6682       tfBGR10, tfBGR10A2, tfBGRA8: begin
6683         Info.biBitCount    := 32;
6684         Info.biCompression := BMP_COMP_BITFIELDS;
6685       end;
6686     else
6687       raise EglBitmapUnsupportedFormat.Create(Format);
6688     end;
6689     Info.biXPelsPerMeter := 2835;
6690     Info.biYPelsPerMeter := 2835;
6691
6692     // prepare bitmasks
6693     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6694       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6695       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6696
6697       RedMask    := FormatDesc.RedMask;
6698       GreenMask  := FormatDesc.GreenMask;
6699       BlueMask   := FormatDesc.BlueMask;
6700       AlphaMask  := FormatDesc.AlphaMask;
6701     end;
6702
6703     // headers
6704     aStream.Write(Header, SizeOf(Header));
6705     aStream.Write(Info, SizeOf(Info));
6706
6707     // colortable
6708     if Assigned(Converter) then
6709       aStream.Write(Converter.ColorTable[0].b,
6710         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6711
6712     // bitmasks
6713     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6714       aStream.Write(RedMask,   SizeOf(Cardinal));
6715       aStream.Write(GreenMask, SizeOf(Cardinal));
6716       aStream.Write(BlueMask,  SizeOf(Cardinal));
6717       aStream.Write(AlphaMask, SizeOf(Cardinal));
6718     end;
6719
6720     // image data
6721     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6722     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6723     Padding     := GetLineWidth - wbLineSize;
6724     PaddingBuff := 0;
6725
6726     pData := Data;
6727     inc(pData, (Height-1) * rbLineSize);
6728
6729     // prepare row buffer. But only for RGB because RGBA supports color masks
6730     // so it's possible to change color within the image.
6731     if Assigned(Converter) then begin
6732       FormatDesc.PreparePixel(Pixel);
6733       GetMem(ConvertBuffer, wbLineSize);
6734       SourceFD := FormatDesc.CreateMappingData;
6735       DestFD   := Converter.CreateMappingData;
6736     end else
6737       ConvertBuffer := nil;
6738
6739     try
6740       for LineIdx := 0 to Height - 1 do begin
6741         // preparing row
6742         if Assigned(Converter) then begin
6743           srcData := pData;
6744           dstData := ConvertBuffer;
6745           for PixelIdx := 0 to Info.biWidth-1 do begin
6746             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6747             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6748             Converter.Map(Pixel, dstData, DestFD);
6749           end;
6750           aStream.Write(ConvertBuffer^, wbLineSize);
6751         end else begin
6752           aStream.Write(pData^, rbLineSize);
6753         end;
6754         dec(pData, rbLineSize);
6755         if (Padding > 0) then
6756           aStream.Write(PaddingBuff, Padding);
6757       end;
6758     finally
6759       // destroy row buffer
6760       if Assigned(ConvertBuffer) then begin
6761         FormatDesc.FreeMappingData(SourceFD);
6762         Converter.FreeMappingData(DestFD);
6763         FreeMem(ConvertBuffer);
6764       end;
6765     end;
6766   finally
6767     if Assigned(Converter) then
6768       Converter.Free;
6769   end;
6770 end;
6771
6772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6773 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6775 type
6776   TTGAHeader = packed record
6777     ImageID: Byte;
6778     ColorMapType: Byte;
6779     ImageType: Byte;
6780     //ColorMapSpec: Array[0..4] of Byte;
6781     ColorMapStart: Word;
6782     ColorMapLength: Word;
6783     ColorMapEntrySize: Byte;
6784     OrigX: Word;
6785     OrigY: Word;
6786     Width: Word;
6787     Height: Word;
6788     Bpp: Byte;
6789     ImageDesc: Byte;
6790   end;
6791
6792 const
6793   TGA_UNCOMPRESSED_RGB  =  2;
6794   TGA_UNCOMPRESSED_GRAY =  3;
6795   TGA_COMPRESSED_RGB    = 10;
6796   TGA_COMPRESSED_GRAY   = 11;
6797
6798   TGA_NONE_COLOR_TABLE  = 0;
6799
6800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6801 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6802 var
6803   Header: TTGAHeader;
6804   ImageData: System.PByte;
6805   StartPosition: Int64;
6806   PixelSize, LineSize: Integer;
6807   tgaFormat: TglBitmapFormat;
6808   FormatDesc: TFormatDescriptor;
6809   Counter: packed record
6810     X, Y: packed record
6811       low, high, dir: Integer;
6812     end;
6813   end;
6814
6815 const
6816   CACHE_SIZE = $4000;
6817
6818   ////////////////////////////////////////////////////////////////////////////////////////
6819   procedure ReadUncompressed;
6820   var
6821     i, j: Integer;
6822     buf, tmp1, tmp2: System.PByte;
6823   begin
6824     buf := nil;
6825     if (Counter.X.dir < 0) then
6826       GetMem(buf, LineSize);
6827     try
6828       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6829         tmp1 := ImageData;
6830         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
6831         if (Counter.X.dir < 0) then begin               //flip X
6832           aStream.Read(buf^, LineSize);
6833           tmp2 := buf;
6834           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
6835           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6836             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6837               tmp1^ := tmp2^;
6838               inc(tmp1);
6839               inc(tmp2);
6840             end;
6841             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6842           end;
6843         end else
6844           aStream.Read(tmp1^, LineSize);
6845         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6846       end;
6847     finally
6848       if Assigned(buf) then
6849         FreeMem(buf);
6850     end;
6851   end;
6852
6853   ////////////////////////////////////////////////////////////////////////////////////////
6854   procedure ReadCompressed;
6855
6856     /////////////////////////////////////////////////////////////////
6857     var
6858       TmpData: System.PByte;
6859       LinePixelsRead: Integer;
6860     procedure CheckLine;
6861     begin
6862       if (LinePixelsRead >= Header.Width) then begin
6863         LinePixelsRead := 0;
6864         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6865         TmpData := ImageData;
6866         inc(TmpData, Counter.Y.low * LineSize);           //set line
6867         if (Counter.X.dir < 0) then                       //if x flipped then
6868           inc(TmpData, LineSize - PixelSize);             //set last pixel
6869       end;
6870     end;
6871
6872     /////////////////////////////////////////////////////////////////
6873     var
6874       Cache: PByte;
6875       CacheSize, CachePos: Integer;
6876     procedure CachedRead(out Buffer; Count: Integer);
6877     var
6878       BytesRead: Integer;
6879     begin
6880       if (CachePos + Count > CacheSize) then begin
6881         //if buffer overflow save non read bytes
6882         BytesRead := 0;
6883         if (CacheSize - CachePos > 0) then begin
6884           BytesRead := CacheSize - CachePos;
6885           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6886           inc(CachePos, BytesRead);
6887         end;
6888
6889         //load cache from file
6890         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6891         aStream.Read(Cache^, CacheSize);
6892         CachePos := 0;
6893
6894         //read rest of requested bytes
6895         if (Count - BytesRead > 0) then begin
6896           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6897           inc(CachePos, Count - BytesRead);
6898         end;
6899       end else begin
6900         //if no buffer overflow just read the data
6901         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6902         inc(CachePos, Count);
6903       end;
6904     end;
6905
6906     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6907     begin
6908       case PixelSize of
6909         1: begin
6910           aBuffer^ := aData^;
6911           inc(aBuffer, Counter.X.dir);
6912         end;
6913         2: begin
6914           PWord(aBuffer)^ := PWord(aData)^;
6915           inc(aBuffer, 2 * Counter.X.dir);
6916         end;
6917         3: begin
6918           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6919           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6920           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6921           inc(aBuffer, 3 * Counter.X.dir);
6922         end;
6923         4: begin
6924           PCardinal(aBuffer)^ := PCardinal(aData)^;
6925           inc(aBuffer, 4 * Counter.X.dir);
6926         end;
6927       end;
6928     end;
6929
6930   var
6931     TotalPixelsToRead, TotalPixelsRead: Integer;
6932     Temp: Byte;
6933     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6934     PixelRepeat: Boolean;
6935     PixelsToRead, PixelCount: Integer;
6936   begin
6937     CacheSize := 0;
6938     CachePos  := 0;
6939
6940     TotalPixelsToRead := Header.Width * Header.Height;
6941     TotalPixelsRead   := 0;
6942     LinePixelsRead    := 0;
6943
6944     GetMem(Cache, CACHE_SIZE);
6945     try
6946       TmpData := ImageData;
6947       inc(TmpData, Counter.Y.low * LineSize);           //set line
6948       if (Counter.X.dir < 0) then                       //if x flipped then
6949         inc(TmpData, LineSize - PixelSize);             //set last pixel
6950
6951       repeat
6952         //read CommandByte
6953         CachedRead(Temp, 1);
6954         PixelRepeat  := (Temp and $80) > 0;
6955         PixelsToRead := (Temp and $7F) + 1;
6956         inc(TotalPixelsRead, PixelsToRead);
6957
6958         if PixelRepeat then
6959           CachedRead(buf[0], PixelSize);
6960         while (PixelsToRead > 0) do begin
6961           CheckLine;
6962           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6963           while (PixelCount > 0) do begin
6964             if not PixelRepeat then
6965               CachedRead(buf[0], PixelSize);
6966             PixelToBuffer(@buf[0], TmpData);
6967             inc(LinePixelsRead);
6968             dec(PixelsToRead);
6969             dec(PixelCount);
6970           end;
6971         end;
6972       until (TotalPixelsRead >= TotalPixelsToRead);
6973     finally
6974       FreeMem(Cache);
6975     end;
6976   end;
6977
6978   function IsGrayFormat: Boolean;
6979   begin
6980     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6981   end;
6982
6983 begin
6984   result := false;
6985
6986   // reading header to test file and set cursor back to begin
6987   StartPosition := aStream.Position;
6988   aStream.Read(Header{%H-}, SizeOf(Header));
6989
6990   // no colormapped files
6991   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6992     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6993   begin
6994     try
6995       if Header.ImageID <> 0 then       // skip image ID
6996         aStream.Position := aStream.Position + Header.ImageID;
6997
6998       tgaFormat := tfEmpty;
6999       case Header.Bpp of
7000          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7001                0: tgaFormat := tfLuminance8;
7002                8: tgaFormat := tfAlpha8;
7003             end;
7004
7005         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7006                0: tgaFormat := tfLuminance16;
7007                8: tgaFormat := tfLuminance8Alpha8;
7008             end else case (Header.ImageDesc and $F) of
7009                0: tgaFormat := tfBGR5;
7010                1: tgaFormat := tfBGR5A1;
7011                4: tgaFormat := tfBGRA4;
7012             end;
7013
7014         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7015                0: tgaFormat := tfBGR8;
7016             end;
7017
7018         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7019                2: tgaFormat := tfBGR10A2;
7020                8: tgaFormat := tfBGRA8;
7021             end;
7022       end;
7023
7024       if (tgaFormat = tfEmpty) then
7025         raise EglBitmapException.Create('LoadTga - unsupported format');
7026
7027       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7028       PixelSize  := FormatDesc.GetSize(1, 1);
7029       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7030
7031       GetMem(ImageData, LineSize * Header.Height);
7032       try
7033         //column direction
7034         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7035           Counter.X.low  := Header.Height-1;;
7036           Counter.X.high := 0;
7037           Counter.X.dir  := -1;
7038         end else begin
7039           Counter.X.low  := 0;
7040           Counter.X.high := Header.Height-1;
7041           Counter.X.dir  := 1;
7042         end;
7043
7044         // Row direction
7045         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7046           Counter.Y.low  := 0;
7047           Counter.Y.high := Header.Height-1;
7048           Counter.Y.dir  := 1;
7049         end else begin
7050           Counter.Y.low  := Header.Height-1;;
7051           Counter.Y.high := 0;
7052           Counter.Y.dir  := -1;
7053         end;
7054
7055         // Read Image
7056         case Header.ImageType of
7057           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7058             ReadUncompressed;
7059           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7060             ReadCompressed;
7061         end;
7062
7063         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7064         result := true;
7065       except
7066         FreeMem(ImageData);
7067         raise;
7068       end;
7069     finally
7070       aStream.Position := StartPosition;
7071     end;
7072   end
7073     else aStream.Position := StartPosition;
7074 end;
7075
7076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7077 procedure TglBitmap.SaveTGA(const aStream: TStream);
7078 var
7079   Header: TTGAHeader;
7080   LineSize, Size, x, y: Integer;
7081   Pixel: TglBitmapPixelData;
7082   LineBuf, SourceData, DestData: PByte;
7083   SourceMD, DestMD: Pointer;
7084   FormatDesc: TFormatDescriptor;
7085   Converter: TFormatDescriptor;
7086 begin
7087   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7088     raise EglBitmapUnsupportedFormat.Create(Format);
7089
7090   //prepare header
7091   FillChar(Header{%H-}, SizeOf(Header), 0);
7092
7093   //set ImageType
7094   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7095                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7096     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7097   else
7098     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7099
7100   //set BitsPerPixel
7101   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7102     Header.Bpp := 8
7103   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7104                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7105     Header.Bpp := 16
7106   else if (Format in [tfBGR8, tfRGB8]) then
7107     Header.Bpp := 24
7108   else
7109     Header.Bpp := 32;
7110
7111   //set AlphaBitCount
7112   case Format of
7113     tfRGB5A1, tfBGR5A1:
7114       Header.ImageDesc := 1 and $F;
7115     tfRGB10A2, tfBGR10A2:
7116       Header.ImageDesc := 2 and $F;
7117     tfRGBA4, tfBGRA4:
7118       Header.ImageDesc := 4 and $F;
7119     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7120       Header.ImageDesc := 8 and $F;
7121   end;
7122
7123   Header.Width     := Width;
7124   Header.Height    := Height;
7125   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7126   aStream.Write(Header, SizeOf(Header));
7127
7128   // convert RGB(A) to BGR(A)
7129   Converter  := nil;
7130   FormatDesc := TFormatDescriptor.Get(Format);
7131   Size       := FormatDesc.GetSize(Dimension);
7132   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7133     if (FormatDesc.RGBInverted = tfEmpty) then
7134       raise EglBitmapException.Create('inverted RGB format is empty');
7135     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7136     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7137        (Converter.PixelSize <> FormatDesc.PixelSize) then
7138       raise EglBitmapException.Create('invalid inverted RGB format');
7139   end;
7140
7141   if Assigned(Converter) then begin
7142     LineSize := FormatDesc.GetSize(Width, 1);
7143     GetMem(LineBuf, LineSize);
7144     SourceMD := FormatDesc.CreateMappingData;
7145     DestMD   := Converter.CreateMappingData;
7146     try
7147       SourceData := Data;
7148       for y := 0 to Height-1 do begin
7149         DestData := LineBuf;
7150         for x := 0 to Width-1 do begin
7151           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7152           Converter.Map(Pixel, DestData, DestMD);
7153         end;
7154         aStream.Write(LineBuf^, LineSize);
7155       end;
7156     finally
7157       FreeMem(LineBuf);
7158       FormatDesc.FreeMappingData(SourceMD);
7159       FormatDesc.FreeMappingData(DestMD);
7160     end;
7161   end else
7162     aStream.Write(Data^, Size);
7163 end;
7164
7165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7166 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7168 const
7169   DDS_MAGIC: Cardinal         = $20534444;
7170
7171   // DDS_header.dwFlags
7172   DDSD_CAPS                   = $00000001;
7173   DDSD_HEIGHT                 = $00000002;
7174   DDSD_WIDTH                  = $00000004;
7175   DDSD_PIXELFORMAT            = $00001000;
7176
7177   // DDS_header.sPixelFormat.dwFlags
7178   DDPF_ALPHAPIXELS            = $00000001;
7179   DDPF_ALPHA                  = $00000002;
7180   DDPF_FOURCC                 = $00000004;
7181   DDPF_RGB                    = $00000040;
7182   DDPF_LUMINANCE              = $00020000;
7183
7184   // DDS_header.sCaps.dwCaps1
7185   DDSCAPS_TEXTURE             = $00001000;
7186
7187   // DDS_header.sCaps.dwCaps2
7188   DDSCAPS2_CUBEMAP            = $00000200;
7189
7190   D3DFMT_DXT1                 = $31545844;
7191   D3DFMT_DXT3                 = $33545844;
7192   D3DFMT_DXT5                 = $35545844;
7193
7194 type
7195   TDDSPixelFormat = packed record
7196     dwSize: Cardinal;
7197     dwFlags: Cardinal;
7198     dwFourCC: Cardinal;
7199     dwRGBBitCount: Cardinal;
7200     dwRBitMask: Cardinal;
7201     dwGBitMask: Cardinal;
7202     dwBBitMask: Cardinal;
7203     dwABitMask: Cardinal;
7204   end;
7205
7206   TDDSCaps = packed record
7207     dwCaps1: Cardinal;
7208     dwCaps2: Cardinal;
7209     dwDDSX: Cardinal;
7210     dwReserved: Cardinal;
7211   end;
7212
7213   TDDSHeader = packed record
7214     dwSize: Cardinal;
7215     dwFlags: Cardinal;
7216     dwHeight: Cardinal;
7217     dwWidth: Cardinal;
7218     dwPitchOrLinearSize: Cardinal;
7219     dwDepth: Cardinal;
7220     dwMipMapCount: Cardinal;
7221     dwReserved: array[0..10] of Cardinal;
7222     PixelFormat: TDDSPixelFormat;
7223     Caps: TDDSCaps;
7224     dwReserved2: Cardinal;
7225   end;
7226
7227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7228 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7229 var
7230   Header: TDDSHeader;
7231   Converter: TbmpBitfieldFormat;
7232
7233   function GetDDSFormat: TglBitmapFormat;
7234   var
7235     fd: TFormatDescriptor;
7236     i: Integer;
7237     Range: TglBitmapColorRec;
7238     match: Boolean;
7239   begin
7240     result := tfEmpty;
7241     with Header.PixelFormat do begin
7242       // Compresses
7243       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7244         case Header.PixelFormat.dwFourCC of
7245           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7246           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7247           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7248         end;
7249       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7250
7251         //find matching format
7252         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7253           fd := TFormatDescriptor.Get(result);
7254           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7255              (8 * fd.PixelSize = dwRGBBitCount) then
7256             exit;
7257         end;
7258
7259         //find format with same Range
7260         Range.r := dwRBitMask;
7261         Range.g := dwGBitMask;
7262         Range.b := dwBBitMask;
7263         Range.a := dwABitMask;
7264         for i := 0 to 3 do begin
7265           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7266             Range.arr[i] := Range.arr[i] shr 1;
7267         end;
7268         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7269           fd := TFormatDescriptor.Get(result);
7270           match := true;
7271           for i := 0 to 3 do
7272             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7273               match := false;
7274               break;
7275             end;
7276           if match then
7277             break;
7278         end;
7279
7280         //no format with same range found -> use default
7281         if (result = tfEmpty) then begin
7282           if (dwABitMask > 0) then
7283             result := tfBGRA8
7284           else
7285             result := tfBGR8;
7286         end;
7287
7288         Converter := TbmpBitfieldFormat.Create;
7289         Converter.RedMask   := dwRBitMask;
7290         Converter.GreenMask := dwGBitMask;
7291         Converter.BlueMask  := dwBBitMask;
7292         Converter.AlphaMask := dwABitMask;
7293         Converter.PixelSize := dwRGBBitCount / 8;
7294       end;
7295     end;
7296   end;
7297
7298 var
7299   StreamPos: Int64;
7300   x, y, LineSize, RowSize, Magic: Cardinal;
7301   NewImage, TmpData, RowData, SrcData: System.PByte;
7302   SourceMD, DestMD: Pointer;
7303   Pixel: TglBitmapPixelData;
7304   ddsFormat: TglBitmapFormat;
7305   FormatDesc: TFormatDescriptor;
7306
7307 begin
7308   result    := false;
7309   Converter := nil;
7310   StreamPos := aStream.Position;
7311
7312   // Magic
7313   aStream.Read(Magic{%H-}, sizeof(Magic));
7314   if (Magic <> DDS_MAGIC) then begin
7315     aStream.Position := StreamPos;
7316     exit;
7317   end;
7318
7319   //Header
7320   aStream.Read(Header{%H-}, sizeof(Header));
7321   if (Header.dwSize <> SizeOf(Header)) or
7322      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7323         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7324   begin
7325     aStream.Position := StreamPos;
7326     exit;
7327   end;
7328
7329   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7330     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7331
7332   ddsFormat := GetDDSFormat;
7333   try
7334     if (ddsFormat = tfEmpty) then
7335       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7336
7337     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7338     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7339     GetMem(NewImage, Header.dwHeight * LineSize);
7340     try
7341       TmpData := NewImage;
7342
7343       //Converter needed
7344       if Assigned(Converter) then begin
7345         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7346         GetMem(RowData, RowSize);
7347         SourceMD := Converter.CreateMappingData;
7348         DestMD   := FormatDesc.CreateMappingData;
7349         try
7350           for y := 0 to Header.dwHeight-1 do begin
7351             TmpData := NewImage;
7352             inc(TmpData, y * LineSize);
7353             SrcData := RowData;
7354             aStream.Read(SrcData^, RowSize);
7355             for x := 0 to Header.dwWidth-1 do begin
7356               Converter.Unmap(SrcData, Pixel, SourceMD);
7357               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7358               FormatDesc.Map(Pixel, TmpData, DestMD);
7359             end;
7360           end;
7361         finally
7362           Converter.FreeMappingData(SourceMD);
7363           FormatDesc.FreeMappingData(DestMD);
7364           FreeMem(RowData);
7365         end;
7366       end else
7367
7368       // Compressed
7369       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7370         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7371         for Y := 0 to Header.dwHeight-1 do begin
7372           aStream.Read(TmpData^, RowSize);
7373           Inc(TmpData, LineSize);
7374         end;
7375       end else
7376
7377       // Uncompressed
7378       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7379         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7380         for Y := 0 to Header.dwHeight-1 do begin
7381           aStream.Read(TmpData^, RowSize);
7382           Inc(TmpData, LineSize);
7383         end;
7384       end else
7385         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7386
7387       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7388       result := true;
7389     except
7390       FreeMem(NewImage);
7391       raise;
7392     end;
7393   finally
7394     FreeAndNil(Converter);
7395   end;
7396 end;
7397
7398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7399 procedure TglBitmap.SaveDDS(const aStream: TStream);
7400 var
7401   Header: TDDSHeader;
7402   FormatDesc: TFormatDescriptor;
7403 begin
7404   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7405     raise EglBitmapUnsupportedFormat.Create(Format);
7406
7407   FormatDesc := TFormatDescriptor.Get(Format);
7408
7409   // Generell
7410   FillChar(Header{%H-}, SizeOf(Header), 0);
7411   Header.dwSize  := SizeOf(Header);
7412   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7413
7414   Header.dwWidth  := Max(1, Width);
7415   Header.dwHeight := Max(1, Height);
7416
7417   // Caps
7418   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7419
7420   // Pixelformat
7421   Header.PixelFormat.dwSize := sizeof(Header);
7422   if (FormatDesc.IsCompressed) then begin
7423     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7424     case Format of
7425       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7426       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7427       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7428     end;
7429   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7430     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7431     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7432     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7433   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7434     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7435     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7436     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7437     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7438   end else begin
7439     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7440     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7441     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7442     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7443     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7444     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7445   end;
7446
7447   if (FormatDesc.HasAlpha) then
7448     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7449
7450   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7451   aStream.Write(Header, SizeOf(Header));
7452   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7453 end;
7454
7455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7456 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7458 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7459 begin
7460   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7461     result := fLines[aIndex]
7462   else
7463     result := nil;
7464 end;
7465
7466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7467 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7468   const aWidth: Integer; const aHeight: Integer);
7469 var
7470   Idx, LineWidth: Integer;
7471 begin
7472   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7473
7474   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7475     // Assigning Data
7476     if Assigned(Data) then begin
7477       SetLength(fLines, GetHeight);
7478       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7479
7480       for Idx := 0 to GetHeight-1 do begin
7481         fLines[Idx] := Data;
7482         Inc(fLines[Idx], Idx * LineWidth);
7483       end;
7484     end
7485       else SetLength(fLines, 0);
7486   end else begin
7487     SetLength(fLines, 0);
7488   end;
7489 end;
7490
7491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7492 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7493 var
7494   FormatDesc: TFormatDescriptor;
7495 begin
7496   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7497
7498   FormatDesc := TFormatDescriptor.Get(Format);
7499   if FormatDesc.IsCompressed then begin
7500     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7501   end else if aBuildWithGlu then begin
7502     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7503       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7504   end else begin
7505     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7506       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7507   end;
7508
7509   // Freigeben
7510   if (FreeDataAfterGenTexture) then
7511     FreeData;
7512 end;
7513
7514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7515 procedure TglBitmap2D.AfterConstruction;
7516 begin
7517   inherited;
7518   Target := GL_TEXTURE_2D;
7519 end;
7520
7521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7522 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7523 var
7524   Temp: pByte;
7525   Size, w, h: Integer;
7526   FormatDesc: TFormatDescriptor;
7527 begin
7528   FormatDesc := TFormatDescriptor.Get(Format);
7529   if FormatDesc.IsCompressed then
7530     raise EglBitmapUnsupportedFormat.Create(Format);
7531
7532   w    := aRight  - aLeft;
7533   h    := aBottom - aTop;
7534   Size := FormatDesc.GetSize(w, h);
7535   GetMem(Temp, Size);
7536   try
7537     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7538     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7539     SetDataPointer(Temp, Format, w, h);
7540     FlipVert;
7541   except
7542     FreeMem(Temp);
7543     raise;
7544   end;
7545 end;
7546
7547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7548 procedure TglBitmap2D.GetDataFromTexture;
7549 var
7550   Temp: PByte;
7551   TempWidth, TempHeight: Integer;
7552   TempIntFormat: Cardinal;
7553   IntFormat, f: TglBitmapFormat;
7554   FormatDesc: TFormatDescriptor;
7555 begin
7556   Bind;
7557
7558   // Request Data
7559   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7560   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7561   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7562
7563   IntFormat := tfEmpty;
7564   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7565     FormatDesc := TFormatDescriptor.Get(f);
7566     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7567       IntFormat := FormatDesc.Format;
7568       break;
7569     end;
7570   end;
7571
7572   // Getting data from OpenGL
7573   FormatDesc := TFormatDescriptor.Get(IntFormat);
7574   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7575   try
7576     if FormatDesc.IsCompressed then
7577       glGetCompressedTexImage(Target, 0, Temp)
7578     else
7579      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7580     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7581   except
7582     FreeMem(Temp);
7583     raise;
7584   end;
7585 end;
7586
7587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7588 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7589 var
7590   BuildWithGlu, PotTex, TexRec: Boolean;
7591   TexSize: Integer;
7592 begin
7593   if Assigned(Data) then begin
7594     // Check Texture Size
7595     if (aTestTextureSize) then begin
7596       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7597
7598       if ((Height > TexSize) or (Width > TexSize)) then
7599         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7600
7601       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7602       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7603
7604       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7605         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7606     end;
7607
7608     CreateId;
7609     SetupParameters(BuildWithGlu);
7610     UploadData(Target, BuildWithGlu);
7611     glAreTexturesResident(1, @fID, @fIsResident);
7612   end;
7613 end;
7614
7615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7616 function TglBitmap2D.FlipHorz: Boolean;
7617 var
7618   Col, Row: Integer;
7619   TempDestData, DestData, SourceData: PByte;
7620   ImgSize: Integer;
7621 begin
7622   result := inherited FlipHorz;
7623   if Assigned(Data) then begin
7624     SourceData := Data;
7625     ImgSize := Height * fRowSize;
7626     GetMem(DestData, ImgSize);
7627     try
7628       TempDestData := DestData;
7629       Dec(TempDestData, fRowSize + fPixelSize);
7630       for Row := 0 to Height -1 do begin
7631         Inc(TempDestData, fRowSize * 2);
7632         for Col := 0 to Width -1 do begin
7633           Move(SourceData^, TempDestData^, fPixelSize);
7634           Inc(SourceData, fPixelSize);
7635           Dec(TempDestData, fPixelSize);
7636         end;
7637       end;
7638       SetDataPointer(DestData, Format);
7639       result := true;
7640     except
7641       FreeMem(DestData);
7642       raise;
7643     end;
7644   end;
7645 end;
7646
7647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7648 function TglBitmap2D.FlipVert: Boolean;
7649 var
7650   Row: Integer;
7651   TempDestData, DestData, SourceData: PByte;
7652 begin
7653   result := inherited FlipVert;
7654   if Assigned(Data) then begin
7655     SourceData := Data;
7656     GetMem(DestData, Height * fRowSize);
7657     try
7658       TempDestData := DestData;
7659       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7660       for Row := 0 to Height -1 do begin
7661         Move(SourceData^, TempDestData^, fRowSize);
7662         Dec(TempDestData, fRowSize);
7663         Inc(SourceData, fRowSize);
7664       end;
7665       SetDataPointer(DestData, Format);
7666       result := true;
7667     except
7668       FreeMem(DestData);
7669       raise;
7670     end;
7671   end;
7672 end;
7673
7674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7675 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7677 type
7678   TMatrixItem = record
7679     X, Y: Integer;
7680     W: Single;
7681   end;
7682
7683   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7684   TglBitmapToNormalMapRec = Record
7685     Scale: Single;
7686     Heights: array of Single;
7687     MatrixU : array of TMatrixItem;
7688     MatrixV : array of TMatrixItem;
7689   end;
7690
7691 const
7692   ONE_OVER_255 = 1 / 255;
7693
7694   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7695 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7696 var
7697   Val: Single;
7698 begin
7699   with FuncRec do begin
7700     Val :=
7701       Source.Data.r * LUMINANCE_WEIGHT_R +
7702       Source.Data.g * LUMINANCE_WEIGHT_G +
7703       Source.Data.b * LUMINANCE_WEIGHT_B;
7704     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7705   end;
7706 end;
7707
7708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7709 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7710 begin
7711   with FuncRec do
7712     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7713 end;
7714
7715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7716 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7717 type
7718   TVec = Array[0..2] of Single;
7719 var
7720   Idx: Integer;
7721   du, dv: Double;
7722   Len: Single;
7723   Vec: TVec;
7724
7725   function GetHeight(X, Y: Integer): Single;
7726   begin
7727     with FuncRec do begin
7728       X := Max(0, Min(Size.X -1, X));
7729       Y := Max(0, Min(Size.Y -1, Y));
7730       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7731     end;
7732   end;
7733
7734 begin
7735   with FuncRec do begin
7736     with PglBitmapToNormalMapRec(Args)^ do begin
7737       du := 0;
7738       for Idx := Low(MatrixU) to High(MatrixU) do
7739         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7740
7741       dv := 0;
7742       for Idx := Low(MatrixU) to High(MatrixU) do
7743         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7744
7745       Vec[0] := -du * Scale;
7746       Vec[1] := -dv * Scale;
7747       Vec[2] := 1;
7748     end;
7749
7750     // Normalize
7751     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7752     if Len <> 0 then begin
7753       Vec[0] := Vec[0] * Len;
7754       Vec[1] := Vec[1] * Len;
7755       Vec[2] := Vec[2] * Len;
7756     end;
7757
7758     // Farbe zuweisem
7759     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7760     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7761     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7762   end;
7763 end;
7764
7765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7766 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7767 var
7768   Rec: TglBitmapToNormalMapRec;
7769
7770   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7771   begin
7772     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7773       Matrix[Index].X := X;
7774       Matrix[Index].Y := Y;
7775       Matrix[Index].W := W;
7776     end;
7777   end;
7778
7779 begin
7780   if TFormatDescriptor.Get(Format).IsCompressed then
7781     raise EglBitmapUnsupportedFormat.Create(Format);
7782
7783   if aScale > 100 then
7784     Rec.Scale := 100
7785   else if aScale < -100 then
7786     Rec.Scale := -100
7787   else
7788     Rec.Scale := aScale;
7789
7790   SetLength(Rec.Heights, Width * Height);
7791   try
7792     case aFunc of
7793       nm4Samples: begin
7794         SetLength(Rec.MatrixU, 2);
7795         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7796         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7797
7798         SetLength(Rec.MatrixV, 2);
7799         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7800         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7801       end;
7802
7803       nmSobel: begin
7804         SetLength(Rec.MatrixU, 6);
7805         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7806         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7807         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7808         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7809         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7810         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7811
7812         SetLength(Rec.MatrixV, 6);
7813         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7814         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7815         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7816         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7817         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7818         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7819       end;
7820
7821       nm3x3: begin
7822         SetLength(Rec.MatrixU, 6);
7823         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7824         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7825         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7826         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7827         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7828         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7829
7830         SetLength(Rec.MatrixV, 6);
7831         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7832         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7833         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7834         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7835         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7836         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7837       end;
7838
7839       nm5x5: begin
7840         SetLength(Rec.MatrixU, 20);
7841         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7842         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7843         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7844         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7845         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7846         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7847         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7848         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7849         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7850         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7851         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7852         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7853         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7854         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7855         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7856         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7857         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7858         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7859         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7860         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7861
7862         SetLength(Rec.MatrixV, 20);
7863         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7864         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7865         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7866         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7867         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7868         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7869         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7870         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7871         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7872         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7873         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7874         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7875         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7876         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7877         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7878         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7879         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7880         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7881         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7882         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7883       end;
7884     end;
7885
7886     // Daten Sammeln
7887     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7888       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7889     else
7890       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7891     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7892   finally
7893     SetLength(Rec.Heights, 0);
7894   end;
7895 end;
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905 (*
7906 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7907 var
7908   pTemp: pByte;
7909   Size: Integer;
7910 begin
7911   if Height > 1 then begin
7912     // extract first line of the data
7913     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7914     GetMem(pTemp, Size);
7915
7916     Move(Data^, pTemp^, Size);
7917
7918     FreeMem(Data);
7919   end else
7920     pTemp := Data;
7921
7922   // set data pointer
7923   inherited SetDataPointer(pTemp, Format, Width);
7924
7925   if FormatIsUncompressed(Format) then begin
7926     fUnmapFunc := FormatGetUnMapFunc(Format);
7927     fGetPixelFunc := GetPixel1DUnmap;
7928   end;
7929 end;
7930
7931
7932 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7933 var
7934   pTemp: pByte;
7935 begin
7936   pTemp := Data;
7937   Inc(pTemp, Pos.X * fPixelSize);
7938
7939   fUnmapFunc(pTemp, Pixel);
7940 end;
7941
7942
7943 function TglBitmap1D.FlipHorz: Boolean;
7944 var
7945   Col: Integer;
7946   pTempDest, pDest, pSource: pByte;
7947 begin
7948   result := inherited FlipHorz;
7949
7950   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7951     pSource := Data;
7952
7953     GetMem(pDest, fRowSize);
7954     try
7955       pTempDest := pDest;
7956
7957       Inc(pTempDest, fRowSize);
7958       for Col := 0 to Width -1 do begin
7959         Move(pSource^, pTempDest^, fPixelSize);
7960
7961         Inc(pSource, fPixelSize);
7962         Dec(pTempDest, fPixelSize);
7963       end;
7964
7965       SetDataPointer(pDest, InternalFormat);
7966
7967       result := true;
7968     finally
7969       FreeMem(pDest);
7970     end;
7971   end;
7972 end;
7973
7974
7975 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7976 begin
7977   // Upload data
7978   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7979     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7980   else
7981
7982   // Upload data
7983   if BuildWithGlu then
7984     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7985   else
7986     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7987
7988   // Freigeben
7989   if (FreeDataAfterGenTexture) then
7990     FreeData;
7991 end;
7992
7993
7994 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7995 var
7996   BuildWithGlu, TexRec: Boolean;
7997   glFormat, glInternalFormat, glType: Cardinal;
7998   TexSize: Integer;
7999 begin
8000   if Assigned(Data) then begin
8001     // Check Texture Size
8002     if (TestTextureSize) then begin
8003       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8004
8005       if (Width > TexSize) then
8006         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8007
8008       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8009                 (Target = GL_TEXTURE_RECTANGLE_ARB);
8010
8011       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8012         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8013     end;
8014
8015     CreateId;
8016
8017     SetupParameters(BuildWithGlu);
8018     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8019
8020     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8021
8022     // Infos sammeln
8023     glAreTexturesResident(1, @fID, @fIsResident);
8024   end;
8025 end;
8026
8027
8028 procedure TglBitmap1D.AfterConstruction;
8029 begin
8030   inherited;
8031
8032   Target := GL_TEXTURE_1D;
8033 end;
8034
8035
8036 { TglBitmapCubeMap }
8037
8038 procedure TglBitmapCubeMap.AfterConstruction;
8039 begin
8040   inherited;
8041
8042   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8043     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8044
8045   SetWrap; // set all to GL_CLAMP_TO_EDGE
8046   Target := GL_TEXTURE_CUBE_MAP;
8047   fGenMode := GL_REFLECTION_MAP;
8048 end;
8049
8050
8051 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8052 begin
8053   inherited Bind (EnableTextureUnit);
8054
8055   if EnableTexCoordsGen then begin
8056     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8057     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8058     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8059     glEnable(GL_TEXTURE_GEN_S);
8060     glEnable(GL_TEXTURE_GEN_T);
8061     glEnable(GL_TEXTURE_GEN_R);
8062   end;
8063 end;
8064
8065
8066 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8067 var
8068   glFormat, glInternalFormat, glType: Cardinal;
8069   BuildWithGlu: Boolean;
8070   TexSize: Integer;
8071 begin
8072   // Check Texture Size
8073   if (TestTextureSize) then begin
8074     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8075
8076     if ((Height > TexSize) or (Width > TexSize)) then
8077       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8078
8079     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8080       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8081   end;
8082
8083   // create Texture
8084   if ID = 0 then begin
8085     CreateID;
8086     SetupParameters(BuildWithGlu);
8087   end;
8088
8089   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8090
8091   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8092 end;
8093
8094
8095 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8096 begin
8097   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8098 end;
8099
8100
8101 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8102   DisableTextureUnit: Boolean);
8103 begin
8104   inherited Unbind (DisableTextureUnit);
8105
8106   if DisableTexCoordsGen then begin
8107     glDisable(GL_TEXTURE_GEN_S);
8108     glDisable(GL_TEXTURE_GEN_T);
8109     glDisable(GL_TEXTURE_GEN_R);
8110   end;
8111 end;
8112
8113
8114 { TglBitmapNormalMap }
8115
8116 type
8117   TVec = Array[0..2] of Single;
8118   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8119
8120   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8121   TglBitmapNormalMapRec = record
8122     HalfSize : Integer;
8123     Func: TglBitmapNormalMapGetVectorFunc;
8124   end;
8125
8126
8127 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8128 begin
8129   Vec[0] := HalfSize;
8130   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8131   Vec[2] := - (Position.X + 0.5 - HalfSize);
8132 end;
8133
8134
8135 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8136 begin
8137   Vec[0] := - HalfSize;
8138   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8139   Vec[2] := Position.X + 0.5 - HalfSize;
8140 end;
8141
8142
8143 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8144 begin
8145   Vec[0] := Position.X + 0.5 - HalfSize;
8146   Vec[1] := HalfSize;
8147   Vec[2] := Position.Y + 0.5 - HalfSize;
8148 end;
8149
8150
8151 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8152 begin
8153   Vec[0] := Position.X + 0.5 - HalfSize;
8154   Vec[1] := - HalfSize;
8155   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8156 end;
8157
8158
8159 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8160 begin
8161   Vec[0] := Position.X + 0.5 - HalfSize;
8162   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8163   Vec[2] := HalfSize;
8164 end;
8165
8166
8167 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8168 begin
8169   Vec[0] := - (Position.X + 0.5 - HalfSize);
8170   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8171   Vec[2] := - HalfSize;
8172 end;
8173
8174
8175 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8176 var
8177   Vec : TVec;
8178   Len: Single;
8179 begin
8180   with FuncRec do begin
8181     with PglBitmapNormalMapRec (CustomData)^ do begin
8182       Func(Vec, Position, HalfSize);
8183
8184       // Normalize
8185       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8186       if Len <> 0 then begin
8187         Vec[0] := Vec[0] * Len;
8188         Vec[1] := Vec[1] * Len;
8189         Vec[2] := Vec[2] * Len;
8190       end;
8191
8192       // Scale Vector and AddVectro
8193       Vec[0] := Vec[0] * 0.5 + 0.5;
8194       Vec[1] := Vec[1] * 0.5 + 0.5;
8195       Vec[2] := Vec[2] * 0.5 + 0.5;
8196     end;
8197
8198     // Set Color
8199     Dest.Red   := Round(Vec[0] * 255);
8200     Dest.Green := Round(Vec[1] * 255);
8201     Dest.Blue  := Round(Vec[2] * 255);
8202   end;
8203 end;
8204
8205
8206 procedure TglBitmapNormalMap.AfterConstruction;
8207 begin
8208   inherited;
8209
8210   fGenMode := GL_NORMAL_MAP;
8211 end;
8212
8213
8214 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8215   TestTextureSize: Boolean);
8216 var
8217   Rec: TglBitmapNormalMapRec;
8218   SizeRec: TglBitmapPixelPosition;
8219 begin
8220   Rec.HalfSize := Size div 2;
8221
8222   FreeDataAfterGenTexture := false;
8223
8224   SizeRec.Fields := [ffX, ffY];
8225   SizeRec.X := Size;
8226   SizeRec.Y := Size;
8227
8228   // Positive X
8229   Rec.Func := glBitmapNormalMapPosX;
8230   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8231   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8232
8233   // Negative X
8234   Rec.Func := glBitmapNormalMapNegX;
8235   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8236   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8237
8238   // Positive Y
8239   Rec.Func := glBitmapNormalMapPosY;
8240   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8241   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8242
8243   // Negative Y
8244   Rec.Func := glBitmapNormalMapNegY;
8245   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8246   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8247
8248   // Positive Z
8249   Rec.Func := glBitmapNormalMapPosZ;
8250   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8251   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8252
8253   // Negative Z
8254   Rec.Func := glBitmapNormalMapNegZ;
8255   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8256   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8257 end;
8258 *)
8259
8260 initialization
8261   glBitmapSetDefaultFormat(tfEmpty);
8262   glBitmapSetDefaultMipmap(mmMipmap);
8263   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8264   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8265
8266   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8267   glBitmapSetDefaultDeleteTextureOnFree    (true);
8268
8269   TFormatDescriptor.Init;
8270
8271 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8272   OpenGLInitialized := false;
8273   InitOpenGLCS := TCriticalSection.Create;
8274 {$ENDIF}
8275
8276 finalization
8277   TFormatDescriptor.Finalize;
8278
8279 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8280   FreeAndNil(InitOpenGLCS);
8281 {$ENDIF}
8282
8283 end.
8284