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 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 2.0.3
  15 ------------------------------------------------------------
  16 History
  17 21-03-2010
  18 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19   then it's your problem if that isn't true. This prevents the unit for incompatibility
  20   with newer versions of Delphi.
  21 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23 10-08-2008
  24 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25 - Additional Datapointer for functioninterface now has the name CustomData
  26 24-07-2008
  27 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28 - If you load an texture from an file the property Filename will be set to the name of the file
  29 - Three new properties to attach custom data to the Texture objects
  30   - CustomName  (free for use string)
  31   - CustomNameW (free for use widestring)
  32   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33 27-05-2008
  34 - RLE TGAs loaded much faster
  35 26-05-2008
  36 - fixed some problem with reading RLE TGAs.
  37 21-05-2008
  38 - function clone now only copys data if it's assigned and now it also copies the ID
  39 - it seems that lazarus dont like comments in comments.
  40 01-05-2008
  41 - It's possible to set the id of the texture
  42 - define GLB_NO_NATIVE_GL deactivated by default
  43 27-04-2008
  44 - Now supports the following libraries
  45   - SDL and SDL_image
  46   - libPNG
  47   - libJPEG
  48 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49 - BMPs now loaded manuel
  50 - Large restructuring
  51 - Property DataPtr now has the name Data
  52 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53 - Unused Depth removed
  54 - Function FreeData to freeing image data added
  55 24-10-2007
  56 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57 15-11-2006
  58 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60 - Function ReadOpenGLExtension is now only intern
  61 29-06-2006
  62 - pngimage now disabled by default like all other versions.
  63 26-06-2006
  64 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65 22-06-2006
  66 - Fixed some Problem with Delphi 5
  67 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68 22-03-2006
  69 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70 09-03-2006
  71 - Internal Format ifDepth8 added
  72 - function GrabScreen now supports all uncompressed formats
  73 31-01-2006
  74 - AddAlphaFromglBitmap implemented
  75 29-12-2005
  76 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77 28-12-2005
  78 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79   property Width, Height, Depth are still existing and new property Dimension are avail
  80 11-12-2005
  81 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82 19-10-2005
  83 - Added function GrabScreen to class TglBitmap2D
  84 18-10-2005
  85 - Added support to Save images
  86 - Added function Clone to Clone Instance
  87 11-10-2005
  88 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89   Usefull for Future
  90 - Several speed optimizations
  91 09-10-2005
  92 - Internal structure change. Loading of TGA, PNG and DDS improved.
  93   Data, format and size will now set directly with SetDataPtr.
  94 - AddFunc now works with all Types of Images and Formats
  95 - Some Funtions moved to Baseclass TglBitmap
  96 06-10-2005
  97 - Added Support to decompress DXT3 and DXT5 compressed Images.
  98 - Added Mapping to convert data from one format into an other.
  99 05-10-2005
 100 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 101   supported Input format (supported by GetPixel) into any uncompresed Format
 102 - Added Support to decompress DXT1 compressed Images.
 103 - SwapColors replaced by ConvertTo
 104 04-10-2005
 105 - Added Support for compressed DDSs
 106 - Added new internal formats (DXT1, DXT3, DXT5)
 107 29-09-2005
 108 - Parameter Components renamed to InternalFormat
 109 23-09-2005
 110 - Some AllocMem replaced with GetMem (little speed change)
 111 - better exception handling. Better protection from memory leaks.
 112 22-09-2005
 113 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 114 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 115 07-09-2005
 116 - Added support for Grayscale textures
 117 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 118 10-07-2005
 119 - Added support for GL_VERSION_2_0
 120 - Added support for GL_EXT_texture_filter_anisotropic
 121 04-07-2005
 122 - Function FillWithColor fills the Image with one Color
 123 - Function LoadNormalMap added
 124 30-06-2005
 125 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 126 - ToNormalMap now supports Sobel (nmSobel) function.
 127 29-06-2005
 128 - support for RLE Compressed RGB TGAs added
 129 28-06-2005
 130 - Class TglBitmapNormalMap added to support Normalmap generation
 131 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 132   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 133 16-06-2005
 134 - Method LoadCubeMapClass removed
 135 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 136 - virtual abstract method GenTexture in class TglBitmap now is protected
 137 12-06-2005
 138 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 139 10-06-2005
 140 - little enhancement for IsPowerOfTwo
 141 - TglBitmap1D.GenTexture now tests NPOT Textures
 142 06-06-2005
 143 - some little name changes. All properties or function with Texture in name are
 144   now without texture in name. We have allways texture so we dosn't name it.
 145 03-06-2005
 146 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 147   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 148 02-06-2005
 149 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 150 25-04-2005
 151 - Function Unbind added
 152 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 153 21-04-2005
 154 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 155 29-03-2005
 156 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 157   To Enable png's use the define pngimage
 158 22-03-2005
 159 - New Functioninterface added
 160 - Function GetPixel added
 161 27-11-2004
 162 - Property BuildMipMaps renamed to MipMap
 163 21-11-2004
 164 - property Name removed.
 165 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 166 22-05-2004
 167 - property name added. Only used in glForms!
 168 26-11-2003
 169 - property FreeDataAfterGenTexture is now available as default (default = true)
 170 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 171 - function MoveMemory replaced with function Move (little speed change)
 172 - several calculations stored in variables (little speed change)
 173 29-09-2003
 174 - property BuildMipsMaps added (default = true)
 175   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 176 - property FreeDataAfterGenTexture added (default = true)
 177   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 178 - parameter DisableOtherTextureUnits of Bind removed
 179 - parameter FreeDataAfterGeneration of GenTextures removed
 180 12-09-2003
 181 - TglBitmap dosn't delete data if class was destroyed (fixed)
 182 09-09-2003
 183 - Bind now enables TextureUnits (by params)
 184 - GenTextures can leave data (by param)
 185 - LoadTextures now optimal
 186 03-09-2003
 187 - Performance optimization in AddFunc
 188 - procedure Bind moved to subclasses
 189 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 190 19-08-2003
 191 - Texturefilter and texturewrap now also as defaults
 192   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 193   Magfilter = GL_LINEAR
 194   Wrap(str) = GL_CLAMP_TO_EDGE
 195 - Added new format tfCompressed to create a compressed texture.
 196 - propertys IsCompressed, TextureSize and IsResident added
 197   IsCompressed and TextureSize only contains data from level 0
 198 18-08-2003
 199 - Added function AddFunc to add PerPixelEffects to Image
 200 - LoadFromFunc now based on AddFunc
 201 - Invert now based on AddFunc
 202 - SwapColors now based on AddFunc
 203 16-08-2003
 204 - Added function FlipHorz
 205 15-08-2003
 206 - Added function LaodFromFunc to create images with function
 207 - Added function FlipVert
 208 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 209 29-07-2003
 210 - Added Alphafunctions to calculate alpha per function
 211 - Added Alpha from ColorKey using alphafunctions
 212 28-07-2003
 213 - First full functionally Version of glBitmap
 214 - Support for 24Bit and 32Bit TGA Pictures added
 215 25-07-2003
 216 - begin of programming
 217 ***********************************************************}
 218 unit glBitmap;
 219
 220 // Please uncomment the defines below to configure the glBitmap to your preferences.
 221 // If you have configured the unit you can uncomment the warning above.
 222 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 223
 224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 225 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // activate to enable build-in OpenGL support with statically linked methods
 228 // use dglOpenGL.pas if not enabled
 229 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 230
 231 // activate to enable build-in OpenGL support with dynamically linked methods
 232 // use dglOpenGL.pas if not enabled
 233 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 234
 235
 236 // activate to enable the support for SDL_surfaces
 237 {.$DEFINE GLB_SDL}
 238
 239 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 240 {.$DEFINE GLB_DELPHI}
 241
 242 // activate to enable the support for TLazIntfImage from Lazarus
 243 {$DEFINE GLB_LAZARUS}
 244
 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   {$IFDEF GLB_PNGIMAGE}         pngimage,                 {$ENDIF}
 388   {$IFDEF GLB_LIB_PNG}          libPNG,                   {$ENDIF}
 389   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                     {$ENDIF}
 390   {$IFDEF GLB_LIB_JPEG}         libJPEG,                  {$ENDIF}
 391
 392   Classes, SysUtils;
 393
 394 {$IFDEF GLB_NATIVE_OGL}
 395 const
 396   GL_TRUE   = 1;
 397   GL_FALSE  = 0;
 398
 399   GL_ZERO = 0;
 400   GL_ONE  = 1;
 401
 402   GL_VERSION    = $1F02;
 403   GL_EXTENSIONS = $1F03;
 404
 405   GL_TEXTURE_1D         = $0DE0;
 406   GL_TEXTURE_2D         = $0DE1;
 407   GL_TEXTURE_RECTANGLE  = $84F5;
 408
 409   GL_NORMAL_MAP                   = $8511;
 410   GL_TEXTURE_CUBE_MAP             = $8513;
 411   GL_REFLECTION_MAP               = $8512;
 412   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 413   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 414   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 415   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 416   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 417   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 418
 419   GL_TEXTURE_WIDTH            = $1000;
 420   GL_TEXTURE_HEIGHT           = $1001;
 421   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 422   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 423
 424   GL_S = $2000;
 425   GL_T = $2001;
 426   GL_R = $2002;
 427   GL_Q = $2003;
 428
 429   GL_TEXTURE_GEN_S = $0C60;
 430   GL_TEXTURE_GEN_T = $0C61;
 431   GL_TEXTURE_GEN_R = $0C62;
 432   GL_TEXTURE_GEN_Q = $0C63;
 433
 434   GL_RED    = $1903;
 435   GL_GREEN  = $1904;
 436   GL_BLUE   = $1905;
 437
 438   GL_ALPHA    = $1906;
 439   GL_ALPHA4   = $803B;
 440   GL_ALPHA8   = $803C;
 441   GL_ALPHA12  = $803D;
 442   GL_ALPHA16  = $803E;
 443
 444   GL_LUMINANCE    = $1909;
 445   GL_LUMINANCE4   = $803F;
 446   GL_LUMINANCE8   = $8040;
 447   GL_LUMINANCE12  = $8041;
 448   GL_LUMINANCE16  = $8042;
 449
 450   GL_LUMINANCE_ALPHA      = $190A;
 451   GL_LUMINANCE4_ALPHA4    = $8043;
 452   GL_LUMINANCE6_ALPHA2    = $8044;
 453   GL_LUMINANCE8_ALPHA8    = $8045;
 454   GL_LUMINANCE12_ALPHA4   = $8046;
 455   GL_LUMINANCE12_ALPHA12  = $8047;
 456   GL_LUMINANCE16_ALPHA16  = $8048;
 457
 458   GL_RGB      = $1907;
 459   GL_BGR      = $80E0;
 460   GL_R3_G3_B2 = $2A10;
 461   GL_RGB4     = $804F;
 462   GL_RGB5     = $8050;
 463   GL_RGB565   = $8D62;
 464   GL_RGB8     = $8051;
 465   GL_RGB10    = $8052;
 466   GL_RGB12    = $8053;
 467   GL_RGB16    = $8054;
 468
 469   GL_RGBA     = $1908;
 470   GL_BGRA     = $80E1;
 471   GL_RGBA2    = $8055;
 472   GL_RGBA4    = $8056;
 473   GL_RGB5_A1  = $8057;
 474   GL_RGBA8    = $8058;
 475   GL_RGB10_A2 = $8059;
 476   GL_RGBA12   = $805A;
 477   GL_RGBA16   = $805B;
 478
 479   GL_DEPTH_COMPONENT    = $1902;
 480   GL_DEPTH_COMPONENT16  = $81A5;
 481   GL_DEPTH_COMPONENT24  = $81A6;
 482   GL_DEPTH_COMPONENT32  = $81A7;
 483
 484   GL_COMPRESSED_RGB                 = $84ED;
 485   GL_COMPRESSED_RGBA                = $84EE;
 486   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 487   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 488   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 489   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 490
 491   GL_UNSIGNED_BYTE            = $1401;
 492   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 493   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 494
 495   GL_UNSIGNED_SHORT             = $1403;
 496   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 497   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 498   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 499   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 500   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 501   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 502
 503   GL_UNSIGNED_INT                 = $1405;
 504   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 505   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 506   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 507   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 508
 509   { Texture Filter }
 510   GL_TEXTURE_MAG_FILTER     = $2800;
 511   GL_TEXTURE_MIN_FILTER     = $2801;
 512   GL_NEAREST                = $2600;
 513   GL_NEAREST_MIPMAP_NEAREST = $2700;
 514   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 515   GL_LINEAR                 = $2601;
 516   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 517   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 518
 519   { Texture Wrap }
 520   GL_TEXTURE_WRAP_S   = $2802;
 521   GL_TEXTURE_WRAP_T   = $2803;
 522   GL_TEXTURE_WRAP_R   = $8072;
 523   GL_CLAMP            = $2900;
 524   GL_REPEAT           = $2901;
 525   GL_CLAMP_TO_EDGE    = $812F;
 526   GL_CLAMP_TO_BORDER  = $812D;
 527   GL_MIRRORED_REPEAT  = $8370;
 528
 529   { Other }
 530   GL_GENERATE_MIPMAP      = $8191;
 531   GL_TEXTURE_BORDER_COLOR = $1004;
 532   GL_MAX_TEXTURE_SIZE     = $0D33;
 533   GL_PACK_ALIGNMENT       = $0D05;
 534   GL_UNPACK_ALIGNMENT     = $0CF5;
 535
 536   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 537   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 538   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 539   GL_TEXTURE_GEN_MODE               = $2500;
 540
 541 {$IF DEFINED(GLB_WIN)}
 542   libglu    = 'glu32.dll';
 543   libopengl = 'opengl32.dll';
 544 {$ELSEIF DEFINED(GLB_LINUX)}
 545   libglu    = 'libGLU.so.1';
 546   libopengl = 'libGL.so.1';
 547 {$IFEND}
 548
 549 type
 550   GLboolean = BYTEBOOL;
 551   GLint     = Integer;
 552   GLsizei   = Integer;
 553   GLuint    = Cardinal;
 554   GLfloat   = Single;
 555   GLenum    = Cardinal;
 556
 557   PGLvoid    = Pointer;
 558   PGLboolean = ^GLboolean;
 559   PGLint     = ^GLint;
 560   PGLuint    = ^GLuint;
 561   PGLfloat   = ^GLfloat;
 562
 563   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 564   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}
 565   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566
 567 {$IF DEFINED(GLB_WIN)}
 568   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 569 {$ELSEIF DEFINED(GLB_LINUX)}
 570   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 571   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 572 {$IFEND}
 573
 574 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 575   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 576   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 577
 578   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 579   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 580
 581   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 582   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 583   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 584   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 585   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 586   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 587   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 588
 589   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 590   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 591   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 592   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 593
 594   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 595   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 596   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 597
 598   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}
 599   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}
 600   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 601
 602   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 603   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 604
 605 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 606   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 607   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 608
 609   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 610   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 611
 612   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 613   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 614   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 615   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 616   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 617   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 618   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 619
 620   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 621   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 622   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 623   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 624
 625   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 626   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;
 627   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 628
 629   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;
 630   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;
 631   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 632
 633   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 634   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 635 {$IFEND}
 636
 637 var
 638   GL_VERSION_1_2,
 639   GL_VERSION_1_3,
 640   GL_VERSION_1_4,
 641   GL_VERSION_2_0,
 642   GL_VERSION_3_3,
 643
 644   GL_SGIS_generate_mipmap,
 645
 646   GL_ARB_texture_border_clamp,
 647   GL_ARB_texture_mirrored_repeat,
 648   GL_ARB_texture_rectangle,
 649   GL_ARB_texture_non_power_of_two,
 650   GL_ARB_texture_swizzle,
 651   GL_ARB_texture_cube_map,
 652
 653   GL_IBM_texture_mirrored_repeat,
 654
 655   GL_NV_texture_rectangle,
 656
 657   GL_EXT_texture_edge_clamp,
 658   GL_EXT_texture_rectangle,
 659   GL_EXT_texture_swizzle,
 660   GL_EXT_texture_cube_map,
 661   GL_EXT_texture_filter_anisotropic: Boolean;
 662
 663   glCompressedTexImage1D: TglCompressedTexImage1D;
 664   glCompressedTexImage2D: TglCompressedTexImage2D;
 665   glGetCompressedTexImage: TglGetCompressedTexImage;
 666
 667 {$IF DEFINED(GLB_WIN)}
 668   wglGetProcAddress: TwglGetProcAddress;
 669 {$ELSEIF DEFINED(GLB_LINUX)}
 670   glXGetProcAddress: TglXGetProcAddress;
 671   glXGetProcAddressARB: TglXGetProcAddress;
 672 {$IFEND}
 673
 674 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 675   glEnable: TglEnable;
 676   glDisable: TglDisable;
 677
 678   glGetString: TglGetString;
 679   glGetIntegerv: TglGetIntegerv;
 680
 681   glTexParameteri: TglTexParameteri;
 682   glTexParameteriv: TglTexParameteriv;
 683   glTexParameterfv: TglTexParameterfv;
 684   glGetTexParameteriv: TglGetTexParameteriv;
 685   glGetTexParameterfv: TglGetTexParameterfv;
 686   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 687   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 688
 689   glTexGeni: TglTexGeni;
 690   glGenTextures: TglGenTextures;
 691   glBindTexture: TglBindTexture;
 692   glDeleteTextures: TglDeleteTextures;
 693
 694   glAreTexturesResident: TglAreTexturesResident;
 695   glReadPixels: TglReadPixels;
 696   glPixelStorei: TglPixelStorei;
 697
 698   glTexImage1D: TglTexImage1D;
 699   glTexImage2D: TglTexImage2D;
 700   glGetTexImage: TglGetTexImage;
 701
 702   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 703   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 704 {$ENDIF}
 705 {$ENDIF}
 706
 707 type
 708 ////////////////////////////////////////////////////////////////////////////////////////////////////
 709   TglBitmapFormat = (
 710     tfEmpty = 0, //must be smallest value!
 711
 712     tfAlpha4,
 713     tfAlpha8,
 714     tfAlpha12,
 715     tfAlpha16,
 716
 717     tfLuminance4,
 718     tfLuminance8,
 719     tfLuminance12,
 720     tfLuminance16,
 721
 722     tfLuminance4Alpha4,
 723     tfLuminance6Alpha2,
 724     tfLuminance8Alpha8,
 725     tfLuminance12Alpha4,
 726     tfLuminance12Alpha12,
 727     tfLuminance16Alpha16,
 728
 729     tfR3G3B2,
 730     tfRGB4,
 731     tfR5G6B5,
 732     tfRGB5,
 733     tfRGB8,
 734     tfRGB10,
 735     tfRGB12,
 736     tfRGB16,
 737
 738     tfRGBA2,
 739     tfRGBA4,
 740     tfRGB5A1,
 741     tfRGBA8,
 742     tfRGB10A2,
 743     tfRGBA12,
 744     tfRGBA16,
 745
 746     tfBGR4,
 747     tfB5G6R5,
 748     tfBGR5,
 749     tfBGR8,
 750     tfBGR10,
 751     tfBGR12,
 752     tfBGR16,
 753
 754     tfBGRA2,
 755     tfBGRA4,
 756     tfBGR5A1,
 757     tfBGRA8,
 758     tfBGR10A2,
 759     tfBGRA12,
 760     tfBGRA16,
 761
 762     tfDepth16,
 763     tfDepth24,
 764     tfDepth32,
 765
 766     tfS3tcDtx1RGBA,
 767     tfS3tcDtx3RGBA,
 768     tfS3tcDtx5RGBA
 769   );
 770
 771   TglBitmapFileType = (
 772      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 773      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 774      ftDDS,
 775      ftTGA,
 776      ftBMP);
 777    TglBitmapFileTypes = set of TglBitmapFileType;
 778
 779    TglBitmapMipMap = (
 780      mmNone,
 781      mmMipmap,
 782      mmMipmapGlu);
 783
 784    TglBitmapNormalMapFunc = (
 785      nm4Samples,
 786      nmSobel,
 787      nm3x3,
 788      nm5x5);
 789
 790  ////////////////////////////////////////////////////////////////////////////////////////////////////
 791    EglBitmap                  = class(Exception);
 792    EglBitmapNotSupported      = class(Exception);
 793    EglBitmapSizeToLarge       = class(EglBitmap);
 794    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 795    EglBitmapUnsupportedFormat = class(EglBitmap)
 796      constructor Create(const aFormat: TglBitmapFormat); overload;
 797      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 798    end;
 799
 800 ////////////////////////////////////////////////////////////////////////////////////////////////////
 801   TglBitmapColorRec = packed record
 802   case Integer of
 803     0: (r, g, b, a: Cardinal);
 804     1: (arr: array[0..3] of Cardinal);
 805   end;
 806
 807   TglBitmapPixelData = packed record
 808     Data, Range: TglBitmapColorRec;
 809     Format: TglBitmapFormat;
 810   end;
 811   PglBitmapPixelData = ^TglBitmapPixelData;
 812
 813 ////////////////////////////////////////////////////////////////////////////////////////////////////
 814   TglBitmapPixelPositionFields = set of (ffX, ffY);
 815   TglBitmapPixelPosition = record
 816     Fields : TglBitmapPixelPositionFields;
 817     X : Word;
 818     Y : Word;
 819   end;
 820
 821 ////////////////////////////////////////////////////////////////////////////////////////////////////
 822   TglBitmap = class;
 823   TglBitmapFunctionRec = record
 824     Sender:   TglBitmap;
 825     Size:     TglBitmapPixelPosition;
 826     Position: TglBitmapPixelPosition;
 827     Source:   TglBitmapPixelData;
 828     Dest:     TglBitmapPixelData;
 829     Args:     Pointer;
 830   end;
 831   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 832
 833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 834   TglBitmap = class
 835   protected
 836     fID: GLuint;
 837     fTarget: GLuint;
 838     fAnisotropic: Integer;
 839     fDeleteTextureOnFree: Boolean;
 840     fFreeDataAfterGenTexture: Boolean;
 841     fData: PByte;
 842     fIsResident: Boolean;
 843     fBorderColor: array[0..3] of Single;
 844
 845     fDimension: TglBitmapPixelPosition;
 846     fMipMap: TglBitmapMipMap;
 847     fFormat: TglBitmapFormat;
 848
 849     // Mapping
 850     fPixelSize: Integer;
 851     fRowSize: Integer;
 852
 853     // Filtering
 854     fFilterMin: GLenum;
 855     fFilterMag: GLenum;
 856
 857     // TexturWarp
 858     fWrapS: GLenum;
 859     fWrapT: GLenum;
 860     fWrapR: GLenum;
 861
 862     //Swizzle
 863     fSwizzle: array[0..3] of GLenum;
 864
 865     // CustomData
 866     fFilename: String;
 867     fCustomName: String;
 868     fCustomNameW: WideString;
 869     fCustomData: Pointer;
 870
 871     //Getter
 872     function GetWidth:  Integer; virtual;
 873     function GetHeight: Integer; virtual;
 874
 875     function GetFileWidth:  Integer; virtual;
 876     function GetFileHeight: Integer; virtual;
 877
 878     //Setter
 879     procedure SetCustomData(const aValue: Pointer);
 880     procedure SetCustomName(const aValue: String);
 881     procedure SetCustomNameW(const aValue: WideString);
 882     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 883     procedure SetFormat(const aValue: TglBitmapFormat);
 884     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 885     procedure SetID(const aValue: Cardinal);
 886     procedure SetMipMap(const aValue: TglBitmapMipMap);
 887     procedure SetTarget(const aValue: Cardinal);
 888     procedure SetAnisotropic(const aValue: Integer);
 889
 890     procedure CreateID;
 891     procedure SetupParameters(out aBuildWithGlu: Boolean);
 892     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 893       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 894     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 895
 896     function FlipHorz: Boolean; virtual;
 897     function FlipVert: Boolean; virtual;
 898
 899     property Width:  Integer read GetWidth;
 900     property Height: Integer read GetHeight;
 901
 902     property FileWidth:  Integer read GetFileWidth;
 903     property FileHeight: Integer read GetFileHeight;
 904   public
 905     //Properties
 906     property ID:           Cardinal        read fID          write SetID;
 907     property Target:       Cardinal        read fTarget      write SetTarget;
 908     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 909     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 910     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 911
 912     property Filename:    String     read fFilename;
 913     property CustomName:  String     read fCustomName  write SetCustomName;
 914     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 915     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 916
 917     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 918     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 919
 920     property Dimension:  TglBitmapPixelPosition  read fDimension;
 921     property Data:       PByte                   read fData;
 922     property IsResident: Boolean                 read fIsResident;
 923
 924     procedure AfterConstruction; override;
 925     procedure BeforeDestruction; override;
 926
 927     procedure PrepareResType(var aResource: String; var aResType: PChar);
 928
 929     //Load
 930     procedure LoadFromFile(const aFilename: String);
 931     procedure LoadFromStream(const aStream: TStream); virtual;
 932     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 933       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 934     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 935     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 936
 937     //Save
 938     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 939     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 940
 941     //Convert
 942     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 943     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 944       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 945   public
 946     //Alpha & Co
 947     {$IFDEF GLB_SDL}
 948     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 949     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 950     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 951     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 952       const aArgs: Pointer = nil): Boolean;
 953     {$ENDIF}
 954
 955     {$IFDEF GLB_DELPHI}
 956     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 957     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 958     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 959     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 960       const aArgs: Pointer = nil): Boolean;
 961     {$ENDIF}
 962
 963     {$IFDEF GLB_LAZARUS}
 964     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 965     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 966     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 967     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 968       const aArgs: Pointer = nil): Boolean;
 969     {$ENDIF}
 970
 971     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 972       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 973     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 974       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 975
 976     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 977     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 978     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 979     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 980
 981     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 982     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 983     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 984
 985     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 986     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 987     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 988
 989     function RemoveAlpha: Boolean; virtual;
 990   public
 991     //Common
 992     function Clone: TglBitmap;
 993     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 994     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 995     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 996     procedure FreeData;
 997
 998     //ColorFill
 999     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1000     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1001     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1002
1003     //TexParameters
1004     procedure SetFilter(const aMin, aMag: GLenum);
1005     procedure SetWrap(
1006       const S: GLenum = GL_CLAMP_TO_EDGE;
1007       const T: GLenum = GL_CLAMP_TO_EDGE;
1008       const R: GLenum = GL_CLAMP_TO_EDGE);
1009     procedure SetSwizzle(const r, g, b, a: GLenum);
1010
1011     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1012     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1013
1014     //Constructors
1015     constructor Create; overload;
1016     constructor Create(const aFileName: String); overload;
1017     constructor Create(const aStream: TStream); overload;
1018     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1019     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1020     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1021     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1022   private
1023     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1024     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1025
1026     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1027     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1028
1029     function LoadBMP(const aStream: TStream): Boolean; virtual;
1030     procedure SaveBMP(const aStream: TStream); virtual;
1031
1032     function LoadTGA(const aStream: TStream): Boolean; virtual;
1033     procedure SaveTGA(const aStream: TStream); virtual;
1034
1035     function LoadDDS(const aStream: TStream): Boolean; virtual;
1036     procedure SaveDDS(const aStream: TStream); virtual;
1037   end;
1038
1039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1040   TglBitmap1D = class(TglBitmap)
1041   protected
1042     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1043       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1044     procedure UploadData(const aBuildWithGlu: Boolean);
1045   public
1046     property Width;
1047     procedure AfterConstruction; override;
1048     function FlipHorz: Boolean; override;
1049     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1050   end;
1051
1052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1053   TglBitmap2D = class(TglBitmap)
1054   protected
1055     fLines: array of PByte;
1056     function GetScanline(const aIndex: Integer): Pointer;
1057     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1058       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1059     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1060   public
1061     property Width;
1062     property Height;
1063     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1064
1065     procedure AfterConstruction; override;
1066
1067     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1068     procedure GetDataFromTexture;
1069     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1070
1071     function FlipHorz: Boolean; override;
1072     function FlipVert: Boolean; override;
1073
1074     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1075       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1076   end;
1077
1078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1079   TglBitmapCubeMap = class(TglBitmap2D)
1080   protected
1081     fGenMode: Integer;
1082     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1083   public
1084     procedure AfterConstruction; override;
1085     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1086     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1087     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1088   end;
1089
1090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1091   TglBitmapNormalMap = class(TglBitmapCubeMap)
1092   public
1093     procedure AfterConstruction; override;
1094     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1095   end;
1096
1097 const
1098   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1099
1100 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1101 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1102 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1103 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1104 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1105 procedure glBitmapSetDefaultWrap(
1106   const S: Cardinal = GL_CLAMP_TO_EDGE;
1107   const T: Cardinal = GL_CLAMP_TO_EDGE;
1108   const R: Cardinal = GL_CLAMP_TO_EDGE);
1109
1110 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1111 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1112 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1113 function glBitmapGetDefaultFormat: TglBitmapFormat;
1114 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1115 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1116
1117 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1118 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1119 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1120
1121 var
1122   glBitmapDefaultDeleteTextureOnFree: Boolean;
1123   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1124   glBitmapDefaultFormat: TglBitmapFormat;
1125   glBitmapDefaultMipmap: TglBitmapMipMap;
1126   glBitmapDefaultFilterMin: Cardinal;
1127   glBitmapDefaultFilterMag: Cardinal;
1128   glBitmapDefaultWrapS: Cardinal;
1129   glBitmapDefaultWrapT: Cardinal;
1130   glBitmapDefaultWrapR: Cardinal;
1131   glDefaultSwizzle: array[0..3] of GLenum;
1132
1133 {$IFDEF GLB_DELPHI}
1134 function CreateGrayPalette: HPALETTE;
1135 {$ENDIF}
1136
1137 implementation
1138
1139 uses
1140   Math, syncobjs, typinfo;
1141
1142 type
1143 {$IFNDEF fpc}
1144   QWord   = System.UInt64;
1145   PQWord  = ^QWord;
1146
1147   PtrInt  = Longint;
1148   PtrUInt = DWord;
1149 {$ENDIF}
1150
1151 ////////////////////////////////////////////////////////////////////////////////////////////////////
1152   TShiftRec = packed record
1153   case Integer of
1154     0: (r, g, b, a: Byte);
1155     1: (arr: array[0..3] of Byte);
1156   end;
1157
1158   TFormatDescriptor = class(TObject)
1159   private
1160     function GetRedMask: QWord;
1161     function GetGreenMask: QWord;
1162     function GetBlueMask: QWord;
1163     function GetAlphaMask: QWord;
1164   protected
1165     fFormat: TglBitmapFormat;
1166     fWithAlpha: TglBitmapFormat;
1167     fWithoutAlpha: TglBitmapFormat;
1168     fRGBInverted: TglBitmapFormat;
1169     fUncompressed: TglBitmapFormat;
1170     fPixelSize: Single;
1171     fIsCompressed: Boolean;
1172
1173     fRange: TglBitmapColorRec;
1174     fShift: TShiftRec;
1175
1176     fglFormat:         Cardinal;
1177     fglInternalFormat: Cardinal;
1178     fglDataFormat:     Cardinal;
1179
1180     function GetComponents: Integer; virtual;
1181   public
1182     property Format:       TglBitmapFormat read fFormat;
1183     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1184     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1185     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1186     property Components:   Integer         read GetComponents;
1187     property PixelSize:    Single          read fPixelSize;
1188     property IsCompressed: Boolean         read fIsCompressed;
1189
1190     property glFormat:         Cardinal read fglFormat;
1191     property glInternalFormat: Cardinal read fglInternalFormat;
1192     property glDataFormat:     Cardinal read fglDataFormat;
1193
1194     property Range: TglBitmapColorRec read fRange;
1195     property Shift: TShiftRec         read fShift;
1196
1197     property RedMask:   QWord read GetRedMask;
1198     property GreenMask: QWord read GetGreenMask;
1199     property BlueMask:  QWord read GetBlueMask;
1200     property AlphaMask: QWord read GetAlphaMask;
1201
1202     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1203     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1204
1205     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1206     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1207
1208     function CreateMappingData: Pointer; virtual;
1209     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1210
1211     function IsEmpty:  Boolean; virtual;
1212     function HasAlpha: Boolean; virtual;
1213     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1214
1215     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1216
1217     constructor Create; virtual;
1218   public
1219     class procedure Init;
1220     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1221     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1222     class procedure Clear;
1223     class procedure Finalize;
1224   end;
1225   TFormatDescriptorClass = class of TFormatDescriptor;
1226
1227   TfdEmpty = class(TFormatDescriptor);
1228
1229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1230   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
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   TfdLuminance_UB1 = class(TFormatDescriptor) //1* 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   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
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   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1249     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1250     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1251     constructor Create; override;
1252   end;
1253
1254   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1255     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1256     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1257     constructor Create; override;
1258   end;
1259
1260   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1261     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1262     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1263     constructor Create; override;
1264   end;
1265
1266   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1267     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269     constructor Create; override;
1270   end;
1271
1272   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1273     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275     constructor Create; override;
1276   end;
1277
1278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1279   TfdAlpha_US1 = class(TFormatDescriptor) //1* 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   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdUniversal_US1 = class(TFormatDescriptor) //1* 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   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1304     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1305     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1306     constructor Create; override;
1307   end;
1308
1309   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1310     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1311     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1312     constructor Create; override;
1313   end;
1314
1315   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1316     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318     constructor Create; override;
1319   end;
1320
1321   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330     constructor Create; override;
1331   end;
1332
1333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1334   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1335     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1336     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1337     constructor Create; override;
1338   end;
1339
1340   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1341     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1342     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1343     constructor Create; override;
1344   end;
1345
1346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1347   TfdAlpha4 = class(TfdAlpha_UB1)
1348     constructor Create; override;
1349   end;
1350
1351   TfdAlpha8 = class(TfdAlpha_UB1)
1352     constructor Create; override;
1353   end;
1354
1355   TfdAlpha12 = class(TfdAlpha_US1)
1356     constructor Create; override;
1357   end;
1358
1359   TfdAlpha16 = class(TfdAlpha_US1)
1360     constructor Create; override;
1361   end;
1362
1363   TfdLuminance4 = class(TfdLuminance_UB1)
1364     constructor Create; override;
1365   end;
1366
1367   TfdLuminance8 = class(TfdLuminance_UB1)
1368     constructor Create; override;
1369   end;
1370
1371   TfdLuminance12 = class(TfdLuminance_US1)
1372     constructor Create; override;
1373   end;
1374
1375   TfdLuminance16 = class(TfdLuminance_US1)
1376     constructor Create; override;
1377   end;
1378
1379   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1380     constructor Create; override;
1381   end;
1382
1383   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1384     constructor Create; override;
1385   end;
1386
1387   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1388     constructor Create; override;
1389   end;
1390
1391   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1392     constructor Create; override;
1393   end;
1394
1395   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1396     constructor Create; override;
1397   end;
1398
1399   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1400     constructor Create; override;
1401   end;
1402
1403   TfdR3G3B2 = class(TfdUniversal_UB1)
1404     constructor Create; override;
1405   end;
1406
1407   TfdRGB4 = class(TfdUniversal_US1)
1408     constructor Create; override;
1409   end;
1410
1411   TfdR5G6B5 = class(TfdUniversal_US1)
1412     constructor Create; override;
1413   end;
1414
1415   TfdRGB5 = class(TfdUniversal_US1)
1416     constructor Create; override;
1417   end;
1418
1419   TfdRGB8 = class(TfdRGB_UB3)
1420     constructor Create; override;
1421   end;
1422
1423   TfdRGB10 = class(TfdUniversal_UI1)
1424     constructor Create; override;
1425   end;
1426
1427   TfdRGB12 = class(TfdRGB_US3)
1428     constructor Create; override;
1429   end;
1430
1431   TfdRGB16 = class(TfdRGB_US3)
1432     constructor Create; override;
1433   end;
1434
1435   TfdRGBA2 = class(TfdRGBA_UB4)
1436     constructor Create; override;
1437   end;
1438
1439   TfdRGBA4 = class(TfdUniversal_US1)
1440     constructor Create; override;
1441   end;
1442
1443   TfdRGB5A1 = class(TfdUniversal_US1)
1444     constructor Create; override;
1445   end;
1446
1447   TfdRGBA8 = class(TfdRGBA_UB4)
1448     constructor Create; override;
1449   end;
1450
1451   TfdRGB10A2 = class(TfdUniversal_UI1)
1452     constructor Create; override;
1453   end;
1454
1455   TfdRGBA12 = class(TfdRGBA_US4)
1456     constructor Create; override;
1457   end;
1458
1459   TfdRGBA16 = class(TfdRGBA_US4)
1460     constructor Create; override;
1461   end;
1462
1463   TfdBGR4 = class(TfdUniversal_US1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdB5G6R5 = class(TfdUniversal_US1)
1468     constructor Create; override;
1469   end;
1470
1471   TfdBGR5 = class(TfdUniversal_US1)
1472     constructor Create; override;
1473   end;
1474
1475   TfdBGR8 = class(TfdBGR_UB3)
1476     constructor Create; override;
1477   end;
1478
1479   TfdBGR10 = class(TfdUniversal_UI1)
1480     constructor Create; override;
1481   end;
1482
1483   TfdBGR12 = class(TfdBGR_US3)
1484     constructor Create; override;
1485   end;
1486
1487   TfdBGR16 = class(TfdBGR_US3)
1488     constructor Create; override;
1489   end;
1490
1491   TfdBGRA2 = class(TfdBGRA_UB4)
1492     constructor Create; override;
1493   end;
1494
1495   TfdBGRA4 = class(TfdUniversal_US1)
1496     constructor Create; override;
1497   end;
1498
1499   TfdBGR5A1 = class(TfdUniversal_US1)
1500     constructor Create; override;
1501   end;
1502
1503   TfdBGRA8 = class(TfdBGRA_UB4)
1504     constructor Create; override;
1505   end;
1506
1507   TfdBGR10A2 = class(TfdUniversal_UI1)
1508     constructor Create; override;
1509   end;
1510
1511   TfdBGRA12 = class(TfdBGRA_US4)
1512     constructor Create; override;
1513   end;
1514
1515   TfdBGRA16 = class(TfdBGRA_US4)
1516     constructor Create; override;
1517   end;
1518
1519   TfdDepth16 = class(TfdDepth_US1)
1520     constructor Create; override;
1521   end;
1522
1523   TfdDepth24 = class(TfdDepth_UI1)
1524     constructor Create; override;
1525   end;
1526
1527   TfdDepth32 = class(TfdDepth_UI1)
1528     constructor Create; override;
1529   end;
1530
1531   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1532     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1533     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1534     constructor Create; override;
1535   end;
1536
1537   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1538     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1539     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1540     constructor Create; override;
1541   end;
1542
1543   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1544     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1545     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1546     constructor Create; override;
1547   end;
1548
1549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1550   TbmpBitfieldFormat = class(TFormatDescriptor)
1551   private
1552     procedure SetRedMask  (const aValue: QWord);
1553     procedure SetGreenMask(const aValue: QWord);
1554     procedure SetBlueMask (const aValue: QWord);
1555     procedure SetAlphaMask(const aValue: QWord);
1556
1557     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1558   public
1559     property RedMask:   QWord read GetRedMask   write SetRedMask;
1560     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1561     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1562     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1563
1564     property PixelSize: Single read fPixelSize write fPixelSize;
1565
1566     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1567     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1568   end;
1569
1570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1571   TbmpColorTableEnty = packed record
1572     b, g, r, a: Byte;
1573   end;
1574   TbmpColorTable = array of TbmpColorTableEnty;
1575   TbmpColorTableFormat = class(TFormatDescriptor)
1576   private
1577     fColorTable: TbmpColorTable;
1578   public
1579     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1580     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1581     property Range:      TglBitmapColorRec read fRange      write fRange;
1582     property Shift:      TShiftRec         read fShift      write fShift;
1583     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1584
1585     procedure CreateColorTable;
1586
1587     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1588     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1589     destructor Destroy; override;
1590   end;
1591
1592 const
1593   LUMINANCE_WEIGHT_R = 0.30;
1594   LUMINANCE_WEIGHT_G = 0.59;
1595   LUMINANCE_WEIGHT_B = 0.11;
1596
1597   ALPHA_WEIGHT_R = 0.30;
1598   ALPHA_WEIGHT_G = 0.59;
1599   ALPHA_WEIGHT_B = 0.11;
1600
1601   DEPTH_WEIGHT_R = 0.333333333;
1602   DEPTH_WEIGHT_G = 0.333333333;
1603   DEPTH_WEIGHT_B = 0.333333333;
1604
1605   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1606
1607   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1608     TfdEmpty,
1609
1610     TfdAlpha4,
1611     TfdAlpha8,
1612     TfdAlpha12,
1613     TfdAlpha16,
1614
1615     TfdLuminance4,
1616     TfdLuminance8,
1617     TfdLuminance12,
1618     TfdLuminance16,
1619
1620     TfdLuminance4Alpha4,
1621     TfdLuminance6Alpha2,
1622     TfdLuminance8Alpha8,
1623     TfdLuminance12Alpha4,
1624     TfdLuminance12Alpha12,
1625     TfdLuminance16Alpha16,
1626
1627     TfdR3G3B2,
1628     TfdRGB4,
1629     TfdR5G6B5,
1630     TfdRGB5,
1631     TfdRGB8,
1632     TfdRGB10,
1633     TfdRGB12,
1634     TfdRGB16,
1635
1636     TfdRGBA2,
1637     TfdRGBA4,
1638     TfdRGB5A1,
1639     TfdRGBA8,
1640     TfdRGB10A2,
1641     TfdRGBA12,
1642     TfdRGBA16,
1643
1644     TfdBGR4,
1645     TfdB5G6R5,
1646     TfdBGR5,
1647     TfdBGR8,
1648     TfdBGR10,
1649     TfdBGR12,
1650     TfdBGR16,
1651
1652     TfdBGRA2,
1653     TfdBGRA4,
1654     TfdBGR5A1,
1655     TfdBGRA8,
1656     TfdBGR10A2,
1657     TfdBGRA12,
1658     TfdBGRA16,
1659
1660     TfdDepth16,
1661     TfdDepth24,
1662     TfdDepth32,
1663
1664     TfdS3tcDtx1RGBA,
1665     TfdS3tcDtx3RGBA,
1666     TfdS3tcDtx5RGBA
1667   );
1668
1669 var
1670   FormatDescriptorCS: TCriticalSection;
1671   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1672
1673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1674 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1675 begin
1676   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1677 end;
1678
1679 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1680 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1681 begin
1682   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1683 end;
1684
1685 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1686 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1687 begin
1688   result.Fields := [];
1689
1690   if X >= 0 then
1691     result.Fields := result.Fields + [ffX];
1692   if Y >= 0 then
1693     result.Fields := result.Fields + [ffY];
1694
1695   result.X := Max(0, X);
1696   result.Y := Max(0, Y);
1697 end;
1698
1699 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1700 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1701 begin
1702   result.r := r;
1703   result.g := g;
1704   result.b := b;
1705   result.a := a;
1706 end;
1707
1708 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1709 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1710 var
1711   i: Integer;
1712 begin
1713   result := false;
1714   for i := 0 to high(r1.arr) do
1715     if (r1.arr[i] <> r2.arr[i]) then
1716       exit;
1717   result := true;
1718 end;
1719
1720 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1721 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1722 begin
1723   result.r := r;
1724   result.g := g;
1725   result.b := b;
1726   result.a := a;
1727 end;
1728
1729 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1730 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1731 begin
1732   result := [];
1733
1734   if (aFormat in [
1735         //4 bbp
1736         tfLuminance4,
1737
1738         //8bpp
1739         tfR3G3B2, tfLuminance8,
1740
1741         //16bpp
1742         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1743         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1744
1745         //24bpp
1746         tfBGR8, tfRGB8,
1747
1748         //32bpp
1749         tfRGB10, tfRGB10A2, tfRGBA8,
1750         tfBGR10, tfBGR10A2, tfBGRA8]) then
1751     result := result + [ftBMP];
1752
1753   if (aFormat in [
1754         //8 bpp
1755         tfLuminance8, tfAlpha8,
1756
1757         //16 bpp
1758         tfLuminance16, tfLuminance8Alpha8,
1759         tfRGB5, tfRGB5A1, tfRGBA4,
1760         tfBGR5, tfBGR5A1, tfBGRA4,
1761
1762         //24 bpp
1763         tfRGB8, tfBGR8,
1764
1765         //32 bpp
1766         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1767     result := result + [ftTGA];
1768
1769   if (aFormat in [
1770         //8 bpp
1771         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1772         tfR3G3B2, tfRGBA2, tfBGRA2,
1773
1774         //16 bpp
1775         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1776         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1777         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1778
1779         //24 bpp
1780         tfRGB8, tfBGR8,
1781
1782         //32 bbp
1783         tfLuminance16Alpha16,
1784         tfRGBA8, tfRGB10A2,
1785         tfBGRA8, tfBGR10A2,
1786
1787         //compressed
1788         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1789     result := result + [ftDDS];
1790
1791   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1792   if aFormat in [
1793       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1794       tfRGB8, tfRGBA8,
1795       tfBGR8, tfBGRA8] then
1796     result := result + [ftPNG];
1797   {$ENDIF}
1798
1799   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1800   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1801     result := result + [ftJPEG];
1802   {$ENDIF}
1803 end;
1804
1805 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1806 function IsPowerOfTwo(aNumber: Integer): Boolean;
1807 begin
1808   while (aNumber and 1) = 0 do
1809     aNumber := aNumber shr 1;
1810   result := aNumber = 1;
1811 end;
1812
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function GetTopMostBit(aBitSet: QWord): Integer;
1815 begin
1816   result := 0;
1817   while aBitSet > 0 do begin
1818     inc(result);
1819     aBitSet := aBitSet shr 1;
1820   end;
1821 end;
1822
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 function CountSetBits(aBitSet: QWord): Integer;
1825 begin
1826   result := 0;
1827   while aBitSet > 0 do begin
1828     if (aBitSet and 1) = 1 then
1829       inc(result);
1830     aBitSet := aBitSet shr 1;
1831   end;
1832 end;
1833
1834 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1835 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1836 begin
1837   result := Trunc(
1838     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1839     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1840     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1841 end;
1842
1843 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1844 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1845 begin
1846   result := Trunc(
1847     DEPTH_WEIGHT_R * aPixel.Data.r +
1848     DEPTH_WEIGHT_G * aPixel.Data.g +
1849     DEPTH_WEIGHT_B * aPixel.Data.b);
1850 end;
1851
1852 {$IFDEF GLB_NATIVE_OGL}
1853 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1854 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1855 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1856 var
1857   GL_LibHandle: Pointer = nil;
1858
1859 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1860 begin
1861   if not Assigned(aLibHandle) then
1862     aLibHandle := GL_LibHandle;
1863
1864 {$IF DEFINED(GLB_WIN)}
1865   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1866   if Assigned(result) then
1867     exit;
1868
1869   if Assigned(wglGetProcAddress) then
1870     result := wglGetProcAddress(aProcName);
1871 {$ELSEIF DEFINED(GLB_LINUX)}
1872   if Assigned(glXGetProcAddress) then begin
1873     result := glXGetProcAddress(aProcName);
1874     if Assigned(result) then
1875       exit;
1876   end;
1877
1878   if Assigned(glXGetProcAddressARB) then begin
1879     result := glXGetProcAddressARB(aProcName);
1880     if Assigned(result) then
1881       exit;
1882   end;
1883
1884   result := dlsym(aLibHandle, aProcName);
1885 {$IFEND}
1886   if not Assigned(result) then
1887     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1888 end;
1889
1890 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1891 var
1892   GLU_LibHandle: Pointer = nil;
1893   OpenGLInitialized: Boolean;
1894   InitOpenGLCS: TCriticalSection;
1895
1896 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1897 procedure glbInitOpenGL;
1898
1899   ////////////////////////////////////////////////////////////////////////////////
1900   function glbLoadLibrary(const aName: PChar): Pointer;
1901   begin
1902     {$IF DEFINED(GLB_WIN)}
1903     result := {%H-}Pointer(LoadLibrary(aName));
1904     {$ELSEIF DEFINED(GLB_LINUX)}
1905     result := dlopen(Name, RTLD_LAZY);
1906     {$ELSE}
1907     result := nil;
1908     {$IFEND}
1909   end;
1910
1911   ////////////////////////////////////////////////////////////////////////////////
1912   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1913   begin
1914     result := false;
1915     if not Assigned(aLibHandle) then
1916       exit;
1917
1918     {$IF DEFINED(GLB_WIN)}
1919     Result := FreeLibrary({%H-}HINST(aLibHandle));
1920     {$ELSEIF DEFINED(GLB_LINUX)}
1921     Result := dlclose(aLibHandle) = 0;
1922     {$IFEND}
1923   end;
1924
1925 begin
1926   if Assigned(GL_LibHandle) then
1927     glbFreeLibrary(GL_LibHandle);
1928
1929   if Assigned(GLU_LibHandle) then
1930     glbFreeLibrary(GLU_LibHandle);
1931
1932   GL_LibHandle := glbLoadLibrary(libopengl);
1933   if not Assigned(GL_LibHandle) then
1934     raise EglBitmap.Create('unable to load library: ' + libopengl);
1935
1936   GLU_LibHandle := glbLoadLibrary(libglu);
1937   if not Assigned(GLU_LibHandle) then
1938     raise EglBitmap.Create('unable to load library: ' + libglu);
1939
1940   try
1941   {$IF DEFINED(GLB_WIN)}
1942     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1943   {$ELSEIF DEFINED(GLB_LINUX)}
1944     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1945     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
1946   {$IFEND}
1947
1948     glEnable := glbGetProcAddress('glEnable');
1949     glDisable := glbGetProcAddress('glDisable');
1950     glGetString := glbGetProcAddress('glGetString');
1951     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1952     glTexParameteri := glbGetProcAddress('glTexParameteri');
1953     glTexParameteriv := glbGetProcAddress('glTexParameteriv');
1954     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1955     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1956     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1957     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1958     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1959     glTexGeni := glbGetProcAddress('glTexGeni');
1960     glGenTextures := glbGetProcAddress('glGenTextures');
1961     glBindTexture := glbGetProcAddress('glBindTexture');
1962     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1963     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1964     glReadPixels := glbGetProcAddress('glReadPixels');
1965     glPixelStorei := glbGetProcAddress('glPixelStorei');
1966     glTexImage1D := glbGetProcAddress('glTexImage1D');
1967     glTexImage2D := glbGetProcAddress('glTexImage2D');
1968     glGetTexImage := glbGetProcAddress('glGetTexImage');
1969
1970     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1971     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1972   finally
1973     glbFreeLibrary(GL_LibHandle);
1974     glbFreeLibrary(GLU_LibHandle);
1975   end;
1976 end;
1977 {$ENDIF}
1978
1979 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1980 procedure glbReadOpenGLExtensions;
1981 var
1982   Buffer: AnsiString;
1983   MajorVersion, MinorVersion: Integer;
1984
1985   ///////////////////////////////////////////////////////////////////////////////////////////
1986   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1987   var
1988     Separator: Integer;
1989   begin
1990     aMinor := 0;
1991     aMajor := 0;
1992
1993     Separator := Pos(AnsiString('.'), aBuffer);
1994     if (Separator > 1) and (Separator < Length(aBuffer)) and
1995        (aBuffer[Separator - 1] in ['0'..'9']) and
1996        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1997
1998       Dec(Separator);
1999       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2000         Dec(Separator);
2001
2002       Delete(aBuffer, 1, Separator);
2003       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2004
2005       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2006         Inc(Separator);
2007
2008       Delete(aBuffer, Separator, 255);
2009       Separator := Pos(AnsiString('.'), aBuffer);
2010
2011       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2012       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2013     end;
2014   end;
2015
2016   ///////////////////////////////////////////////////////////////////////////////////////////
2017   function CheckExtension(const Extension: AnsiString): Boolean;
2018   var
2019     ExtPos: Integer;
2020   begin
2021     ExtPos := Pos(Extension, Buffer);
2022     result := ExtPos > 0;
2023     if result then
2024       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2025   end;
2026
2027   ///////////////////////////////////////////////////////////////////////////////////////////
2028   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2029   begin
2030     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2031   end;
2032
2033 begin
2034 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2035   InitOpenGLCS.Enter;
2036   try
2037     if not OpenGLInitialized then begin
2038       glbInitOpenGL;
2039       OpenGLInitialized := true;
2040     end;
2041   finally
2042     InitOpenGLCS.Leave;
2043   end;
2044 {$ENDIF}
2045
2046   // Version
2047   Buffer := glGetString(GL_VERSION);
2048   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2049
2050   GL_VERSION_1_2 := CheckVersion(1, 2);
2051   GL_VERSION_1_3 := CheckVersion(1, 3);
2052   GL_VERSION_1_4 := CheckVersion(1, 4);
2053   GL_VERSION_2_0 := CheckVersion(2, 0);
2054   GL_VERSION_3_3 := CheckVersion(3, 3);
2055
2056   // Extensions
2057   Buffer := glGetString(GL_EXTENSIONS);
2058   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2059   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2060   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2061   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2062   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2063   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2064   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2065   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2066   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2067   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2068   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2069   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2070   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2071   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2072
2073   if GL_VERSION_1_3 then begin
2074     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2075     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2076     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2077   end else begin
2078     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2079     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2080     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2081   end;
2082 end;
2083 {$ENDIF}
2084
2085 {$IFDEF GLB_SDL_IMAGE}
2086 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2090 begin
2091   result := TStream(context^.unknown.data1).Seek(offset, whence);
2092 end;
2093
2094 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2095 begin
2096   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2097 end;
2098
2099 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2100 begin
2101   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2102 end;
2103
2104 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2105 begin
2106   result := 0;
2107 end;
2108
2109 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2110 begin
2111   result := SDL_AllocRW;
2112
2113   if result = nil then
2114     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2115
2116   result^.seek := glBitmapRWseek;
2117   result^.read := glBitmapRWread;
2118   result^.write := glBitmapRWwrite;
2119   result^.close := glBitmapRWclose;
2120   result^.unknown.data1 := Stream;
2121 end;
2122 {$ENDIF}
2123
2124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2125 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2126 begin
2127   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2128 end;
2129
2130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2131 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2132 begin
2133   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2134 end;
2135
2136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2137 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2138 begin
2139   glBitmapDefaultMipmap := aValue;
2140 end;
2141
2142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2143 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2144 begin
2145   glBitmapDefaultFormat := aFormat;
2146 end;
2147
2148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2149 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2150 begin
2151   glBitmapDefaultFilterMin := aMin;
2152   glBitmapDefaultFilterMag := aMag;
2153 end;
2154
2155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2156 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2157 begin
2158   glBitmapDefaultWrapS := S;
2159   glBitmapDefaultWrapT := T;
2160   glBitmapDefaultWrapR := R;
2161 end;
2162
2163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2164 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2165 begin
2166   glDefaultSwizzle[0] := r;
2167   glDefaultSwizzle[1] := g;
2168   glDefaultSwizzle[2] := b;
2169   glDefaultSwizzle[3] := a;
2170 end;
2171
2172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2174 begin
2175   result := glBitmapDefaultDeleteTextureOnFree;
2176 end;
2177
2178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2180 begin
2181   result := glBitmapDefaultFreeDataAfterGenTextures;
2182 end;
2183
2184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2186 begin
2187   result := glBitmapDefaultMipmap;
2188 end;
2189
2190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2191 function glBitmapGetDefaultFormat: TglBitmapFormat;
2192 begin
2193   result := glBitmapDefaultFormat;
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2198 begin
2199   aMin := glBitmapDefaultFilterMin;
2200   aMag := glBitmapDefaultFilterMag;
2201 end;
2202
2203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2204 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2205 begin
2206   S := glBitmapDefaultWrapS;
2207   T := glBitmapDefaultWrapT;
2208   R := glBitmapDefaultWrapR;
2209 end;
2210
2211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2213 begin
2214   r := glDefaultSwizzle[0];
2215   g := glDefaultSwizzle[1];
2216   b := glDefaultSwizzle[2];
2217   a := glDefaultSwizzle[3];
2218 end;
2219
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2223 function TFormatDescriptor.GetRedMask: QWord;
2224 begin
2225   result := fRange.r shl fShift.r;
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 function TFormatDescriptor.GetGreenMask: QWord;
2230 begin
2231   result := fRange.g shl fShift.g;
2232 end;
2233
2234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2235 function TFormatDescriptor.GetBlueMask: QWord;
2236 begin
2237   result := fRange.b shl fShift.b;
2238 end;
2239
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 function TFormatDescriptor.GetAlphaMask: QWord;
2242 begin
2243   result := fRange.a shl fShift.a;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 function TFormatDescriptor.GetComponents: Integer;
2248 var
2249   i: Integer;
2250 begin
2251   result := 0;
2252   for i := 0 to 3 do
2253     if (fRange.arr[i] > 0) then
2254       inc(result);
2255 end;
2256
2257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2258 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2259 var
2260   w, h: Integer;
2261 begin
2262   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2263     w := Max(1, aSize.X);
2264     h := Max(1, aSize.Y);
2265     result := GetSize(w, h);
2266   end else
2267     result := 0;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2272 begin
2273   result := 0;
2274   if (aWidth <= 0) or (aHeight <= 0) then
2275     exit;
2276   result := Ceil(aWidth * aHeight * fPixelSize);
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 function TFormatDescriptor.CreateMappingData: Pointer;
2281 begin
2282   result := nil;
2283 end;
2284
2285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2286 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2287 begin
2288   //DUMMY
2289 end;
2290
2291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2292 function TFormatDescriptor.IsEmpty: Boolean;
2293 begin
2294   result := (fFormat = tfEmpty);
2295 end;
2296
2297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 function TFormatDescriptor.HasAlpha: Boolean;
2299 begin
2300   result := (fRange.a > 0);
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2305 begin
2306   result := false;
2307   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2308     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2309   if (aRedMask   <> RedMask) then
2310     exit;
2311   if (aGreenMask <> GreenMask) then
2312     exit;
2313   if (aBlueMask  <> BlueMask) then
2314     exit;
2315   if (aAlphaMask <> AlphaMask) then
2316     exit;
2317   result := true;
2318 end;
2319
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2322 begin
2323   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2324   aPixel.Data   := fRange;
2325   aPixel.Range  := fRange;
2326   aPixel.Format := fFormat;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 constructor TFormatDescriptor.Create;
2331 begin
2332   inherited Create;
2333
2334   fFormat       := tfEmpty;
2335   fWithAlpha    := tfEmpty;
2336   fWithoutAlpha := tfEmpty;
2337   fRGBInverted  := tfEmpty;
2338   fUncompressed := tfEmpty;
2339   fPixelSize    := 0.0;
2340   fIsCompressed := false;
2341
2342   fglFormat         := 0;
2343   fglInternalFormat := 0;
2344   fglDataFormat     := 0;
2345
2346   FillChar(fRange, 0, SizeOf(fRange));
2347   FillChar(fShift, 0, SizeOf(fShift));
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2354 begin
2355   aData^ := aPixel.Data.a;
2356   inc(aData);
2357 end;
2358
2359 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2360 begin
2361   aPixel.Data.r := 0;
2362   aPixel.Data.g := 0;
2363   aPixel.Data.b := 0;
2364   aPixel.Data.a := aData^;
2365   inc(aData);
2366 end;
2367
2368 constructor TfdAlpha_UB1.Create;
2369 begin
2370   inherited Create;
2371   fPixelSize        := 1.0;
2372   fRange.a          := $FF;
2373   fglFormat         := GL_ALPHA;
2374   fglDataFormat     := GL_UNSIGNED_BYTE;
2375 end;
2376
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2380 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2381 begin
2382   aData^ := LuminanceWeight(aPixel);
2383   inc(aData);
2384 end;
2385
2386 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2387 begin
2388   aPixel.Data.r := aData^;
2389   aPixel.Data.g := aData^;
2390   aPixel.Data.b := aData^;
2391   aPixel.Data.a := 0;
2392   inc(aData);
2393 end;
2394
2395 constructor TfdLuminance_UB1.Create;
2396 begin
2397   inherited Create;
2398   fPixelSize        := 1.0;
2399   fRange.r          := $FF;
2400   fRange.g          := $FF;
2401   fRange.b          := $FF;
2402   fglFormat         := GL_LUMINANCE;
2403   fglDataFormat     := GL_UNSIGNED_BYTE;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2409 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2410 var
2411   i: Integer;
2412 begin
2413   aData^ := 0;
2414   for i := 0 to 3 do
2415     if (fRange.arr[i] > 0) then
2416       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2417   inc(aData);
2418 end;
2419
2420 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2421 var
2422   i: Integer;
2423 begin
2424   for i := 0 to 3 do
2425     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2426   inc(aData);
2427 end;
2428
2429 constructor TfdUniversal_UB1.Create;
2430 begin
2431   inherited Create;
2432   fPixelSize := 1.0;
2433 end;
2434
2435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2436 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2439 begin
2440   inherited Map(aPixel, aData, aMapData);
2441   aData^ := aPixel.Data.a;
2442   inc(aData);
2443 end;
2444
2445 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2446 begin
2447   inherited Unmap(aData, aPixel, aMapData);
2448   aPixel.Data.a := aData^;
2449   inc(aData);
2450 end;
2451
2452 constructor TfdLuminanceAlpha_UB2.Create;
2453 begin
2454   inherited Create;
2455   fPixelSize        := 2.0;
2456   fRange.a          := $FF;
2457   fShift.a          :=   8;
2458   fglFormat         := GL_LUMINANCE_ALPHA;
2459   fglDataFormat     := GL_UNSIGNED_BYTE;
2460 end;
2461
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2466 begin
2467   aData^ := aPixel.Data.r;
2468   inc(aData);
2469   aData^ := aPixel.Data.g;
2470   inc(aData);
2471   aData^ := aPixel.Data.b;
2472   inc(aData);
2473 end;
2474
2475 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2476 begin
2477   aPixel.Data.r := aData^;
2478   inc(aData);
2479   aPixel.Data.g := aData^;
2480   inc(aData);
2481   aPixel.Data.b := aData^;
2482   inc(aData);
2483   aPixel.Data.a := 0;
2484 end;
2485
2486 constructor TfdRGB_UB3.Create;
2487 begin
2488   inherited Create;
2489   fPixelSize        := 3.0;
2490   fRange.r          := $FF;
2491   fRange.g          := $FF;
2492   fRange.b          := $FF;
2493   fShift.r          :=   0;
2494   fShift.g          :=   8;
2495   fShift.b          :=  16;
2496   fglFormat         := GL_RGB;
2497   fglDataFormat     := GL_UNSIGNED_BYTE;
2498 end;
2499
2500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2501 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2503 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2504 begin
2505   aData^ := aPixel.Data.b;
2506   inc(aData);
2507   aData^ := aPixel.Data.g;
2508   inc(aData);
2509   aData^ := aPixel.Data.r;
2510   inc(aData);
2511 end;
2512
2513 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2514 begin
2515   aPixel.Data.b := aData^;
2516   inc(aData);
2517   aPixel.Data.g := aData^;
2518   inc(aData);
2519   aPixel.Data.r := aData^;
2520   inc(aData);
2521   aPixel.Data.a := 0;
2522 end;
2523
2524 constructor TfdBGR_UB3.Create;
2525 begin
2526   fPixelSize        := 3.0;
2527   fRange.r          := $FF;
2528   fRange.g          := $FF;
2529   fRange.b          := $FF;
2530   fShift.r          :=  16;
2531   fShift.g          :=   8;
2532   fShift.b          :=   0;
2533   fglFormat         := GL_BGR;
2534   fglDataFormat     := GL_UNSIGNED_BYTE;
2535 end;
2536
2537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2538 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2540 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2541 begin
2542   inherited Map(aPixel, aData, aMapData);
2543   aData^ := aPixel.Data.a;
2544   inc(aData);
2545 end;
2546
2547 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2548 begin
2549   inherited Unmap(aData, aPixel, aMapData);
2550   aPixel.Data.a := aData^;
2551   inc(aData);
2552 end;
2553
2554 constructor TfdRGBA_UB4.Create;
2555 begin
2556   inherited Create;
2557   fPixelSize        := 4.0;
2558   fRange.a          := $FF;
2559   fShift.a          :=  24;
2560   fglFormat         := GL_RGBA;
2561   fglDataFormat     := GL_UNSIGNED_BYTE;
2562 end;
2563
2564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2565 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2567 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2568 begin
2569   inherited Map(aPixel, aData, aMapData);
2570   aData^ := aPixel.Data.a;
2571   inc(aData);
2572 end;
2573
2574 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2575 begin
2576   inherited Unmap(aData, aPixel, aMapData);
2577   aPixel.Data.a := aData^;
2578   inc(aData);
2579 end;
2580
2581 constructor TfdBGRA_UB4.Create;
2582 begin
2583   inherited Create;
2584   fPixelSize        := 4.0;
2585   fRange.a          := $FF;
2586   fShift.a          :=  24;
2587   fglFormat         := GL_BGRA;
2588   fglDataFormat     := GL_UNSIGNED_BYTE;
2589 end;
2590
2591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2592 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2594 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2595 begin
2596   PWord(aData)^ := aPixel.Data.a;
2597   inc(aData, 2);
2598 end;
2599
2600 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2601 begin
2602   aPixel.Data.r := 0;
2603   aPixel.Data.g := 0;
2604   aPixel.Data.b := 0;
2605   aPixel.Data.a := PWord(aData)^;
2606   inc(aData, 2);
2607 end;
2608
2609 constructor TfdAlpha_US1.Create;
2610 begin
2611   inherited Create;
2612   fPixelSize        := 2.0;
2613   fRange.a          := $FFFF;
2614   fglFormat         := GL_ALPHA;
2615   fglDataFormat     := GL_UNSIGNED_SHORT;
2616 end;
2617
2618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2619 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2621 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2622 begin
2623   PWord(aData)^ := LuminanceWeight(aPixel);
2624   inc(aData, 2);
2625 end;
2626
2627 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2628 begin
2629   aPixel.Data.r := PWord(aData)^;
2630   aPixel.Data.g := PWord(aData)^;
2631   aPixel.Data.b := PWord(aData)^;
2632   aPixel.Data.a := 0;
2633   inc(aData, 2);
2634 end;
2635
2636 constructor TfdLuminance_US1.Create;
2637 begin
2638   inherited Create;
2639   fPixelSize        := 2.0;
2640   fRange.r          := $FFFF;
2641   fRange.g          := $FFFF;
2642   fRange.b          := $FFFF;
2643   fglFormat         := GL_LUMINANCE;
2644   fglDataFormat     := GL_UNSIGNED_SHORT;
2645 end;
2646
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2651 var
2652   i: Integer;
2653 begin
2654   PWord(aData)^ := 0;
2655   for i := 0 to 3 do
2656     if (fRange.arr[i] > 0) then
2657       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2658   inc(aData, 2);
2659 end;
2660
2661 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2662 var
2663   i: Integer;
2664 begin
2665   for i := 0 to 3 do
2666     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2667   inc(aData, 2);
2668 end;
2669
2670 constructor TfdUniversal_US1.Create;
2671 begin
2672   inherited Create;
2673   fPixelSize := 2.0;
2674 end;
2675
2676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2680 begin
2681   PWord(aData)^ := DepthWeight(aPixel);
2682   inc(aData, 2);
2683 end;
2684
2685 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2686 begin
2687   aPixel.Data.r := PWord(aData)^;
2688   aPixel.Data.g := PWord(aData)^;
2689   aPixel.Data.b := PWord(aData)^;
2690   aPixel.Data.a := 0;
2691   inc(aData, 2);
2692 end;
2693
2694 constructor TfdDepth_US1.Create;
2695 begin
2696   inherited Create;
2697   fPixelSize        := 2.0;
2698   fRange.r          := $FFFF;
2699   fRange.g          := $FFFF;
2700   fRange.b          := $FFFF;
2701   fglFormat         := GL_DEPTH_COMPONENT;
2702   fglDataFormat     := GL_UNSIGNED_SHORT;
2703 end;
2704
2705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2709 begin
2710   inherited Map(aPixel, aData, aMapData);
2711   PWord(aData)^ := aPixel.Data.a;
2712   inc(aData, 2);
2713 end;
2714
2715 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2716 begin
2717   inherited Unmap(aData, aPixel, aMapData);
2718   aPixel.Data.a := PWord(aData)^;
2719   inc(aData, 2);
2720 end;
2721
2722 constructor TfdLuminanceAlpha_US2.Create;
2723 begin
2724   inherited Create;
2725   fPixelSize        :=   4.0;
2726   fRange.a          := $FFFF;
2727   fShift.a          :=    16;
2728   fglFormat         := GL_LUMINANCE_ALPHA;
2729   fglDataFormat     := GL_UNSIGNED_SHORT;
2730 end;
2731
2732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2736 begin
2737   PWord(aData)^ := aPixel.Data.r;
2738   inc(aData, 2);
2739   PWord(aData)^ := aPixel.Data.g;
2740   inc(aData, 2);
2741   PWord(aData)^ := aPixel.Data.b;
2742   inc(aData, 2);
2743 end;
2744
2745 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2746 begin
2747   aPixel.Data.r := PWord(aData)^;
2748   inc(aData, 2);
2749   aPixel.Data.g := PWord(aData)^;
2750   inc(aData, 2);
2751   aPixel.Data.b := PWord(aData)^;
2752   inc(aData, 2);
2753   aPixel.Data.a := 0;
2754 end;
2755
2756 constructor TfdRGB_US3.Create;
2757 begin
2758   inherited Create;
2759   fPixelSize        :=   6.0;
2760   fRange.r          := $FFFF;
2761   fRange.g          := $FFFF;
2762   fRange.b          := $FFFF;
2763   fShift.r          :=     0;
2764   fShift.g          :=    16;
2765   fShift.b          :=    32;
2766   fglFormat         := GL_RGB;
2767   fglDataFormat     := GL_UNSIGNED_SHORT;
2768 end;
2769
2770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2771 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2773 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2774 begin
2775   PWord(aData)^ := aPixel.Data.b;
2776   inc(aData, 2);
2777   PWord(aData)^ := aPixel.Data.g;
2778   inc(aData, 2);
2779   PWord(aData)^ := aPixel.Data.r;
2780   inc(aData, 2);
2781 end;
2782
2783 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2784 begin
2785   aPixel.Data.b := PWord(aData)^;
2786   inc(aData, 2);
2787   aPixel.Data.g := PWord(aData)^;
2788   inc(aData, 2);
2789   aPixel.Data.r := PWord(aData)^;
2790   inc(aData, 2);
2791   aPixel.Data.a := 0;
2792 end;
2793
2794 constructor TfdBGR_US3.Create;
2795 begin
2796   inherited Create;
2797   fPixelSize        :=   6.0;
2798   fRange.r          := $FFFF;
2799   fRange.g          := $FFFF;
2800   fRange.b          := $FFFF;
2801   fShift.r          :=    32;
2802   fShift.g          :=    16;
2803   fShift.b          :=     0;
2804   fglFormat         := GL_BGR;
2805   fglDataFormat     := GL_UNSIGNED_SHORT;
2806 end;
2807
2808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2809 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2811 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2812 begin
2813   inherited Map(aPixel, aData, aMapData);
2814   PWord(aData)^ := aPixel.Data.a;
2815   inc(aData, 2);
2816 end;
2817
2818 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2819 begin
2820   inherited Unmap(aData, aPixel, aMapData);
2821   aPixel.Data.a := PWord(aData)^;
2822   inc(aData, 2);
2823 end;
2824
2825 constructor TfdRGBA_US4.Create;
2826 begin
2827   inherited Create;
2828   fPixelSize        :=   8.0;
2829   fRange.a          := $FFFF;
2830   fShift.a          :=    48;
2831   fglFormat         := GL_RGBA;
2832   fglDataFormat     := GL_UNSIGNED_SHORT;
2833 end;
2834
2835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2836 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2838 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2839 begin
2840   inherited Map(aPixel, aData, aMapData);
2841   PWord(aData)^ := aPixel.Data.a;
2842   inc(aData, 2);
2843 end;
2844
2845 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2846 begin
2847   inherited Unmap(aData, aPixel, aMapData);
2848   aPixel.Data.a := PWord(aData)^;
2849   inc(aData, 2);
2850 end;
2851
2852 constructor TfdBGRA_US4.Create;
2853 begin
2854   inherited Create;
2855   fPixelSize        :=   8.0;
2856   fRange.a          := $FFFF;
2857   fShift.a          :=    48;
2858   fglFormat         := GL_BGRA;
2859   fglDataFormat     := GL_UNSIGNED_SHORT;
2860 end;
2861
2862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2863 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2865 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2866 var
2867   i: Integer;
2868 begin
2869   PCardinal(aData)^ := 0;
2870   for i := 0 to 3 do
2871     if (fRange.arr[i] > 0) then
2872       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2873   inc(aData, 4);
2874 end;
2875
2876 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2877 var
2878   i: Integer;
2879 begin
2880   for i := 0 to 3 do
2881     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2882   inc(aData, 2);
2883 end;
2884
2885 constructor TfdUniversal_UI1.Create;
2886 begin
2887   inherited Create;
2888   fPixelSize := 4.0;
2889 end;
2890
2891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2892 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2894 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2895 begin
2896   PCardinal(aData)^ := DepthWeight(aPixel);
2897   inc(aData, 4);
2898 end;
2899
2900 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2901 begin
2902   aPixel.Data.r := PCardinal(aData)^;
2903   aPixel.Data.g := PCardinal(aData)^;
2904   aPixel.Data.b := PCardinal(aData)^;
2905   aPixel.Data.a := 0;
2906   inc(aData, 4);
2907 end;
2908
2909 constructor TfdDepth_UI1.Create;
2910 begin
2911   inherited Create;
2912   fPixelSize        := 4.0;
2913   fRange.r          := $FFFFFFFF;
2914   fRange.g          := $FFFFFFFF;
2915   fRange.b          := $FFFFFFFF;
2916   fglFormat         := GL_DEPTH_COMPONENT;
2917   fglDataFormat     := GL_UNSIGNED_INT;
2918 end;
2919
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 constructor TfdAlpha4.Create;
2924 begin
2925   inherited Create;
2926   fFormat           := tfAlpha4;
2927   fWithAlpha        := tfAlpha4;
2928   fglInternalFormat := GL_ALPHA4;
2929 end;
2930
2931 constructor TfdAlpha8.Create;
2932 begin
2933   inherited Create;
2934   fFormat           := tfAlpha8;
2935   fWithAlpha        := tfAlpha8;
2936   fglInternalFormat := GL_ALPHA8;
2937 end;
2938
2939 constructor TfdAlpha12.Create;
2940 begin
2941   inherited Create;
2942   fFormat           := tfAlpha12;
2943   fWithAlpha        := tfAlpha12;
2944   fglInternalFormat := GL_ALPHA12;
2945 end;
2946
2947 constructor TfdAlpha16.Create;
2948 begin
2949   inherited Create;
2950   fFormat           := tfAlpha16;
2951   fWithAlpha        := tfAlpha16;
2952   fglInternalFormat := GL_ALPHA16;
2953 end;
2954
2955 constructor TfdLuminance4.Create;
2956 begin
2957   inherited Create;
2958   fFormat           := tfLuminance4;
2959   fWithAlpha        := tfLuminance4Alpha4;
2960   fWithoutAlpha     := tfLuminance4;
2961   fglInternalFormat := GL_LUMINANCE4;
2962 end;
2963
2964 constructor TfdLuminance8.Create;
2965 begin
2966   inherited Create;
2967   fFormat           := tfLuminance8;
2968   fWithAlpha        := tfLuminance8Alpha8;
2969   fWithoutAlpha     := tfLuminance8;
2970   fglInternalFormat := GL_LUMINANCE8;
2971 end;
2972
2973 constructor TfdLuminance12.Create;
2974 begin
2975   inherited Create;
2976   fFormat           := tfLuminance12;
2977   fWithAlpha        := tfLuminance12Alpha12;
2978   fWithoutAlpha     := tfLuminance12;
2979   fglInternalFormat := GL_LUMINANCE12;
2980 end;
2981
2982 constructor TfdLuminance16.Create;
2983 begin
2984   inherited Create;
2985   fFormat           := tfLuminance16;
2986   fWithAlpha        := tfLuminance16Alpha16;
2987   fWithoutAlpha     := tfLuminance16;
2988   fglInternalFormat := GL_LUMINANCE16;
2989 end;
2990
2991 constructor TfdLuminance4Alpha4.Create;
2992 begin
2993   inherited Create;
2994   fFormat           := tfLuminance4Alpha4;
2995   fWithAlpha        := tfLuminance4Alpha4;
2996   fWithoutAlpha     := tfLuminance4;
2997   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2998 end;
2999
3000 constructor TfdLuminance6Alpha2.Create;
3001 begin
3002   inherited Create;
3003   fFormat           := tfLuminance6Alpha2;
3004   fWithAlpha        := tfLuminance6Alpha2;
3005   fWithoutAlpha     := tfLuminance8;
3006   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3007 end;
3008
3009 constructor TfdLuminance8Alpha8.Create;
3010 begin
3011   inherited Create;
3012   fFormat           := tfLuminance8Alpha8;
3013   fWithAlpha        := tfLuminance8Alpha8;
3014   fWithoutAlpha     := tfLuminance8;
3015   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3016 end;
3017
3018 constructor TfdLuminance12Alpha4.Create;
3019 begin
3020   inherited Create;
3021   fFormat           := tfLuminance12Alpha4;
3022   fWithAlpha        := tfLuminance12Alpha4;
3023   fWithoutAlpha     := tfLuminance12;
3024   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3025 end;
3026
3027 constructor TfdLuminance12Alpha12.Create;
3028 begin
3029   inherited Create;
3030   fFormat           := tfLuminance12Alpha12;
3031   fWithAlpha        := tfLuminance12Alpha12;
3032   fWithoutAlpha     := tfLuminance12;
3033   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3034 end;
3035
3036 constructor TfdLuminance16Alpha16.Create;
3037 begin
3038   inherited Create;
3039   fFormat           := tfLuminance16Alpha16;
3040   fWithAlpha        := tfLuminance16Alpha16;
3041   fWithoutAlpha     := tfLuminance16;
3042   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3043 end;
3044
3045 constructor TfdR3G3B2.Create;
3046 begin
3047   inherited Create;
3048   fFormat           := tfR3G3B2;
3049   fWithAlpha        := tfRGBA2;
3050   fWithoutAlpha     := tfR3G3B2;
3051   fRange.r          := $7;
3052   fRange.g          := $7;
3053   fRange.b          := $3;
3054   fShift.r          :=  0;
3055   fShift.g          :=  3;
3056   fShift.b          :=  6;
3057   fglFormat         := GL_RGB;
3058   fglInternalFormat := GL_R3_G3_B2;
3059   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3060 end;
3061
3062 constructor TfdRGB4.Create;
3063 begin
3064   inherited Create;
3065   fFormat           := tfRGB4;
3066   fWithAlpha        := tfRGBA4;
3067   fWithoutAlpha     := tfRGB4;
3068   fRGBInverted      := tfBGR4;
3069   fRange.r          := $F;
3070   fRange.g          := $F;
3071   fRange.b          := $F;
3072   fShift.r          :=  0;
3073   fShift.g          :=  4;
3074   fShift.b          :=  8;
3075   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3076   fglInternalFormat := GL_RGB4;
3077   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3078 end;
3079
3080 constructor TfdR5G6B5.Create;
3081 begin
3082   inherited Create;
3083   fFormat           := tfR5G6B5;
3084   fWithAlpha        := tfRGBA4;
3085   fWithoutAlpha     := tfR5G6B5;
3086   fRGBInverted      := tfB5G6R5;
3087   fRange.r          := $1F;
3088   fRange.g          := $3F;
3089   fRange.b          := $1F;
3090   fShift.r          :=   0;
3091   fShift.g          :=   5;
3092   fShift.b          :=  11;
3093   fglFormat         := GL_RGB;
3094   fglInternalFormat := GL_RGB565;
3095   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3096 end;
3097
3098 constructor TfdRGB5.Create;
3099 begin
3100   inherited Create;
3101   fFormat           := tfRGB5;
3102   fWithAlpha        := tfRGB5A1;
3103   fWithoutAlpha     := tfRGB5;
3104   fRGBInverted      := tfBGR5;
3105   fRange.r          := $1F;
3106   fRange.g          := $1F;
3107   fRange.b          := $1F;
3108   fShift.r          :=   0;
3109   fShift.g          :=   5;
3110   fShift.b          :=  10;
3111   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3112   fglInternalFormat := GL_RGB5;
3113   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3114 end;
3115
3116 constructor TfdRGB8.Create;
3117 begin
3118   inherited Create;
3119   fFormat           := tfRGB8;
3120   fWithAlpha        := tfRGBA8;
3121   fWithoutAlpha     := tfRGB8;
3122   fRGBInverted      := tfBGR8;
3123   fglInternalFormat := GL_RGB8;
3124 end;
3125
3126 constructor TfdRGB10.Create;
3127 begin
3128   inherited Create;
3129   fFormat           := tfRGB10;
3130   fWithAlpha        := tfRGB10A2;
3131   fWithoutAlpha     := tfRGB10;
3132   fRGBInverted      := tfBGR10;
3133   fRange.r          := $3FF;
3134   fRange.g          := $3FF;
3135   fRange.b          := $3FF;
3136   fShift.r          :=    0;
3137   fShift.g          :=   10;
3138   fShift.b          :=   20;
3139   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3140   fglInternalFormat := GL_RGB10;
3141   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3142 end;
3143
3144 constructor TfdRGB12.Create;
3145 begin
3146   inherited Create;
3147   fFormat           := tfRGB12;
3148   fWithAlpha        := tfRGBA12;
3149   fWithoutAlpha     := tfRGB12;
3150   fRGBInverted      := tfBGR12;
3151   fglInternalFormat := GL_RGB12;
3152 end;
3153
3154 constructor TfdRGB16.Create;
3155 begin
3156   inherited Create;
3157   fFormat           := tfRGB16;
3158   fWithAlpha        := tfRGBA16;
3159   fWithoutAlpha     := tfRGB16;
3160   fRGBInverted      := tfBGR16;
3161   fglInternalFormat := GL_RGB16;
3162 end;
3163
3164 constructor TfdRGBA2.Create;
3165 begin
3166   inherited Create;
3167   fFormat           := tfRGBA2;
3168   fWithAlpha        := tfRGBA2;
3169   fWithoutAlpha     := tfR3G3B2;
3170   fRGBInverted      := tfBGRA2;
3171   fglInternalFormat := GL_RGBA2;
3172 end;
3173
3174 constructor TfdRGBA4.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfRGBA4;
3178   fWithAlpha        := tfRGBA4;
3179   fWithoutAlpha     := tfRGB4;
3180   fRGBInverted      := tfBGRA4;
3181   fRange.r          := $F;
3182   fRange.g          := $F;
3183   fRange.b          := $F;
3184   fRange.a          := $F;
3185   fShift.r          :=  0;
3186   fShift.g          :=  4;
3187   fShift.b          :=  8;
3188   fShift.a          := 12;
3189   fglFormat         := GL_RGBA;
3190   fglInternalFormat := GL_RGBA4;
3191   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3192 end;
3193
3194 constructor TfdRGB5A1.Create;
3195 begin
3196   inherited Create;
3197   fFormat           := tfRGB5A1;
3198   fWithAlpha        := tfRGB5A1;
3199   fWithoutAlpha     := tfRGB5;
3200   fRGBInverted      := tfBGR5A1;
3201   fRange.r          := $1F;
3202   fRange.g          := $1F;
3203   fRange.b          := $1F;
3204   fRange.a          := $01;
3205   fShift.r          :=   0;
3206   fShift.g          :=   5;
3207   fShift.b          :=  10;
3208   fShift.a          :=  15;
3209   fglFormat         := GL_RGBA;
3210   fglInternalFormat := GL_RGB5_A1;
3211   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3212 end;
3213
3214 constructor TfdRGBA8.Create;
3215 begin
3216   inherited Create;
3217   fFormat           := tfRGBA8;
3218   fWithAlpha        := tfRGBA8;
3219   fWithoutAlpha     := tfRGB8;
3220   fRGBInverted      := tfBGRA8;
3221   fglInternalFormat := GL_RGBA8;
3222 end;
3223
3224 constructor TfdRGB10A2.Create;
3225 begin
3226   inherited Create;
3227   fFormat           := tfRGB10A2;
3228   fWithAlpha        := tfRGB10A2;
3229   fWithoutAlpha     := tfRGB10;
3230   fRGBInverted      := tfBGR10A2;
3231   fRange.r          := $3FF;
3232   fRange.g          := $3FF;
3233   fRange.b          := $3FF;
3234   fRange.a          := $003;
3235   fShift.r          :=    0;
3236   fShift.g          :=   10;
3237   fShift.b          :=   20;
3238   fShift.a          :=   30;
3239   fglFormat         := GL_RGBA;
3240   fglInternalFormat := GL_RGB10_A2;
3241   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3242 end;
3243
3244 constructor TfdRGBA12.Create;
3245 begin
3246   inherited Create;
3247   fFormat           := tfRGBA12;
3248   fWithAlpha        := tfRGBA12;
3249   fWithoutAlpha     := tfRGB12;
3250   fRGBInverted      := tfBGRA12;
3251   fglInternalFormat := GL_RGBA12;
3252 end;
3253
3254 constructor TfdRGBA16.Create;
3255 begin
3256   inherited Create;
3257   fFormat           := tfRGBA16;
3258   fWithAlpha        := tfRGBA16;
3259   fWithoutAlpha     := tfRGB16;
3260   fRGBInverted      := tfBGRA16;
3261   fglInternalFormat := GL_RGBA16;
3262 end;
3263
3264 constructor TfdBGR4.Create;
3265 begin
3266   inherited Create;
3267   fPixelSize        := 2.0;
3268   fFormat           := tfBGR4;
3269   fWithAlpha        := tfBGRA4;
3270   fWithoutAlpha     := tfBGR4;
3271   fRGBInverted      := tfRGB4;
3272   fRange.r          := $F;
3273   fRange.g          := $F;
3274   fRange.b          := $F;
3275   fRange.a          := $0;
3276   fShift.r          :=  8;
3277   fShift.g          :=  4;
3278   fShift.b          :=  0;
3279   fShift.a          :=  0;
3280   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3281   fglInternalFormat := GL_RGB4;
3282   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3283 end;
3284
3285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3288 constructor TfdB5G6R5.Create;
3289 begin
3290   inherited Create;
3291   fFormat           := tfB5G6R5;
3292   fWithAlpha        := tfBGRA4;
3293   fWithoutAlpha     := tfB5G6R5;
3294   fRGBInverted      := tfR5G6B5;
3295   fRange.r          := $1F;
3296   fRange.g          := $3F;
3297   fRange.b          := $1F;
3298   fShift.r          :=  11;
3299   fShift.g          :=   5;
3300   fShift.b          :=   0;
3301   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3302   fglInternalFormat := GL_RGB8;
3303   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3304 end;
3305
3306 constructor TfdBGR5.Create;
3307 begin
3308   inherited Create;
3309   fPixelSize        := 2.0;
3310   fFormat           := tfBGR5;
3311   fWithAlpha        := tfBGR5A1;
3312   fWithoutAlpha     := tfBGR5;
3313   fRGBInverted      := tfRGB5;
3314   fRange.r          := $1F;
3315   fRange.g          := $1F;
3316   fRange.b          := $1F;
3317   fRange.a          := $00;
3318   fShift.r          :=  10;
3319   fShift.g          :=   5;
3320   fShift.b          :=   0;
3321   fShift.a          :=   0;
3322   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3323   fglInternalFormat := GL_RGB5;
3324   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3325 end;
3326
3327 constructor TfdBGR8.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfBGR8;
3331   fWithAlpha        := tfBGRA8;
3332   fWithoutAlpha     := tfBGR8;
3333   fRGBInverted      := tfRGB8;
3334   fglInternalFormat := GL_RGB8;
3335 end;
3336
3337 constructor TfdBGR10.Create;
3338 begin
3339   inherited Create;
3340   fFormat           := tfBGR10;
3341   fWithAlpha        := tfBGR10A2;
3342   fWithoutAlpha     := tfBGR10;
3343   fRGBInverted      := tfRGB10;
3344   fRange.r          := $3FF;
3345   fRange.g          := $3FF;
3346   fRange.b          := $3FF;
3347   fRange.a          := $000;
3348   fShift.r          :=   20;
3349   fShift.g          :=   10;
3350   fShift.b          :=    0;
3351   fShift.a          :=    0;
3352   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3353   fglInternalFormat := GL_RGB10;
3354   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3355 end;
3356
3357 constructor TfdBGR12.Create;
3358 begin
3359   inherited Create;
3360   fFormat           := tfBGR12;
3361   fWithAlpha        := tfBGRA12;
3362   fWithoutAlpha     := tfBGR12;
3363   fRGBInverted      := tfRGB12;
3364   fglInternalFormat := GL_RGB12;
3365 end;
3366
3367 constructor TfdBGR16.Create;
3368 begin
3369   inherited Create;
3370   fFormat           := tfBGR16;
3371   fWithAlpha        := tfBGRA16;
3372   fWithoutAlpha     := tfBGR16;
3373   fRGBInverted      := tfRGB16;
3374   fglInternalFormat := GL_RGB16;
3375 end;
3376
3377 constructor TfdBGRA2.Create;
3378 begin
3379   inherited Create;
3380   fFormat           := tfBGRA2;
3381   fWithAlpha        := tfBGRA4;
3382   fWithoutAlpha     := tfBGR4;
3383   fRGBInverted      := tfRGBA2;
3384   fglInternalFormat := GL_RGBA2;
3385 end;
3386
3387 constructor TfdBGRA4.Create;
3388 begin
3389   inherited Create;
3390   fFormat           := tfBGRA4;
3391   fWithAlpha        := tfBGRA4;
3392   fWithoutAlpha     := tfBGR4;
3393   fRGBInverted      := tfRGBA4;
3394   fRange.r          := $F;
3395   fRange.g          := $F;
3396   fRange.b          := $F;
3397   fRange.a          := $F;
3398   fShift.r          :=  8;
3399   fShift.g          :=  4;
3400   fShift.b          :=  0;
3401   fShift.a          := 12;
3402   fglFormat         := GL_BGRA;
3403   fglInternalFormat := GL_RGBA4;
3404   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3405 end;
3406
3407 constructor TfdBGR5A1.Create;
3408 begin
3409   inherited Create;
3410   fFormat           := tfBGR5A1;
3411   fWithAlpha        := tfBGR5A1;
3412   fWithoutAlpha     := tfBGR5;
3413   fRGBInverted      := tfRGB5A1;
3414   fRange.r          := $1F;
3415   fRange.g          := $1F;
3416   fRange.b          := $1F;
3417   fRange.a          := $01;
3418   fShift.r          :=  10;
3419   fShift.g          :=   5;
3420   fShift.b          :=   0;
3421   fShift.a          :=  15;
3422   fglFormat         := GL_BGRA;
3423   fglInternalFormat := GL_RGB5_A1;
3424   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3425 end;
3426
3427 constructor TfdBGRA8.Create;
3428 begin
3429   inherited Create;
3430   fFormat           := tfBGRA8;
3431   fWithAlpha        := tfBGRA8;
3432   fWithoutAlpha     := tfBGR8;
3433   fRGBInverted      := tfRGBA8;
3434   fglInternalFormat := GL_RGBA8;
3435 end;
3436
3437 constructor TfdBGR10A2.Create;
3438 begin
3439   inherited Create;
3440   fFormat           := tfBGR10A2;
3441   fWithAlpha        := tfBGR10A2;
3442   fWithoutAlpha     := tfBGR10;
3443   fRGBInverted      := tfRGB10A2;
3444   fRange.r          := $3FF;
3445   fRange.g          := $3FF;
3446   fRange.b          := $3FF;
3447   fRange.a          := $003;
3448   fShift.r          :=   20;
3449   fShift.g          :=   10;
3450   fShift.b          :=    0;
3451   fShift.a          :=   30;
3452   fglFormat         := GL_BGRA;
3453   fglInternalFormat := GL_RGB10_A2;
3454   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3455 end;
3456
3457 constructor TfdBGRA12.Create;
3458 begin
3459   inherited Create;
3460   fFormat           := tfBGRA12;
3461   fWithAlpha        := tfBGRA12;
3462   fWithoutAlpha     := tfBGR12;
3463   fRGBInverted      := tfRGBA12;
3464   fglInternalFormat := GL_RGBA12;
3465 end;
3466
3467 constructor TfdBGRA16.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfBGRA16;
3471   fWithAlpha        := tfBGRA16;
3472   fWithoutAlpha     := tfBGR16;
3473   fRGBInverted      := tfRGBA16;
3474   fglInternalFormat := GL_RGBA16;
3475 end;
3476
3477 constructor TfdDepth16.Create;
3478 begin
3479   inherited Create;
3480   fFormat           := tfDepth16;
3481   fWithAlpha        := tfEmpty;
3482   fWithoutAlpha     := tfDepth16;
3483   fglInternalFormat := GL_DEPTH_COMPONENT16;
3484 end;
3485
3486 constructor TfdDepth24.Create;
3487 begin
3488   inherited Create;
3489   fFormat           := tfDepth24;
3490   fWithAlpha        := tfEmpty;
3491   fWithoutAlpha     := tfDepth24;
3492   fglInternalFormat := GL_DEPTH_COMPONENT24;
3493 end;
3494
3495 constructor TfdDepth32.Create;
3496 begin
3497   inherited Create;
3498   fFormat           := tfDepth32;
3499   fWithAlpha        := tfEmpty;
3500   fWithoutAlpha     := tfDepth32;
3501   fglInternalFormat := GL_DEPTH_COMPONENT32;
3502 end;
3503
3504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3505 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3507 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3508 begin
3509   raise EglBitmap.Create('mapping for compressed formats is not supported');
3510 end;
3511
3512 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3513 begin
3514   raise EglBitmap.Create('mapping for compressed formats is not supported');
3515 end;
3516
3517 constructor TfdS3tcDtx1RGBA.Create;
3518 begin
3519   inherited Create;
3520   fFormat           := tfS3tcDtx1RGBA;
3521   fWithAlpha        := tfS3tcDtx1RGBA;
3522   fUncompressed     := tfRGB5A1;
3523   fPixelSize        := 0.5;
3524   fIsCompressed     := true;
3525   fglFormat         := GL_COMPRESSED_RGBA;
3526   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3527   fglDataFormat     := GL_UNSIGNED_BYTE;
3528 end;
3529
3530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3531 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3533 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3534 begin
3535   raise EglBitmap.Create('mapping for compressed formats is not supported');
3536 end;
3537
3538 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3539 begin
3540   raise EglBitmap.Create('mapping for compressed formats is not supported');
3541 end;
3542
3543 constructor TfdS3tcDtx3RGBA.Create;
3544 begin
3545   inherited Create;
3546   fFormat           := tfS3tcDtx3RGBA;
3547   fWithAlpha        := tfS3tcDtx3RGBA;
3548   fUncompressed     := tfRGBA8;
3549   fPixelSize        := 1.0;
3550   fIsCompressed     := true;
3551   fglFormat         := GL_COMPRESSED_RGBA;
3552   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3553   fglDataFormat     := GL_UNSIGNED_BYTE;
3554 end;
3555
3556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3557 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3559 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3560 begin
3561   raise EglBitmap.Create('mapping for compressed formats is not supported');
3562 end;
3563
3564 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3565 begin
3566   raise EglBitmap.Create('mapping for compressed formats is not supported');
3567 end;
3568
3569 constructor TfdS3tcDtx5RGBA.Create;
3570 begin
3571   inherited Create;
3572   fFormat           := tfS3tcDtx3RGBA;
3573   fWithAlpha        := tfS3tcDtx3RGBA;
3574   fUncompressed     := tfRGBA8;
3575   fPixelSize        := 1.0;
3576   fIsCompressed     := true;
3577   fglFormat         := GL_COMPRESSED_RGBA;
3578   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3579   fglDataFormat     := GL_UNSIGNED_BYTE;
3580 end;
3581
3582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3583 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3585 class procedure TFormatDescriptor.Init;
3586 begin
3587   if not Assigned(FormatDescriptorCS) then
3588     FormatDescriptorCS := TCriticalSection.Create;
3589 end;
3590
3591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3592 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3593 begin
3594   FormatDescriptorCS.Enter;
3595   try
3596     result := FormatDescriptors[aFormat];
3597     if not Assigned(result) then begin
3598       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3599       FormatDescriptors[aFormat] := result;
3600     end;
3601   finally
3602     FormatDescriptorCS.Leave;
3603   end;
3604 end;
3605
3606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3607 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3608 begin
3609   result := Get(Get(aFormat).WithAlpha);
3610 end;
3611
3612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3613 class procedure TFormatDescriptor.Clear;
3614 var
3615   f: TglBitmapFormat;
3616 begin
3617   FormatDescriptorCS.Enter;
3618   try
3619     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3620       FreeAndNil(FormatDescriptors[f]);
3621   finally
3622     FormatDescriptorCS.Leave;
3623   end;
3624 end;
3625
3626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3627 class procedure TFormatDescriptor.Finalize;
3628 begin
3629   Clear;
3630   FreeAndNil(FormatDescriptorCS);
3631 end;
3632
3633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3634 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3636 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3637 begin
3638   Update(aValue, fRange.r, fShift.r);
3639 end;
3640
3641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3642 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3643 begin
3644   Update(aValue, fRange.g, fShift.g);
3645 end;
3646
3647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3648 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3649 begin
3650   Update(aValue, fRange.b, fShift.b);
3651 end;
3652
3653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3655 begin
3656   Update(aValue, fRange.a, fShift.a);
3657 end;
3658
3659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3660 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3661   aShift: Byte);
3662 begin
3663   aShift := 0;
3664   aRange := 0;
3665   if (aMask = 0) then
3666     exit;
3667   while (aMask > 0) and ((aMask and 1) = 0) do begin
3668     inc(aShift);
3669     aMask := aMask shr 1;
3670   end;
3671   aRange := 1;
3672   while (aMask > 0) do begin
3673     aRange := aRange shl 1;
3674     aMask  := aMask  shr 1;
3675   end;
3676   dec(aRange);
3677
3678   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3679 end;
3680
3681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3682 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3683 var
3684   data: QWord;
3685   s: Integer;
3686 begin
3687   data :=
3688     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3689     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3690     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3691     ((aPixel.Data.a and fRange.a) shl fShift.a);
3692   s := Round(fPixelSize);
3693   case s of
3694     1:           aData^  := data;
3695     2:     PWord(aData)^ := data;
3696     4: PCardinal(aData)^ := data;
3697     8:    PQWord(aData)^ := data;
3698   else
3699     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3700   end;
3701   inc(aData, s);
3702 end;
3703
3704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3706 var
3707   data: QWord;
3708   s, i: Integer;
3709 begin
3710   s := Round(fPixelSize);
3711   case s of
3712     1: data :=           aData^;
3713     2: data :=     PWord(aData)^;
3714     4: data := PCardinal(aData)^;
3715     8: data :=    PQWord(aData)^;
3716   else
3717     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3718   end;
3719   for i := 0 to 3 do
3720     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3721   inc(aData, s);
3722 end;
3723
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3727 procedure TbmpColorTableFormat.CreateColorTable;
3728 var
3729   i: Integer;
3730 begin
3731   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3732     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3733
3734   if (Format = tfLuminance4) then
3735     SetLength(fColorTable, 16)
3736   else
3737     SetLength(fColorTable, 256);
3738
3739   case Format of
3740     tfLuminance4: begin
3741       for i := 0 to High(fColorTable) do begin
3742         fColorTable[i].r := 16 * i;
3743         fColorTable[i].g := 16 * i;
3744         fColorTable[i].b := 16 * i;
3745         fColorTable[i].a := 0;
3746       end;
3747     end;
3748
3749     tfLuminance8: begin
3750       for i := 0 to High(fColorTable) do begin
3751         fColorTable[i].r := i;
3752         fColorTable[i].g := i;
3753         fColorTable[i].b := i;
3754         fColorTable[i].a := 0;
3755       end;
3756     end;
3757
3758     tfR3G3B2: begin
3759       for i := 0 to High(fColorTable) do begin
3760         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3761         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3762         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3763         fColorTable[i].a := 0;
3764       end;
3765     end;
3766   end;
3767 end;
3768
3769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3770 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3771 var
3772   d: Byte;
3773 begin
3774   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3775     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3776
3777   case Format of
3778     tfLuminance4: begin
3779       if (aMapData = nil) then
3780         aData^ := 0;
3781       d := LuminanceWeight(aPixel) and Range.r;
3782       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3783       inc(PByte(aMapData), 4);
3784       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3785         inc(aData);
3786         aMapData := nil;
3787       end;
3788     end;
3789
3790     tfLuminance8: begin
3791       aData^ := LuminanceWeight(aPixel) and Range.r;
3792       inc(aData);
3793     end;
3794
3795     tfR3G3B2: begin
3796       aData^ := Round(
3797         ((aPixel.Data.r and Range.r) shl Shift.r) or
3798         ((aPixel.Data.g and Range.g) shl Shift.g) or
3799         ((aPixel.Data.b and Range.b) shl Shift.b));
3800       inc(aData);
3801     end;
3802   end;
3803 end;
3804
3805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3806 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3807 var
3808   idx: QWord;
3809   s: Integer;
3810   bits: Byte;
3811   f: Single;
3812 begin
3813   s    := Trunc(fPixelSize);
3814   f    := fPixelSize - s;
3815   bits := Round(8 * f);
3816   case s of
3817     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3818     1: idx :=           aData^;
3819     2: idx :=     PWord(aData)^;
3820     4: idx := PCardinal(aData)^;
3821     8: idx :=    PQWord(aData)^;
3822   else
3823     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3824   end;
3825   if (idx >= Length(fColorTable)) then
3826     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3827   with fColorTable[idx] do begin
3828     aPixel.Data.r := r;
3829     aPixel.Data.g := g;
3830     aPixel.Data.b := b;
3831     aPixel.Data.a := a;
3832   end;
3833   inc(PByte(aMapData), bits);
3834   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3835     inc(aData, 1);
3836     dec(PByte(aMapData), 8);
3837   end;
3838   inc(aData, s);
3839 end;
3840
3841 destructor TbmpColorTableFormat.Destroy;
3842 begin
3843   SetLength(fColorTable, 0);
3844   inherited Destroy;
3845 end;
3846
3847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3848 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3850 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3851 var
3852   i: Integer;
3853 begin
3854   for i := 0 to 3 do begin
3855     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3856       if (aSourceFD.Range.arr[i] > 0) then
3857         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3858       else
3859         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3860     end;
3861   end;
3862 end;
3863
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3866 begin
3867   with aFuncRec do begin
3868     if (Source.Range.r   > 0) then
3869       Dest.Data.r := Source.Data.r;
3870     if (Source.Range.g > 0) then
3871       Dest.Data.g := Source.Data.g;
3872     if (Source.Range.b  > 0) then
3873       Dest.Data.b := Source.Data.b;
3874     if (Source.Range.a > 0) then
3875       Dest.Data.a := Source.Data.a;
3876   end;
3877 end;
3878
3879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3880 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3881 var
3882   i: Integer;
3883 begin
3884   with aFuncRec do begin
3885     for i := 0 to 3 do
3886       if (Source.Range.arr[i] > 0) then
3887         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3888   end;
3889 end;
3890
3891 type
3892   TShiftData = packed record
3893     case Integer of
3894       0: (r, g, b, a: SmallInt);
3895       1: (arr: array[0..3] of SmallInt);
3896   end;
3897   PShiftData = ^TShiftData;
3898
3899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3900 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3901 var
3902   i: Integer;
3903 begin
3904   with aFuncRec do
3905     for i := 0 to 3 do
3906       if (Source.Range.arr[i] > 0) then
3907         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3908 end;
3909
3910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3912 begin
3913   with aFuncRec do begin
3914     Dest.Data := Source.Data;
3915     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3916       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3917       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3918       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3919     end;
3920     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3921       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3922     end;
3923   end;
3924 end;
3925
3926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3927 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3928 var
3929   i: Integer;
3930 begin
3931   with aFuncRec do begin
3932     for i := 0 to 3 do
3933       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3934   end;
3935 end;
3936
3937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3938 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3939 var
3940   Temp: Single;
3941 begin
3942   with FuncRec do begin
3943     if (FuncRec.Args = nil) then begin //source has no alpha
3944       Temp :=
3945         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3946         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3947         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3948       Dest.Data.a := Round(Dest.Range.a * Temp);
3949     end else
3950       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3951   end;
3952 end;
3953
3954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3955 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3956 type
3957   PglBitmapPixelData = ^TglBitmapPixelData;
3958 begin
3959   with FuncRec do begin
3960     Dest.Data.r := Source.Data.r;
3961     Dest.Data.g := Source.Data.g;
3962     Dest.Data.b := Source.Data.b;
3963
3964     with PglBitmapPixelData(Args)^ do
3965       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3966           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3967           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3968         Dest.Data.a := 0
3969       else
3970         Dest.Data.a := Dest.Range.a;
3971   end;
3972 end;
3973
3974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3975 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3976 begin
3977   with FuncRec do begin
3978     Dest.Data.r := Source.Data.r;
3979     Dest.Data.g := Source.Data.g;
3980     Dest.Data.b := Source.Data.b;
3981     Dest.Data.a := PCardinal(Args)^;
3982   end;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3987 type
3988   PRGBPix = ^TRGBPix;
3989   TRGBPix = array [0..2] of byte;
3990 var
3991   Temp: Byte;
3992 begin
3993   while aWidth > 0 do begin
3994     Temp := PRGBPix(aData)^[0];
3995     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3996     PRGBPix(aData)^[2] := Temp;
3997
3998     if aHasAlpha then
3999       Inc(aData, 4)
4000     else
4001       Inc(aData, 3);
4002     dec(aWidth);
4003   end;
4004 end;
4005
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4009 function TglBitmap.GetWidth: Integer;
4010 begin
4011   if (ffX in fDimension.Fields) then
4012     result := fDimension.X
4013   else
4014     result := -1;
4015 end;
4016
4017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4018 function TglBitmap.GetHeight: Integer;
4019 begin
4020   if (ffY in fDimension.Fields) then
4021     result := fDimension.Y
4022   else
4023     result := -1;
4024 end;
4025
4026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4027 function TglBitmap.GetFileWidth: Integer;
4028 begin
4029   result := Max(1, Width);
4030 end;
4031
4032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4033 function TglBitmap.GetFileHeight: Integer;
4034 begin
4035   result := Max(1, Height);
4036 end;
4037
4038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4039 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4040 begin
4041   if fCustomData = aValue then
4042     exit;
4043   fCustomData := aValue;
4044 end;
4045
4046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4047 procedure TglBitmap.SetCustomName(const aValue: String);
4048 begin
4049   if fCustomName = aValue then
4050     exit;
4051   fCustomName := aValue;
4052 end;
4053
4054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4055 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4056 begin
4057   if fCustomNameW = aValue then
4058     exit;
4059   fCustomNameW := aValue;
4060 end;
4061
4062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4063 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4064 begin
4065   if fDeleteTextureOnFree = aValue then
4066     exit;
4067   fDeleteTextureOnFree := aValue;
4068 end;
4069
4070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4071 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4072 begin
4073   if fFormat = aValue then
4074     exit;
4075   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4076     raise EglBitmapUnsupportedFormat.Create(Format);
4077   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4078 end;
4079
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4082 begin
4083   if fFreeDataAfterGenTexture = aValue then
4084     exit;
4085   fFreeDataAfterGenTexture := aValue;
4086 end;
4087
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 procedure TglBitmap.SetID(const aValue: Cardinal);
4090 begin
4091   if fID = aValue then
4092     exit;
4093   fID := aValue;
4094 end;
4095
4096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4097 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4098 begin
4099   if fMipMap = aValue then
4100     exit;
4101   fMipMap := aValue;
4102 end;
4103
4104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4105 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4106 begin
4107   if fTarget = aValue then
4108     exit;
4109   fTarget := aValue;
4110 end;
4111
4112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4114 var
4115   MaxAnisotropic: Integer;
4116 begin
4117   fAnisotropic := aValue;
4118   if (ID > 0) then begin
4119     if GL_EXT_texture_filter_anisotropic then begin
4120       if fAnisotropic > 0 then begin
4121         Bind(false);
4122         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4123         if aValue > MaxAnisotropic then
4124           fAnisotropic := MaxAnisotropic;
4125         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4126       end;
4127     end else begin
4128       fAnisotropic := 0;
4129     end;
4130   end;
4131 end;
4132
4133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4134 procedure TglBitmap.CreateID;
4135 begin
4136   if (ID <> 0) then
4137     glDeleteTextures(1, @fID);
4138   glGenTextures(1, @fID);
4139   Bind(false);
4140 end;
4141
4142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4144 begin
4145   // Set Up Parameters
4146   SetWrap(fWrapS, fWrapT, fWrapR);
4147   SetFilter(fFilterMin, fFilterMag);
4148   SetAnisotropic(fAnisotropic);
4149   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4150
4151   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4152     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4153
4154   // Mip Maps Generation Mode
4155   aBuildWithGlu := false;
4156   if (MipMap = mmMipmap) then begin
4157     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4158       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4159     else
4160       aBuildWithGlu := true;
4161   end else if (MipMap = mmMipmapGlu) then
4162     aBuildWithGlu := true;
4163 end;
4164
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4167   const aWidth: Integer; const aHeight: Integer);
4168 var
4169   s: Single;
4170 begin
4171   if (Data <> aData) then begin
4172     if (Assigned(Data)) then
4173       FreeMem(Data);
4174     fData := aData;
4175   end;
4176
4177   FillChar(fDimension, SizeOf(fDimension), 0);
4178   if not Assigned(fData) then begin
4179     fFormat    := tfEmpty;
4180     fPixelSize := 0;
4181     fRowSize   := 0;
4182   end else begin
4183     if aWidth <> -1 then begin
4184       fDimension.Fields := fDimension.Fields + [ffX];
4185       fDimension.X := aWidth;
4186     end;
4187
4188     if aHeight <> -1 then begin
4189       fDimension.Fields := fDimension.Fields + [ffY];
4190       fDimension.Y := aHeight;
4191     end;
4192
4193     s := TFormatDescriptor.Get(aFormat).PixelSize;
4194     fFormat    := aFormat;
4195     fPixelSize := Ceil(s);
4196     fRowSize   := Ceil(s * aWidth);
4197   end;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 function TglBitmap.FlipHorz: Boolean;
4202 begin
4203   result := false;
4204 end;
4205
4206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4207 function TglBitmap.FlipVert: Boolean;
4208 begin
4209   result := false;
4210 end;
4211
4212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4213 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4215 procedure TglBitmap.AfterConstruction;
4216 begin
4217   inherited AfterConstruction;
4218
4219   fID         := 0;
4220   fTarget     := 0;
4221   fIsResident := false;
4222
4223   fFormat                  := glBitmapGetDefaultFormat;
4224   fMipMap                  := glBitmapDefaultMipmap;
4225   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4226   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4227
4228   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4229   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4230   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4231 end;
4232
4233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4234 procedure TglBitmap.BeforeDestruction;
4235 var
4236   NewData: PByte;
4237 begin
4238   NewData := nil;
4239   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4240   if (fID > 0) and fDeleteTextureOnFree then
4241     glDeleteTextures(1, @fID);
4242   inherited BeforeDestruction;
4243 end;
4244
4245 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4246 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4247 var
4248   TempPos: Integer;
4249 begin
4250   if not Assigned(aResType) then begin
4251     TempPos   := Pos('.', aResource);
4252     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4253     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4254   end;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 procedure TglBitmap.LoadFromFile(const aFilename: String);
4259 var
4260   fs: TFileStream;
4261 begin
4262   if not FileExists(aFilename) then
4263     raise EglBitmap.Create('file does not exist: ' + aFilename);
4264   fFilename := aFilename;
4265   fs := TFileStream.Create(fFilename, fmOpenRead);
4266   try
4267     fs.Position := 0;
4268     LoadFromStream(fs);
4269   finally
4270     fs.Free;
4271   end;
4272 end;
4273
4274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4275 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4276 begin
4277   {$IFDEF GLB_SUPPORT_PNG_READ}
4278   if not LoadPNG(aStream) then
4279   {$ENDIF}
4280   {$IFDEF GLB_SUPPORT_JPEG_READ}
4281   if not LoadJPEG(aStream) then
4282   {$ENDIF}
4283   if not LoadDDS(aStream) then
4284   if not LoadTGA(aStream) then
4285   if not LoadBMP(aStream) then
4286     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4287 end;
4288
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4291   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4292 var
4293   tmpData: PByte;
4294   size: Integer;
4295 begin
4296   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4297   GetMem(tmpData, size);
4298   try
4299     FillChar(tmpData^, size, #$FF);
4300     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4301   except
4302     if Assigned(tmpData) then
4303       FreeMem(tmpData);
4304     raise;
4305   end;
4306   AddFunc(Self, aFunc, false, Format, aArgs);
4307 end;
4308
4309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4310 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4311 var
4312   rs: TResourceStream;
4313 begin
4314   PrepareResType(aResource, aResType);
4315   rs := TResourceStream.Create(aInstance, aResource, aResType);
4316   try
4317     LoadFromStream(rs);
4318   finally
4319     rs.Free;
4320   end;
4321 end;
4322
4323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4324 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4325 var
4326   rs: TResourceStream;
4327 begin
4328   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4329   try
4330     LoadFromStream(rs);
4331   finally
4332     rs.Free;
4333   end;
4334 end;
4335
4336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4337 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4338 var
4339   fs: TFileStream;
4340 begin
4341   fs := TFileStream.Create(aFileName, fmCreate);
4342   try
4343     fs.Position := 0;
4344     SaveToStream(fs, aFileType);
4345   finally
4346     fs.Free;
4347   end;
4348 end;
4349
4350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4351 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4352 begin
4353   case aFileType of
4354     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4355     ftPNG:  SavePNG(aStream);
4356     {$ENDIF}
4357     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4358     ftJPEG: SaveJPEG(aStream);
4359     {$ENDIF}
4360     ftDDS:  SaveDDS(aStream);
4361     ftTGA:  SaveTGA(aStream);
4362     ftBMP:  SaveBMP(aStream);
4363   end;
4364 end;
4365
4366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4368 begin
4369   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4370 end;
4371
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4374   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4375 var
4376   DestData, TmpData, SourceData: pByte;
4377   TempHeight, TempWidth: Integer;
4378   SourceFD, DestFD: TFormatDescriptor;
4379   SourceMD, DestMD: Pointer;
4380
4381   FuncRec: TglBitmapFunctionRec;
4382 begin
4383   Assert(Assigned(Data));
4384   Assert(Assigned(aSource));
4385   Assert(Assigned(aSource.Data));
4386
4387   result := false;
4388   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4389     SourceFD := TFormatDescriptor.Get(aSource.Format);
4390     DestFD   := TFormatDescriptor.Get(aFormat);
4391
4392     if (SourceFD.IsCompressed) then
4393       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4394     if (DestFD.IsCompressed) then
4395       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4396
4397     // inkompatible Formats so CreateTemp
4398     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4399       aCreateTemp := true;
4400
4401     // Values
4402     TempHeight := Max(1, aSource.Height);
4403     TempWidth  := Max(1, aSource.Width);
4404
4405     FuncRec.Sender := Self;
4406     FuncRec.Args   := aArgs;
4407
4408     TmpData := nil;
4409     if aCreateTemp then begin
4410       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4411       DestData := TmpData;
4412     end else
4413       DestData := Data;
4414
4415     try
4416       SourceFD.PreparePixel(FuncRec.Source);
4417       DestFD.PreparePixel  (FuncRec.Dest);
4418
4419       SourceMD := SourceFD.CreateMappingData;
4420       DestMD   := DestFD.CreateMappingData;
4421
4422       FuncRec.Size            := aSource.Dimension;
4423       FuncRec.Position.Fields := FuncRec.Size.Fields;
4424
4425       try
4426         SourceData := aSource.Data;
4427         FuncRec.Position.Y := 0;
4428         while FuncRec.Position.Y < TempHeight do begin
4429           FuncRec.Position.X := 0;
4430           while FuncRec.Position.X < TempWidth do begin
4431             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4432             aFunc(FuncRec);
4433             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4434             inc(FuncRec.Position.X);
4435           end;
4436           inc(FuncRec.Position.Y);
4437         end;
4438
4439         // Updating Image or InternalFormat
4440         if aCreateTemp then
4441           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4442         else if (aFormat <> fFormat) then
4443           Format := aFormat;
4444
4445         result := true;
4446       finally
4447         SourceFD.FreeMappingData(SourceMD);
4448         DestFD.FreeMappingData(DestMD);
4449       end;
4450     except
4451       if aCreateTemp and Assigned(TmpData) then
4452         FreeMem(TmpData);
4453       raise;
4454     end;
4455   end;
4456 end;
4457
4458 {$IFDEF GLB_SDL}
4459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4460 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4461 var
4462   Row, RowSize: Integer;
4463   SourceData, TmpData: PByte;
4464   TempDepth: Integer;
4465   FormatDesc: TFormatDescriptor;
4466
4467   function GetRowPointer(Row: Integer): pByte;
4468   begin
4469     result := aSurface.pixels;
4470     Inc(result, Row * RowSize);
4471   end;
4472
4473 begin
4474   result := false;
4475
4476   FormatDesc := TFormatDescriptor.Get(Format);
4477   if FormatDesc.IsCompressed then
4478     raise EglBitmapUnsupportedFormat.Create(Format);
4479
4480   if Assigned(Data) then begin
4481     case Trunc(FormatDesc.PixelSize) of
4482       1: TempDepth :=  8;
4483       2: TempDepth := 16;
4484       3: TempDepth := 24;
4485       4: TempDepth := 32;
4486     else
4487       raise EglBitmapUnsupportedFormat.Create(Format);
4488     end;
4489
4490     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4491       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4492     SourceData := Data;
4493     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4494
4495     for Row := 0 to FileHeight-1 do begin
4496       TmpData := GetRowPointer(Row);
4497       if Assigned(TmpData) then begin
4498         Move(SourceData^, TmpData^, RowSize);
4499         inc(SourceData, RowSize);
4500       end;
4501     end;
4502     result := true;
4503   end;
4504 end;
4505
4506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4507 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4508 var
4509   pSource, pData, pTempData: PByte;
4510   Row, RowSize, TempWidth, TempHeight: Integer;
4511   IntFormat: TglBitmapFormat;
4512   FormatDesc: TFormatDescriptor;
4513
4514   function GetRowPointer(Row: Integer): pByte;
4515   begin
4516     result := aSurface^.pixels;
4517     Inc(result, Row * RowSize);
4518   end;
4519
4520 begin
4521   result := false;
4522   if (Assigned(aSurface)) then begin
4523     with aSurface^.format^ do begin
4524       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4525         FormatDesc := TFormatDescriptor.Get(IntFormat);
4526         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4527           break;
4528       end;
4529       if (IntFormat = tfEmpty) then
4530         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4531     end;
4532
4533     TempWidth  := aSurface^.w;
4534     TempHeight := aSurface^.h;
4535     RowSize := FormatDesc.GetSize(TempWidth, 1);
4536     GetMem(pData, TempHeight * RowSize);
4537     try
4538       pTempData := pData;
4539       for Row := 0 to TempHeight -1 do begin
4540         pSource := GetRowPointer(Row);
4541         if (Assigned(pSource)) then begin
4542           Move(pSource^, pTempData^, RowSize);
4543           Inc(pTempData, RowSize);
4544         end;
4545       end;
4546       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4547       result := true;
4548     except
4549       if Assigned(pData) then
4550         FreeMem(pData);
4551       raise;
4552     end;
4553   end;
4554 end;
4555
4556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4557 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4558 var
4559   Row, Col, AlphaInterleave: Integer;
4560   pSource, pDest: PByte;
4561
4562   function GetRowPointer(Row: Integer): pByte;
4563   begin
4564     result := aSurface.pixels;
4565     Inc(result, Row * Width);
4566   end;
4567
4568 begin
4569   result := false;
4570   if Assigned(Data) then begin
4571     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4572       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4573
4574       AlphaInterleave := 0;
4575       case Format of
4576         tfLuminance8Alpha8:
4577           AlphaInterleave := 1;
4578         tfBGRA8, tfRGBA8:
4579           AlphaInterleave := 3;
4580       end;
4581
4582       pSource := Data;
4583       for Row := 0 to Height -1 do begin
4584         pDest := GetRowPointer(Row);
4585         if Assigned(pDest) then begin
4586           for Col := 0 to Width -1 do begin
4587             Inc(pSource, AlphaInterleave);
4588             pDest^ := pSource^;
4589             Inc(pDest);
4590             Inc(pSource);
4591           end;
4592         end;
4593       end;
4594       result := true;
4595     end;
4596   end;
4597 end;
4598
4599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4600 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4601 var
4602   bmp: TglBitmap2D;
4603 begin
4604   bmp := TglBitmap2D.Create;
4605   try
4606     bmp.AssignFromSurface(aSurface);
4607     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4608   finally
4609     bmp.Free;
4610   end;
4611 end;
4612 {$ENDIF}
4613
4614 {$IFDEF GLB_DELPHI}
4615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4616 function CreateGrayPalette: HPALETTE;
4617 var
4618   Idx: Integer;
4619   Pal: PLogPalette;
4620 begin
4621   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4622
4623   Pal.palVersion := $300;
4624   Pal.palNumEntries := 256;
4625
4626   for Idx := 0 to Pal.palNumEntries - 1 do begin
4627     Pal.palPalEntry[Idx].peRed   := Idx;
4628     Pal.palPalEntry[Idx].peGreen := Idx;
4629     Pal.palPalEntry[Idx].peBlue  := Idx;
4630     Pal.palPalEntry[Idx].peFlags := 0;
4631   end;
4632   Result := CreatePalette(Pal^);
4633   FreeMem(Pal);
4634 end;
4635
4636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4637 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4638 var
4639   Row: Integer;
4640   pSource, pData: PByte;
4641 begin
4642   result := false;
4643   if Assigned(Data) then begin
4644     if Assigned(aBitmap) then begin
4645       aBitmap.Width  := Width;
4646       aBitmap.Height := Height;
4647
4648       case Format of
4649         tfAlpha8, tfLuminance8: begin
4650           aBitmap.PixelFormat := pf8bit;
4651           aBitmap.Palette     := CreateGrayPalette;
4652         end;
4653         tfRGB5A1:
4654           aBitmap.PixelFormat := pf15bit;
4655         tfR5G6B5:
4656           aBitmap.PixelFormat := pf16bit;
4657         tfRGB8, tfBGR8:
4658           aBitmap.PixelFormat := pf24bit;
4659         tfRGBA8, tfBGRA8:
4660           aBitmap.PixelFormat := pf32bit;
4661       else
4662         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4663       end;
4664
4665       pSource := Data;
4666       for Row := 0 to FileHeight -1 do begin
4667         pData := aBitmap.Scanline[Row];
4668         Move(pSource^, pData^, fRowSize);
4669         Inc(pSource, fRowSize);
4670         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4671           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4672       end;
4673       result := true;
4674     end;
4675   end;
4676 end;
4677
4678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4679 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4680 var
4681   pSource, pData, pTempData: PByte;
4682   Row, RowSize, TempWidth, TempHeight: Integer;
4683   IntFormat: TglBitmapFormat;
4684 begin
4685   result := false;
4686
4687   if (Assigned(aBitmap)) then begin
4688     case aBitmap.PixelFormat of
4689       pf8bit:
4690         IntFormat := tfLuminance8;
4691       pf15bit:
4692         IntFormat := tfRGB5A1;
4693       pf16bit:
4694         IntFormat := tfR5G6B5;
4695       pf24bit:
4696         IntFormat := tfBGR8;
4697       pf32bit:
4698         IntFormat := tfBGRA8;
4699     else
4700       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4701     end;
4702
4703     TempWidth  := aBitmap.Width;
4704     TempHeight := aBitmap.Height;
4705     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4706     GetMem(pData, TempHeight * RowSize);
4707     try
4708       pTempData := pData;
4709       for Row := 0 to TempHeight -1 do begin
4710         pSource := aBitmap.Scanline[Row];
4711         if (Assigned(pSource)) then begin
4712           Move(pSource^, pTempData^, RowSize);
4713           Inc(pTempData, RowSize);
4714         end;
4715       end;
4716       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4717       result := true;
4718     except
4719       if Assigned(pData) then
4720         FreeMem(pData);
4721       raise;
4722     end;
4723   end;
4724 end;
4725
4726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4727 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4728 var
4729   Row, Col, AlphaInterleave: Integer;
4730   pSource, pDest: PByte;
4731 begin
4732   result := false;
4733
4734   if Assigned(Data) then begin
4735     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4736       if Assigned(aBitmap) then begin
4737         aBitmap.PixelFormat := pf8bit;
4738         aBitmap.Palette     := CreateGrayPalette;
4739         aBitmap.Width       := Width;
4740         aBitmap.Height      := Height;
4741
4742         case Format of
4743           tfLuminance8Alpha8:
4744             AlphaInterleave := 1;
4745           tfRGBA8, tfBGRA8:
4746             AlphaInterleave := 3;
4747           else
4748             AlphaInterleave := 0;
4749         end;
4750
4751         // Copy Data
4752         pSource := Data;
4753
4754         for Row := 0 to Height -1 do begin
4755           pDest := aBitmap.Scanline[Row];
4756           if Assigned(pDest) then begin
4757             for Col := 0 to Width -1 do begin
4758               Inc(pSource, AlphaInterleave);
4759               pDest^ := pSource^;
4760               Inc(pDest);
4761               Inc(pSource);
4762             end;
4763           end;
4764         end;
4765         result := true;
4766       end;
4767     end;
4768   end;
4769 end;
4770
4771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4772 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4773 var
4774   tex: TglBitmap2D;
4775 begin
4776   tex := TglBitmap2D.Create;
4777   try
4778     tex.AssignFromBitmap(ABitmap);
4779     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4780   finally
4781     tex.Free;
4782   end;
4783 end;
4784 {$ENDIF}
4785
4786 {$IFDEF GLB_LAZARUS}
4787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4788 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4789 var
4790   rid: TRawImageDescription;
4791   FormatDesc: TFormatDescriptor;
4792 begin
4793   result := false;
4794   if not Assigned(aImage) or (Format = tfEmpty) then
4795     exit;
4796   FormatDesc := TFormatDescriptor.Get(Format);
4797   if FormatDesc.IsCompressed then
4798     exit;
4799
4800   FillChar(rid{%H-}, SizeOf(rid), 0);
4801   if (Format in [
4802        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4803        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4804        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4805     rid.Format := ricfGray
4806   else
4807     rid.Format := ricfRGBA;
4808
4809   rid.Width        := Width;
4810   rid.Height       := Height;
4811   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4812   rid.BitOrder     := riboBitsInOrder;
4813   rid.ByteOrder    := riboLSBFirst;
4814   rid.LineOrder    := riloTopToBottom;
4815   rid.LineEnd      := rileTight;
4816   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4817   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4818   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4819   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4820   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4821   rid.RedShift     := FormatDesc.Shift.r;
4822   rid.GreenShift   := FormatDesc.Shift.g;
4823   rid.BlueShift    := FormatDesc.Shift.b;
4824   rid.AlphaShift   := FormatDesc.Shift.a;
4825
4826   rid.MaskBitsPerPixel  := 0;
4827   rid.PaletteColorCount := 0;
4828
4829   aImage.DataDescription := rid;
4830   aImage.CreateData;
4831
4832   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4833
4834   result := true;
4835 end;
4836
4837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4838 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4839 var
4840   f: TglBitmapFormat;
4841   FormatDesc: TFormatDescriptor;
4842   ImageData: PByte;
4843   ImageSize: Integer;
4844 begin
4845   result := false;
4846   if not Assigned(aImage) then
4847     exit;
4848   for f := High(f) downto Low(f) do begin
4849     FormatDesc := TFormatDescriptor.Get(f);
4850     with aImage.DataDescription do
4851       if FormatDesc.MaskMatch(
4852         (QWord(1 shl RedPrec  )-1) shl RedShift,
4853         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4854         (QWord(1 shl BluePrec )-1) shl BlueShift,
4855         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4856         break;
4857   end;
4858
4859   if (f = tfEmpty) then
4860     exit;
4861
4862   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4863   ImageData := GetMem(ImageSize);
4864   try
4865     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4866     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4867   except
4868     if Assigned(ImageData) then
4869       FreeMem(ImageData);
4870     raise;
4871   end;
4872
4873   result := true;
4874 end;
4875
4876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4877 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4878 var
4879   rid: TRawImageDescription;
4880   FormatDesc: TFormatDescriptor;
4881   Pixel: TglBitmapPixelData;
4882   x, y: Integer;
4883   srcMD: Pointer;
4884   src, dst: PByte;
4885 begin
4886   result := false;
4887   if not Assigned(aImage) or (Format = tfEmpty) then
4888     exit;
4889   FormatDesc := TFormatDescriptor.Get(Format);
4890   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4891     exit;
4892
4893   FillChar(rid{%H-}, SizeOf(rid), 0);
4894   rid.Format       := ricfGray;
4895   rid.Width        := Width;
4896   rid.Height       := Height;
4897   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4898   rid.BitOrder     := riboBitsInOrder;
4899   rid.ByteOrder    := riboLSBFirst;
4900   rid.LineOrder    := riloTopToBottom;
4901   rid.LineEnd      := rileTight;
4902   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4903   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4904   rid.GreenPrec    := 0;
4905   rid.BluePrec     := 0;
4906   rid.AlphaPrec    := 0;
4907   rid.RedShift     := 0;
4908   rid.GreenShift   := 0;
4909   rid.BlueShift    := 0;
4910   rid.AlphaShift   := 0;
4911
4912   rid.MaskBitsPerPixel  := 0;
4913   rid.PaletteColorCount := 0;
4914
4915   aImage.DataDescription := rid;
4916   aImage.CreateData;
4917
4918   srcMD := FormatDesc.CreateMappingData;
4919   try
4920     FormatDesc.PreparePixel(Pixel);
4921     src := Data;
4922     dst := aImage.PixelData;
4923     for y := 0 to Height-1 do
4924       for x := 0 to Width-1 do begin
4925         FormatDesc.Unmap(src, Pixel, srcMD);
4926         case rid.BitsPerPixel of
4927            8: begin
4928             dst^ := Pixel.Data.a;
4929             inc(dst);
4930           end;
4931           16: begin
4932             PWord(dst)^ := Pixel.Data.a;
4933             inc(dst, 2);
4934           end;
4935           24: begin
4936             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4937             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4938             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4939             inc(dst, 3);
4940           end;
4941           32: begin
4942             PCardinal(dst)^ := Pixel.Data.a;
4943             inc(dst, 4);
4944           end;
4945         else
4946           raise EglBitmapUnsupportedFormat.Create(Format);
4947         end;
4948       end;
4949   finally
4950     FormatDesc.FreeMappingData(srcMD);
4951   end;
4952   result := true;
4953 end;
4954
4955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4956 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4957 var
4958   tex: TglBitmap2D;
4959 begin
4960   tex := TglBitmap2D.Create;
4961   try
4962     tex.AssignFromLazIntfImage(aImage);
4963     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4964   finally
4965     tex.Free;
4966   end;
4967 end;
4968 {$ENDIF}
4969
4970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4971 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4972   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4973 var
4974   rs: TResourceStream;
4975 begin
4976   PrepareResType(aResource, aResType);
4977   rs := TResourceStream.Create(aInstance, aResource, aResType);
4978   try
4979     result := AddAlphaFromStream(rs, aFunc, aArgs);
4980   finally
4981     rs.Free;
4982   end;
4983 end;
4984
4985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4986 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4987   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4988 var
4989   rs: TResourceStream;
4990 begin
4991   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4992   try
4993     result := AddAlphaFromStream(rs, aFunc, aArgs);
4994   finally
4995     rs.Free;
4996   end;
4997 end;
4998
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5001 begin
5002   if TFormatDescriptor.Get(Format).IsCompressed then
5003     raise EglBitmapUnsupportedFormat.Create(Format);
5004   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5005 end;
5006
5007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5008 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5009 var
5010   FS: TFileStream;
5011 begin
5012   FS := TFileStream.Create(FileName, fmOpenRead);
5013   try
5014     result := AddAlphaFromStream(FS, aFunc, aArgs);
5015   finally
5016     FS.Free;
5017   end;
5018 end;
5019
5020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5021 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5022 var
5023   tex: TglBitmap2D;
5024 begin
5025   tex := TglBitmap2D.Create(aStream);
5026   try
5027     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5028   finally
5029     tex.Free;
5030   end;
5031 end;
5032
5033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5034 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5035 var
5036   DestData, DestData2, SourceData: pByte;
5037   TempHeight, TempWidth: Integer;
5038   SourceFD, DestFD: TFormatDescriptor;
5039   SourceMD, DestMD, DestMD2: Pointer;
5040
5041   FuncRec: TglBitmapFunctionRec;
5042 begin
5043   result := false;
5044
5045   Assert(Assigned(Data));
5046   Assert(Assigned(aBitmap));
5047   Assert(Assigned(aBitmap.Data));
5048
5049   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5050     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5051
5052     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5053     DestFD   := TFormatDescriptor.Get(Format);
5054
5055     if not Assigned(aFunc) then begin
5056       aFunc        := glBitmapAlphaFunc;
5057       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5058     end else
5059       FuncRec.Args := aArgs;
5060
5061     // Values
5062     TempHeight := aBitmap.FileHeight;
5063     TempWidth  := aBitmap.FileWidth;
5064
5065     FuncRec.Sender          := Self;
5066     FuncRec.Size            := Dimension;
5067     FuncRec.Position.Fields := FuncRec.Size.Fields;
5068
5069     DestData   := Data;
5070     DestData2  := Data;
5071     SourceData := aBitmap.Data;
5072
5073     // Mapping
5074     SourceFD.PreparePixel(FuncRec.Source);
5075     DestFD.PreparePixel  (FuncRec.Dest);
5076
5077     SourceMD := SourceFD.CreateMappingData;
5078     DestMD   := DestFD.CreateMappingData;
5079     DestMD2  := DestFD.CreateMappingData;
5080     try
5081       FuncRec.Position.Y := 0;
5082       while FuncRec.Position.Y < TempHeight do begin
5083         FuncRec.Position.X := 0;
5084         while FuncRec.Position.X < TempWidth do begin
5085           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5086           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5087           aFunc(FuncRec);
5088           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5089           inc(FuncRec.Position.X);
5090         end;
5091         inc(FuncRec.Position.Y);
5092       end;
5093     finally
5094       SourceFD.FreeMappingData(SourceMD);
5095       DestFD.FreeMappingData(DestMD);
5096       DestFD.FreeMappingData(DestMD2);
5097     end;
5098   end;
5099 end;
5100
5101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5102 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5103 begin
5104   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5105 end;
5106
5107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5108 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5109 var
5110   PixelData: TglBitmapPixelData;
5111 begin
5112   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5113   result := AddAlphaFromColorKeyFloat(
5114     aRed   / PixelData.Range.r,
5115     aGreen / PixelData.Range.g,
5116     aBlue  / PixelData.Range.b,
5117     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5118 end;
5119
5120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5121 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5122 var
5123   values: array[0..2] of Single;
5124   tmp: Cardinal;
5125   i: Integer;
5126   PixelData: TglBitmapPixelData;
5127 begin
5128   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5129   with PixelData do begin
5130     values[0] := aRed;
5131     values[1] := aGreen;
5132     values[2] := aBlue;
5133
5134     for i := 0 to 2 do begin
5135       tmp          := Trunc(Range.arr[i] * aDeviation);
5136       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5137       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5138     end;
5139     Data.a  := 0;
5140     Range.a := 0;
5141   end;
5142   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5143 end;
5144
5145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5146 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5147 begin
5148   result := AddAlphaFromValueFloat(aAlpha / $FF);
5149 end;
5150
5151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5152 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5153 var
5154   PixelData: TglBitmapPixelData;
5155 begin
5156   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5157   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5158 end;
5159
5160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5161 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5162 var
5163   PixelData: TglBitmapPixelData;
5164 begin
5165   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5166   with PixelData do
5167     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5168   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5169 end;
5170
5171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5172 function TglBitmap.RemoveAlpha: Boolean;
5173 var
5174   FormatDesc: TFormatDescriptor;
5175 begin
5176   result := false;
5177   FormatDesc := TFormatDescriptor.Get(Format);
5178   if Assigned(Data) then begin
5179     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5180       raise EglBitmapUnsupportedFormat.Create(Format);
5181     result := ConvertTo(FormatDesc.WithoutAlpha);
5182   end;
5183 end;
5184
5185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5186 function TglBitmap.Clone: TglBitmap;
5187 var
5188   Temp: TglBitmap;
5189   TempPtr: PByte;
5190   Size: Integer;
5191 begin
5192   result := nil;
5193   Temp := (ClassType.Create as TglBitmap);
5194   try
5195     // copy texture data if assigned
5196     if Assigned(Data) then begin
5197       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5198       GetMem(TempPtr, Size);
5199       try
5200         Move(Data^, TempPtr^, Size);
5201         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5202       except
5203         if Assigned(TempPtr) then
5204           FreeMem(TempPtr);
5205         raise;
5206       end;
5207     end else begin
5208       TempPtr := nil;
5209       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5210     end;
5211
5212         // copy properties
5213     Temp.fID                      := ID;
5214     Temp.fTarget                  := Target;
5215     Temp.fFormat                  := Format;
5216     Temp.fMipMap                  := MipMap;
5217     Temp.fAnisotropic             := Anisotropic;
5218     Temp.fBorderColor             := fBorderColor;
5219     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5220     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5221     Temp.fFilterMin               := fFilterMin;
5222     Temp.fFilterMag               := fFilterMag;
5223     Temp.fWrapS                   := fWrapS;
5224     Temp.fWrapT                   := fWrapT;
5225     Temp.fWrapR                   := fWrapR;
5226     Temp.fFilename                := fFilename;
5227     Temp.fCustomName              := fCustomName;
5228     Temp.fCustomNameW             := fCustomNameW;
5229     Temp.fCustomData              := fCustomData;
5230
5231     result := Temp;
5232   except
5233     FreeAndNil(Temp);
5234     raise;
5235   end;
5236 end;
5237
5238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5239 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5240 var
5241   SourceFD, DestFD: TFormatDescriptor;
5242   SourcePD, DestPD: TglBitmapPixelData;
5243   ShiftData: TShiftData;
5244
5245   function CanCopyDirect: Boolean;
5246   begin
5247     result :=
5248       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5249       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5250       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5251       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5252   end;
5253
5254   function CanShift: Boolean;
5255   begin
5256     result :=
5257       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5258       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5259       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5260       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5261   end;
5262
5263   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5264   begin
5265     result := 0;
5266     while (aSource > aDest) and (aSource > 0) do begin
5267       inc(result);
5268       aSource := aSource shr 1;
5269     end;
5270   end;
5271
5272 begin
5273   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5274     SourceFD := TFormatDescriptor.Get(Format);
5275     DestFD   := TFormatDescriptor.Get(aFormat);
5276
5277     SourceFD.PreparePixel(SourcePD);
5278     DestFD.PreparePixel  (DestPD);
5279
5280     if CanCopyDirect then
5281       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5282     else if CanShift then begin
5283       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5284       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5285       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5286       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5287       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5288     end else
5289       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5290   end else
5291     result := true;
5292 end;
5293
5294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5295 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5296 begin
5297   if aUseRGB or aUseAlpha then
5298     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5299       ((PtrInt(aUseAlpha) and 1) shl 1) or
5300        (PtrInt(aUseRGB)   and 1)      ));
5301 end;
5302
5303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5304 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5305 begin
5306   fBorderColor[0] := aRed;
5307   fBorderColor[1] := aGreen;
5308   fBorderColor[2] := aBlue;
5309   fBorderColor[3] := aAlpha;
5310   if (ID > 0) then begin
5311     Bind(false);
5312     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5313   end;
5314 end;
5315
5316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5317 procedure TglBitmap.FreeData;
5318 var
5319   TempPtr: PByte;
5320 begin
5321   TempPtr := nil;
5322   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5323 end;
5324
5325 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5326 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5327   const aAlpha: Byte);
5328 begin
5329   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5330 end;
5331
5332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5333 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5334 var
5335   PixelData: TglBitmapPixelData;
5336 begin
5337   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5338   FillWithColorFloat(
5339     aRed   / PixelData.Range.r,
5340     aGreen / PixelData.Range.g,
5341     aBlue  / PixelData.Range.b,
5342     aAlpha / PixelData.Range.a);
5343 end;
5344
5345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5346 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5347 var
5348   PixelData: TglBitmapPixelData;
5349 begin
5350   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5351   with PixelData do begin
5352     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5353     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5354     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5355     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5356   end;
5357   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5358 end;
5359
5360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5361 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5362 begin
5363   //check MIN filter
5364   case aMin of
5365     GL_NEAREST:
5366       fFilterMin := GL_NEAREST;
5367     GL_LINEAR:
5368       fFilterMin := GL_LINEAR;
5369     GL_NEAREST_MIPMAP_NEAREST:
5370       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5371     GL_LINEAR_MIPMAP_NEAREST:
5372       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5373     GL_NEAREST_MIPMAP_LINEAR:
5374       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5375     GL_LINEAR_MIPMAP_LINEAR:
5376       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5377     else
5378       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5379   end;
5380
5381   //check MAG filter
5382   case aMag of
5383     GL_NEAREST:
5384       fFilterMag := GL_NEAREST;
5385     GL_LINEAR:
5386       fFilterMag := GL_LINEAR;
5387     else
5388       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5389   end;
5390
5391   //apply filter
5392   if (ID > 0) then begin
5393     Bind(false);
5394     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5395
5396     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5397       case fFilterMin of
5398         GL_NEAREST, GL_LINEAR:
5399           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5400         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5401           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5402         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5403           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5404       end;
5405     end else
5406       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5407   end;
5408 end;
5409
5410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5411 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5412
5413   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5414   begin
5415     case aValue of
5416       GL_CLAMP:
5417         aTarget := GL_CLAMP;
5418
5419       GL_REPEAT:
5420         aTarget := GL_REPEAT;
5421
5422       GL_CLAMP_TO_EDGE: begin
5423         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5424           aTarget := GL_CLAMP_TO_EDGE
5425         else
5426           aTarget := GL_CLAMP;
5427       end;
5428
5429       GL_CLAMP_TO_BORDER: begin
5430         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5431           aTarget := GL_CLAMP_TO_BORDER
5432         else
5433           aTarget := GL_CLAMP;
5434       end;
5435
5436       GL_MIRRORED_REPEAT: begin
5437         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5438           aTarget := GL_MIRRORED_REPEAT
5439         else
5440           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5441       end;
5442     else
5443       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5444     end;
5445   end;
5446
5447 begin
5448   CheckAndSetWrap(S, fWrapS);
5449   CheckAndSetWrap(T, fWrapT);
5450   CheckAndSetWrap(R, fWrapR);
5451
5452   if (ID > 0) then begin
5453     Bind(false);
5454     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5455     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5456     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5457   end;
5458 end;
5459
5460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5461 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5462
5463   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5464   begin
5465     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5466        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5467       fSwizzle[aIndex] := aValue
5468     else
5469       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5470   end;
5471
5472 begin
5473   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5474     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5475   CheckAndSetValue(r, 0);
5476   CheckAndSetValue(g, 1);
5477   CheckAndSetValue(b, 2);
5478   CheckAndSetValue(a, 3);
5479
5480   if (ID > 0) then begin
5481     Bind(false);
5482     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5483   end;
5484 end;
5485
5486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5487 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5488 begin
5489   if aEnableTextureUnit then
5490     glEnable(Target);
5491   if (ID > 0) then
5492     glBindTexture(Target, ID);
5493 end;
5494
5495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5496 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5497 begin
5498   if aDisableTextureUnit then
5499     glDisable(Target);
5500   glBindTexture(Target, 0);
5501 end;
5502
5503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5504 constructor TglBitmap.Create;
5505 begin
5506   if (ClassType = TglBitmap) then
5507     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5508 {$IFDEF GLB_NATIVE_OGL}
5509   glbReadOpenGLExtensions;
5510 {$ENDIF}
5511   inherited Create;
5512 end;
5513
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 constructor TglBitmap.Create(const aFileName: String);
5516 begin
5517   Create;
5518   LoadFromFile(FileName);
5519 end;
5520
5521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5522 constructor TglBitmap.Create(const aStream: TStream);
5523 begin
5524   Create;
5525   LoadFromStream(aStream);
5526 end;
5527
5528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5529 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5530 var
5531   Image: PByte;
5532   ImageSize: Integer;
5533 begin
5534   Create;
5535   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5536   GetMem(Image, ImageSize);
5537   try
5538     FillChar(Image^, ImageSize, #$FF);
5539     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5540   except
5541     if Assigned(Image) then
5542       FreeMem(Image);
5543     raise;
5544   end;
5545 end;
5546
5547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5548 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5549   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5550 begin
5551   Create;
5552   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5553 end;
5554
5555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5556 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5557 begin
5558   Create;
5559   LoadFromResource(aInstance, aResource, aResType);
5560 end;
5561
5562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5563 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5564 begin
5565   Create;
5566   LoadFromResourceID(aInstance, aResourceID, aResType);
5567 end;
5568
5569 {$IFDEF GLB_SUPPORT_PNG_READ}
5570 {$IF DEFINED(GLB_SDL_IMAGE)}
5571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5572 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5574 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5575 var
5576   Surface: PSDL_Surface;
5577   RWops: PSDL_RWops;
5578 begin
5579   result := false;
5580   RWops := glBitmapCreateRWops(aStream);
5581   try
5582     if IMG_isPNG(RWops) > 0 then begin
5583       Surface := IMG_LoadPNG_RW(RWops);
5584       try
5585         AssignFromSurface(Surface);
5586         result := true;
5587       finally
5588         SDL_FreeSurface(Surface);
5589       end;
5590     end;
5591   finally
5592     SDL_FreeRW(RWops);
5593   end;
5594 end;
5595
5596 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5598 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5599 begin
5600   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5601 end;
5602
5603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5604 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5605 var
5606   StreamPos: Int64;
5607   signature: array [0..7] of byte;
5608   png: png_structp;
5609   png_info: png_infop;
5610
5611   TempHeight, TempWidth: Integer;
5612   Format: TglBitmapFormat;
5613
5614   png_data: pByte;
5615   png_rows: array of pByte;
5616   Row, LineSize: Integer;
5617 begin
5618   result := false;
5619
5620   if not init_libPNG then
5621     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5622
5623   try
5624     // signature
5625     StreamPos := aStream.Position;
5626     aStream.Read(signature{%H-}, 8);
5627     aStream.Position := StreamPos;
5628
5629     if png_check_sig(@signature, 8) <> 0 then begin
5630       // png read struct
5631       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5632       if png = nil then
5633         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5634
5635       // png info
5636       png_info := png_create_info_struct(png);
5637       if png_info = nil then begin
5638         png_destroy_read_struct(@png, nil, nil);
5639         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5640       end;
5641
5642       // set read callback
5643       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5644
5645       // read informations
5646       png_read_info(png, png_info);
5647
5648       // size
5649       TempHeight := png_get_image_height(png, png_info);
5650       TempWidth := png_get_image_width(png, png_info);
5651
5652       // format
5653       case png_get_color_type(png, png_info) of
5654         PNG_COLOR_TYPE_GRAY:
5655           Format := tfLuminance8;
5656         PNG_COLOR_TYPE_GRAY_ALPHA:
5657           Format := tfLuminance8Alpha8;
5658         PNG_COLOR_TYPE_RGB:
5659           Format := tfRGB8;
5660         PNG_COLOR_TYPE_RGB_ALPHA:
5661           Format := tfRGBA8;
5662         else
5663           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5664       end;
5665
5666       // cut upper 8 bit from 16 bit formats
5667       if png_get_bit_depth(png, png_info) > 8 then
5668         png_set_strip_16(png);
5669
5670       // expand bitdepth smaller than 8
5671       if png_get_bit_depth(png, png_info) < 8 then
5672         png_set_expand(png);
5673
5674       // allocating mem for scanlines
5675       LineSize := png_get_rowbytes(png, png_info);
5676       GetMem(png_data, TempHeight * LineSize);
5677       try
5678         SetLength(png_rows, TempHeight);
5679         for Row := Low(png_rows) to High(png_rows) do begin
5680           png_rows[Row] := png_data;
5681           Inc(png_rows[Row], Row * LineSize);
5682         end;
5683
5684         // read complete image into scanlines
5685         png_read_image(png, @png_rows[0]);
5686
5687         // read end
5688         png_read_end(png, png_info);
5689
5690         // destroy read struct
5691         png_destroy_read_struct(@png, @png_info, nil);
5692
5693         SetLength(png_rows, 0);
5694
5695         // set new data
5696         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5697
5698         result := true;
5699       except
5700         if Assigned(png_data) then
5701           FreeMem(png_data);
5702         raise;
5703       end;
5704     end;
5705   finally
5706     quit_libPNG;
5707   end;
5708 end;
5709
5710 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5712 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5713 var
5714   StreamPos: Int64;
5715   Png: TPNGObject;
5716   Header: String[8];
5717   Row, Col, PixSize, LineSize: Integer;
5718   NewImage, pSource, pDest, pAlpha: pByte;
5719   PngFormat: TglBitmapFormat;
5720   FormatDesc: TFormatDescriptor;
5721
5722 const
5723   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5724
5725 begin
5726   result := false;
5727
5728   StreamPos := aStream.Position;
5729   aStream.Read(Header[0], SizeOf(Header));
5730   aStream.Position := StreamPos;
5731
5732   {Test if the header matches}
5733   if Header = PngHeader then begin
5734     Png := TPNGObject.Create;
5735     try
5736       Png.LoadFromStream(aStream);
5737
5738       case Png.Header.ColorType of
5739         COLOR_GRAYSCALE:
5740           PngFormat := tfLuminance8;
5741         COLOR_GRAYSCALEALPHA:
5742           PngFormat := tfLuminance8Alpha8;
5743         COLOR_RGB:
5744           PngFormat := tfBGR8;
5745         COLOR_RGBALPHA:
5746           PngFormat := tfBGRA8;
5747         else
5748           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5749       end;
5750
5751       FormatDesc := TFormatDescriptor.Get(PngFormat);
5752       PixSize    := Round(FormatDesc.PixelSize);
5753       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5754
5755       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5756       try
5757         pDest := NewImage;
5758
5759         case Png.Header.ColorType of
5760           COLOR_RGB, COLOR_GRAYSCALE:
5761             begin
5762               for Row := 0 to Png.Height -1 do begin
5763                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5764                 Inc(pDest, LineSize);
5765               end;
5766             end;
5767           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5768             begin
5769               PixSize := PixSize -1;
5770
5771               for Row := 0 to Png.Height -1 do begin
5772                 pSource := Png.Scanline[Row];
5773                 pAlpha := pByte(Png.AlphaScanline[Row]);
5774
5775                 for Col := 0 to Png.Width -1 do begin
5776                   Move (pSource^, pDest^, PixSize);
5777                   Inc(pSource, PixSize);
5778                   Inc(pDest, PixSize);
5779
5780                   pDest^ := pAlpha^;
5781                   inc(pAlpha);
5782                   Inc(pDest);
5783                 end;
5784               end;
5785             end;
5786           else
5787             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5788         end;
5789
5790         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5791
5792         result := true;
5793       except
5794         if Assigned(NewImage) then
5795           FreeMem(NewImage);
5796         raise;
5797       end;
5798     finally
5799       Png.Free;
5800     end;
5801   end;
5802 end;
5803 {$IFEND}
5804 {$ENDIF}
5805
5806 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5807 {$IFDEF GLB_LIB_PNG}
5808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5809 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5810 begin
5811   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5812 end;
5813 {$ENDIF}
5814
5815 {$IF DEFINED(GLB_LIB_PNG)}
5816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5817 procedure TglBitmap.SavePNG(const aStream: TStream);
5818 var
5819   png: png_structp;
5820   png_info: png_infop;
5821   png_rows: array of pByte;
5822   LineSize: Integer;
5823   ColorType: Integer;
5824   Row: Integer;
5825   FormatDesc: TFormatDescriptor;
5826 begin
5827   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5828     raise EglBitmapUnsupportedFormat.Create(Format);
5829
5830   if not init_libPNG then
5831     raise Exception.Create('unable to initialize libPNG.');
5832
5833   try
5834     case Format of
5835       tfAlpha8, tfLuminance8:
5836         ColorType := PNG_COLOR_TYPE_GRAY;
5837       tfLuminance8Alpha8:
5838         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5839       tfBGR8, tfRGB8:
5840         ColorType := PNG_COLOR_TYPE_RGB;
5841       tfBGRA8, tfRGBA8:
5842         ColorType := PNG_COLOR_TYPE_RGBA;
5843       else
5844         raise EglBitmapUnsupportedFormat.Create(Format);
5845     end;
5846
5847     FormatDesc := TFormatDescriptor.Get(Format);
5848     LineSize := FormatDesc.GetSize(Width, 1);
5849
5850     // creating array for scanline
5851     SetLength(png_rows, Height);
5852     try
5853       for Row := 0 to Height - 1 do begin
5854         png_rows[Row] := Data;
5855         Inc(png_rows[Row], Row * LineSize)
5856       end;
5857
5858       // write struct
5859       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5860       if png = nil then
5861         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5862
5863       // create png info
5864       png_info := png_create_info_struct(png);
5865       if png_info = nil then begin
5866         png_destroy_write_struct(@png, nil);
5867         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5868       end;
5869
5870       // set read callback
5871       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5872
5873       // set compression
5874       png_set_compression_level(png, 6);
5875
5876       if Format in [tfBGR8, tfBGRA8] then
5877         png_set_bgr(png);
5878
5879       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5880       png_write_info(png, png_info);
5881       png_write_image(png, @png_rows[0]);
5882       png_write_end(png, png_info);
5883       png_destroy_write_struct(@png, @png_info);
5884     finally
5885       SetLength(png_rows, 0);
5886     end;
5887   finally
5888     quit_libPNG;
5889   end;
5890 end;
5891
5892 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5894 procedure TglBitmap.SavePNG(const aStream: TStream);
5895 var
5896   Png: TPNGObject;
5897
5898   pSource, pDest: pByte;
5899   X, Y, PixSize: Integer;
5900   ColorType: Cardinal;
5901   Alpha: Boolean;
5902
5903   pTemp: pByte;
5904   Temp: Byte;
5905 begin
5906   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5907     raise EglBitmapUnsupportedFormat.Create(Format);
5908
5909   case Format of
5910     tfAlpha8, tfLuminance8: begin
5911       ColorType := COLOR_GRAYSCALE;
5912       PixSize   := 1;
5913       Alpha     := false;
5914     end;
5915     tfLuminance8Alpha8: begin
5916       ColorType := COLOR_GRAYSCALEALPHA;
5917       PixSize   := 1;
5918       Alpha     := true;
5919     end;
5920     tfBGR8, tfRGB8: begin
5921       ColorType := COLOR_RGB;
5922       PixSize   := 3;
5923       Alpha     := false;
5924     end;
5925     tfBGRA8, tfRGBA8: begin
5926       ColorType := COLOR_RGBALPHA;
5927       PixSize   := 3;
5928       Alpha     := true
5929     end;
5930   else
5931     raise EglBitmapUnsupportedFormat.Create(Format);
5932   end;
5933
5934   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5935   try
5936     // Copy ImageData
5937     pSource := Data;
5938     for Y := 0 to Height -1 do begin
5939       pDest := png.ScanLine[Y];
5940       for X := 0 to Width -1 do begin
5941         Move(pSource^, pDest^, PixSize);
5942         Inc(pDest, PixSize);
5943         Inc(pSource, PixSize);
5944         if Alpha then begin
5945           png.AlphaScanline[Y]^[X] := pSource^;
5946           Inc(pSource);
5947         end;
5948       end;
5949
5950       // convert RGB line to BGR
5951       if Format in [tfRGB8, tfRGBA8] then begin
5952         pTemp := png.ScanLine[Y];
5953         for X := 0 to Width -1 do begin
5954           Temp := pByteArray(pTemp)^[0];
5955           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5956           pByteArray(pTemp)^[2] := Temp;
5957           Inc(pTemp, 3);
5958         end;
5959       end;
5960     end;
5961
5962     // Save to Stream
5963     Png.CompressionLevel := 6;
5964     Png.SaveToStream(aStream);
5965   finally
5966     FreeAndNil(Png);
5967   end;
5968 end;
5969 {$IFEND}
5970 {$ENDIF}
5971
5972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5973 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5975 {$IFDEF GLB_LIB_JPEG}
5976 type
5977   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5978   glBitmap_libJPEG_source_mgr = record
5979     pub: jpeg_source_mgr;
5980
5981     SrcStream: TStream;
5982     SrcBuffer: array [1..4096] of byte;
5983   end;
5984
5985   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5986   glBitmap_libJPEG_dest_mgr = record
5987     pub: jpeg_destination_mgr;
5988
5989     DestStream: TStream;
5990     DestBuffer: array [1..4096] of byte;
5991   end;
5992
5993 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5994 begin
5995   //DUMMY
5996 end;
5997
5998
5999 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6000 begin
6001   //DUMMY
6002 end;
6003
6004
6005 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6006 begin
6007   //DUMMY
6008 end;
6009
6010 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6011 begin
6012   //DUMMY
6013 end;
6014
6015
6016 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6017 begin
6018   //DUMMY
6019 end;
6020
6021
6022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6023 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6024 var
6025   src: glBitmap_libJPEG_source_mgr_ptr;
6026   bytes: integer;
6027 begin
6028   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6029
6030   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6031         if (bytes <= 0) then begin
6032                 src^.SrcBuffer[1] := $FF;
6033                 src^.SrcBuffer[2] := JPEG_EOI;
6034                 bytes := 2;
6035         end;
6036
6037         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6038         src^.pub.bytes_in_buffer := bytes;
6039
6040   result := true;
6041 end;
6042
6043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6044 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6045 var
6046   src: glBitmap_libJPEG_source_mgr_ptr;
6047 begin
6048   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6049
6050   if num_bytes > 0 then begin
6051     // wanted byte isn't in buffer so set stream position and read buffer
6052     if num_bytes > src^.pub.bytes_in_buffer then begin
6053       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6054       src^.pub.fill_input_buffer(cinfo);
6055     end else begin
6056       // wanted byte is in buffer so only skip
6057                 inc(src^.pub.next_input_byte, num_bytes);
6058                 dec(src^.pub.bytes_in_buffer, num_bytes);
6059     end;
6060   end;
6061 end;
6062
6063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6064 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6065 var
6066   dest: glBitmap_libJPEG_dest_mgr_ptr;
6067 begin
6068   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6069
6070   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6071     // write complete buffer
6072     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6073
6074     // reset buffer
6075     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6076     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6077   end;
6078
6079   result := true;
6080 end;
6081
6082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6083 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6084 var
6085   Idx: Integer;
6086   dest: glBitmap_libJPEG_dest_mgr_ptr;
6087 begin
6088   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6089
6090   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6091     // check for endblock
6092     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6093       // write endblock
6094       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6095
6096       // leave
6097       break;
6098     end else
6099       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6100   end;
6101 end;
6102 {$ENDIF}
6103
6104 {$IFDEF GLB_SUPPORT_JPEG_READ}
6105 {$IF DEFINED(GLB_SDL_IMAGE)}
6106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6107 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6108 var
6109   Surface: PSDL_Surface;
6110   RWops: PSDL_RWops;
6111 begin
6112   result := false;
6113
6114   RWops := glBitmapCreateRWops(aStream);
6115   try
6116     if IMG_isJPG(RWops) > 0 then begin
6117       Surface := IMG_LoadJPG_RW(RWops);
6118       try
6119         AssignFromSurface(Surface);
6120         result := true;
6121       finally
6122         SDL_FreeSurface(Surface);
6123       end;
6124     end;
6125   finally
6126     SDL_FreeRW(RWops);
6127   end;
6128 end;
6129
6130 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6132 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6133 var
6134   StreamPos: Int64;
6135   Temp: array[0..1]of Byte;
6136
6137   jpeg: jpeg_decompress_struct;
6138   jpeg_err: jpeg_error_mgr;
6139
6140   IntFormat: TglBitmapFormat;
6141   pImage: pByte;
6142   TempHeight, TempWidth: Integer;
6143
6144   pTemp: pByte;
6145   Row: Integer;
6146
6147   FormatDesc: TFormatDescriptor;
6148 begin
6149   result := false;
6150
6151   if not init_libJPEG then
6152     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6153
6154   try
6155     // reading first two bytes to test file and set cursor back to begin
6156     StreamPos := aStream.Position;
6157     aStream.Read({%H-}Temp[0], 2);
6158     aStream.Position := StreamPos;
6159
6160     // if Bitmap then read file.
6161     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6162       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6163       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6164
6165       // error managment
6166       jpeg.err := jpeg_std_error(@jpeg_err);
6167       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6168       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6169
6170       // decompression struct
6171       jpeg_create_decompress(@jpeg);
6172
6173       // allocation space for streaming methods
6174       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6175
6176       // seeting up custom functions
6177       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6178         pub.init_source       := glBitmap_libJPEG_init_source;
6179         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6180         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6181         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6182         pub.term_source       := glBitmap_libJPEG_term_source;
6183
6184         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6185         pub.next_input_byte := nil;   // until buffer loaded
6186
6187         SrcStream := aStream;
6188       end;
6189
6190       // set global decoding state
6191       jpeg.global_state := DSTATE_START;
6192
6193       // read header of jpeg
6194       jpeg_read_header(@jpeg, false);
6195
6196       // setting output parameter
6197       case jpeg.jpeg_color_space of
6198         JCS_GRAYSCALE:
6199           begin
6200             jpeg.out_color_space := JCS_GRAYSCALE;
6201             IntFormat := tfLuminance8;
6202           end;
6203         else
6204           jpeg.out_color_space := JCS_RGB;
6205           IntFormat := tfRGB8;
6206       end;
6207
6208       // reading image
6209       jpeg_start_decompress(@jpeg);
6210
6211       TempHeight := jpeg.output_height;
6212       TempWidth := jpeg.output_width;
6213
6214       FormatDesc := TFormatDescriptor.Get(IntFormat);
6215
6216       // creating new image
6217       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6218       try
6219         pTemp := pImage;
6220
6221         for Row := 0 to TempHeight -1 do begin
6222           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6223           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6224         end;
6225
6226         // finish decompression
6227         jpeg_finish_decompress(@jpeg);
6228
6229         // destroy decompression
6230         jpeg_destroy_decompress(@jpeg);
6231
6232         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6233
6234         result := true;
6235       except
6236         if Assigned(pImage) then
6237           FreeMem(pImage);
6238         raise;
6239       end;
6240     end;
6241   finally
6242     quit_libJPEG;
6243   end;
6244 end;
6245
6246 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6248 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6249 var
6250   bmp: TBitmap;
6251   jpg: TJPEGImage;
6252   StreamPos: Int64;
6253   Temp: array[0..1]of Byte;
6254 begin
6255   result := false;
6256
6257   // reading first two bytes to test file and set cursor back to begin
6258   StreamPos := aStream.Position;
6259   aStream.Read(Temp[0], 2);
6260   aStream.Position := StreamPos;
6261
6262   // if Bitmap then read file.
6263   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6264     bmp := TBitmap.Create;
6265     try
6266       jpg := TJPEGImage.Create;
6267       try
6268         jpg.LoadFromStream(aStream);
6269         bmp.Assign(jpg);
6270         result := AssignFromBitmap(bmp);
6271       finally
6272         jpg.Free;
6273       end;
6274     finally
6275       bmp.Free;
6276     end;
6277   end;
6278 end;
6279 {$IFEND}
6280 {$ENDIF}
6281
6282 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6283 {$IF DEFINED(GLB_LIB_JPEG)}
6284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6285 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6286 var
6287   jpeg: jpeg_compress_struct;
6288   jpeg_err: jpeg_error_mgr;
6289   Row: Integer;
6290   pTemp, pTemp2: pByte;
6291
6292   procedure CopyRow(pDest, pSource: pByte);
6293   var
6294     X: Integer;
6295   begin
6296     for X := 0 to Width - 1 do begin
6297       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6298       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6299       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6300       Inc(pDest, 3);
6301       Inc(pSource, 3);
6302     end;
6303   end;
6304
6305 begin
6306   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6307     raise EglBitmapUnsupportedFormat.Create(Format);
6308
6309   if not init_libJPEG then
6310     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6311
6312   try
6313     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6314     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6315
6316     // error managment
6317     jpeg.err := jpeg_std_error(@jpeg_err);
6318     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6319     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6320
6321     // compression struct
6322     jpeg_create_compress(@jpeg);
6323
6324     // allocation space for streaming methods
6325     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6326
6327     // seeting up custom functions
6328     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6329       pub.init_destination    := glBitmap_libJPEG_init_destination;
6330       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6331       pub.term_destination    := glBitmap_libJPEG_term_destination;
6332
6333       pub.next_output_byte  := @DestBuffer[1];
6334       pub.free_in_buffer    := Length(DestBuffer);
6335
6336       DestStream := aStream;
6337     end;
6338
6339     // very important state
6340     jpeg.global_state := CSTATE_START;
6341     jpeg.image_width  := Width;
6342     jpeg.image_height := Height;
6343     case Format of
6344       tfAlpha8, tfLuminance8: begin
6345         jpeg.input_components := 1;
6346         jpeg.in_color_space   := JCS_GRAYSCALE;
6347       end;
6348       tfRGB8, tfBGR8: begin
6349         jpeg.input_components := 3;
6350         jpeg.in_color_space   := JCS_RGB;
6351       end;
6352     end;
6353
6354     jpeg_set_defaults(@jpeg);
6355     jpeg_set_quality(@jpeg, 95, true);
6356     jpeg_start_compress(@jpeg, true);
6357     pTemp := Data;
6358
6359     if Format = tfBGR8 then
6360       GetMem(pTemp2, fRowSize)
6361     else
6362       pTemp2 := pTemp;
6363
6364     try
6365       for Row := 0 to jpeg.image_height -1 do begin
6366         // prepare row
6367         if Format = tfBGR8 then
6368           CopyRow(pTemp2, pTemp)
6369         else
6370           pTemp2 := pTemp;
6371
6372         // write row
6373         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6374         inc(pTemp, fRowSize);
6375       end;
6376     finally
6377       // free memory
6378       if Format = tfBGR8 then
6379         FreeMem(pTemp2);
6380     end;
6381     jpeg_finish_compress(@jpeg);
6382     jpeg_destroy_compress(@jpeg);
6383   finally
6384     quit_libJPEG;
6385   end;
6386 end;
6387
6388 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6390 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6391 var
6392   Bmp: TBitmap;
6393   Jpg: TJPEGImage;
6394 begin
6395   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6396     raise EglBitmapUnsupportedFormat.Create(Format);
6397
6398   Bmp := TBitmap.Create;
6399   try
6400     Jpg := TJPEGImage.Create;
6401     try
6402       AssignToBitmap(Bmp);
6403       if (Format in [tfAlpha8, tfLuminance8]) then begin
6404         Jpg.Grayscale   := true;
6405         Jpg.PixelFormat := jf8Bit;
6406       end;
6407       Jpg.Assign(Bmp);
6408       Jpg.SaveToStream(aStream);
6409     finally
6410       FreeAndNil(Jpg);
6411     end;
6412   finally
6413     FreeAndNil(Bmp);
6414   end;
6415 end;
6416 {$IFEND}
6417 {$ENDIF}
6418
6419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6420 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6422 const
6423   BMP_MAGIC          = $4D42;
6424
6425   BMP_COMP_RGB       = 0;
6426   BMP_COMP_RLE8      = 1;
6427   BMP_COMP_RLE4      = 2;
6428   BMP_COMP_BITFIELDS = 3;
6429
6430 type
6431   TBMPHeader = packed record
6432     bfType: Word;
6433     bfSize: Cardinal;
6434     bfReserved1: Word;
6435     bfReserved2: Word;
6436     bfOffBits: Cardinal;
6437   end;
6438
6439   TBMPInfo = packed record
6440     biSize: Cardinal;
6441     biWidth: Longint;
6442     biHeight: Longint;
6443     biPlanes: Word;
6444     biBitCount: Word;
6445     biCompression: Cardinal;
6446     biSizeImage: Cardinal;
6447     biXPelsPerMeter: Longint;
6448     biYPelsPerMeter: Longint;
6449     biClrUsed: Cardinal;
6450     biClrImportant: Cardinal;
6451   end;
6452
6453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6454 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6455
6456   //////////////////////////////////////////////////////////////////////////////////////////////////
6457   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6458   begin
6459     result := tfEmpty;
6460     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6461     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6462
6463     //Read Compression
6464     case aInfo.biCompression of
6465       BMP_COMP_RLE4,
6466       BMP_COMP_RLE8: begin
6467         raise EglBitmap.Create('RLE compression is not supported');
6468       end;
6469       BMP_COMP_BITFIELDS: begin
6470         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6471           aStream.Read(aMask.r, SizeOf(aMask.r));
6472           aStream.Read(aMask.g, SizeOf(aMask.g));
6473           aStream.Read(aMask.b, SizeOf(aMask.b));
6474           aStream.Read(aMask.a, SizeOf(aMask.a));
6475         end else
6476           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6477       end;
6478     end;
6479
6480     //get suitable format
6481     case aInfo.biBitCount of
6482        8: result := tfLuminance8;
6483       16: result := tfBGR5;
6484       24: result := tfBGR8;
6485       32: result := tfBGRA8;
6486     end;
6487   end;
6488
6489   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6490   var
6491     i, c: Integer;
6492     ColorTable: TbmpColorTable;
6493   begin
6494     result := nil;
6495     if (aInfo.biBitCount >= 16) then
6496       exit;
6497     aFormat := tfLuminance8;
6498     c := aInfo.biClrUsed;
6499     if (c = 0) then
6500       c := 1 shl aInfo.biBitCount;
6501     SetLength(ColorTable, c);
6502     for i := 0 to c-1 do begin
6503       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6504       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6505         aFormat := tfRGB8;
6506     end;
6507
6508     result := TbmpColorTableFormat.Create;
6509     result.PixelSize  := aInfo.biBitCount / 8;
6510     result.ColorTable := ColorTable;
6511     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6512   end;
6513
6514   //////////////////////////////////////////////////////////////////////////////////////////////////
6515   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6516     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6517   var
6518     TmpFormat: TglBitmapFormat;
6519     FormatDesc: TFormatDescriptor;
6520   begin
6521     result := nil;
6522     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6523       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6524         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6525         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6526           aFormat := FormatDesc.Format;
6527           exit;
6528         end;
6529       end;
6530
6531       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6532         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6533       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6534         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6535
6536       result := TbmpBitfieldFormat.Create;
6537       result.PixelSize := aInfo.biBitCount / 8;
6538       result.RedMask   := aMask.r;
6539       result.GreenMask := aMask.g;
6540       result.BlueMask  := aMask.b;
6541       result.AlphaMask := aMask.a;
6542     end;
6543   end;
6544
6545 var
6546   //simple types
6547   StartPos: Int64;
6548   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6549   PaddingBuff: Cardinal;
6550   LineBuf, ImageData, TmpData: PByte;
6551   SourceMD, DestMD: Pointer;
6552   BmpFormat: TglBitmapFormat;
6553
6554   //records
6555   Mask: TglBitmapColorRec;
6556   Header: TBMPHeader;
6557   Info: TBMPInfo;
6558
6559   //classes
6560   SpecialFormat: TFormatDescriptor;
6561   FormatDesc: TFormatDescriptor;
6562
6563   //////////////////////////////////////////////////////////////////////////////////////////////////
6564   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6565   var
6566     i: Integer;
6567     Pixel: TglBitmapPixelData;
6568   begin
6569     aStream.Read(aLineBuf^, rbLineSize);
6570     SpecialFormat.PreparePixel(Pixel);
6571     for i := 0 to Info.biWidth-1 do begin
6572       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6573       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6574       FormatDesc.Map(Pixel, aData, DestMD);
6575     end;
6576   end;
6577
6578 begin
6579   result        := false;
6580   BmpFormat     := tfEmpty;
6581   SpecialFormat := nil;
6582   LineBuf       := nil;
6583   SourceMD      := nil;
6584   DestMD        := nil;
6585
6586   // Header
6587   StartPos := aStream.Position;
6588   aStream.Read(Header{%H-}, SizeOf(Header));
6589
6590   if Header.bfType = BMP_MAGIC then begin
6591     try try
6592       BmpFormat        := ReadInfo(Info, Mask);
6593       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6594       if not Assigned(SpecialFormat) then
6595         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6596       aStream.Position := StartPos + Header.bfOffBits;
6597
6598       if (BmpFormat <> tfEmpty) then begin
6599         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6600         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6601         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6602         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6603
6604         //get Memory
6605         DestMD    := FormatDesc.CreateMappingData;
6606         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6607         GetMem(ImageData, ImageSize);
6608         if Assigned(SpecialFormat) then begin
6609           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6610           SourceMD := SpecialFormat.CreateMappingData;
6611         end;
6612
6613         //read Data
6614         try try
6615           FillChar(ImageData^, ImageSize, $FF);
6616           TmpData := ImageData;
6617           if (Info.biHeight > 0) then
6618             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6619           for i := 0 to Abs(Info.biHeight)-1 do begin
6620             if Assigned(SpecialFormat) then
6621               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6622             else
6623               aStream.Read(TmpData^, wbLineSize);   //else only read data
6624             if (Info.biHeight > 0) then
6625               dec(TmpData, wbLineSize)
6626             else
6627               inc(TmpData, wbLineSize);
6628             aStream.Read(PaddingBuff{%H-}, Padding);
6629           end;
6630           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6631           result := true;
6632         finally
6633           if Assigned(LineBuf) then
6634             FreeMem(LineBuf);
6635           if Assigned(SourceMD) then
6636             SpecialFormat.FreeMappingData(SourceMD);
6637           FormatDesc.FreeMappingData(DestMD);
6638         end;
6639         except
6640           if Assigned(ImageData) then
6641             FreeMem(ImageData);
6642           raise;
6643         end;
6644       end else
6645         raise EglBitmap.Create('LoadBMP - No suitable format found');
6646     except
6647       aStream.Position := StartPos;
6648       raise;
6649     end;
6650     finally
6651       FreeAndNil(SpecialFormat);
6652     end;
6653   end
6654     else aStream.Position := StartPos;
6655 end;
6656
6657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6658 procedure TglBitmap.SaveBMP(const aStream: TStream);
6659 var
6660   Header: TBMPHeader;
6661   Info: TBMPInfo;
6662   Converter: TbmpColorTableFormat;
6663   FormatDesc: TFormatDescriptor;
6664   SourceFD, DestFD: Pointer;
6665   pData, srcData, dstData, ConvertBuffer: pByte;
6666
6667   Pixel: TglBitmapPixelData;
6668   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6669   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6670
6671   PaddingBuff: Cardinal;
6672
6673   function GetLineWidth : Integer;
6674   begin
6675     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6676   end;
6677
6678 begin
6679   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6680     raise EglBitmapUnsupportedFormat.Create(Format);
6681
6682   Converter  := nil;
6683   FormatDesc := TFormatDescriptor.Get(Format);
6684   ImageSize  := FormatDesc.GetSize(Dimension);
6685
6686   FillChar(Header{%H-}, SizeOf(Header), 0);
6687   Header.bfType      := BMP_MAGIC;
6688   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6689   Header.bfReserved1 := 0;
6690   Header.bfReserved2 := 0;
6691   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6692
6693   FillChar(Info{%H-}, SizeOf(Info), 0);
6694   Info.biSize        := SizeOf(Info);
6695   Info.biWidth       := Width;
6696   Info.biHeight      := Height;
6697   Info.biPlanes      := 1;
6698   Info.biCompression := BMP_COMP_RGB;
6699   Info.biSizeImage   := ImageSize;
6700
6701   try
6702     case Format of
6703       tfLuminance4: begin
6704         Info.biBitCount  := 4;
6705         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6706         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6707         Converter           := TbmpColorTableFormat.Create;
6708         Converter.PixelSize := 0.5;
6709         Converter.Format    := Format;
6710         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6711         Converter.CreateColorTable;
6712       end;
6713
6714       tfR3G3B2, tfLuminance8: begin
6715         Info.biBitCount  :=  8;
6716         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6717         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6718         Converter           := TbmpColorTableFormat.Create;
6719         Converter.PixelSize := 1;
6720         Converter.Format    := Format;
6721         if (Format = tfR3G3B2) then begin
6722           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6723           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6724         end else
6725           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6726         Converter.CreateColorTable;
6727       end;
6728
6729       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6730       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6731         Info.biBitCount    := 16;
6732         Info.biCompression := BMP_COMP_BITFIELDS;
6733       end;
6734
6735       tfBGR8, tfRGB8: begin
6736         Info.biBitCount := 24;
6737       end;
6738
6739       tfRGB10, tfRGB10A2, tfRGBA8,
6740       tfBGR10, tfBGR10A2, tfBGRA8: begin
6741         Info.biBitCount    := 32;
6742         Info.biCompression := BMP_COMP_BITFIELDS;
6743       end;
6744     else
6745       raise EglBitmapUnsupportedFormat.Create(Format);
6746     end;
6747     Info.biXPelsPerMeter := 2835;
6748     Info.biYPelsPerMeter := 2835;
6749
6750     // prepare bitmasks
6751     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6752       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6753       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6754
6755       RedMask    := FormatDesc.RedMask;
6756       GreenMask  := FormatDesc.GreenMask;
6757       BlueMask   := FormatDesc.BlueMask;
6758       AlphaMask  := FormatDesc.AlphaMask;
6759     end;
6760
6761     // headers
6762     aStream.Write(Header, SizeOf(Header));
6763     aStream.Write(Info, SizeOf(Info));
6764
6765     // colortable
6766     if Assigned(Converter) then
6767       aStream.Write(Converter.ColorTable[0].b,
6768         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6769
6770     // bitmasks
6771     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6772       aStream.Write(RedMask,   SizeOf(Cardinal));
6773       aStream.Write(GreenMask, SizeOf(Cardinal));
6774       aStream.Write(BlueMask,  SizeOf(Cardinal));
6775       aStream.Write(AlphaMask, SizeOf(Cardinal));
6776     end;
6777
6778     // image data
6779     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6780     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6781     Padding     := GetLineWidth - wbLineSize;
6782     PaddingBuff := 0;
6783
6784     pData := Data;
6785     inc(pData, (Height-1) * rbLineSize);
6786
6787     // prepare row buffer. But only for RGB because RGBA supports color masks
6788     // so it's possible to change color within the image.
6789     if Assigned(Converter) then begin
6790       FormatDesc.PreparePixel(Pixel);
6791       GetMem(ConvertBuffer, wbLineSize);
6792       SourceFD := FormatDesc.CreateMappingData;
6793       DestFD   := Converter.CreateMappingData;
6794     end else
6795       ConvertBuffer := nil;
6796
6797     try
6798       for LineIdx := 0 to Height - 1 do begin
6799         // preparing row
6800         if Assigned(Converter) then begin
6801           srcData := pData;
6802           dstData := ConvertBuffer;
6803           for PixelIdx := 0 to Info.biWidth-1 do begin
6804             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6805             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6806             Converter.Map(Pixel, dstData, DestFD);
6807           end;
6808           aStream.Write(ConvertBuffer^, wbLineSize);
6809         end else begin
6810           aStream.Write(pData^, rbLineSize);
6811         end;
6812         dec(pData, rbLineSize);
6813         if (Padding > 0) then
6814           aStream.Write(PaddingBuff, Padding);
6815       end;
6816     finally
6817       // destroy row buffer
6818       if Assigned(ConvertBuffer) then begin
6819         FormatDesc.FreeMappingData(SourceFD);
6820         Converter.FreeMappingData(DestFD);
6821         FreeMem(ConvertBuffer);
6822       end;
6823     end;
6824   finally
6825     if Assigned(Converter) then
6826       Converter.Free;
6827   end;
6828 end;
6829
6830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6831 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6833 type
6834   TTGAHeader = packed record
6835     ImageID: Byte;
6836     ColorMapType: Byte;
6837     ImageType: Byte;
6838     //ColorMapSpec: Array[0..4] of Byte;
6839     ColorMapStart: Word;
6840     ColorMapLength: Word;
6841     ColorMapEntrySize: Byte;
6842     OrigX: Word;
6843     OrigY: Word;
6844     Width: Word;
6845     Height: Word;
6846     Bpp: Byte;
6847     ImageDesc: Byte;
6848   end;
6849
6850 const
6851   TGA_UNCOMPRESSED_RGB  =  2;
6852   TGA_UNCOMPRESSED_GRAY =  3;
6853   TGA_COMPRESSED_RGB    = 10;
6854   TGA_COMPRESSED_GRAY   = 11;
6855
6856   TGA_NONE_COLOR_TABLE  = 0;
6857
6858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6859 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6860 var
6861   Header: TTGAHeader;
6862   ImageData: System.PByte;
6863   StartPosition: Int64;
6864   PixelSize, LineSize: Integer;
6865   tgaFormat: TglBitmapFormat;
6866   FormatDesc: TFormatDescriptor;
6867   Counter: packed record
6868     X, Y: packed record
6869       low, high, dir: Integer;
6870     end;
6871   end;
6872
6873 const
6874   CACHE_SIZE = $4000;
6875
6876   ////////////////////////////////////////////////////////////////////////////////////////
6877   procedure ReadUncompressed;
6878   var
6879     i, j: Integer;
6880     buf, tmp1, tmp2: System.PByte;
6881   begin
6882     buf := nil;
6883     if (Counter.X.dir < 0) then
6884       GetMem(buf, LineSize);
6885     try
6886       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6887         tmp1 := ImageData;
6888         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
6889         if (Counter.X.dir < 0) then begin               //flip X
6890           aStream.Read(buf^, LineSize);
6891           tmp2 := buf;
6892           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
6893           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6894             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6895               tmp1^ := tmp2^;
6896               inc(tmp1);
6897               inc(tmp2);
6898             end;
6899             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6900           end;
6901         end else
6902           aStream.Read(tmp1^, LineSize);
6903         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6904       end;
6905     finally
6906       if Assigned(buf) then
6907         FreeMem(buf);
6908     end;
6909   end;
6910
6911   ////////////////////////////////////////////////////////////////////////////////////////
6912   procedure ReadCompressed;
6913
6914     /////////////////////////////////////////////////////////////////
6915     var
6916       TmpData: System.PByte;
6917       LinePixelsRead: Integer;
6918     procedure CheckLine;
6919     begin
6920       if (LinePixelsRead >= Header.Width) then begin
6921         LinePixelsRead := 0;
6922         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6923         TmpData := ImageData;
6924         inc(TmpData, Counter.Y.low * LineSize);           //set line
6925         if (Counter.X.dir < 0) then                       //if x flipped then
6926           inc(TmpData, LineSize - PixelSize);             //set last pixel
6927       end;
6928     end;
6929
6930     /////////////////////////////////////////////////////////////////
6931     var
6932       Cache: PByte;
6933       CacheSize, CachePos: Integer;
6934     procedure CachedRead(out Buffer; Count: Integer);
6935     var
6936       BytesRead: Integer;
6937     begin
6938       if (CachePos + Count > CacheSize) then begin
6939         //if buffer overflow save non read bytes
6940         BytesRead := 0;
6941         if (CacheSize - CachePos > 0) then begin
6942           BytesRead := CacheSize - CachePos;
6943           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6944           inc(CachePos, BytesRead);
6945         end;
6946
6947         //load cache from file
6948         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6949         aStream.Read(Cache^, CacheSize);
6950         CachePos := 0;
6951
6952         //read rest of requested bytes
6953         if (Count - BytesRead > 0) then begin
6954           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6955           inc(CachePos, Count - BytesRead);
6956         end;
6957       end else begin
6958         //if no buffer overflow just read the data
6959         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6960         inc(CachePos, Count);
6961       end;
6962     end;
6963
6964     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6965     begin
6966       case PixelSize of
6967         1: begin
6968           aBuffer^ := aData^;
6969           inc(aBuffer, Counter.X.dir);
6970         end;
6971         2: begin
6972           PWord(aBuffer)^ := PWord(aData)^;
6973           inc(aBuffer, 2 * Counter.X.dir);
6974         end;
6975         3: begin
6976           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6977           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6978           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6979           inc(aBuffer, 3 * Counter.X.dir);
6980         end;
6981         4: begin
6982           PCardinal(aBuffer)^ := PCardinal(aData)^;
6983           inc(aBuffer, 4 * Counter.X.dir);
6984         end;
6985       end;
6986     end;
6987
6988   var
6989     TotalPixelsToRead, TotalPixelsRead: Integer;
6990     Temp: Byte;
6991     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6992     PixelRepeat: Boolean;
6993     PixelsToRead, PixelCount: Integer;
6994   begin
6995     CacheSize := 0;
6996     CachePos  := 0;
6997
6998     TotalPixelsToRead := Header.Width * Header.Height;
6999     TotalPixelsRead   := 0;
7000     LinePixelsRead    := 0;
7001
7002     GetMem(Cache, CACHE_SIZE);
7003     try
7004       TmpData := ImageData;
7005       inc(TmpData, Counter.Y.low * LineSize);           //set line
7006       if (Counter.X.dir < 0) then                       //if x flipped then
7007         inc(TmpData, LineSize - PixelSize);             //set last pixel
7008
7009       repeat
7010         //read CommandByte
7011         CachedRead(Temp, 1);
7012         PixelRepeat  := (Temp and $80) > 0;
7013         PixelsToRead := (Temp and $7F) + 1;
7014         inc(TotalPixelsRead, PixelsToRead);
7015
7016         if PixelRepeat then
7017           CachedRead(buf[0], PixelSize);
7018         while (PixelsToRead > 0) do begin
7019           CheckLine;
7020           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7021           while (PixelCount > 0) do begin
7022             if not PixelRepeat then
7023               CachedRead(buf[0], PixelSize);
7024             PixelToBuffer(@buf[0], TmpData);
7025             inc(LinePixelsRead);
7026             dec(PixelsToRead);
7027             dec(PixelCount);
7028           end;
7029         end;
7030       until (TotalPixelsRead >= TotalPixelsToRead);
7031     finally
7032       FreeMem(Cache);
7033     end;
7034   end;
7035
7036   function IsGrayFormat: Boolean;
7037   begin
7038     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7039   end;
7040
7041 begin
7042   result := false;
7043
7044   // reading header to test file and set cursor back to begin
7045   StartPosition := aStream.Position;
7046   aStream.Read(Header{%H-}, SizeOf(Header));
7047
7048   // no colormapped files
7049   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7050     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7051   begin
7052     try
7053       if Header.ImageID <> 0 then       // skip image ID
7054         aStream.Position := aStream.Position + Header.ImageID;
7055
7056       tgaFormat := tfEmpty;
7057       case Header.Bpp of
7058          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7059                0: tgaFormat := tfLuminance8;
7060                8: tgaFormat := tfAlpha8;
7061             end;
7062
7063         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7064                0: tgaFormat := tfLuminance16;
7065                8: tgaFormat := tfLuminance8Alpha8;
7066             end else case (Header.ImageDesc and $F) of
7067                0: tgaFormat := tfBGR5;
7068                1: tgaFormat := tfBGR5A1;
7069                4: tgaFormat := tfBGRA4;
7070             end;
7071
7072         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7073                0: tgaFormat := tfBGR8;
7074             end;
7075
7076         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7077                2: tgaFormat := tfBGR10A2;
7078                8: tgaFormat := tfBGRA8;
7079             end;
7080       end;
7081
7082       if (tgaFormat = tfEmpty) then
7083         raise EglBitmap.Create('LoadTga - unsupported format');
7084
7085       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7086       PixelSize  := FormatDesc.GetSize(1, 1);
7087       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7088
7089       GetMem(ImageData, LineSize * Header.Height);
7090       try
7091         //column direction
7092         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7093           Counter.X.low  := Header.Height-1;;
7094           Counter.X.high := 0;
7095           Counter.X.dir  := -1;
7096         end else begin
7097           Counter.X.low  := 0;
7098           Counter.X.high := Header.Height-1;
7099           Counter.X.dir  := 1;
7100         end;
7101
7102         // Row direction
7103         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7104           Counter.Y.low  := 0;
7105           Counter.Y.high := Header.Height-1;
7106           Counter.Y.dir  := 1;
7107         end else begin
7108           Counter.Y.low  := Header.Height-1;;
7109           Counter.Y.high := 0;
7110           Counter.Y.dir  := -1;
7111         end;
7112
7113         // Read Image
7114         case Header.ImageType of
7115           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7116             ReadUncompressed;
7117           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7118             ReadCompressed;
7119         end;
7120
7121         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7122         result := true;
7123       except
7124         if Assigned(ImageData) then
7125           FreeMem(ImageData);
7126         raise;
7127       end;
7128     finally
7129       aStream.Position := StartPosition;
7130     end;
7131   end
7132     else aStream.Position := StartPosition;
7133 end;
7134
7135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7136 procedure TglBitmap.SaveTGA(const aStream: TStream);
7137 var
7138   Header: TTGAHeader;
7139   LineSize, Size, x, y: Integer;
7140   Pixel: TglBitmapPixelData;
7141   LineBuf, SourceData, DestData: PByte;
7142   SourceMD, DestMD: Pointer;
7143   FormatDesc: TFormatDescriptor;
7144   Converter: TFormatDescriptor;
7145 begin
7146   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7147     raise EglBitmapUnsupportedFormat.Create(Format);
7148
7149   //prepare header
7150   FillChar(Header{%H-}, SizeOf(Header), 0);
7151
7152   //set ImageType
7153   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7154                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7155     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7156   else
7157     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7158
7159   //set BitsPerPixel
7160   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7161     Header.Bpp := 8
7162   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7163                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7164     Header.Bpp := 16
7165   else if (Format in [tfBGR8, tfRGB8]) then
7166     Header.Bpp := 24
7167   else
7168     Header.Bpp := 32;
7169
7170   //set AlphaBitCount
7171   case Format of
7172     tfRGB5A1, tfBGR5A1:
7173       Header.ImageDesc := 1 and $F;
7174     tfRGB10A2, tfBGR10A2:
7175       Header.ImageDesc := 2 and $F;
7176     tfRGBA4, tfBGRA4:
7177       Header.ImageDesc := 4 and $F;
7178     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7179       Header.ImageDesc := 8 and $F;
7180   end;
7181
7182   Header.Width     := Width;
7183   Header.Height    := Height;
7184   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7185   aStream.Write(Header, SizeOf(Header));
7186
7187   // convert RGB(A) to BGR(A)
7188   Converter  := nil;
7189   FormatDesc := TFormatDescriptor.Get(Format);
7190   Size       := FormatDesc.GetSize(Dimension);
7191   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7192     if (FormatDesc.RGBInverted = tfEmpty) then
7193       raise EglBitmap.Create('inverted RGB format is empty');
7194     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7195     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7196        (Converter.PixelSize <> FormatDesc.PixelSize) then
7197       raise EglBitmap.Create('invalid inverted RGB format');
7198   end;
7199
7200   if Assigned(Converter) then begin
7201     LineSize := FormatDesc.GetSize(Width, 1);
7202     GetMem(LineBuf, LineSize);
7203     SourceMD := FormatDesc.CreateMappingData;
7204     DestMD   := Converter.CreateMappingData;
7205     try
7206       SourceData := Data;
7207       for y := 0 to Height-1 do begin
7208         DestData := LineBuf;
7209         for x := 0 to Width-1 do begin
7210           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7211           Converter.Map(Pixel, DestData, DestMD);
7212         end;
7213         aStream.Write(LineBuf^, LineSize);
7214       end;
7215     finally
7216       FreeMem(LineBuf);
7217       FormatDesc.FreeMappingData(SourceMD);
7218       FormatDesc.FreeMappingData(DestMD);
7219     end;
7220   end else
7221     aStream.Write(Data^, Size);
7222 end;
7223
7224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7225 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7227 const
7228   DDS_MAGIC: Cardinal         = $20534444;
7229
7230   // DDS_header.dwFlags
7231   DDSD_CAPS                   = $00000001;
7232   DDSD_HEIGHT                 = $00000002;
7233   DDSD_WIDTH                  = $00000004;
7234   DDSD_PIXELFORMAT            = $00001000;
7235
7236   // DDS_header.sPixelFormat.dwFlags
7237   DDPF_ALPHAPIXELS            = $00000001;
7238   DDPF_ALPHA                  = $00000002;
7239   DDPF_FOURCC                 = $00000004;
7240   DDPF_RGB                    = $00000040;
7241   DDPF_LUMINANCE              = $00020000;
7242
7243   // DDS_header.sCaps.dwCaps1
7244   DDSCAPS_TEXTURE             = $00001000;
7245
7246   // DDS_header.sCaps.dwCaps2
7247   DDSCAPS2_CUBEMAP            = $00000200;
7248
7249   D3DFMT_DXT1                 = $31545844;
7250   D3DFMT_DXT3                 = $33545844;
7251   D3DFMT_DXT5                 = $35545844;
7252
7253 type
7254   TDDSPixelFormat = packed record
7255     dwSize: Cardinal;
7256     dwFlags: Cardinal;
7257     dwFourCC: Cardinal;
7258     dwRGBBitCount: Cardinal;
7259     dwRBitMask: Cardinal;
7260     dwGBitMask: Cardinal;
7261     dwBBitMask: Cardinal;
7262     dwABitMask: Cardinal;
7263   end;
7264
7265   TDDSCaps = packed record
7266     dwCaps1: Cardinal;
7267     dwCaps2: Cardinal;
7268     dwDDSX: Cardinal;
7269     dwReserved: Cardinal;
7270   end;
7271
7272   TDDSHeader = packed record
7273     dwSize: Cardinal;
7274     dwFlags: Cardinal;
7275     dwHeight: Cardinal;
7276     dwWidth: Cardinal;
7277     dwPitchOrLinearSize: Cardinal;
7278     dwDepth: Cardinal;
7279     dwMipMapCount: Cardinal;
7280     dwReserved: array[0..10] of Cardinal;
7281     PixelFormat: TDDSPixelFormat;
7282     Caps: TDDSCaps;
7283     dwReserved2: Cardinal;
7284   end;
7285
7286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7287 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7288 var
7289   Header: TDDSHeader;
7290   Converter: TbmpBitfieldFormat;
7291
7292   function GetDDSFormat: TglBitmapFormat;
7293   var
7294     fd: TFormatDescriptor;
7295     i: Integer;
7296     Range: TglBitmapColorRec;
7297     match: Boolean;
7298   begin
7299     result := tfEmpty;
7300     with Header.PixelFormat do begin
7301       // Compresses
7302       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7303         case Header.PixelFormat.dwFourCC of
7304           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7305           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7306           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7307         end;
7308       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7309
7310         //find matching format
7311         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7312           fd := TFormatDescriptor.Get(result);
7313           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7314              (8 * fd.PixelSize = dwRGBBitCount) then
7315             exit;
7316         end;
7317
7318         //find format with same Range
7319         Range.r := dwRBitMask;
7320         Range.g := dwGBitMask;
7321         Range.b := dwBBitMask;
7322         Range.a := dwABitMask;
7323         for i := 0 to 3 do begin
7324           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7325             Range.arr[i] := Range.arr[i] shr 1;
7326         end;
7327         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7328           fd := TFormatDescriptor.Get(result);
7329           match := true;
7330           for i := 0 to 3 do
7331             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7332               match := false;
7333               break;
7334             end;
7335           if match then
7336             break;
7337         end;
7338
7339         //no format with same range found -> use default
7340         if (result = tfEmpty) then begin
7341           if (dwABitMask > 0) then
7342             result := tfBGRA8
7343           else
7344             result := tfBGR8;
7345         end;
7346
7347         Converter := TbmpBitfieldFormat.Create;
7348         Converter.RedMask   := dwRBitMask;
7349         Converter.GreenMask := dwGBitMask;
7350         Converter.BlueMask  := dwBBitMask;
7351         Converter.AlphaMask := dwABitMask;
7352         Converter.PixelSize := dwRGBBitCount / 8;
7353       end;
7354     end;
7355   end;
7356
7357 var
7358   StreamPos: Int64;
7359   x, y, LineSize, RowSize, Magic: Cardinal;
7360   NewImage, TmpData, RowData, SrcData: System.PByte;
7361   SourceMD, DestMD: Pointer;
7362   Pixel: TglBitmapPixelData;
7363   ddsFormat: TglBitmapFormat;
7364   FormatDesc: TFormatDescriptor;
7365
7366 begin
7367   result    := false;
7368   Converter := nil;
7369   StreamPos := aStream.Position;
7370
7371   // Magic
7372   aStream.Read(Magic{%H-}, sizeof(Magic));
7373   if (Magic <> DDS_MAGIC) then begin
7374     aStream.Position := StreamPos;
7375     exit;
7376   end;
7377
7378   //Header
7379   aStream.Read(Header{%H-}, sizeof(Header));
7380   if (Header.dwSize <> SizeOf(Header)) or
7381      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7382         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7383   begin
7384     aStream.Position := StreamPos;
7385     exit;
7386   end;
7387
7388   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7389     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7390
7391   ddsFormat := GetDDSFormat;
7392   try
7393     if (ddsFormat = tfEmpty) then
7394       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7395
7396     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7397     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7398     GetMem(NewImage, Header.dwHeight * LineSize);
7399     try
7400       TmpData := NewImage;
7401
7402       //Converter needed
7403       if Assigned(Converter) then begin
7404         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7405         GetMem(RowData, RowSize);
7406         SourceMD := Converter.CreateMappingData;
7407         DestMD   := FormatDesc.CreateMappingData;
7408         try
7409           for y := 0 to Header.dwHeight-1 do begin
7410             TmpData := NewImage;
7411             inc(TmpData, y * LineSize);
7412             SrcData := RowData;
7413             aStream.Read(SrcData^, RowSize);
7414             for x := 0 to Header.dwWidth-1 do begin
7415               Converter.Unmap(SrcData, Pixel, SourceMD);
7416               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7417               FormatDesc.Map(Pixel, TmpData, DestMD);
7418             end;
7419           end;
7420         finally
7421           Converter.FreeMappingData(SourceMD);
7422           FormatDesc.FreeMappingData(DestMD);
7423           FreeMem(RowData);
7424         end;
7425       end else
7426
7427       // Compressed
7428       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7429         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7430         for Y := 0 to Header.dwHeight-1 do begin
7431           aStream.Read(TmpData^, RowSize);
7432           Inc(TmpData, LineSize);
7433         end;
7434       end else
7435
7436       // Uncompressed
7437       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7438         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7439         for Y := 0 to Header.dwHeight-1 do begin
7440           aStream.Read(TmpData^, RowSize);
7441           Inc(TmpData, LineSize);
7442         end;
7443       end else
7444         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7445
7446       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7447       result := true;
7448     except
7449       if Assigned(NewImage) then
7450         FreeMem(NewImage);
7451       raise;
7452     end;
7453   finally
7454     FreeAndNil(Converter);
7455   end;
7456 end;
7457
7458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7459 procedure TglBitmap.SaveDDS(const aStream: TStream);
7460 var
7461   Header: TDDSHeader;
7462   FormatDesc: TFormatDescriptor;
7463 begin
7464   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7465     raise EglBitmapUnsupportedFormat.Create(Format);
7466
7467   FormatDesc := TFormatDescriptor.Get(Format);
7468
7469   // Generell
7470   FillChar(Header{%H-}, SizeOf(Header), 0);
7471   Header.dwSize  := SizeOf(Header);
7472   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7473
7474   Header.dwWidth  := Max(1, Width);
7475   Header.dwHeight := Max(1, Height);
7476
7477   // Caps
7478   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7479
7480   // Pixelformat
7481   Header.PixelFormat.dwSize := sizeof(Header);
7482   if (FormatDesc.IsCompressed) then begin
7483     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7484     case Format of
7485       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7486       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7487       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7488     end;
7489   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7490     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7491     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7492     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7493   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7494     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7495     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7496     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7497     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7498   end else begin
7499     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7500     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7501     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7502     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7503     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7504     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7505   end;
7506
7507   if (FormatDesc.HasAlpha) then
7508     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7509
7510   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7511   aStream.Write(Header, SizeOf(Header));
7512   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7513 end;
7514
7515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7516 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7518 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7519   const aWidth: Integer; const aHeight: Integer);
7520 var
7521   pTemp: pByte;
7522   Size: Integer;
7523 begin
7524   if (aHeight > 1) then begin
7525     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7526     GetMem(pTemp, Size);
7527     try
7528       Move(aData^, pTemp^, Size);
7529       FreeMem(aData);
7530       aData := nil;
7531     except
7532       FreeMem(pTemp);
7533       raise;
7534     end;
7535   end else
7536     pTemp := aData;
7537   inherited SetDataPointer(pTemp, aFormat, aWidth);
7538 end;
7539
7540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7541 function TglBitmap1D.FlipHorz: Boolean;
7542 var
7543   Col: Integer;
7544   pTempDest, pDest, pSource: PByte;
7545 begin
7546   result := inherited FlipHorz;
7547   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7548     pSource := Data;
7549     GetMem(pDest, fRowSize);
7550     try
7551       pTempDest := pDest;
7552       Inc(pTempDest, fRowSize);
7553       for Col := 0 to Width-1 do begin
7554         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7555         Move(pSource^, pTempDest^, fPixelSize);
7556         Inc(pSource, fPixelSize);
7557       end;
7558       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7559       result := true;
7560     except
7561       if Assigned(pDest) then
7562         FreeMem(pDest);
7563       raise;
7564     end;
7565   end;
7566 end;
7567
7568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7569 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7570 var
7571   FormatDesc: TFormatDescriptor;
7572 begin
7573   // Upload data
7574   FormatDesc := TFormatDescriptor.Get(Format);
7575   if FormatDesc.IsCompressed then
7576     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7577   else if aBuildWithGlu then
7578     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7579   else
7580     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7581
7582   // Free Data
7583   if (FreeDataAfterGenTexture) then
7584     FreeData;
7585 end;
7586
7587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7588 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7589 var
7590   BuildWithGlu, 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 (Width > TexSize) then
7599         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7600
7601       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7602                 (Target = GL_TEXTURE_RECTANGLE);
7603       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7604         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7605     end;
7606
7607     CreateId;
7608     SetupParameters(BuildWithGlu);
7609     UploadData(BuildWithGlu);
7610     glAreTexturesResident(1, @fID, @fIsResident);
7611   end;
7612 end;
7613
7614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7615 procedure TglBitmap1D.AfterConstruction;
7616 begin
7617   inherited;
7618   Target := GL_TEXTURE_1D;
7619 end;
7620
7621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7622 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7624 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7625 begin
7626   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7627     result := fLines[aIndex]
7628   else
7629     result := nil;
7630 end;
7631
7632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7633 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7634   const aWidth: Integer; const aHeight: Integer);
7635 var
7636   Idx, LineWidth: Integer;
7637 begin
7638   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7639
7640   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7641     // Assigning Data
7642     if Assigned(Data) then begin
7643       SetLength(fLines, GetHeight);
7644       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7645
7646       for Idx := 0 to GetHeight-1 do begin
7647         fLines[Idx] := Data;
7648         Inc(fLines[Idx], Idx * LineWidth);
7649       end;
7650     end
7651       else SetLength(fLines, 0);
7652   end else begin
7653     SetLength(fLines, 0);
7654   end;
7655 end;
7656
7657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7658 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7659 var
7660   FormatDesc: TFormatDescriptor;
7661 begin
7662   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7663
7664   FormatDesc := TFormatDescriptor.Get(Format);
7665   if FormatDesc.IsCompressed then begin
7666     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7667   end else if aBuildWithGlu then begin
7668     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7669       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7670   end else begin
7671     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7672       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7673   end;
7674
7675   // Freigeben
7676   if (FreeDataAfterGenTexture) then
7677     FreeData;
7678 end;
7679
7680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7681 procedure TglBitmap2D.AfterConstruction;
7682 begin
7683   inherited;
7684   Target := GL_TEXTURE_2D;
7685 end;
7686
7687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7688 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7689 var
7690   Temp: pByte;
7691   Size, w, h: Integer;
7692   FormatDesc: TFormatDescriptor;
7693 begin
7694   FormatDesc := TFormatDescriptor.Get(Format);
7695   if FormatDesc.IsCompressed then
7696     raise EglBitmapUnsupportedFormat.Create(Format);
7697
7698   w    := aRight  - aLeft;
7699   h    := aBottom - aTop;
7700   Size := FormatDesc.GetSize(w, h);
7701   GetMem(Temp, Size);
7702   try
7703     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7704     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7705     SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
7706     FlipVert;
7707   except
7708     if Assigned(Temp) then
7709       FreeMem(Temp);
7710     raise;
7711   end;
7712 end;
7713
7714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7715 procedure TglBitmap2D.GetDataFromTexture;
7716 var
7717   Temp: PByte;
7718   TempWidth, TempHeight: Integer;
7719   TempIntFormat: Cardinal;
7720   IntFormat, f: TglBitmapFormat;
7721   FormatDesc: TFormatDescriptor;
7722 begin
7723   Bind;
7724
7725   // Request Data
7726   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7727   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7728   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7729
7730   IntFormat := tfEmpty;
7731   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7732     FormatDesc := TFormatDescriptor.Get(f);
7733     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7734       IntFormat := FormatDesc.Format;
7735       break;
7736     end;
7737   end;
7738
7739   // Getting data from OpenGL
7740   FormatDesc := TFormatDescriptor.Get(IntFormat);
7741   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7742   try
7743     if FormatDesc.IsCompressed then
7744       glGetCompressedTexImage(Target, 0, Temp)
7745     else
7746      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7747     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7748   except
7749     if Assigned(Temp) then
7750       FreeMem(Temp);
7751     raise;
7752   end;
7753 end;
7754
7755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7756 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7757 var
7758   BuildWithGlu, PotTex, TexRec: Boolean;
7759   TexSize: Integer;
7760 begin
7761   if Assigned(Data) then begin
7762     // Check Texture Size
7763     if (aTestTextureSize) then begin
7764       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7765
7766       if ((Height > TexSize) or (Width > TexSize)) then
7767         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7768
7769       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7770       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7771       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7772         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7773     end;
7774
7775     CreateId;
7776     SetupParameters(BuildWithGlu);
7777     UploadData(Target, BuildWithGlu);
7778     glAreTexturesResident(1, @fID, @fIsResident);
7779   end;
7780 end;
7781
7782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7783 function TglBitmap2D.FlipHorz: Boolean;
7784 var
7785   Col, Row: Integer;
7786   TempDestData, DestData, SourceData: PByte;
7787   ImgSize: Integer;
7788 begin
7789   result := inherited FlipHorz;
7790   if Assigned(Data) then begin
7791     SourceData := Data;
7792     ImgSize := Height * fRowSize;
7793     GetMem(DestData, ImgSize);
7794     try
7795       TempDestData := DestData;
7796       Dec(TempDestData, fRowSize + fPixelSize);
7797       for Row := 0 to Height -1 do begin
7798         Inc(TempDestData, fRowSize * 2);
7799         for Col := 0 to Width -1 do begin
7800           Move(SourceData^, TempDestData^, fPixelSize);
7801           Inc(SourceData, fPixelSize);
7802           Dec(TempDestData, fPixelSize);
7803         end;
7804       end;
7805       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7806       result := true;
7807     except
7808       if Assigned(DestData) then
7809         FreeMem(DestData);
7810       raise;
7811     end;
7812   end;
7813 end;
7814
7815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7816 function TglBitmap2D.FlipVert: Boolean;
7817 var
7818   Row: Integer;
7819   TempDestData, DestData, SourceData: PByte;
7820 begin
7821   result := inherited FlipVert;
7822   if Assigned(Data) then begin
7823     SourceData := Data;
7824     GetMem(DestData, Height * fRowSize);
7825     try
7826       TempDestData := DestData;
7827       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7828       for Row := 0 to Height -1 do begin
7829         Move(SourceData^, TempDestData^, fRowSize);
7830         Dec(TempDestData, fRowSize);
7831         Inc(SourceData, fRowSize);
7832       end;
7833       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7834       result := true;
7835     except
7836       if Assigned(DestData) then
7837         FreeMem(DestData);
7838       raise;
7839     end;
7840   end;
7841 end;
7842
7843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7844 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7846 type
7847   TMatrixItem = record
7848     X, Y: Integer;
7849     W: Single;
7850   end;
7851
7852   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7853   TglBitmapToNormalMapRec = Record
7854     Scale: Single;
7855     Heights: array of Single;
7856     MatrixU : array of TMatrixItem;
7857     MatrixV : array of TMatrixItem;
7858   end;
7859
7860 const
7861   ONE_OVER_255 = 1 / 255;
7862
7863   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7864 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7865 var
7866   Val: Single;
7867 begin
7868   with FuncRec do begin
7869     Val :=
7870       Source.Data.r * LUMINANCE_WEIGHT_R +
7871       Source.Data.g * LUMINANCE_WEIGHT_G +
7872       Source.Data.b * LUMINANCE_WEIGHT_B;
7873     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7874   end;
7875 end;
7876
7877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7878 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7879 begin
7880   with FuncRec do
7881     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7882 end;
7883
7884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7885 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7886 type
7887   TVec = Array[0..2] of Single;
7888 var
7889   Idx: Integer;
7890   du, dv: Double;
7891   Len: Single;
7892   Vec: TVec;
7893
7894   function GetHeight(X, Y: Integer): Single;
7895   begin
7896     with FuncRec do begin
7897       X := Max(0, Min(Size.X -1, X));
7898       Y := Max(0, Min(Size.Y -1, Y));
7899       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7900     end;
7901   end;
7902
7903 begin
7904   with FuncRec do begin
7905     with PglBitmapToNormalMapRec(Args)^ do begin
7906       du := 0;
7907       for Idx := Low(MatrixU) to High(MatrixU) do
7908         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7909
7910       dv := 0;
7911       for Idx := Low(MatrixU) to High(MatrixU) do
7912         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7913
7914       Vec[0] := -du * Scale;
7915       Vec[1] := -dv * Scale;
7916       Vec[2] := 1;
7917     end;
7918
7919     // Normalize
7920     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7921     if Len <> 0 then begin
7922       Vec[0] := Vec[0] * Len;
7923       Vec[1] := Vec[1] * Len;
7924       Vec[2] := Vec[2] * Len;
7925     end;
7926
7927     // Farbe zuweisem
7928     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7929     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7930     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7931   end;
7932 end;
7933
7934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7935 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7936 var
7937   Rec: TglBitmapToNormalMapRec;
7938
7939   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7940   begin
7941     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7942       Matrix[Index].X := X;
7943       Matrix[Index].Y := Y;
7944       Matrix[Index].W := W;
7945     end;
7946   end;
7947
7948 begin
7949   if TFormatDescriptor.Get(Format).IsCompressed then
7950     raise EglBitmapUnsupportedFormat.Create(Format);
7951
7952   if aScale > 100 then
7953     Rec.Scale := 100
7954   else if aScale < -100 then
7955     Rec.Scale := -100
7956   else
7957     Rec.Scale := aScale;
7958
7959   SetLength(Rec.Heights, Width * Height);
7960   try
7961     case aFunc of
7962       nm4Samples: begin
7963         SetLength(Rec.MatrixU, 2);
7964         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7965         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7966
7967         SetLength(Rec.MatrixV, 2);
7968         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7969         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7970       end;
7971
7972       nmSobel: begin
7973         SetLength(Rec.MatrixU, 6);
7974         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7975         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7976         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7977         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7978         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7979         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7980
7981         SetLength(Rec.MatrixV, 6);
7982         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7983         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7984         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7985         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7986         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7987         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7988       end;
7989
7990       nm3x3: begin
7991         SetLength(Rec.MatrixU, 6);
7992         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7993         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7994         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7995         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7996         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7997         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7998
7999         SetLength(Rec.MatrixV, 6);
8000         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8001         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8002         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8003         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8004         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8005         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8006       end;
8007
8008       nm5x5: begin
8009         SetLength(Rec.MatrixU, 20);
8010         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8011         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8012         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8013         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8014         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8015         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8016         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8017         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8018         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8019         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8020         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8021         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8022         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8023         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8024         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8025         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8026         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8027         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8028         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8029         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8030
8031         SetLength(Rec.MatrixV, 20);
8032         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8033         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8034         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8035         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8036         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8037         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8038         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8039         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8040         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8041         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8042         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8043         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8044         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8045         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8046         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8047         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8048         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8049         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8050         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8051         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8052       end;
8053     end;
8054
8055     // Daten Sammeln
8056     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8057       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8058     else
8059       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8060     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8061   finally
8062     SetLength(Rec.Heights, 0);
8063   end;
8064 end;
8065
8066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8067 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8069 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8070 begin
8071   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8072 end;
8073
8074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8075 procedure TglBitmapCubeMap.AfterConstruction;
8076 begin
8077   inherited;
8078
8079   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8080     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8081
8082   SetWrap;
8083   Target   := GL_TEXTURE_CUBE_MAP;
8084   fGenMode := GL_REFLECTION_MAP;
8085 end;
8086
8087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8088 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8089 var
8090   BuildWithGlu: Boolean;
8091   TexSize: Integer;
8092 begin
8093   if (aTestTextureSize) then begin
8094     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8095
8096     if (Height > TexSize) or (Width > TexSize) then
8097       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8098
8099     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8100       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8101   end;
8102
8103   if (ID = 0) then
8104     CreateID;
8105   SetupParameters(BuildWithGlu);
8106   UploadData(aCubeTarget, BuildWithGlu);
8107 end;
8108
8109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8110 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8111 begin
8112   inherited Bind (aEnableTextureUnit);
8113   if aEnableTexCoordsGen then begin
8114     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8115     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8116     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8117     glEnable(GL_TEXTURE_GEN_S);
8118     glEnable(GL_TEXTURE_GEN_T);
8119     glEnable(GL_TEXTURE_GEN_R);
8120   end;
8121 end;
8122
8123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8124 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8125 begin
8126   inherited Unbind(aDisableTextureUnit);
8127   if aDisableTexCoordsGen then begin
8128     glDisable(GL_TEXTURE_GEN_S);
8129     glDisable(GL_TEXTURE_GEN_T);
8130     glDisable(GL_TEXTURE_GEN_R);
8131   end;
8132 end;
8133
8134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8135 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8137 type
8138   TVec = Array[0..2] of Single;
8139   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8140
8141   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8142   TglBitmapNormalMapRec = record
8143     HalfSize : Integer;
8144     Func: TglBitmapNormalMapGetVectorFunc;
8145   end;
8146
8147   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8148 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8149 begin
8150   aVec[0] := aHalfSize;
8151   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8152   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8153 end;
8154
8155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8156 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8157 begin
8158   aVec[0] := - aHalfSize;
8159   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8160   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8161 end;
8162
8163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8164 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8165 begin
8166   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8167   aVec[1] := aHalfSize;
8168   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8169 end;
8170
8171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8172 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8173 begin
8174   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8175   aVec[1] := - aHalfSize;
8176   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8177 end;
8178
8179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8180 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8181 begin
8182   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8183   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8184   aVec[2] := aHalfSize;
8185 end;
8186
8187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8188 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8189 begin
8190   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8191   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8192   aVec[2] := - aHalfSize;
8193 end;
8194
8195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8196 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8197 var
8198   i: Integer;
8199   Vec: TVec;
8200   Len: Single;
8201 begin
8202   with FuncRec do begin
8203     with PglBitmapNormalMapRec(Args)^ do begin
8204       Func(Vec, Position, HalfSize);
8205
8206       // Normalize
8207       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8208       if Len <> 0 then begin
8209         Vec[0] := Vec[0] * Len;
8210         Vec[1] := Vec[1] * Len;
8211         Vec[2] := Vec[2] * Len;
8212       end;
8213
8214       // Scale Vector and AddVectro
8215       Vec[0] := Vec[0] * 0.5 + 0.5;
8216       Vec[1] := Vec[1] * 0.5 + 0.5;
8217       Vec[2] := Vec[2] * 0.5 + 0.5;
8218     end;
8219
8220     // Set Color
8221     for i := 0 to 2 do
8222       Dest.Data.arr[i] := Round(Vec[i] * 255);
8223   end;
8224 end;
8225
8226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8227 procedure TglBitmapNormalMap.AfterConstruction;
8228 begin
8229   inherited;
8230   fGenMode := GL_NORMAL_MAP;
8231 end;
8232
8233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8234 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8235 var
8236   Rec: TglBitmapNormalMapRec;
8237   SizeRec: TglBitmapPixelPosition;
8238 begin
8239   Rec.HalfSize := aSize div 2;
8240   FreeDataAfterGenTexture := false;
8241
8242   SizeRec.Fields := [ffX, ffY];
8243   SizeRec.X := aSize;
8244   SizeRec.Y := aSize;
8245
8246   // Positive X
8247   Rec.Func := glBitmapNormalMapPosX;
8248   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8249   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8250
8251   // Negative X
8252   Rec.Func := glBitmapNormalMapNegX;
8253   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8254   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8255
8256   // Positive Y
8257   Rec.Func := glBitmapNormalMapPosY;
8258   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8259   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8260
8261   // Negative Y
8262   Rec.Func := glBitmapNormalMapNegY;
8263   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8264   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8265
8266   // Positive Z
8267   Rec.Func := glBitmapNormalMapPosZ;
8268   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8269   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8270
8271   // Negative Z
8272   Rec.Func := glBitmapNormalMapNegZ;
8273   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8274   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8275 end;
8276
8277
8278 initialization
8279   glBitmapSetDefaultFormat (tfEmpty);
8280   glBitmapSetDefaultMipmap (mmMipmap);
8281   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8282   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8283   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8284
8285   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8286   glBitmapSetDefaultDeleteTextureOnFree    (true);
8287
8288   TFormatDescriptor.Init;
8289
8290 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8291   OpenGLInitialized := false;
8292   InitOpenGLCS := TCriticalSection.Create;
8293 {$ENDIF}
8294
8295 finalization
8296   TFormatDescriptor.Finalize;
8297
8298 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8299   FreeAndNil(InitOpenGLCS);
8300 {$ENDIF}
8301
8302 end.
8303