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/) (2013)
   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 3.0.1
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // enable OpenGL ES support
 230 {.$DEFINE OPENGL_ES_1_1}
 231 {.$DEFINE OPENGL_ES_2_0}
 232 {.$DEFINE OPENGL_ES_3_0}
 233 {.$DEFINE OPENGL_ES_EXT}
 234
 235 // activate to enable build-in OpenGL support with statically linked methods
 236 // use dglOpenGL.pas if not enabled
 237 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 238
 239 // activate to enable build-in OpenGL support with dynamically linked methods
 240 // use dglOpenGL.pas if not enabled
 241 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 242
 243
 244 // activate to enable the support for SDL_surfaces
 245 {.$DEFINE GLB_SDL}
 246
 247 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
 248 {.$DEFINE GLB_DELPHI}
 249
 250 // activate to enable the support for TLazIntfImage from Lazarus
 251 {.$DEFINE GLB_LAZARUS}
 252
 253
 254
 255 // activate to enable the support of SDL_image to load files. (READ ONLY)
 256 // If you enable SDL_image all other libraries will be ignored!
 257 {.$DEFINE GLB_SDL_IMAGE}
 258
 259
 260
 261 // activate to enable Lazarus TPortableNetworkGraphic support
 262 // if you enable this pngImage and libPNG will be ignored
 263 {.$DEFINE GLB_LAZ_PNG}
 264
 265 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 266 // if you enable pngimage the libPNG will be ignored
 267 {.$DEFINE GLB_PNGIMAGE}
 268
 269 // activate to use the libPNG -> http://www.libpng.org/
 270 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 271 {.$DEFINE GLB_LIB_PNG}
 272
 273
 274
 275 // activate to enable Lazarus TJPEGImage support
 276 // if you enable this delphi jpegs and libJPEG will be ignored
 277 {.$DEFINE GLB_LAZ_JPEG}
 278
 279 // if you enable delphi jpegs the libJPEG will be ignored
 280 {.$DEFINE GLB_DELPHI_JPEG}
 281
 282 // activate to use the libJPEG -> http://www.ijg.org/
 283 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 284 {.$DEFINE GLB_LIB_JPEG}
 285
 286
 287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 288 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 290 // Delphi Versions
 291 {$IFDEF fpc}
 292   {$MODE Delphi}
 293
 294   {$IFDEF CPUI386}
 295     {$DEFINE CPU386}
 296     {$ASMMODE INTEL}
 297   {$ENDIF}
 298
 299   {$IFNDEF WINDOWS}
 300     {$linklib c}
 301   {$ENDIF}
 302 {$ENDIF}
 303
 304 // Operation System
 305 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 306   {$DEFINE GLB_WIN}
 307 {$ELSEIF DEFINED(LINUX)}
 308   {$DEFINE GLB_LINUX}
 309 {$IFEND}
 310
 311 // OpenGL ES
 312 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 313 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
 314 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 315 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
 316
 317 // native OpenGL Support
 318 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 319   {$IFDEF OPENGL_ES}
 320     {$ERROR 'native OpenGL is not supported yet for OpenGL ES, please use dglOpenGLES.pas instead'}
 321   {$ELSE}
 322     {$DEFINE GLB_NATIVE_OGL}
 323   {$ENDIF}
 324 {$IFEND}
 325
 326 // checking define combinations
 327 //SDL Image
 328 {$IFDEF GLB_SDL_IMAGE}
 329   {$IFNDEF GLB_SDL}
 330     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 331     {$DEFINE GLB_SDL}
 332   {$ENDIF}
 333
 334   {$IFDEF GLB_LAZ_PNG}
 335     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 336     {$undef GLB_LAZ_PNG}
 337   {$ENDIF}
 338
 339   {$IFDEF GLB_PNGIMAGE}
 340     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 341     {$undef GLB_PNGIMAGE}
 342   {$ENDIF}
 343
 344   {$IFDEF GLB_LAZ_JPEG}
 345     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 346     {$undef GLB_LAZ_JPEG}
 347   {$ENDIF}
 348
 349   {$IFDEF GLB_DELPHI_JPEG}
 350     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 351     {$undef GLB_DELPHI_JPEG}
 352   {$ENDIF}
 353
 354   {$IFDEF GLB_LIB_PNG}
 355     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 356     {$undef GLB_LIB_PNG}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_LIB_JPEG}
 360     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 361     {$undef GLB_LIB_JPEG}
 362   {$ENDIF}
 363
 364   {$DEFINE GLB_SUPPORT_PNG_READ}
 365   {$DEFINE GLB_SUPPORT_JPEG_READ}
 366 {$ENDIF}
 367
 368 // Lazarus TPortableNetworkGraphic
 369 {$IFDEF GLB_LAZ_PNG}
 370   {$IFNDEF GLB_LAZARUS}
 371     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 372     {$DEFINE GLB_LAZARUS}
 373   {$ENDIF}
 374
 375   {$IFDEF GLB_PNGIMAGE}
 376     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 377     {$undef GLB_PNGIMAGE}
 378   {$ENDIF}
 379
 380   {$IFDEF GLB_LIB_PNG}
 381     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 382     {$undef GLB_LIB_PNG}
 383   {$ENDIF}
 384
 385   {$DEFINE GLB_SUPPORT_PNG_READ}
 386   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 387 {$ENDIF}
 388
 389 // PNG Image
 390 {$IFDEF GLB_PNGIMAGE}
 391   {$IFDEF GLB_LIB_PNG}
 392     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 393     {$undef GLB_LIB_PNG}
 394   {$ENDIF}
 395
 396   {$DEFINE GLB_SUPPORT_PNG_READ}
 397   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 398 {$ENDIF}
 399
 400 // libPNG
 401 {$IFDEF GLB_LIB_PNG}
 402   {$DEFINE GLB_SUPPORT_PNG_READ}
 403   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 404 {$ENDIF}
 405
 406 // Lazarus TJPEGImage
 407 {$IFDEF GLB_LAZ_JPEG}
 408   {$IFNDEF GLB_LAZARUS}
 409     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 410     {$DEFINE GLB_LAZARUS}
 411   {$ENDIF}
 412
 413   {$IFDEF GLB_DELPHI_JPEG}
 414     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 415     {$undef GLB_DELPHI_JPEG}
 416   {$ENDIF}
 417
 418   {$IFDEF GLB_LIB_JPEG}
 419     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 420     {$undef GLB_LIB_JPEG}
 421   {$ENDIF}
 422
 423   {$DEFINE GLB_SUPPORT_JPEG_READ}
 424   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 425 {$ENDIF}
 426
 427 // JPEG Image
 428 {$IFDEF GLB_DELPHI_JPEG}
 429   {$IFDEF GLB_LIB_JPEG}
 430     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 431     {$undef GLB_LIB_JPEG}
 432   {$ENDIF}
 433
 434   {$DEFINE GLB_SUPPORT_JPEG_READ}
 435   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 436 {$ENDIF}
 437
 438 // libJPEG
 439 {$IFDEF GLB_LIB_JPEG}
 440   {$DEFINE GLB_SUPPORT_JPEG_READ}
 441   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 442 {$ENDIF}
 443
 444 // native OpenGL
 445 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 446   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 447 {$IFEND}
 448
 449 // general options
 450 {$EXTENDEDSYNTAX ON}
 451 {$LONGSTRINGS ON}
 452 {$ALIGN ON}
 453 {$IFNDEF FPC}
 454   {$OPTIMIZATION ON}
 455 {$ENDIF}
 456
 457 interface
 458
 459 uses
 460   {$IFNDEF GLB_NATIVE_OGL}
 461     {$IFDEF OPENGL_ES}          dglOpenGLES,
 462     {$ELSE}                     dglOpenGL,                          {$ENDIF}
 463                                                                     {$ENDIF}
 464   {$IF DEFINED(GLB_WIN) AND
 465        (DEFINED(GLB_NATIVE_OGL) OR
 466         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 467
 468   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 469   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 470   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 471
 472   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 473   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 474   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 475   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 476   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 477
 478   Classes, SysUtils;
 479
 480 {$IFDEF GLB_NATIVE_OGL}
 481 const
 482   GL_TRUE   = 1;
 483   GL_FALSE  = 0;
 484
 485   GL_ZERO = 0;
 486   GL_ONE  = 1;
 487
 488   GL_VERSION    = $1F02;
 489   GL_EXTENSIONS = $1F03;
 490
 491   GL_TEXTURE_1D         = $0DE0;
 492   GL_TEXTURE_2D         = $0DE1;
 493   GL_TEXTURE_RECTANGLE  = $84F5;
 494
 495   GL_NORMAL_MAP                   = $8511;
 496   GL_TEXTURE_CUBE_MAP             = $8513;
 497   GL_REFLECTION_MAP               = $8512;
 498   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 499   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 500   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 501   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 502   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 503   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 504
 505   GL_TEXTURE_WIDTH            = $1000;
 506   GL_TEXTURE_HEIGHT           = $1001;
 507   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 508   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 509
 510   GL_S = $2000;
 511   GL_T = $2001;
 512   GL_R = $2002;
 513   GL_Q = $2003;
 514
 515   GL_TEXTURE_GEN_S = $0C60;
 516   GL_TEXTURE_GEN_T = $0C61;
 517   GL_TEXTURE_GEN_R = $0C62;
 518   GL_TEXTURE_GEN_Q = $0C63;
 519
 520   GL_RED    = $1903;
 521   GL_GREEN  = $1904;
 522   GL_BLUE   = $1905;
 523
 524   GL_ALPHA    = $1906;
 525   GL_ALPHA4   = $803B;
 526   GL_ALPHA8   = $803C;
 527   GL_ALPHA12  = $803D;
 528   GL_ALPHA16  = $803E;
 529
 530   GL_LUMINANCE    = $1909;
 531   GL_LUMINANCE4   = $803F;
 532   GL_LUMINANCE8   = $8040;
 533   GL_LUMINANCE12  = $8041;
 534   GL_LUMINANCE16  = $8042;
 535
 536   GL_LUMINANCE_ALPHA      = $190A;
 537   GL_LUMINANCE4_ALPHA4    = $8043;
 538   GL_LUMINANCE6_ALPHA2    = $8044;
 539   GL_LUMINANCE8_ALPHA8    = $8045;
 540   GL_LUMINANCE12_ALPHA4   = $8046;
 541   GL_LUMINANCE12_ALPHA12  = $8047;
 542   GL_LUMINANCE16_ALPHA16  = $8048;
 543
 544   GL_RGB      = $1907;
 545   GL_BGR      = $80E0;
 546   GL_R3_G3_B2 = $2A10;
 547   GL_RGB4     = $804F;
 548   GL_RGB5     = $8050;
 549   GL_RGB565   = $8D62;
 550   GL_RGB8     = $8051;
 551   GL_RGB10    = $8052;
 552   GL_RGB12    = $8053;
 553   GL_RGB16    = $8054;
 554
 555   GL_RGBA     = $1908;
 556   GL_BGRA     = $80E1;
 557   GL_RGBA2    = $8055;
 558   GL_RGBA4    = $8056;
 559   GL_RGB5_A1  = $8057;
 560   GL_RGBA8    = $8058;
 561   GL_RGB10_A2 = $8059;
 562   GL_RGBA12   = $805A;
 563   GL_RGBA16   = $805B;
 564
 565   GL_DEPTH_COMPONENT    = $1902;
 566   GL_DEPTH_COMPONENT16  = $81A5;
 567   GL_DEPTH_COMPONENT24  = $81A6;
 568   GL_DEPTH_COMPONENT32  = $81A7;
 569
 570   GL_COMPRESSED_RGB                 = $84ED;
 571   GL_COMPRESSED_RGBA                = $84EE;
 572   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 573   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 574   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 575   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 576
 577   GL_UNSIGNED_BYTE            = $1401;
 578   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 579   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 580
 581   GL_UNSIGNED_SHORT             = $1403;
 582   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 583   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 584   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 585   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 586   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 587   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 588
 589   GL_UNSIGNED_INT                 = $1405;
 590   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 591   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 592   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 593   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 594
 595   { Texture Filter }
 596   GL_TEXTURE_MAG_FILTER     = $2800;
 597   GL_TEXTURE_MIN_FILTER     = $2801;
 598   GL_NEAREST                = $2600;
 599   GL_NEAREST_MIPMAP_NEAREST = $2700;
 600   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 601   GL_LINEAR                 = $2601;
 602   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 603   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 604
 605   { Texture Wrap }
 606   GL_TEXTURE_WRAP_S   = $2802;
 607   GL_TEXTURE_WRAP_T   = $2803;
 608   GL_TEXTURE_WRAP_R   = $8072;
 609   GL_CLAMP            = $2900;
 610   GL_REPEAT           = $2901;
 611   GL_CLAMP_TO_EDGE    = $812F;
 612   GL_CLAMP_TO_BORDER  = $812D;
 613   GL_MIRRORED_REPEAT  = $8370;
 614
 615   { Other }
 616   GL_GENERATE_MIPMAP      = $8191;
 617   GL_TEXTURE_BORDER_COLOR = $1004;
 618   GL_MAX_TEXTURE_SIZE     = $0D33;
 619   GL_PACK_ALIGNMENT       = $0D05;
 620   GL_UNPACK_ALIGNMENT     = $0CF5;
 621
 622   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 623   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 624   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 625   GL_TEXTURE_GEN_MODE               = $2500;
 626
 627 {$IF DEFINED(GLB_WIN)}
 628   libglu    = 'glu32.dll';
 629   libopengl = 'opengl32.dll';
 630 {$ELSEIF DEFINED(GLB_LINUX)}
 631   libglu    = 'libGLU.so.1';
 632   libopengl = 'libGL.so.1';
 633 {$IFEND}
 634
 635 type
 636   GLboolean = BYTEBOOL;
 637   GLint     = Integer;
 638   GLsizei   = Integer;
 639   GLuint    = Cardinal;
 640   GLfloat   = Single;
 641   GLenum    = Cardinal;
 642
 643   PGLvoid    = Pointer;
 644   PGLboolean = ^GLboolean;
 645   PGLint     = ^GLint;
 646   PGLuint    = ^GLuint;
 647   PGLfloat   = ^GLfloat;
 648
 649   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   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}
 651   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652
 653 {$IF DEFINED(GLB_WIN)}
 654   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 655 {$ELSEIF DEFINED(GLB_LINUX)}
 656   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 657   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 658 {$IFEND}
 659
 660 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 661   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663
 664   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 665   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666
 667   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 669   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 672   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 673   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 674
 675   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 676   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 677   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 678   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 679
 680   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 681   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 682   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 683
 684   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}
 685   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}
 686   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 687
 688   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 689   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 690
 691 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 692   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694
 695   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 696   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697
 698   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 700   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 701   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 702   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 703   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 704   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 705
 706   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 707   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 708   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 709   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 710
 711   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 712   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;
 713   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 714
 715   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;
 716   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;
 717   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 718
 719   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 720   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 721 {$IFEND}
 722
 723 var
 724   GL_VERSION_1_2,
 725   GL_VERSION_1_3,
 726   GL_VERSION_1_4,
 727   GL_VERSION_2_0,
 728   GL_VERSION_3_3,
 729
 730   GL_SGIS_generate_mipmap,
 731
 732   GL_ARB_texture_border_clamp,
 733   GL_ARB_texture_mirrored_repeat,
 734   GL_ARB_texture_rectangle,
 735   GL_ARB_texture_non_power_of_two,
 736   GL_ARB_texture_swizzle,
 737   GL_ARB_texture_cube_map,
 738
 739   GL_IBM_texture_mirrored_repeat,
 740
 741   GL_NV_texture_rectangle,
 742
 743   GL_EXT_texture_edge_clamp,
 744   GL_EXT_texture_rectangle,
 745   GL_EXT_texture_swizzle,
 746   GL_EXT_texture_cube_map,
 747   GL_EXT_texture_filter_anisotropic: Boolean;
 748
 749   glCompressedTexImage1D: TglCompressedTexImage1D;
 750   glCompressedTexImage2D: TglCompressedTexImage2D;
 751   glGetCompressedTexImage: TglGetCompressedTexImage;
 752
 753 {$IF DEFINED(GLB_WIN)}
 754   wglGetProcAddress: TwglGetProcAddress;
 755 {$ELSEIF DEFINED(GLB_LINUX)}
 756   glXGetProcAddress: TglXGetProcAddress;
 757   glXGetProcAddressARB: TglXGetProcAddress;
 758 {$IFEND}
 759
 760 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 761   glEnable: TglEnable;
 762   glDisable: TglDisable;
 763
 764   glGetString: TglGetString;
 765   glGetIntegerv: TglGetIntegerv;
 766
 767   glTexParameteri: TglTexParameteri;
 768   glTexParameteriv: TglTexParameteriv;
 769   glTexParameterfv: TglTexParameterfv;
 770   glGetTexParameteriv: TglGetTexParameteriv;
 771   glGetTexParameterfv: TglGetTexParameterfv;
 772   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 773   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 774
 775   glTexGeni: TglTexGeni;
 776   glGenTextures: TglGenTextures;
 777   glBindTexture: TglBindTexture;
 778   glDeleteTextures: TglDeleteTextures;
 779
 780   glAreTexturesResident: TglAreTexturesResident;
 781   glReadPixels: TglReadPixels;
 782   glPixelStorei: TglPixelStorei;
 783
 784   glTexImage1D: TglTexImage1D;
 785   glTexImage2D: TglTexImage2D;
 786   glGetTexImage: TglGetTexImage;
 787
 788   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 789   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 790 {$ENDIF}
 791 {$ENDIF}
 792
 793 type
 794 ////////////////////////////////////////////////////////////////////////////////////////////////////
 795 // the name of formats is composed of the following constituents:
 796 // - multiple chanals:
 797 //    - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved)
 798 //    - width of the chanel in bit       (4, 8, 16, ...)
 799 // - data type                           (e.g. ub, us, ui)
 800 // - number of data types
 801
 802 {$IFNDEF fpc}
 803   QWord   = System.UInt64;
 804   PQWord  = ^QWord;
 805
 806   PtrInt  = Longint;
 807   PtrUInt = DWord;
 808 {$ENDIF}
 809
 810   TglBitmapFormat = (
 811     tfEmpty = 0,                //must be smallest value!
 812
 813     tfAlpha4ub1,                // 1 x unsigned byte
 814     tfAlpha8ub1,                // 1 x unsigned byte
 815     tfAlpha16us1,               // 1 x unsigned short
 816
 817     tfLuminance4ub1,            // 1 x unsigned byte
 818     tfLuminance8ub1,            // 1 x unsigned byte
 819     tfLuminance16us1,           // 1 x unsigned short
 820
 821     tfLuminance4Alpha4ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 822     tfLuminance6Alpha2ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 823     tfLuminance8Alpha8ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 824     tfLuminance12Alpha4us2,     // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 825     tfLuminance16Alpha16us2,    // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 826
 827     tfR3G3B2ub1,                // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 828     tfRGBX4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 829     tfXRGB4us1,                 // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 830     tfR5G6B5us1,                // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 831     tfRGB5X1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 832     tfX1RGB5us1,                // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 833     tfRGB8ub3,                  // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 834     tfRGBX8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 835     tfXRGB8ui1,                 // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 836     tfRGB10X2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 837     tfX2RGB10ui1,               // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 838     tfRGB16us3,                 // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 839
 840     tfRGBA4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 841     tfARGB4us1,                 // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 842     tfRGB5A1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 843     tfA1RGB5us1,                // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 844     tfRGBA8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 845     tfARGB8ui1,                 // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 846     tfRGBA8ub4,                 // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 847     tfRGB10A2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 848     tfA2RGB10ui1,               // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 849     tfRGBA16us4,                // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 850
 851     tfBGRX4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 852     tfXBGR4us1,                 // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 853     tfB5G6R5us1,                // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 854     tfBGR5X1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 855     tfX1BGR5us1,                // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 856     tfBGR8ub3,                  // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 857     tfBGRX8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 858     tfXBGR8ui1,                 // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 859     tfBGR10X2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 860     tfX2BGR10ui1,               // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 861     tfBGR16us3,                 // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 862
 863     tfBGRA4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 864     tfABGR4us1,                 // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 865     tfBGR5A1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 866     tfA1BGR5us1,                // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 867     tfBGRA8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 868     tfABGR8ui1,                 // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 869     tfBGRA8ub4,                 // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 870     tfBGR10A2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 871     tfA2BGR10ui1,               // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 872     tfBGRA16us4,                // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 873
 874     tfDepth16us1,               // 1 x unsigned short (depth)
 875     tfDepth24ui1,               // 1 x unsigned int (depth)
 876     tfDepth32ui1,               // 1 x unsigned int (depth)
 877
 878     tfS3tcDtx1RGBA,
 879     tfS3tcDtx3RGBA,
 880     tfS3tcDtx5RGBA
 881   );
 882
 883   TglBitmapFileType = (
 884      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 885      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 886      ftDDS,
 887      ftTGA,
 888      ftBMP,
 889      ftRAW);
 890    TglBitmapFileTypes = set of TglBitmapFileType;
 891
 892    TglBitmapMipMap = (
 893      mmNone,
 894      mmMipmap,
 895      mmMipmapGlu);
 896
 897    TglBitmapNormalMapFunc = (
 898      nm4Samples,
 899      nmSobel,
 900      nm3x3,
 901      nm5x5);
 902
 903  ////////////////////////////////////////////////////////////////////////////////////////////////////
 904    EglBitmap                  = class(Exception);
 905    EglBitmapNotSupported      = class(Exception);
 906    EglBitmapSizeToLarge       = class(EglBitmap);
 907    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 908    EglBitmapUnsupportedFormat = class(EglBitmap)
 909    public
 910      constructor Create(const aFormat: TglBitmapFormat); overload;
 911      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 912    end;
 913
 914 ////////////////////////////////////////////////////////////////////////////////////////////////////
 915   TglBitmapRec4ui = packed record
 916   case Integer of
 917     0: (r, g, b, a: Cardinal);
 918     1: (arr: array[0..3] of Cardinal);
 919   end;
 920
 921   TglBitmapRec4ub = packed record
 922   case Integer of
 923     0: (r, g, b, a: Byte);
 924     1: (arr: array[0..3] of Byte);
 925   end;
 926
 927   TglBitmapRec4ul = packed record
 928   case Integer of
 929     0: (r, g, b, a: QWord);
 930     1: (arr: array[0..3] of QWord);
 931   end;
 932
 933   TglBitmapFormatDescriptor = class(TObject)
 934   private
 935     // cached properties
 936     fBytesPerPixel: Single;
 937     fChannelCount: Integer;
 938     fMask: TglBitmapRec4ul;
 939     fRange: TglBitmapRec4ui;
 940
 941     function GetHasRed: Boolean;
 942     function GetHasGreen: Boolean;
 943     function GetHasBlue: Boolean;
 944     function GetHasAlpha: Boolean;
 945     function GetHasColor: Boolean;
 946     function GetIsGrayscale: Boolean;
 947   protected
 948     fFormat:        TglBitmapFormat;
 949     fWithAlpha:     TglBitmapFormat;
 950     fWithoutAlpha:  TglBitmapFormat;
 951     fOpenGLFormat:  TglBitmapFormat;
 952     fRGBInverted:   TglBitmapFormat;
 953     fUncompressed:  TglBitmapFormat;
 954
 955     fBitsPerPixel: Integer;
 956     fIsCompressed: Boolean;
 957
 958     fPrecision: TglBitmapRec4ub;
 959     fShift:     TglBitmapRec4ub;
 960
 961     fglFormat:         GLenum;
 962     fglInternalFormat: GLenum;
 963     fglDataFormat:     GLenum;
 964
 965     procedure SetValues; virtual;
 966     procedure CalcValues;
 967   public
 968     property Format:        TglBitmapFormat read fFormat;
 969     property ChannelCount:  Integer         read fChannelCount;
 970     property IsCompressed:  Boolean         read fIsCompressed;
 971     property BitsPerPixel:  Integer         read fBitsPerPixel;
 972     property BytesPerPixel: Single          read fBytesPerPixel;
 973
 974     property Precision: TglBitmapRec4ub read fPrecision;
 975     property Shift:     TglBitmapRec4ub read fShift;
 976     property Range:     TglBitmapRec4ui read fRange;
 977     property Mask:      TglBitmapRec4ul read fMask;
 978
 979     property RGBInverted:  TglBitmapFormat read fRGBInverted;
 980     property WithAlpha:    TglBitmapFormat read fWithAlpha;
 981     property WithoutAlpha: TglBitmapFormat read fWithAlpha;
 982     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
 983     property Uncompressed: TglBitmapFormat read fUncompressed;
 984
 985     property glFormat:         GLenum  read fglFormat;
 986     property glInternalFormat: GLenum  read fglInternalFormat;
 987     property glDataFormat:     GLenum  read fglDataFormat;
 988
 989     property HasRed:       Boolean read GetHasRed;
 990     property HasGreen:     Boolean read GetHasGreen;
 991     property HasBlue:      Boolean read GetHasBlue;
 992     property HasAlpha:     Boolean read GetHasAlpha;
 993     property HasColor:     Boolean read GetHasColor;
 994     property IsGrayscale:  Boolean read GetIsGrayscale;
 995
 996     constructor Create;
 997   public
 998     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 999   end;
1000
1001 ////////////////////////////////////////////////////////////////////////////////////////////////////
1002   TglBitmapPixelData = packed record
1003     Data:   TglBitmapRec4ui;
1004     Range:  TglBitmapRec4ui;
1005     Format: TglBitmapFormat;
1006   end;
1007   PglBitmapPixelData = ^TglBitmapPixelData;
1008
1009   TglBitmapPixelPositionFields = set of (ffX, ffY);
1010   TglBitmapPixelPosition = record
1011     Fields : TglBitmapPixelPositionFields;
1012     X : Word;
1013     Y : Word;
1014   end;
1015
1016 ////////////////////////////////////////////////////////////////////////////////////////////////////
1017   TglBitmap = class;
1018   TglBitmapFunctionRec = record
1019     Sender:   TglBitmap;
1020     Size:     TglBitmapPixelPosition;
1021     Position: TglBitmapPixelPosition;
1022     Source:   TglBitmapPixelData;
1023     Dest:     TglBitmapPixelData;
1024     Args:     Pointer;
1025   end;
1026   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
1027
1028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1029   TglBitmap = class
1030   private
1031     function GetFormatDesc: TglBitmapFormatDescriptor;
1032   protected
1033     fID: GLuint;
1034     fTarget: GLuint;
1035     fAnisotropic: Integer;
1036     fDeleteTextureOnFree: Boolean;
1037     fFreeDataOnDestroy: Boolean;
1038     fFreeDataAfterGenTexture: Boolean;
1039     fData: PByte;
1040 {$IFNDEF OPENGL_ES}
1041     fIsResident: GLboolean;
1042 {$ENDIF}
1043     fBorderColor: array[0..3] of Single;
1044
1045     fDimension: TglBitmapPixelPosition;
1046     fMipMap: TglBitmapMipMap;
1047     fFormat: TglBitmapFormat;
1048
1049     // Mapping
1050     fPixelSize: Integer;
1051     fRowSize: Integer;
1052
1053     // Filtering
1054     fFilterMin: GLenum;
1055     fFilterMag: GLenum;
1056
1057     // TexturWarp
1058     fWrapS: GLenum;
1059     fWrapT: GLenum;
1060     fWrapR: GLenum;
1061
1062 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1063     //Swizzle
1064     fSwizzle: array[0..3] of GLenum;
1065 {$IFEND}
1066
1067     // CustomData
1068     fFilename: String;
1069     fCustomName: String;
1070     fCustomNameW: WideString;
1071     fCustomData: Pointer;
1072
1073     //Getter
1074     function GetWidth:  Integer; virtual;
1075     function GetHeight: Integer; virtual;
1076
1077     function GetFileWidth:  Integer; virtual;
1078     function GetFileHeight: Integer; virtual;
1079
1080     //Setter
1081     procedure SetCustomData(const aValue: Pointer);
1082     procedure SetCustomName(const aValue: String);
1083     procedure SetCustomNameW(const aValue: WideString);
1084     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1085     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1086     procedure SetFormat(const aValue: TglBitmapFormat);
1087     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1088     procedure SetID(const aValue: Cardinal);
1089     procedure SetMipMap(const aValue: TglBitmapMipMap);
1090     procedure SetTarget(const aValue: Cardinal);
1091     procedure SetAnisotropic(const aValue: Integer);
1092
1093     procedure CreateID;
1094     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1095     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1096       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1097     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1098
1099     function FlipHorz: Boolean; virtual;
1100     function FlipVert: Boolean; virtual;
1101
1102     property Width:  Integer read GetWidth;
1103     property Height: Integer read GetHeight;
1104
1105     property FileWidth:  Integer read GetFileWidth;
1106     property FileHeight: Integer read GetFileHeight;
1107   public
1108     //Properties
1109     property ID:           Cardinal        read fID          write SetID;
1110     property Target:       Cardinal        read fTarget      write SetTarget;
1111     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1112     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1113     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1114
1115     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1116
1117     property Filename:    String     read fFilename;
1118     property CustomName:  String     read fCustomName  write SetCustomName;
1119     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1120     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1121
1122     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1123     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1124     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1125
1126     property Dimension:  TglBitmapPixelPosition  read fDimension;
1127     property Data:       PByte                   read fData;
1128 {$IFNDEF OPENGL_ES}
1129     property IsResident: GLboolean               read fIsResident;
1130 {$ENDIF}
1131
1132     procedure AfterConstruction; override;
1133     procedure BeforeDestruction; override;
1134
1135     procedure PrepareResType(var aResource: String; var aResType: PChar);
1136
1137     //Load
1138     procedure LoadFromFile(const aFilename: String);
1139     procedure LoadFromStream(const aStream: TStream); virtual;
1140     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1141       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1142     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1143     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1144
1145     //Save
1146     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1147     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1148
1149     //Convert
1150     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1151     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1152       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1153   public
1154     //Alpha & Co
1155     {$IFDEF GLB_SDL}
1156     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1157     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1158     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1159     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1160       const aArgs: Pointer = nil): Boolean;
1161     {$ENDIF}
1162
1163     {$IFDEF GLB_DELPHI}
1164     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1165     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1166     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1167     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1168       const aArgs: Pointer = nil): Boolean;
1169     {$ENDIF}
1170
1171     {$IFDEF GLB_LAZARUS}
1172     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1173     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1174     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1175     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1176       const aArgs: Pointer = nil): Boolean;
1177     {$ENDIF}
1178
1179     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1180       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1181     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1182       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1183
1184     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1185     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1186     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1187     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1188
1189     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1190     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1191     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1192
1193     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1194     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1195     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1196
1197     function RemoveAlpha: Boolean; virtual;
1198   public
1199     //Common
1200     function Clone: TglBitmap;
1201     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1202     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1203 {$IFNDEF OPENGL_ES}
1204     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1205 {$ENDIF}
1206     procedure FreeData;
1207
1208     //ColorFill
1209     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1210     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1211     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1212
1213     //TexParameters
1214     procedure SetFilter(const aMin, aMag: GLenum);
1215     procedure SetWrap(
1216       const S: GLenum = GL_CLAMP_TO_EDGE;
1217       const T: GLenum = GL_CLAMP_TO_EDGE;
1218       const R: GLenum = GL_CLAMP_TO_EDGE);
1219 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1220     procedure SetSwizzle(const r, g, b, a: GLenum);
1221 {$IFEND}
1222
1223     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1224     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1225
1226     //Constructors
1227     constructor Create; overload;
1228     constructor Create(const aFileName: String); overload;
1229     constructor Create(const aStream: TStream); overload;
1230     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1231     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1232     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1233     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1234   private
1235     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1236     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1237
1238     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1239     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1240
1241     function LoadRAW(const aStream: TStream): Boolean;
1242     procedure SaveRAW(const aStream: TStream);
1243
1244     function LoadBMP(const aStream: TStream): Boolean;
1245     procedure SaveBMP(const aStream: TStream);
1246
1247     function LoadTGA(const aStream: TStream): Boolean;
1248     procedure SaveTGA(const aStream: TStream);
1249
1250     function LoadDDS(const aStream: TStream): Boolean;
1251     procedure SaveDDS(const aStream: TStream);
1252   end;
1253
1254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1255 {$IFNDEF OPENGL_ES}
1256   TglBitmap1D = class(TglBitmap)
1257   protected
1258     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1259       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1260     procedure UploadData(const aBuildWithGlu: Boolean);
1261   public
1262     property Width;
1263     procedure AfterConstruction; override;
1264     function FlipHorz: Boolean; override;
1265     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1266   end;
1267 {$ENDIF}
1268
1269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1270   TglBitmap2D = class(TglBitmap)
1271   protected
1272     fLines: array of PByte;
1273     function GetScanline(const aIndex: Integer): Pointer;
1274     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1275       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1276     procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1277   public
1278     property Width;
1279     property Height;
1280     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1281
1282     procedure AfterConstruction; override;
1283
1284     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1285 {$IFNDEF OPENGL_ES}
1286     procedure GetDataFromTexture;
1287 {$ENDIF}
1288     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1289
1290     function FlipHorz: Boolean; override;
1291     function FlipVert: Boolean; override;
1292
1293     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1294       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1295   end;
1296
1297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1298 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1299   TglBitmapCubeMap = class(TglBitmap2D)
1300   protected
1301   {$IFNDEF OPENGL_ES}
1302     fGenMode: Integer;
1303   {$ENDIF}
1304     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1305   public
1306     procedure AfterConstruction; override;
1307     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1308     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1309     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1310   end;
1311 {$IFEND}
1312
1313 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1315   TglBitmapNormalMap = class(TglBitmapCubeMap)
1316   public
1317     procedure AfterConstruction; override;
1318     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1319   end;
1320 {$IFEND}
1321
1322 const
1323   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1324
1325 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1326 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1327 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1328 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1329 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1330 procedure glBitmapSetDefaultWrap(
1331   const S: Cardinal = GL_CLAMP_TO_EDGE;
1332   const T: Cardinal = GL_CLAMP_TO_EDGE;
1333   const R: Cardinal = GL_CLAMP_TO_EDGE);
1334
1335 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1336 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1337 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1338 function glBitmapGetDefaultFormat: TglBitmapFormat;
1339 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1340 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1341
1342 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1343 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1344 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1345 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1346 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1347 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1348
1349 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1350
1351 var
1352   glBitmapDefaultDeleteTextureOnFree: Boolean;
1353   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1354   glBitmapDefaultFormat: TglBitmapFormat;
1355   glBitmapDefaultMipmap: TglBitmapMipMap;
1356   glBitmapDefaultFilterMin: Cardinal;
1357   glBitmapDefaultFilterMag: Cardinal;
1358   glBitmapDefaultWrapS: Cardinal;
1359   glBitmapDefaultWrapT: Cardinal;
1360   glBitmapDefaultWrapR: Cardinal;
1361   glDefaultSwizzle: array[0..3] of GLenum;
1362
1363 {$IFDEF GLB_DELPHI}
1364 function CreateGrayPalette: HPALETTE;
1365 {$ENDIF}
1366
1367 implementation
1368
1369 uses
1370   Math, syncobjs, typinfo
1371   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1372
1373 ////////////////////////////////////////////////////////////////////////////////////////////////////
1374 type
1375   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1376   public
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1379
1380     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1381     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1382
1383     function CreateMappingData: Pointer; virtual;
1384     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1385
1386     function IsEmpty: Boolean; virtual;
1387     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1388
1389     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1390
1391     constructor Create; virtual;
1392   public
1393     class procedure Init;
1394     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1395     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1396     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1397     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1398     class procedure Clear;
1399     class procedure Finalize;
1400   end;
1401   TFormatDescriptorClass = class of TFormatDescriptor;
1402
1403   TfdEmpty = class(TFormatDescriptor);
1404
1405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1406   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409   end;
1410
1411   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1412     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1413     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1414   end;
1415
1416   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1417     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1418     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1419   end;
1420
1421   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1422     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1423     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1424   end;
1425
1426   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1427     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1428     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1429   end;
1430
1431   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1432     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1433     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1434   end;
1435
1436   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1437     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1438     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1439   end;
1440
1441   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1442     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1443     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1444   end;
1445
1446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1447   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1448     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1449     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1450   end;
1451
1452   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1453     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1454     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1455   end;
1456
1457   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1458     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1459     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1460   end;
1461
1462   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1463     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1464     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1465   end;
1466
1467   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1468     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1469     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1470   end;
1471
1472   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1473     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1474     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1475   end;
1476
1477   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1478     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1479     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1480   end;
1481
1482   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1483     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1484     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1485   end;
1486
1487   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1488     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1489     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1490   end;
1491
1492   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1493     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1494     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1495   end;
1496
1497   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1498     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1499     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1500   end;
1501
1502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1503   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1504     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1505     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1506   end;
1507
1508   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1509     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1510     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1511   end;
1512
1513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1514   TfdAlpha4ub1 = class(TfdAlphaUB1)
1515     procedure SetValues; override;
1516   end;
1517
1518   TfdAlpha8ub1 = class(TfdAlphaUB1)
1519     procedure SetValues; override;
1520   end;
1521
1522   TfdAlpha16us1 = class(TfdAlphaUS1)
1523     procedure SetValues; override;
1524   end;
1525
1526   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1527     procedure SetValues; override;
1528   end;
1529
1530   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1531     procedure SetValues; override;
1532   end;
1533
1534   TfdLuminance16us1 = class(TfdLuminanceUS1)
1535     procedure SetValues; override;
1536   end;
1537
1538   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1539     procedure SetValues; override;
1540   end;
1541
1542   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1543     procedure SetValues; override;
1544   end;
1545
1546   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1547     procedure SetValues; override;
1548   end;
1549
1550   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1551     procedure SetValues; override;
1552   end;
1553
1554   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1555     procedure SetValues; override;
1556   end;
1557
1558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1559   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1560     procedure SetValues; override;
1561   end;
1562
1563   TfdRGBX4us1 = class(TfdUniversalUS1)
1564     procedure SetValues; override;
1565   end;
1566
1567   TfdXRGB4us1 = class(TfdUniversalUS1)
1568     procedure SetValues; override;
1569   end;
1570
1571   TfdR5G6B5us1 = class(TfdUniversalUS1)
1572     procedure SetValues; override;
1573   end;
1574
1575   TfdRGB5X1us1 = class(TfdUniversalUS1)
1576     procedure SetValues; override;
1577   end;
1578
1579   TfdX1RGB5us1 = class(TfdUniversalUS1)
1580     procedure SetValues; override;
1581   end;
1582
1583   TfdRGB8ub3 = class(TfdRGBub3)
1584     procedure SetValues; override;
1585   end;
1586
1587   TfdRGBX8ui1 = class(TfdUniversalUI1)
1588     procedure SetValues; override;
1589   end;
1590
1591   TfdXRGB8ui1 = class(TfdUniversalUI1)
1592     procedure SetValues; override;
1593   end;
1594
1595   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1596     procedure SetValues; override;
1597   end;
1598
1599   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1600     procedure SetValues; override;
1601   end;
1602
1603   TfdRGB16us3 = class(TfdRGBus3)
1604     procedure SetValues; override;
1605   end;
1606
1607   TfdRGBA4us1 = class(TfdUniversalUS1)
1608     procedure SetValues; override;
1609   end;
1610
1611   TfdARGB4us1 = class(TfdUniversalUS1)
1612     procedure SetValues; override;
1613   end;
1614
1615   TfdRGB5A1us1 = class(TfdUniversalUS1)
1616     procedure SetValues; override;
1617   end;
1618
1619   TfdA1RGB5us1 = class(TfdUniversalUS1)
1620     procedure SetValues; override;
1621   end;
1622
1623   TfdRGBA8ui1 = class(TfdUniversalUI1)
1624     procedure SetValues; override;
1625   end;
1626
1627   TfdARGB8ui1 = class(TfdUniversalUI1)
1628     procedure SetValues; override;
1629   end;
1630
1631   TfdRGBA8ub4 = class(TfdRGBAub4)
1632     procedure SetValues; override;
1633   end;
1634
1635   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1636     procedure SetValues; override;
1637   end;
1638
1639   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1640     procedure SetValues; override;
1641   end;
1642
1643   TfdRGBA16us4 = class(TfdRGBAus4)
1644     procedure SetValues; override;
1645   end;
1646
1647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1648   TfdBGRX4us1 = class(TfdUniversalUS1)
1649     procedure SetValues; override;
1650   end;
1651
1652   TfdXBGR4us1 = class(TfdUniversalUS1)
1653     procedure SetValues; override;
1654   end;
1655
1656   TfdB5G6R5us1 = class(TfdUniversalUS1)
1657     procedure SetValues; override;
1658   end;
1659
1660   TfdBGR5X1us1 = class(TfdUniversalUS1)
1661     procedure SetValues; override;
1662   end;
1663
1664   TfdX1BGR5us1 = class(TfdUniversalUS1)
1665     procedure SetValues; override;
1666   end;
1667
1668   TfdBGR8ub3 = class(TfdBGRub3)
1669     procedure SetValues; override;
1670   end;
1671
1672   TfdBGRX8ui1 = class(TfdUniversalUI1)
1673     procedure SetValues; override;
1674   end;
1675
1676   TfdXBGR8ui1 = class(TfdUniversalUI1)
1677     procedure SetValues; override;
1678   end;
1679
1680   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1681     procedure SetValues; override;
1682   end;
1683
1684   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1685     procedure SetValues; override;
1686   end;
1687
1688   TfdBGR16us3 = class(TfdBGRus3)
1689     procedure SetValues; override;
1690   end;
1691
1692   TfdBGRA4us1 = class(TfdUniversalUS1)
1693     procedure SetValues; override;
1694   end;
1695
1696   TfdABGR4us1 = class(TfdUniversalUS1)
1697     procedure SetValues; override;
1698   end;
1699
1700   TfdBGR5A1us1 = class(TfdUniversalUS1)
1701     procedure SetValues; override;
1702   end;
1703
1704   TfdA1BGR5us1 = class(TfdUniversalUS1)
1705     procedure SetValues; override;
1706   end;
1707
1708   TfdBGRA8ui1 = class(TfdUniversalUI1)
1709     procedure SetValues; override;
1710   end;
1711
1712   TfdABGR8ui1 = class(TfdUniversalUI1)
1713     procedure SetValues; override;
1714   end;
1715
1716   TfdBGRA8ub4 = class(TfdBGRAub4)
1717     procedure SetValues; override;
1718   end;
1719
1720   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1721     procedure SetValues; override;
1722   end;
1723
1724   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1725     procedure SetValues; override;
1726   end;
1727
1728   TfdBGRA16us4 = class(TfdBGRAus4)
1729     procedure SetValues; override;
1730   end;
1731
1732   TfdDepth16us1 = class(TfdDepthUS1)
1733     procedure SetValues; override;
1734   end;
1735
1736   TfdDepth24ui1 = class(TfdDepthUI1)
1737     procedure SetValues; override;
1738   end;
1739
1740   TfdDepth32ui1 = class(TfdDepthUI1)
1741     procedure SetValues; override;
1742   end;
1743
1744   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1745     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1746     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1747     procedure SetValues; override;
1748   end;
1749
1750   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1751     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1752     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1753     procedure SetValues; override;
1754   end;
1755
1756   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1757     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1758     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1759     procedure SetValues; override;
1760   end;
1761
1762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1763   TbmpBitfieldFormat = class(TFormatDescriptor)
1764   public
1765     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1766     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1767     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1768     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1769   end;
1770
1771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1772   TbmpColorTableEnty = packed record
1773     b, g, r, a: Byte;
1774   end;
1775   TbmpColorTable = array of TbmpColorTableEnty;
1776   TbmpColorTableFormat = class(TFormatDescriptor)
1777   private
1778     fBitsPerPixel: Integer;
1779     fColorTable: TbmpColorTable;
1780   protected
1781     procedure SetValues; override;
1782   public
1783     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1784     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1785
1786     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1787     procedure CalcValues;
1788     procedure CreateColorTable;
1789
1790     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1791     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1792     destructor Destroy; override;
1793   end;
1794
1795 const
1796   LUMINANCE_WEIGHT_R = 0.30;
1797   LUMINANCE_WEIGHT_G = 0.59;
1798   LUMINANCE_WEIGHT_B = 0.11;
1799
1800   ALPHA_WEIGHT_R = 0.30;
1801   ALPHA_WEIGHT_G = 0.59;
1802   ALPHA_WEIGHT_B = 0.11;
1803
1804   DEPTH_WEIGHT_R = 0.333333333;
1805   DEPTH_WEIGHT_G = 0.333333333;
1806   DEPTH_WEIGHT_B = 0.333333333;
1807
1808   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1809     TfdEmpty,
1810
1811     TfdAlpha4ub1,
1812     TfdAlpha8ub1,
1813     TfdAlpha16us1,
1814
1815     TfdLuminance4ub1,
1816     TfdLuminance8ub1,
1817     TfdLuminance16us1,
1818
1819     TfdLuminance4Alpha4ub2,
1820     TfdLuminance6Alpha2ub2,
1821     TfdLuminance8Alpha8ub2,
1822     TfdLuminance12Alpha4us2,
1823     TfdLuminance16Alpha16us2,
1824
1825     TfdR3G3B2ub1,
1826     TfdRGBX4us1,
1827     TfdXRGB4us1,
1828     TfdR5G6B5us1,
1829     TfdRGB5X1us1,
1830     TfdX1RGB5us1,
1831     TfdRGB8ub3,
1832     TfdRGBX8ui1,
1833     TfdXRGB8ui1,
1834     TfdRGB10X2ui1,
1835     TfdX2RGB10ui1,
1836     TfdRGB16us3,
1837
1838     TfdRGBA4us1,
1839     TfdARGB4us1,
1840     TfdRGB5A1us1,
1841     TfdA1RGB5us1,
1842     TfdRGBA8ui1,
1843     TfdARGB8ui1,
1844     TfdRGBA8ub4,
1845     TfdRGB10A2ui1,
1846     TfdA2RGB10ui1,
1847     TfdRGBA16us4,
1848
1849     TfdBGRX4us1,
1850     TfdXBGR4us1,
1851     TfdB5G6R5us1,
1852     TfdBGR5X1us1,
1853     TfdX1BGR5us1,
1854     TfdBGR8ub3,
1855     TfdBGRX8ui1,
1856     TfdXBGR8ui1,
1857     TfdBGR10X2ui1,
1858     TfdX2BGR10ui1,
1859     TfdBGR16us3,
1860
1861     TfdBGRA4us1,
1862     TfdABGR4us1,
1863     TfdBGR5A1us1,
1864     TfdA1BGR5us1,
1865     TfdBGRA8ui1,
1866     TfdABGR8ui1,
1867     TfdBGRA8ub4,
1868     TfdBGR10A2ui1,
1869     TfdA2BGR10ui1,
1870     TfdBGRA16us4,
1871
1872     TfdDepth16us1,
1873     TfdDepth24ui1,
1874     TfdDepth32ui1,
1875
1876     TfdS3tcDtx1RGBA,
1877     TfdS3tcDtx3RGBA,
1878     TfdS3tcDtx5RGBA
1879   );
1880
1881 var
1882   FormatDescriptorCS: TCriticalSection;
1883   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1884
1885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1886 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1887 begin
1888   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1889 end;
1890
1891 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1892 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1893 begin
1894   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1895 end;
1896
1897 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1898 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1899 begin
1900   result.Fields := [];
1901
1902   if X >= 0 then
1903     result.Fields := result.Fields + [ffX];
1904   if Y >= 0 then
1905     result.Fields := result.Fields + [ffY];
1906
1907   result.X := Max(0, X);
1908   result.Y := Max(0, Y);
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1913 begin
1914   result.r := r;
1915   result.g := g;
1916   result.b := b;
1917   result.a := a;
1918 end;
1919
1920 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1921 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1922 begin
1923   result.r := r;
1924   result.g := g;
1925   result.b := b;
1926   result.a := a;
1927 end;
1928
1929 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1930 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1931 begin
1932   result.r := r;
1933   result.g := g;
1934   result.b := b;
1935   result.a := a;
1936 end;
1937
1938 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1939 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1940 var
1941   i: Integer;
1942 begin
1943   result := false;
1944   for i := 0 to high(r1.arr) do
1945     if (r1.arr[i] <> r2.arr[i]) then
1946       exit;
1947   result := true;
1948 end;
1949
1950 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1951 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1952 var
1953   i: Integer;
1954 begin
1955   result := false;
1956   for i := 0 to high(r1.arr) do
1957     if (r1.arr[i] <> r2.arr[i]) then
1958       exit;
1959   result := true;
1960 end;
1961
1962 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1963 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1964 var
1965   desc: TFormatDescriptor;
1966   p, tmp: PByte;
1967   x, y, i: Integer;
1968   md: Pointer;
1969   px: TglBitmapPixelData;
1970 begin
1971   result := nil;
1972   desc := TFormatDescriptor.Get(aFormat);
1973   if (desc.IsCompressed) or (desc.glFormat = 0) then
1974     exit;
1975
1976   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1977   md := desc.CreateMappingData;
1978   try
1979     tmp := p;
1980     desc.PreparePixel(px);
1981     for y := 0 to 4 do
1982       for x := 0 to 4 do begin
1983         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1984         for i := 0 to 3 do begin
1985           if ((y < 3) and (y = i)) or
1986              ((y = 3) and (i < 3)) or
1987              ((y = 4) and (i = 3))
1988           then
1989             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1990           else if ((y < 4) and (i = 3)) or
1991                   ((y = 4) and (i < 3))
1992           then
1993             px.Data.arr[i] := px.Range.arr[i]
1994           else
1995             px.Data.arr[i] := 0; //px.Range.arr[i];
1996         end;
1997         desc.Map(px, tmp, md);
1998       end;
1999   finally
2000     desc.FreeMappingData(md);
2001   end;
2002
2003   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
2004   result.FreeDataOnDestroy       := true;
2005   result.FreeDataAfterGenTexture := false;
2006   result.SetFilter(GL_NEAREST, GL_NEAREST);
2007 end;
2008
2009 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2010 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
2011 begin
2012   result.r := r;
2013   result.g := g;
2014   result.b := b;
2015   result.a := a;
2016 end;
2017
2018 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2019 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
2020 begin
2021   result := [];
2022
2023   if (aFormat in [
2024         //8bpp
2025         tfAlpha4ub1, tfAlpha8ub1,
2026         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
2027
2028         //16bpp
2029         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2030         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
2031         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
2032
2033         //24bpp
2034         tfBGR8ub3, tfRGB8ub3,
2035
2036         //32bpp
2037         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
2038         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2039   then
2040     result := result + [ ftBMP ];
2041
2042   if (aFormat in [
2043         //8bbp
2044         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2045
2046         //16bbp
2047         tfAlpha16us1, tfLuminance16us1,
2048         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2049         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2050
2051         //24bbp
2052         tfBGR8ub3,
2053
2054         //32bbp
2055         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2056         tfDepth24ui1, tfDepth32ui1])
2057   then
2058     result := result + [ftTGA];
2059
2060   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2061     result := result + [ftDDS];
2062
2063 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2064   if aFormat in [
2065       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2066       tfRGB8ub3, tfRGBA8ui1,
2067       tfBGR8ub3, tfBGRA8ui1] then
2068     result := result + [ftPNG];
2069 {$ENDIF}
2070
2071 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2072   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2073     result := result + [ftJPEG];
2074 {$ENDIF}
2075 end;
2076
2077 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2078 function IsPowerOfTwo(aNumber: Integer): Boolean;
2079 begin
2080   while (aNumber and 1) = 0 do
2081     aNumber := aNumber shr 1;
2082   result := aNumber = 1;
2083 end;
2084
2085 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2086 function GetTopMostBit(aBitSet: QWord): Integer;
2087 begin
2088   result := 0;
2089   while aBitSet > 0 do begin
2090     inc(result);
2091     aBitSet := aBitSet shr 1;
2092   end;
2093 end;
2094
2095 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2096 function CountSetBits(aBitSet: QWord): Integer;
2097 begin
2098   result := 0;
2099   while aBitSet > 0 do begin
2100     if (aBitSet and 1) = 1 then
2101       inc(result);
2102     aBitSet := aBitSet shr 1;
2103   end;
2104 end;
2105
2106 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2107 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2108 begin
2109   result := Trunc(
2110     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2111     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2112     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2113 end;
2114
2115 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2116 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2117 begin
2118   result := Trunc(
2119     DEPTH_WEIGHT_R * aPixel.Data.r +
2120     DEPTH_WEIGHT_G * aPixel.Data.g +
2121     DEPTH_WEIGHT_B * aPixel.Data.b);
2122 end;
2123
2124 {$IFDEF GLB_NATIVE_OGL}
2125 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2126 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2127 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2128 var
2129   GL_LibHandle: Pointer = nil;
2130
2131 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2132 begin
2133   if not Assigned(aLibHandle) then
2134     aLibHandle := GL_LibHandle;
2135
2136 {$IF DEFINED(GLB_WIN)}
2137   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2138   if Assigned(result) then
2139     exit;
2140
2141   if Assigned(wglGetProcAddress) then
2142     result := wglGetProcAddress(aProcName);
2143 {$ELSEIF DEFINED(GLB_LINUX)}
2144   if Assigned(glXGetProcAddress) then begin
2145     result := glXGetProcAddress(aProcName);
2146     if Assigned(result) then
2147       exit;
2148   end;
2149
2150   if Assigned(glXGetProcAddressARB) then begin
2151     result := glXGetProcAddressARB(aProcName);
2152     if Assigned(result) then
2153       exit;
2154   end;
2155
2156   result := dlsym(aLibHandle, aProcName);
2157 {$IFEND}
2158   if not Assigned(result) and aRaiseOnErr then
2159     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2160 end;
2161
2162 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2163 var
2164   GLU_LibHandle: Pointer = nil;
2165   OpenGLInitialized: Boolean;
2166   InitOpenGLCS: TCriticalSection;
2167
2168 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2169 procedure glbInitOpenGL;
2170
2171   ////////////////////////////////////////////////////////////////////////////////
2172   function glbLoadLibrary(const aName: PChar): Pointer;
2173   begin
2174     {$IF DEFINED(GLB_WIN)}
2175     result := {%H-}Pointer(LoadLibrary(aName));
2176     {$ELSEIF DEFINED(GLB_LINUX)}
2177     result := dlopen(Name, RTLD_LAZY);
2178     {$ELSE}
2179     result := nil;
2180     {$IFEND}
2181   end;
2182
2183   ////////////////////////////////////////////////////////////////////////////////
2184   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2185   begin
2186     result := false;
2187     if not Assigned(aLibHandle) then
2188       exit;
2189
2190     {$IF DEFINED(GLB_WIN)}
2191     Result := FreeLibrary({%H-}HINST(aLibHandle));
2192     {$ELSEIF DEFINED(GLB_LINUX)}
2193     Result := dlclose(aLibHandle) = 0;
2194     {$IFEND}
2195   end;
2196
2197 begin
2198   if Assigned(GL_LibHandle) then
2199     glbFreeLibrary(GL_LibHandle);
2200
2201   if Assigned(GLU_LibHandle) then
2202     glbFreeLibrary(GLU_LibHandle);
2203
2204   GL_LibHandle := glbLoadLibrary(libopengl);
2205   if not Assigned(GL_LibHandle) then
2206     raise EglBitmap.Create('unable to load library: ' + libopengl);
2207
2208   GLU_LibHandle := glbLoadLibrary(libglu);
2209   if not Assigned(GLU_LibHandle) then
2210     raise EglBitmap.Create('unable to load library: ' + libglu);
2211
2212 {$IF DEFINED(GLB_WIN)}
2213   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2214 {$ELSEIF DEFINED(GLB_LINUX)}
2215   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2216   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2217 {$IFEND}
2218
2219   glEnable := glbGetProcAddress('glEnable');
2220   glDisable := glbGetProcAddress('glDisable');
2221   glGetString := glbGetProcAddress('glGetString');
2222   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2223   glTexParameteri := glbGetProcAddress('glTexParameteri');
2224   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2225   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2226   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2227   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2228   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2229   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2230   glTexGeni := glbGetProcAddress('glTexGeni');
2231   glGenTextures := glbGetProcAddress('glGenTextures');
2232   glBindTexture := glbGetProcAddress('glBindTexture');
2233   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2234   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2235   glReadPixels := glbGetProcAddress('glReadPixels');
2236   glPixelStorei := glbGetProcAddress('glPixelStorei');
2237   glTexImage1D := glbGetProcAddress('glTexImage1D');
2238   glTexImage2D := glbGetProcAddress('glTexImage2D');
2239   glGetTexImage := glbGetProcAddress('glGetTexImage');
2240
2241   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2242   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2243 end;
2244 {$ENDIF}
2245
2246 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure glbReadOpenGLExtensions;
2248 var
2249   Buffer: AnsiString;
2250   MajorVersion, MinorVersion: Integer;
2251
2252   ///////////////////////////////////////////////////////////////////////////////////////////
2253   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2254   var
2255     Separator: Integer;
2256   begin
2257     aMinor := 0;
2258     aMajor := 0;
2259
2260     Separator := Pos(AnsiString('.'), aBuffer);
2261     if (Separator > 1) and (Separator < Length(aBuffer)) and
2262        (aBuffer[Separator - 1] in ['0'..'9']) and
2263        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2264
2265       Dec(Separator);
2266       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2267         Dec(Separator);
2268
2269       Delete(aBuffer, 1, Separator);
2270       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2271
2272       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2273         Inc(Separator);
2274
2275       Delete(aBuffer, Separator, 255);
2276       Separator := Pos(AnsiString('.'), aBuffer);
2277
2278       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2279       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2280     end;
2281   end;
2282
2283   ///////////////////////////////////////////////////////////////////////////////////////////
2284   function CheckExtension(const Extension: AnsiString): Boolean;
2285   var
2286     ExtPos: Integer;
2287   begin
2288     ExtPos := Pos(Extension, Buffer);
2289     result := ExtPos > 0;
2290     if result then
2291       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2292   end;
2293
2294   ///////////////////////////////////////////////////////////////////////////////////////////
2295   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2296   begin
2297     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2298   end;
2299
2300 begin
2301 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2302   InitOpenGLCS.Enter;
2303   try
2304     if not OpenGLInitialized then begin
2305       glbInitOpenGL;
2306       OpenGLInitialized := true;
2307     end;
2308   finally
2309     InitOpenGLCS.Leave;
2310   end;
2311 {$ENDIF}
2312
2313   // Version
2314   Buffer := glGetString(GL_VERSION);
2315   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2316
2317   GL_VERSION_1_2 := CheckVersion(1, 2);
2318   GL_VERSION_1_3 := CheckVersion(1, 3);
2319   GL_VERSION_1_4 := CheckVersion(1, 4);
2320   GL_VERSION_2_0 := CheckVersion(2, 0);
2321   GL_VERSION_3_3 := CheckVersion(3, 3);
2322
2323   // Extensions
2324   Buffer := glGetString(GL_EXTENSIONS);
2325   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2326   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2327   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2328   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2329   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2330   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2331   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2332   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2333   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2334   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2335   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2336   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2337   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2338   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2339
2340   if GL_VERSION_1_3 then begin
2341     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2342     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2343     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2344   end else begin
2345     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2346     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2347     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2348   end;
2349 end;
2350 {$ENDIF}
2351
2352 {$IFDEF GLB_SDL_IMAGE}
2353 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2355 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2356 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2357 begin
2358   result := TStream(context^.unknown.data1).Seek(offset, whence);
2359 end;
2360
2361 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2362 begin
2363   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2364 end;
2365
2366 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2367 begin
2368   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2369 end;
2370
2371 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2372 begin
2373   result := 0;
2374 end;
2375
2376 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2377 begin
2378   result := SDL_AllocRW;
2379
2380   if result = nil then
2381     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2382
2383   result^.seek := glBitmapRWseek;
2384   result^.read := glBitmapRWread;
2385   result^.write := glBitmapRWwrite;
2386   result^.close := glBitmapRWclose;
2387   result^.unknown.data1 := Stream;
2388 end;
2389 {$ENDIF}
2390
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2393 begin
2394   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2395 end;
2396
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2399 begin
2400   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2405 begin
2406   glBitmapDefaultMipmap := aValue;
2407 end;
2408
2409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2410 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2411 begin
2412   glBitmapDefaultFormat := aFormat;
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2417 begin
2418   glBitmapDefaultFilterMin := aMin;
2419   glBitmapDefaultFilterMag := aMag;
2420 end;
2421
2422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2423 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2424 begin
2425   glBitmapDefaultWrapS := S;
2426   glBitmapDefaultWrapT := T;
2427   glBitmapDefaultWrapR := R;
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2432 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2433 begin
2434   glDefaultSwizzle[0] := r;
2435   glDefaultSwizzle[1] := g;
2436   glDefaultSwizzle[2] := b;
2437   glDefaultSwizzle[3] := a;
2438 end;
2439 {$IFEND}
2440
2441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2442 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2443 begin
2444   result := glBitmapDefaultDeleteTextureOnFree;
2445 end;
2446
2447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2448 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2449 begin
2450   result := glBitmapDefaultFreeDataAfterGenTextures;
2451 end;
2452
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2455 begin
2456   result := glBitmapDefaultMipmap;
2457 end;
2458
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 function glBitmapGetDefaultFormat: TglBitmapFormat;
2461 begin
2462   result := glBitmapDefaultFormat;
2463 end;
2464
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2467 begin
2468   aMin := glBitmapDefaultFilterMin;
2469   aMag := glBitmapDefaultFilterMag;
2470 end;
2471
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2474 begin
2475   S := glBitmapDefaultWrapS;
2476   T := glBitmapDefaultWrapT;
2477   R := glBitmapDefaultWrapR;
2478 end;
2479
2480 {$IFNDEF OPENGL_ES}
2481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2482 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2483 begin
2484   r := glDefaultSwizzle[0];
2485   g := glDefaultSwizzle[1];
2486   b := glDefaultSwizzle[2];
2487   a := glDefaultSwizzle[3];
2488 end;
2489 {$ENDIF}
2490
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2495 var
2496   w, h: Integer;
2497 begin
2498   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2499     w := Max(1, aSize.X);
2500     h := Max(1, aSize.Y);
2501     result := GetSize(w, h);
2502   end else
2503     result := 0;
2504 end;
2505
2506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2507 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2508 begin
2509   result := 0;
2510   if (aWidth <= 0) or (aHeight <= 0) then
2511     exit;
2512   result := Ceil(aWidth * aHeight * BytesPerPixel);
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 function TFormatDescriptor.CreateMappingData: Pointer;
2517 begin
2518   result := nil;
2519 end;
2520
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2523 begin
2524   //DUMMY
2525 end;
2526
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 function TFormatDescriptor.IsEmpty: Boolean;
2529 begin
2530   result := (fFormat = tfEmpty);
2531 end;
2532
2533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2534 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2535 var
2536   i: Integer;
2537   m: TglBitmapRec4ul;
2538 begin
2539   result := false;
2540   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2541     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2542   m := Mask;
2543   for i := 0 to 3 do
2544     if (aMask.arr[i] <> m.arr[i]) then
2545       exit;
2546   result := true;
2547 end;
2548
2549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2551 begin
2552   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2553   aPixel.Data   := Range;
2554   aPixel.Format := fFormat;
2555   aPixel.Range  := Range;
2556 end;
2557
2558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 constructor TFormatDescriptor.Create;
2560 begin
2561   inherited Create;
2562 end;
2563
2564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2565 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2567 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2568 begin
2569   aData^ := aPixel.Data.a;
2570   inc(aData);
2571 end;
2572
2573 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2574 begin
2575   aPixel.Data.r := 0;
2576   aPixel.Data.g := 0;
2577   aPixel.Data.b := 0;
2578   aPixel.Data.a := aData^;
2579   inc(aData);
2580 end;
2581
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2586 begin
2587   aData^ := LuminanceWeight(aPixel);
2588   inc(aData);
2589 end;
2590
2591 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2592 begin
2593   aPixel.Data.r := aData^;
2594   aPixel.Data.g := aData^;
2595   aPixel.Data.b := aData^;
2596   aPixel.Data.a := 0;
2597   inc(aData);
2598 end;
2599
2600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2601 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2604 var
2605   i: Integer;
2606 begin
2607   aData^ := 0;
2608   for i := 0 to 3 do
2609     if (Range.arr[i] > 0) then
2610       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2611   inc(aData);
2612 end;
2613
2614 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2615 var
2616   i: Integer;
2617 begin
2618   for i := 0 to 3 do
2619     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2620   inc(aData);
2621 end;
2622
2623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2624 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2626 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2627 begin
2628   inherited Map(aPixel, aData, aMapData);
2629   aData^ := aPixel.Data.a;
2630   inc(aData);
2631 end;
2632
2633 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2634 begin
2635   inherited Unmap(aData, aPixel, aMapData);
2636   aPixel.Data.a := aData^;
2637   inc(aData);
2638 end;
2639
2640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2644 begin
2645   aData^ := aPixel.Data.r;
2646   inc(aData);
2647   aData^ := aPixel.Data.g;
2648   inc(aData);
2649   aData^ := aPixel.Data.b;
2650   inc(aData);
2651 end;
2652
2653 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2654 begin
2655   aPixel.Data.r := aData^;
2656   inc(aData);
2657   aPixel.Data.g := aData^;
2658   inc(aData);
2659   aPixel.Data.b := aData^;
2660   inc(aData);
2661   aPixel.Data.a := 0;
2662 end;
2663
2664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2665 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2668 begin
2669   aData^ := aPixel.Data.b;
2670   inc(aData);
2671   aData^ := aPixel.Data.g;
2672   inc(aData);
2673   aData^ := aPixel.Data.r;
2674   inc(aData);
2675 end;
2676
2677 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2678 begin
2679   aPixel.Data.b := aData^;
2680   inc(aData);
2681   aPixel.Data.g := aData^;
2682   inc(aData);
2683   aPixel.Data.r := aData^;
2684   inc(aData);
2685   aPixel.Data.a := 0;
2686 end;
2687
2688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2689 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2691 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2692 begin
2693   inherited Map(aPixel, aData, aMapData);
2694   aData^ := aPixel.Data.a;
2695   inc(aData);
2696 end;
2697
2698 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2699 begin
2700   inherited Unmap(aData, aPixel, aMapData);
2701   aPixel.Data.a := aData^;
2702   inc(aData);
2703 end;
2704
2705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2709 begin
2710   inherited Map(aPixel, aData, aMapData);
2711   aData^ := aPixel.Data.a;
2712   inc(aData);
2713 end;
2714
2715 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2716 begin
2717   inherited Unmap(aData, aPixel, aMapData);
2718   aPixel.Data.a := aData^;
2719   inc(aData);
2720 end;
2721
2722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2723 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2726 begin
2727   PWord(aData)^ := aPixel.Data.a;
2728   inc(aData, 2);
2729 end;
2730
2731 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2732 begin
2733   aPixel.Data.r := 0;
2734   aPixel.Data.g := 0;
2735   aPixel.Data.b := 0;
2736   aPixel.Data.a := PWord(aData)^;
2737   inc(aData, 2);
2738 end;
2739
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2743 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2744 begin
2745   PWord(aData)^ := LuminanceWeight(aPixel);
2746   inc(aData, 2);
2747 end;
2748
2749 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2750 begin
2751   aPixel.Data.r := PWord(aData)^;
2752   aPixel.Data.g := PWord(aData)^;
2753   aPixel.Data.b := PWord(aData)^;
2754   aPixel.Data.a := 0;
2755   inc(aData, 2);
2756 end;
2757
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2762 var
2763   i: Integer;
2764 begin
2765   PWord(aData)^ := 0;
2766   for i := 0 to 3 do
2767     if (Range.arr[i] > 0) then
2768       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2769   inc(aData, 2);
2770 end;
2771
2772 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2773 var
2774   i: Integer;
2775 begin
2776   for i := 0 to 3 do
2777     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2778   inc(aData, 2);
2779 end;
2780
2781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2782 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2784 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2785 begin
2786   PWord(aData)^ := DepthWeight(aPixel);
2787   inc(aData, 2);
2788 end;
2789
2790 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2791 begin
2792   aPixel.Data.r := PWord(aData)^;
2793   aPixel.Data.g := PWord(aData)^;
2794   aPixel.Data.b := PWord(aData)^;
2795   aPixel.Data.a := PWord(aData)^;;
2796   inc(aData, 2);
2797 end;
2798
2799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2802 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2803 begin
2804   inherited Map(aPixel, aData, aMapData);
2805   PWord(aData)^ := aPixel.Data.a;
2806   inc(aData, 2);
2807 end;
2808
2809 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2810 begin
2811   inherited Unmap(aData, aPixel, aMapData);
2812   aPixel.Data.a := PWord(aData)^;
2813   inc(aData, 2);
2814 end;
2815
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2820 begin
2821   PWord(aData)^ := aPixel.Data.r;
2822   inc(aData, 2);
2823   PWord(aData)^ := aPixel.Data.g;
2824   inc(aData, 2);
2825   PWord(aData)^ := aPixel.Data.b;
2826   inc(aData, 2);
2827 end;
2828
2829 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2830 begin
2831   aPixel.Data.r := PWord(aData)^;
2832   inc(aData, 2);
2833   aPixel.Data.g := PWord(aData)^;
2834   inc(aData, 2);
2835   aPixel.Data.b := PWord(aData)^;
2836   inc(aData, 2);
2837   aPixel.Data.a := 0;
2838 end;
2839
2840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2843 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2844 begin
2845   PWord(aData)^ := aPixel.Data.b;
2846   inc(aData, 2);
2847   PWord(aData)^ := aPixel.Data.g;
2848   inc(aData, 2);
2849   PWord(aData)^ := aPixel.Data.r;
2850   inc(aData, 2);
2851 end;
2852
2853 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2854 begin
2855   aPixel.Data.b := PWord(aData)^;
2856   inc(aData, 2);
2857   aPixel.Data.g := PWord(aData)^;
2858   inc(aData, 2);
2859   aPixel.Data.r := PWord(aData)^;
2860   inc(aData, 2);
2861   aPixel.Data.a := 0;
2862 end;
2863
2864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2865 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2867 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2868 begin
2869   inherited Map(aPixel, aData, aMapData);
2870   PWord(aData)^ := aPixel.Data.a;
2871   inc(aData, 2);
2872 end;
2873
2874 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2875 begin
2876   inherited Unmap(aData, aPixel, aMapData);
2877   aPixel.Data.a := PWord(aData)^;
2878   inc(aData, 2);
2879 end;
2880
2881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2885 begin
2886   PWord(aData)^ := aPixel.Data.a;
2887   inc(aData, 2);
2888   inherited Map(aPixel, aData, aMapData);
2889 end;
2890
2891 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2892 begin
2893   aPixel.Data.a := PWord(aData)^;
2894   inc(aData, 2);
2895   inherited Unmap(aData, aPixel, aMapData);
2896 end;
2897
2898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2899 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2901 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2902 begin
2903   inherited Map(aPixel, aData, aMapData);
2904   PWord(aData)^ := aPixel.Data.a;
2905   inc(aData, 2);
2906 end;
2907
2908 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2909 begin
2910   inherited Unmap(aData, aPixel, aMapData);
2911   aPixel.Data.a := PWord(aData)^;
2912   inc(aData, 2);
2913 end;
2914
2915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2916 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2919 begin
2920   PWord(aData)^ := aPixel.Data.a;
2921   inc(aData, 2);
2922   inherited Map(aPixel, aData, aMapData);
2923 end;
2924
2925 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2926 begin
2927   aPixel.Data.a := PWord(aData)^;
2928   inc(aData, 2);
2929   inherited Unmap(aData, aPixel, aMapData);
2930 end;
2931
2932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2933 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2935 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2936 var
2937   i: Integer;
2938 begin
2939   PCardinal(aData)^ := 0;
2940   for i := 0 to 3 do
2941     if (Range.arr[i] > 0) then
2942       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2943   inc(aData, 4);
2944 end;
2945
2946 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2947 var
2948   i: Integer;
2949 begin
2950   for i := 0 to 3 do
2951     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2952   inc(aData, 2);
2953 end;
2954
2955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2956 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2959 begin
2960   PCardinal(aData)^ := DepthWeight(aPixel);
2961   inc(aData, 4);
2962 end;
2963
2964 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2965 begin
2966   aPixel.Data.r := PCardinal(aData)^;
2967   aPixel.Data.g := PCardinal(aData)^;
2968   aPixel.Data.b := PCardinal(aData)^;
2969   aPixel.Data.a := PCardinal(aData)^;
2970   inc(aData, 4);
2971 end;
2972
2973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 procedure TfdAlpha4ub1.SetValues;
2977 begin
2978   inherited SetValues;
2979   fBitsPerPixel     := 8;
2980   fFormat           := tfAlpha4ub1;
2981   fWithAlpha        := tfAlpha4ub1;
2982   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2983   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2984 {$IFNDEF OPENGL_ES}
2985   fOpenGLFormat     := tfAlpha4ub1;
2986   fglFormat         := GL_ALPHA;
2987   fglInternalFormat := GL_ALPHA4;
2988   fglDataFormat     := GL_UNSIGNED_BYTE;
2989 {$ELSE}
2990   fOpenGLFormat     := tfAlpha8ub1;
2991 {$ENDIF}
2992 end;
2993
2994 procedure TfdAlpha8ub1.SetValues;
2995 begin
2996   inherited SetValues;
2997   fBitsPerPixel     := 8;
2998   fFormat           := tfAlpha8ub1;
2999   fWithAlpha        := tfAlpha8ub1;
3000   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
3001   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3002   fOpenGLFormat     := tfAlpha8ub1;
3003   fglFormat         := GL_ALPHA;
3004   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
3005   fglDataFormat     := GL_UNSIGNED_BYTE;
3006 end;
3007
3008 procedure TfdAlpha16us1.SetValues;
3009 begin
3010   inherited SetValues;
3011   fBitsPerPixel     := 16;
3012   fFormat           := tfAlpha16us1;
3013   fWithAlpha        := tfAlpha16us1;
3014   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
3015   fShift            := glBitmapRec4ub(0, 0, 0,  0);
3016 {$IFNDEF OPENGL_ES}
3017   fOpenGLFormat     := tfAlpha16us1;
3018   fglFormat         := GL_ALPHA;
3019   fglInternalFormat := GL_ALPHA16;
3020   fglDataFormat     := GL_UNSIGNED_SHORT;
3021 {$ELSE}
3022   fOpenGLFormat     := tfAlpha8ub1;
3023 {$ENDIF}
3024 end;
3025
3026 procedure TfdLuminance4ub1.SetValues;
3027 begin
3028   inherited SetValues;
3029   fBitsPerPixel     := 8;
3030   fFormat           := tfLuminance4ub1;
3031   fWithAlpha        := tfLuminance4Alpha4ub2;
3032   fWithoutAlpha     := tfLuminance4ub1;
3033   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3034   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3035 {$IFNDEF OPENGL_ES}
3036   fOpenGLFormat     := tfLuminance4ub1;
3037   fglFormat         := GL_LUMINANCE;
3038   fglInternalFormat := GL_LUMINANCE4;
3039   fglDataFormat     := GL_UNSIGNED_BYTE;
3040 {$ELSE}
3041   fOpenGLFormat     := tfLuminance8ub1;
3042 {$ENDIF}
3043 end;
3044
3045 procedure TfdLuminance8ub1.SetValues;
3046 begin
3047   inherited SetValues;
3048   fBitsPerPixel     := 8;
3049   fFormat           := tfLuminance8ub1;
3050   fWithAlpha        := tfLuminance8Alpha8ub2;
3051   fWithoutAlpha     := tfLuminance8ub1;
3052   fOpenGLFormat     := tfLuminance8ub1;
3053   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3054   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3055   fglFormat         := GL_LUMINANCE;
3056   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
3057   fglDataFormat     := GL_UNSIGNED_BYTE;
3058 end;
3059
3060 procedure TfdLuminance16us1.SetValues;
3061 begin
3062   inherited SetValues;
3063   fBitsPerPixel     := 16;
3064   fFormat           := tfLuminance16us1;
3065   fWithAlpha        := tfLuminance16Alpha16us2;
3066   fWithoutAlpha     := tfLuminance16us1;
3067   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3068   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3069 {$IFNDEF OPENGL_ES}
3070   fOpenGLFormat     := tfLuminance16us1;
3071   fglFormat         := GL_LUMINANCE;
3072   fglInternalFormat := GL_LUMINANCE16;
3073   fglDataFormat     := GL_UNSIGNED_SHORT;
3074 {$ELSE}
3075   fOpenGLFormat     := tfLuminance8ub1;
3076 {$ENDIF}
3077 end;
3078
3079 procedure TfdLuminance4Alpha4ub2.SetValues;
3080 begin
3081   inherited SetValues;
3082   fBitsPerPixel     := 16;
3083   fFormat           := tfLuminance4Alpha4ub2;
3084   fWithAlpha        := tfLuminance4Alpha4ub2;
3085   fWithoutAlpha     := tfLuminance4ub1;
3086   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3087   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3088 {$IFNDEF OPENGL_ES}
3089   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3090   fglFormat         := GL_LUMINANCE_ALPHA;
3091   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3092   fglDataFormat     := GL_UNSIGNED_BYTE;
3093 {$ELSE}
3094   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3095 {$ENDIF}
3096 end;
3097
3098 procedure TfdLuminance6Alpha2ub2.SetValues;
3099 begin
3100   inherited SetValues;
3101   fBitsPerPixel     := 16;
3102   fFormat           := tfLuminance6Alpha2ub2;
3103   fWithAlpha        := tfLuminance6Alpha2ub2;
3104   fWithoutAlpha     := tfLuminance8ub1;
3105   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3106   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3107 {$IFNDEF OPENGL_ES}
3108   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3109   fglFormat         := GL_LUMINANCE_ALPHA;
3110   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3111   fglDataFormat     := GL_UNSIGNED_BYTE;
3112 {$ELSE}
3113   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3114 {$ENDIF}
3115 end;
3116
3117 procedure TfdLuminance8Alpha8ub2.SetValues;
3118 begin
3119   inherited SetValues;
3120   fBitsPerPixel     := 16;
3121   fFormat           := tfLuminance8Alpha8ub2;
3122   fWithAlpha        := tfLuminance8Alpha8ub2;
3123   fWithoutAlpha     := tfLuminance8ub1;
3124   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3125   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3126   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3127   fglFormat         := GL_LUMINANCE_ALPHA;
3128   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
3129   fglDataFormat     := GL_UNSIGNED_BYTE;
3130 end;
3131
3132 procedure TfdLuminance12Alpha4us2.SetValues;
3133 begin
3134   inherited SetValues;
3135   fBitsPerPixel     := 32;
3136   fFormat           := tfLuminance12Alpha4us2;
3137   fWithAlpha        := tfLuminance12Alpha4us2;
3138   fWithoutAlpha     := tfLuminance16us1;
3139   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3140   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3141 {$IFNDEF OPENGL_ES}
3142   fOpenGLFormat     := tfLuminance12Alpha4us2;
3143   fglFormat         := GL_LUMINANCE_ALPHA;
3144   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3145   fglDataFormat     := GL_UNSIGNED_SHORT;
3146 {$ELSE}
3147   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3148 {$ENDIF}
3149 end;
3150
3151 procedure TfdLuminance16Alpha16us2.SetValues;
3152 begin
3153   inherited SetValues;
3154   fBitsPerPixel     := 32;
3155   fFormat           := tfLuminance16Alpha16us2;
3156   fWithAlpha        := tfLuminance16Alpha16us2;
3157   fWithoutAlpha     := tfLuminance16us1;
3158   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3159   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3160 {$IFNDEF OPENGL_ES}
3161   fOpenGLFormat     := tfLuminance16Alpha16us2;
3162   fglFormat         := GL_LUMINANCE_ALPHA;
3163   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3164   fglDataFormat     := GL_UNSIGNED_SHORT;
3165 {$ELSE}
3166   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3167 {$ENDIF}
3168 end;
3169
3170 procedure TfdR3G3B2ub1.SetValues;
3171 begin
3172   inherited SetValues;
3173   fBitsPerPixel     := 8;
3174   fFormat           := tfR3G3B2ub1;
3175   fWithAlpha        := tfRGBA4us1;
3176   fWithoutAlpha     := tfR3G3B2ub1;
3177   fRGBInverted      := tfEmpty;
3178   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3179   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3180 {$IFNDEF OPENGL_ES}
3181   fOpenGLFormat     := tfR3G3B2ub1;
3182   fglFormat         := GL_RGB;
3183   fglInternalFormat := GL_R3_G3_B2;
3184   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3185 {$ELSE}
3186   fOpenGLFormat     := tfR5G6B5us1;
3187 {$ENDIF}
3188 end;
3189
3190 procedure TfdRGBX4us1.SetValues;
3191 begin
3192   inherited SetValues;
3193   fBitsPerPixel     := 16;
3194   fFormat           := tfRGBX4us1;
3195   fWithAlpha        := tfRGBA4us1;
3196   fWithoutAlpha     := tfRGBX4us1;
3197   fRGBInverted      := tfBGRX4us1;
3198   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3199   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3200 {$IFNDEF OPENGL_ES}
3201   fOpenGLFormat     := tfRGBX4us1;
3202   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3203   fglInternalFormat := GL_RGB4;
3204   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3205 {$ELSE}
3206   fOpenGLFormat     := tfR5G6B5us1;
3207 {$ENDIF}
3208 end;
3209
3210 procedure TfdXRGB4us1.SetValues;
3211 begin
3212   inherited SetValues;
3213   fBitsPerPixel     := 16;
3214   fFormat           := tfXRGB4us1;
3215   fWithAlpha        := tfARGB4us1;
3216   fWithoutAlpha     := tfXRGB4us1;
3217   fRGBInverted      := tfXBGR4us1;
3218   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3219   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3220 {$IFNDEF OPENGL_ES}
3221   fOpenGLFormat     := tfXRGB4us1;
3222   fglFormat         := GL_BGRA;
3223   fglInternalFormat := GL_RGB4;
3224   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3225 {$ELSE}
3226   fOpenGLFormat     := tfR5G6B5us1;
3227 {$ENDIF}
3228 end;
3229
3230 procedure TfdR5G6B5us1.SetValues;
3231 begin
3232   inherited SetValues;
3233   fBitsPerPixel     := 16;
3234   fFormat           := tfR5G6B5us1;
3235   fWithAlpha        := tfRGB5A1us1;
3236   fWithoutAlpha     := tfR5G6B5us1;
3237   fRGBInverted      := tfB5G6R5us1;
3238   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3239   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3240 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3241   fOpenGLFormat     := tfR5G6B5us1;
3242   fglFormat         := GL_RGB;
3243   fglInternalFormat := GL_RGB565;
3244   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3245 {$ELSE}
3246   fOpenGLFormat     := tfRGB8ub3;
3247 {$IFEND}
3248 end;
3249
3250 procedure TfdRGB5X1us1.SetValues;
3251 begin
3252   inherited SetValues;
3253   fBitsPerPixel     := 16;
3254   fFormat           := tfRGB5X1us1;
3255   fWithAlpha        := tfRGB5A1us1;
3256   fWithoutAlpha     := tfRGB5X1us1;
3257   fRGBInverted      := tfBGR5X1us1;
3258   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3259   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3260 {$IFNDEF OPENGL_ES}
3261   fOpenGLFormat     := tfRGB5X1us1;
3262   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3263   fglInternalFormat := GL_RGB5;
3264   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3265 {$ELSE}
3266   fOpenGLFormat     := tfR5G6B5us1;
3267 {$ENDIF}
3268 end;
3269
3270 procedure TfdX1RGB5us1.SetValues;
3271 begin
3272   inherited SetValues;
3273   fBitsPerPixel     := 16;
3274   fFormat           := tfX1RGB5us1;
3275   fWithAlpha        := tfA1RGB5us1;
3276   fWithoutAlpha     := tfX1RGB5us1;
3277   fRGBInverted      := tfX1BGR5us1;
3278   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3279   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3280 {$IFNDEF OPENGL_ES}
3281   fOpenGLFormat     := tfX1RGB5us1;
3282   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3283   fglInternalFormat := GL_RGB5;
3284   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3285 {$ELSE}
3286   fOpenGLFormat     := tfR5G6B5us1;
3287 {$ENDIF}
3288 end;
3289
3290 procedure TfdRGB8ub3.SetValues;
3291 begin
3292   inherited SetValues;
3293   fBitsPerPixel     := 24;
3294   fFormat           := tfRGB8ub3;
3295   fWithAlpha        := tfRGBA8ub4;
3296   fWithoutAlpha     := tfRGB8ub3;
3297   fRGBInverted      := tfBGR8ub3;
3298   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3299   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3300   fOpenGLFormat     := tfRGB8ub3;
3301   fglFormat         := GL_RGB;
3302   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
3303   fglDataFormat     := GL_UNSIGNED_BYTE;
3304 end;
3305
3306 procedure TfdRGBX8ui1.SetValues;
3307 begin
3308   inherited SetValues;
3309   fBitsPerPixel     := 32;
3310   fFormat           := tfRGBX8ui1;
3311   fWithAlpha        := tfRGBA8ui1;
3312   fWithoutAlpha     := tfRGBX8ui1;
3313   fRGBInverted      := tfBGRX8ui1;
3314   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3315   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3316 {$IFNDEF OPENGL_ES}
3317   fOpenGLFormat     := tfRGBX8ui1;
3318   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3319   fglInternalFormat := GL_RGB8;
3320   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3321 {$ELSE}
3322   fOpenGLFormat     := tfRGB8ub3;
3323 {$ENDIF}
3324 end;
3325
3326 procedure TfdXRGB8ui1.SetValues;
3327 begin
3328   inherited SetValues;
3329   fBitsPerPixel     := 32;
3330   fFormat           := tfXRGB8ui1;
3331   fWithAlpha        := tfXRGB8ui1;
3332   fWithoutAlpha     := tfXRGB8ui1;
3333   fOpenGLFormat     := tfXRGB8ui1;
3334   fRGBInverted      := tfXBGR8ui1;
3335   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3336   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3337 {$IFNDEF OPENGL_ES}
3338   fOpenGLFormat     := tfXRGB8ui1;
3339   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3340   fglInternalFormat := GL_RGB8;
3341   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3342 {$ELSE}
3343   fOpenGLFormat     := tfRGB8ub3;
3344 {$ENDIF}
3345 end;
3346
3347 procedure TfdRGB10X2ui1.SetValues;
3348 begin
3349   inherited SetValues;
3350   fBitsPerPixel     := 32;
3351   fFormat           := tfRGB10X2ui1;
3352   fWithAlpha        := tfRGB10A2ui1;
3353   fWithoutAlpha     := tfRGB10X2ui1;
3354   fRGBInverted      := tfBGR10X2ui1;
3355   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3356   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3357 {$IFNDEF OPENGL_ES}
3358   fOpenGLFormat     := tfRGB10X2ui1;
3359   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3360   fglInternalFormat := GL_RGB10;
3361   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3362 {$ELSE}
3363   fOpenGLFormat     := tfRGB16us3;
3364 {$ENDIF}
3365 end;
3366
3367 procedure TfdX2RGB10ui1.SetValues;
3368 begin
3369   inherited SetValues;
3370   fBitsPerPixel     := 32;
3371   fFormat           := tfX2RGB10ui1;
3372   fWithAlpha        := tfA2RGB10ui1;
3373   fWithoutAlpha     := tfX2RGB10ui1;
3374   fRGBInverted      := tfX2BGR10ui1;
3375   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3376   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3377 {$IFNDEF OPENGL_ES}
3378   fOpenGLFormat     := tfX2RGB10ui1;
3379   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3380   fglInternalFormat := GL_RGB10;
3381   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3382 {$ELSE}
3383   fOpenGLFormat     := tfRGB16us3;
3384 {$ENDIF}
3385 end;
3386
3387 procedure TfdRGB16us3.SetValues;
3388 begin
3389   inherited SetValues;
3390   fBitsPerPixel     := 48;
3391   fFormat           := tfRGB16us3;
3392   fWithAlpha        := tfRGBA16us4;
3393   fWithoutAlpha     := tfRGB16us3;
3394   fRGBInverted      := tfBGR16us3;
3395   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3396   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3397 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3398   fOpenGLFormat     := tfRGB16us3;
3399   fglFormat         := GL_RGB;
3400   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3401   fglDataFormat     := GL_UNSIGNED_SHORT;
3402 {$ELSE}
3403   fOpenGLFormat     := tfRGB8ub3;
3404 {$IFEND}
3405 end;
3406
3407 procedure TfdRGBA4us1.SetValues;
3408 begin
3409   inherited SetValues;
3410   fBitsPerPixel     := 16;
3411   fFormat           := tfRGBA4us1;
3412   fWithAlpha        := tfRGBA4us1;
3413   fWithoutAlpha     := tfRGBX4us1;
3414   fOpenGLFormat     := tfRGBA4us1;
3415   fRGBInverted      := tfBGRA4us1;
3416   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3417   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3418   fglFormat         := GL_RGBA;
3419   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3420   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3421 end;
3422
3423 procedure TfdARGB4us1.SetValues;
3424 begin
3425   inherited SetValues;
3426   fBitsPerPixel     := 16;
3427   fFormat           := tfARGB4us1;
3428   fWithAlpha        := tfARGB4us1;
3429   fWithoutAlpha     := tfXRGB4us1;
3430   fRGBInverted      := tfABGR4us1;
3431   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3432   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3433 {$IFNDEF OPENGL_ES}
3434   fOpenGLFormat     := tfARGB4us1;
3435   fglFormat         := GL_BGRA;
3436   fglInternalFormat := GL_RGBA4;
3437   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3438 {$ELSE}
3439   fOpenGLFormat     := tfRGBA4us1;
3440 {$ENDIF}
3441 end;
3442
3443 procedure TfdRGB5A1us1.SetValues;
3444 begin
3445   inherited SetValues;
3446   fBitsPerPixel     := 16;
3447   fFormat           := tfRGB5A1us1;
3448   fWithAlpha        := tfRGB5A1us1;
3449   fWithoutAlpha     := tfRGB5X1us1;
3450   fOpenGLFormat     := tfRGB5A1us1;
3451   fRGBInverted      := tfBGR5A1us1;
3452   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3453   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3454   fglFormat         := GL_RGBA;
3455   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3456   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3457 end;
3458
3459 procedure TfdA1RGB5us1.SetValues;
3460 begin
3461   inherited SetValues;
3462   fBitsPerPixel     := 16;
3463   fFormat           := tfA1RGB5us1;
3464   fWithAlpha        := tfA1RGB5us1;
3465   fWithoutAlpha     := tfX1RGB5us1;
3466   fRGBInverted      := tfA1BGR5us1;
3467   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3468   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3469 {$IFNDEF OPENGL_ES}
3470   fOpenGLFormat     := tfA1RGB5us1;
3471   fglFormat         := GL_BGRA;
3472   fglInternalFormat := GL_RGB5_A1;
3473   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3474 {$ELSE}
3475   fOpenGLFormat     := tfRGB5A1us1;
3476 {$ENDIF}
3477 end;
3478
3479 procedure TfdRGBA8ui1.SetValues;
3480 begin
3481   inherited SetValues;
3482   fBitsPerPixel     := 32;
3483   fFormat           := tfRGBA8ui1;
3484   fWithAlpha        := tfRGBA8ui1;
3485   fWithoutAlpha     := tfRGBX8ui1;
3486   fRGBInverted      := tfBGRA8ui1;
3487   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3488   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3489 {$IFNDEF OPENGL_ES}
3490   fOpenGLFormat     := tfRGBA8ui1;
3491   fglFormat         := GL_RGBA;
3492   fglInternalFormat := GL_RGBA8;
3493   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3494 {$ELSE}
3495   fOpenGLFormat     := tfRGBA8ub4;
3496 {$ENDIF}
3497 end;
3498
3499 procedure TfdARGB8ui1.SetValues;
3500 begin
3501   inherited SetValues;
3502   fBitsPerPixel     := 32;
3503   fFormat           := tfARGB8ui1;
3504   fWithAlpha        := tfARGB8ui1;
3505   fWithoutAlpha     := tfXRGB8ui1;
3506   fRGBInverted      := tfABGR8ui1;
3507   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3508   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3509 {$IFNDEF OPENGL_ES}
3510   fOpenGLFormat     := tfARGB8ui1;
3511   fglFormat         := GL_BGRA;
3512   fglInternalFormat := GL_RGBA8;
3513   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3514 {$ELSE}
3515   fOpenGLFormat     := tfRGBA8ub4;
3516 {$ENDIF}
3517 end;
3518
3519 procedure TfdRGBA8ub4.SetValues;
3520 begin
3521   inherited SetValues;
3522   fBitsPerPixel     := 32;
3523   fFormat           := tfRGBA8ub4;
3524   fWithAlpha        := tfRGBA8ub4;
3525   fWithoutAlpha     := tfRGB8ub3;
3526   fOpenGLFormat     := tfRGBA8ub4;
3527   fRGBInverted      := tfBGRA8ub4;
3528   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3529   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3530   fglFormat         := GL_RGBA;
3531   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3532   fglDataFormat     := GL_UNSIGNED_BYTE;
3533 end;
3534
3535 procedure TfdRGB10A2ui1.SetValues;
3536 begin
3537   inherited SetValues;
3538   fBitsPerPixel     := 32;
3539   fFormat           := tfRGB10A2ui1;
3540   fWithAlpha        := tfRGB10A2ui1;
3541   fWithoutAlpha     := tfRGB10X2ui1;
3542   fRGBInverted      := tfBGR10A2ui1;
3543   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3544   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3545 {$IFNDEF OPENGL_ES}
3546   fOpenGLFormat     := tfRGB10A2ui1;
3547   fglFormat         := GL_RGBA;
3548   fglInternalFormat := GL_RGB10_A2;
3549   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3550 {$ELSE}
3551   fOpenGLFormat     := tfA2RGB10ui1;
3552 {$ENDIF}
3553 end;
3554
3555 procedure TfdA2RGB10ui1.SetValues;
3556 begin
3557   inherited SetValues;
3558   fBitsPerPixel     := 32;
3559   fFormat           := tfA2RGB10ui1;
3560   fWithAlpha        := tfA2RGB10ui1;
3561   fWithoutAlpha     := tfX2RGB10ui1;
3562   fRGBInverted      := tfA2BGR10ui1;
3563   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3564   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3565 {$IF NOT DEFINED(OPENGL_ES)}
3566   fOpenGLFormat     := tfA2RGB10ui1;
3567   fglFormat         := GL_BGRA;
3568   fglInternalFormat := GL_RGB10_A2;
3569   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3570 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3571   fOpenGLFormat     := tfA2RGB10ui1;
3572   fglFormat         := GL_RGBA;
3573   fglInternalFormat := GL_RGB10_A2;
3574   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3575 {$ELSE}
3576   fOpenGLFormat     := tfRGBA8ui1;
3577 {$IFEND}
3578 end;
3579
3580 procedure TfdRGBA16us4.SetValues;
3581 begin
3582   inherited SetValues;
3583   fBitsPerPixel     := 64;
3584   fFormat           := tfRGBA16us4;
3585   fWithAlpha        := tfRGBA16us4;
3586   fWithoutAlpha     := tfRGB16us3;
3587   fRGBInverted      := tfBGRA16us4;
3588   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3589   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3590 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3591   fOpenGLFormat     := tfRGBA16us4;
3592   fglFormat         := GL_RGBA;
3593   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3594   fglDataFormat     := GL_UNSIGNED_SHORT;
3595 {$ELSE}
3596   fOpenGLFormat     := tfRGBA8ub4;
3597 {$IFEND}
3598 end;
3599
3600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3603 procedure TfdBGRX4us1.SetValues;
3604 begin
3605   inherited SetValues;
3606   fBitsPerPixel     := 16;
3607   fFormat           := tfBGRX4us1;
3608   fWithAlpha        := tfBGRA4us1;
3609   fWithoutAlpha     := tfBGRX4us1;
3610   fRGBInverted      := tfRGBX4us1;
3611   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3612   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3613 {$IFNDEF OPENGL_ES}
3614   fOpenGLFormat     := tfBGRX4us1;
3615   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3616   fglInternalFormat := GL_RGB4;
3617   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3618 {$ELSE}
3619   fOpenGLFormat     := tfR5G6B5us1;
3620 {$ENDIF}
3621 end;
3622
3623 procedure TfdXBGR4us1.SetValues;
3624 begin
3625   inherited SetValues;
3626   fBitsPerPixel     := 16;
3627   fFormat           := tfXBGR4us1;
3628   fWithAlpha        := tfABGR4us1;
3629   fWithoutAlpha     := tfXBGR4us1;
3630   fRGBInverted      := tfXRGB4us1;
3631   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3632   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3633 {$IFNDEF OPENGL_ES}
3634   fOpenGLFormat     := tfXBGR4us1;
3635   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3636   fglInternalFormat := GL_RGB4;
3637   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3638 {$ELSE}
3639   fOpenGLFormat     := tfR5G6B5us1;
3640 {$ENDIF}
3641 end;
3642
3643 procedure TfdB5G6R5us1.SetValues;
3644 begin
3645   inherited SetValues;
3646   fBitsPerPixel     := 16;
3647   fFormat           := tfB5G6R5us1;
3648   fWithAlpha        := tfBGR5A1us1;
3649   fWithoutAlpha     := tfB5G6R5us1;
3650   fRGBInverted      := tfR5G6B5us1;
3651   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3652   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3653 {$IFNDEF OPENGL_ES}
3654   fOpenGLFormat     := tfB5G6R5us1;
3655   fglFormat         := GL_RGB;
3656   fglInternalFormat := GL_RGB565;
3657   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3658 {$ELSE}
3659   fOpenGLFormat     := tfR5G6B5us1;
3660 {$ENDIF}
3661 end;
3662
3663 procedure TfdBGR5X1us1.SetValues;
3664 begin
3665   inherited SetValues;
3666   fBitsPerPixel     := 16;
3667   fFormat           := tfBGR5X1us1;
3668   fWithAlpha        := tfBGR5A1us1;
3669   fWithoutAlpha     := tfBGR5X1us1;
3670   fRGBInverted      := tfRGB5X1us1;
3671   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3672   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3673 {$IFNDEF OPENGL_ES}
3674   fOpenGLFormat     := tfBGR5X1us1;
3675   fglFormat         := GL_BGRA;
3676   fglInternalFormat := GL_RGB5;
3677   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3678 {$ELSE}
3679   fOpenGLFormat     := tfR5G6B5us1;
3680 {$ENDIF}
3681 end;
3682
3683 procedure TfdX1BGR5us1.SetValues;
3684 begin
3685   inherited SetValues;
3686   fBitsPerPixel     := 16;
3687   fFormat           := tfX1BGR5us1;
3688   fWithAlpha        := tfA1BGR5us1;
3689   fWithoutAlpha     := tfX1BGR5us1;
3690   fRGBInverted      := tfX1RGB5us1;
3691   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3692   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3693 {$IFNDEF OPENGL_ES}
3694   fOpenGLFormat     := tfX1BGR5us1;
3695   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3696   fglInternalFormat := GL_RGB5;
3697   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3698 {$ELSE}
3699   fOpenGLFormat     := tfR5G6B5us1;
3700 {$ENDIF}
3701 end;
3702
3703 procedure TfdBGR8ub3.SetValues;
3704 begin
3705   inherited SetValues;
3706   fBitsPerPixel     := 24;
3707   fFormat           := tfBGR8ub3;
3708   fWithAlpha        := tfBGRA8ub4;
3709   fWithoutAlpha     := tfBGR8ub3;
3710   fRGBInverted      := tfRGB8ub3;
3711   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3712   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3713 {$IFNDEF OPENGL_ES}
3714   fOpenGLFormat     := tfBGR8ub3;
3715   fglFormat         := GL_BGR;
3716   fglInternalFormat := GL_RGB8;
3717   fglDataFormat     := GL_UNSIGNED_BYTE;
3718 {$ELSE}
3719   fOpenGLFormat     := tfRGB8ub3;
3720 {$ENDIF}
3721 end;
3722
3723 procedure TfdBGRX8ui1.SetValues;
3724 begin
3725   inherited SetValues;
3726   fBitsPerPixel     := 32;
3727   fFormat           := tfBGRX8ui1;
3728   fWithAlpha        := tfBGRA8ui1;
3729   fWithoutAlpha     := tfBGRX8ui1;
3730   fRGBInverted      := tfRGBX8ui1;
3731   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3732   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3733 {$IFNDEF OPENGL_ES}
3734   fOpenGLFormat     := tfBGRX8ui1;
3735   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3736   fglInternalFormat := GL_RGB8;
3737   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3738 {$ELSE}
3739   fOpenGLFormat     := tfRGB8ub3;
3740 {$ENDIF}
3741 end;
3742
3743 procedure TfdXBGR8ui1.SetValues;
3744 begin
3745   inherited SetValues;
3746   fBitsPerPixel     := 32;
3747   fFormat           := tfXBGR8ui1;
3748   fWithAlpha        := tfABGR8ui1;
3749   fWithoutAlpha     := tfXBGR8ui1;
3750   fRGBInverted      := tfXRGB8ui1;
3751   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3752   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3753 {$IFNDEF OPENGL_ES}
3754   fOpenGLFormat     := tfXBGR8ui1;
3755   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3756   fglInternalFormat := GL_RGB8;
3757   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3758 {$ELSE}
3759   fOpenGLFormat     := tfRGB8ub3;
3760 {$ENDIF}
3761 end;
3762
3763 procedure TfdBGR10X2ui1.SetValues;
3764 begin
3765   inherited SetValues;
3766   fBitsPerPixel     := 32;
3767   fFormat           := tfBGR10X2ui1;
3768   fWithAlpha        := tfBGR10A2ui1;
3769   fWithoutAlpha     := tfBGR10X2ui1;
3770   fRGBInverted      := tfRGB10X2ui1;
3771   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3772   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3773 {$IFNDEF OPENGL_ES}
3774   fOpenGLFormat     := tfBGR10X2ui1;
3775   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3776   fglInternalFormat := GL_RGB10;
3777   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3778 {$ELSE}
3779   fOpenGLFormat     := tfRGB16us3;
3780 {$ENDIF}
3781 end;
3782
3783 procedure TfdX2BGR10ui1.SetValues;
3784 begin
3785   inherited SetValues;
3786   fBitsPerPixel     := 32;
3787   fFormat           := tfX2BGR10ui1;
3788   fWithAlpha        := tfA2BGR10ui1;
3789   fWithoutAlpha     := tfX2BGR10ui1;
3790   fRGBInverted      := tfX2RGB10ui1;
3791   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3792   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3793 {$IFNDEF OPENGL_ES}
3794   fOpenGLFormat     := tfX2BGR10ui1;
3795   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3796   fglInternalFormat := GL_RGB10;
3797   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3798 {$ELSE}
3799   fOpenGLFormat     := tfRGB16us3;
3800 {$ENDIF}
3801 end;
3802
3803 procedure TfdBGR16us3.SetValues;
3804 begin
3805   inherited SetValues;
3806   fBitsPerPixel     := 48;
3807   fFormat           := tfBGR16us3;
3808   fWithAlpha        := tfBGRA16us4;
3809   fWithoutAlpha     := tfBGR16us3;
3810   fRGBInverted      := tfRGB16us3;
3811   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3812   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3813 {$IFNDEF OPENGL_ES}
3814   fOpenGLFormat     := tfBGR16us3;
3815   fglFormat         := GL_BGR;
3816   fglInternalFormat := GL_RGB16;
3817   fglDataFormat     := GL_UNSIGNED_SHORT;
3818 {$ELSE}
3819   fOpenGLFormat     := tfRGB16us3;
3820 {$ENDIF}
3821 end;
3822
3823 procedure TfdBGRA4us1.SetValues;
3824 begin
3825   inherited SetValues;
3826   fBitsPerPixel     := 16;
3827   fFormat           := tfBGRA4us1;
3828   fWithAlpha        := tfBGRA4us1;
3829   fWithoutAlpha     := tfBGRX4us1;
3830   fRGBInverted      := tfRGBA4us1;
3831   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3832   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3833 {$IFNDEF OPENGL_ES}
3834   fOpenGLFormat     := tfBGRA4us1;
3835   fglFormat         := GL_BGRA;
3836   fglInternalFormat := GL_RGBA4;
3837   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3838 {$ELSE}
3839   fOpenGLFormat     := tfRGBA4us1;
3840 {$ENDIF}
3841 end;
3842
3843 procedure TfdABGR4us1.SetValues;
3844 begin
3845   inherited SetValues;
3846   fBitsPerPixel     := 16;
3847   fFormat           := tfABGR4us1;
3848   fWithAlpha        := tfABGR4us1;
3849   fWithoutAlpha     := tfXBGR4us1;
3850   fRGBInverted      := tfARGB4us1;
3851   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3852   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3853 {$IFNDEF OPENGL_ES}
3854   fOpenGLFormat     := tfABGR4us1;
3855   fglFormat         := GL_RGBA;
3856   fglInternalFormat := GL_RGBA4;
3857   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3858 {$ELSE}
3859   fOpenGLFormat     := tfRGBA4us1;
3860 {$ENDIF}
3861 end;
3862
3863 procedure TfdBGR5A1us1.SetValues;
3864 begin
3865   inherited SetValues;
3866   fBitsPerPixel     := 16;
3867   fFormat           := tfBGR5A1us1;
3868   fWithAlpha        := tfBGR5A1us1;
3869   fWithoutAlpha     := tfBGR5X1us1;
3870   fRGBInverted      := tfRGB5A1us1;
3871   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3872   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3873 {$IFNDEF OPENGL_ES}
3874   fOpenGLFormat     := tfBGR5A1us1;
3875   fglFormat         := GL_BGRA;
3876   fglInternalFormat := GL_RGB5_A1;
3877   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3878 {$ELSE}
3879   fOpenGLFormat     := tfRGB5A1us1;
3880 {$ENDIF}
3881 end;
3882
3883 procedure TfdA1BGR5us1.SetValues;
3884 begin
3885   inherited SetValues;
3886   fBitsPerPixel     := 16;
3887   fFormat           := tfA1BGR5us1;
3888   fWithAlpha        := tfA1BGR5us1;
3889   fWithoutAlpha     := tfX1BGR5us1;
3890   fRGBInverted      := tfA1RGB5us1;
3891   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3892   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3893 {$IFNDEF OPENGL_ES}
3894   fOpenGLFormat     := tfA1BGR5us1;
3895   fglFormat         := GL_RGBA;
3896   fglInternalFormat := GL_RGB5_A1;
3897   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3898 {$ELSE}
3899   fOpenGLFormat     := tfRGB5A1us1;
3900 {$ENDIF}
3901 end;
3902
3903 procedure TfdBGRA8ui1.SetValues;
3904 begin
3905   inherited SetValues;
3906   fBitsPerPixel     := 32;
3907   fFormat           := tfBGRA8ui1;
3908   fWithAlpha        := tfBGRA8ui1;
3909   fWithoutAlpha     := tfBGRX8ui1;
3910   fRGBInverted      := tfRGBA8ui1;
3911   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3912   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3913 {$IFNDEF OPENGL_ES}
3914   fOpenGLFormat     := tfBGRA8ui1;
3915   fglFormat         := GL_BGRA;
3916   fglInternalFormat := GL_RGBA8;
3917   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3918 {$ELSE}
3919   fOpenGLFormat     := tfRGBA8ub4;
3920 {$ENDIF}
3921 end;
3922
3923 procedure TfdABGR8ui1.SetValues;
3924 begin
3925   inherited SetValues;
3926   fBitsPerPixel     := 32;
3927   fFormat           := tfABGR8ui1;
3928   fWithAlpha        := tfABGR8ui1;
3929   fWithoutAlpha     := tfXBGR8ui1;
3930   fRGBInverted      := tfARGB8ui1;
3931   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3932   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3933 {$IFNDEF OPENGL_ES}
3934   fOpenGLFormat     := tfABGR8ui1;
3935   fglFormat         := GL_RGBA;
3936   fglInternalFormat := GL_RGBA8;
3937   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3938 {$ELSE}
3939   fOpenGLFormat     := tfRGBA8ub4
3940 {$ENDIF}
3941 end;
3942
3943 procedure TfdBGRA8ub4.SetValues;
3944 begin
3945   inherited SetValues;
3946   fBitsPerPixel     := 32;
3947   fFormat           := tfBGRA8ub4;
3948   fWithAlpha        := tfBGRA8ub4;
3949   fWithoutAlpha     := tfBGR8ub3;
3950   fRGBInverted      := tfRGBA8ub4;
3951   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3952   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3953 {$IFNDEF OPENGL_ES}
3954   fOpenGLFormat     := tfBGRA8ub4;
3955   fglFormat         := GL_BGRA;
3956   fglInternalFormat := GL_RGBA8;
3957   fglDataFormat     := GL_UNSIGNED_BYTE;
3958 {$ELSE}
3959   fOpenGLFormat     := tfRGBA8ub4;
3960 {$ENDIF}
3961 end;
3962
3963 procedure TfdBGR10A2ui1.SetValues;
3964 begin
3965   inherited SetValues;
3966   fBitsPerPixel     := 32;
3967   fFormat           := tfBGR10A2ui1;
3968   fWithAlpha        := tfBGR10A2ui1;
3969   fWithoutAlpha     := tfBGR10X2ui1;
3970   fRGBInverted      := tfRGB10A2ui1;
3971   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3972   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3973 {$IFNDEF OPENGL_ES}
3974   fOpenGLFormat     := tfBGR10A2ui1;
3975   fglFormat         := GL_BGRA;
3976   fglInternalFormat := GL_RGB10_A2;
3977   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3978 {$ELSE}
3979   fOpenGLFormat     := tfA2RGB10ui1;
3980 {$ENDIF}
3981 end;
3982
3983 procedure TfdA2BGR10ui1.SetValues;
3984 begin
3985   inherited SetValues;
3986   fBitsPerPixel     := 32;
3987   fFormat           := tfA2BGR10ui1;
3988   fWithAlpha        := tfA2BGR10ui1;
3989   fWithoutAlpha     := tfX2BGR10ui1;
3990   fRGBInverted      := tfA2RGB10ui1;
3991   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3992   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3993 {$IFNDEF OPENGL_ES}
3994   fOpenGLFormat     := tfA2BGR10ui1;
3995   fglFormat         := GL_RGBA;
3996   fglInternalFormat := GL_RGB10_A2;
3997   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3998 {$ELSE}
3999   fOpenGLFormat     := tfA2RGB10ui1;
4000 {$ENDIF}
4001 end;
4002
4003 procedure TfdBGRA16us4.SetValues;
4004 begin
4005   inherited SetValues;
4006   fBitsPerPixel     := 64;
4007   fFormat           := tfBGRA16us4;
4008   fWithAlpha        := tfBGRA16us4;
4009   fWithoutAlpha     := tfBGR16us3;
4010   fRGBInverted      := tfRGBA16us4;
4011   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4012   fShift            := glBitmapRec4ub(32, 16,  0, 48);
4013 {$IFNDEF OPENGL_ES}
4014   fOpenGLFormat     := tfBGRA16us4;
4015   fglFormat         := GL_BGRA;
4016   fglInternalFormat := GL_RGBA16;
4017   fglDataFormat     := GL_UNSIGNED_SHORT;
4018 {$ELSE}
4019   fOpenGLFormat     := tfRGBA16us4;
4020 {$ENDIF}
4021 end;
4022
4023 procedure TfdDepth16us1.SetValues;
4024 begin
4025   inherited SetValues;
4026   fBitsPerPixel     := 16;
4027   fFormat           := tfDepth16us1;
4028   fWithoutAlpha     := tfDepth16us1;
4029   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4030   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4031 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
4032   fOpenGLFormat     := tfDepth16us1;
4033   fglFormat         := GL_DEPTH_COMPONENT;
4034   fglInternalFormat := GL_DEPTH_COMPONENT16;
4035   fglDataFormat     := GL_UNSIGNED_SHORT;
4036 {$IFEND}
4037 end;
4038
4039 procedure TfdDepth24ui1.SetValues;
4040 begin
4041   inherited SetValues;
4042   fBitsPerPixel     := 32;
4043   fFormat           := tfDepth24ui1;
4044   fWithoutAlpha     := tfDepth24ui1;
4045   fOpenGLFormat     := tfDepth24ui1;
4046   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4047   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4048 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
4049   fOpenGLFormat     := tfDepth24ui1;
4050   fglFormat         := GL_DEPTH_COMPONENT;
4051   fglInternalFormat := GL_DEPTH_COMPONENT24;
4052   fglDataFormat     := GL_UNSIGNED_INT;
4053 {$IFEND}
4054 end;
4055
4056 procedure TfdDepth32ui1.SetValues;
4057 begin
4058   inherited SetValues;
4059   fBitsPerPixel     := 32;
4060   fFormat           := tfDepth32ui1;
4061   fWithoutAlpha     := tfDepth32ui1;
4062   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4063   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4064 {$IF NOT DEFINED(OPENGL_ES)}
4065   fOpenGLFormat     := tfDepth32ui1;
4066   fglFormat         := GL_DEPTH_COMPONENT;
4067   fglInternalFormat := GL_DEPTH_COMPONENT32;
4068   fglDataFormat     := GL_UNSIGNED_INT;
4069 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
4070   fOpenGLFormat     := tfDepth24ui1;
4071 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
4072   fOpenGLFormat     := tfDepth16us1;
4073 {$IFEND}
4074 end;
4075
4076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4077 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4079 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4080 begin
4081   raise EglBitmap.Create('mapping for compressed formats is not supported');
4082 end;
4083
4084 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4085 begin
4086   raise EglBitmap.Create('mapping for compressed formats is not supported');
4087 end;
4088
4089 procedure TfdS3tcDtx1RGBA.SetValues;
4090 begin
4091   inherited SetValues;
4092   fFormat           := tfS3tcDtx1RGBA;
4093   fWithAlpha        := tfS3tcDtx1RGBA;
4094   fUncompressed     := tfRGB5A1us1;
4095   fBitsPerPixel     := 4;
4096   fIsCompressed     := true;
4097 {$IFNDEF OPENGL_ES}
4098   fOpenGLFormat     := tfS3tcDtx1RGBA;
4099   fglFormat         := GL_COMPRESSED_RGBA;
4100   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4101   fglDataFormat     := GL_UNSIGNED_BYTE;
4102 {$ELSE}
4103   fOpenGLFormat     := fUncompressed;
4104 {$ENDIF}
4105 end;
4106
4107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4108 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4110 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4111 begin
4112   raise EglBitmap.Create('mapping for compressed formats is not supported');
4113 end;
4114
4115 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4116 begin
4117   raise EglBitmap.Create('mapping for compressed formats is not supported');
4118 end;
4119
4120 procedure TfdS3tcDtx3RGBA.SetValues;
4121 begin
4122   inherited SetValues;
4123   fFormat           := tfS3tcDtx3RGBA;
4124   fWithAlpha        := tfS3tcDtx3RGBA;
4125   fUncompressed     := tfRGBA8ub4;
4126   fBitsPerPixel     := 8;
4127   fIsCompressed     := true;
4128 {$IFNDEF OPENGL_ES}
4129   fOpenGLFormat     := tfS3tcDtx3RGBA;
4130   fglFormat         := GL_COMPRESSED_RGBA;
4131   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4132   fglDataFormat     := GL_UNSIGNED_BYTE;
4133 {$ELSE}
4134   fOpenGLFormat     := fUncompressed;
4135 {$ENDIF}
4136 end;
4137
4138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4139 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4141 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4142 begin
4143   raise EglBitmap.Create('mapping for compressed formats is not supported');
4144 end;
4145
4146 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4147 begin
4148   raise EglBitmap.Create('mapping for compressed formats is not supported');
4149 end;
4150
4151 procedure TfdS3tcDtx5RGBA.SetValues;
4152 begin
4153   inherited SetValues;
4154   fFormat           := tfS3tcDtx3RGBA;
4155   fWithAlpha        := tfS3tcDtx3RGBA;
4156   fUncompressed     := tfRGBA8ub4;
4157   fBitsPerPixel     := 8;
4158   fIsCompressed     := true;
4159 {$IFNDEF OPENGL_ES}
4160   fOpenGLFormat     := tfS3tcDtx3RGBA;
4161   fglFormat         := GL_COMPRESSED_RGBA;
4162   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4163   fglDataFormat     := GL_UNSIGNED_BYTE;
4164 {$ELSE}
4165   fOpenGLFormat     := fUncompressed;
4166 {$ENDIF}
4167 end;
4168
4169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4170 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
4173 begin
4174   result := (fPrecision.r > 0);
4175 end;
4176
4177 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
4178 begin
4179   result := (fPrecision.g > 0);
4180 end;
4181
4182 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
4183 begin
4184   result := (fPrecision.b > 0);
4185 end;
4186
4187 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
4188 begin
4189   result := (fPrecision.a > 0);
4190 end;
4191
4192 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
4193 begin
4194   result := HasRed or HasGreen or HasBlue;
4195 end;
4196
4197 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
4198 begin
4199   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
4200 end;
4201
4202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4203 procedure TglBitmapFormatDescriptor.SetValues;
4204 begin
4205   fFormat       := tfEmpty;
4206   fWithAlpha    := tfEmpty;
4207   fWithoutAlpha := tfEmpty;
4208   fOpenGLFormat := tfEmpty;
4209   fRGBInverted  := tfEmpty;
4210   fUncompressed := tfEmpty;
4211
4212   fBitsPerPixel := 0;
4213   fIsCompressed := false;
4214
4215   fglFormat         := 0;
4216   fglInternalFormat := 0;
4217   fglDataFormat     := 0;
4218
4219   FillChar(fPrecision, 0, SizeOf(fPrecision));
4220   FillChar(fShift,     0, SizeOf(fShift));
4221 end;
4222
4223 procedure TglBitmapFormatDescriptor.CalcValues;
4224 var
4225   i: Integer;
4226 begin
4227   fBytesPerPixel := fBitsPerPixel / 8;
4228   fChannelCount  := 0;
4229   for i := 0 to 3 do begin
4230     if (fPrecision.arr[i] > 0) then
4231       inc(fChannelCount);
4232     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
4233     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
4234   end;
4235 end;
4236
4237 constructor TglBitmapFormatDescriptor.Create;
4238 begin
4239   inherited Create;
4240   SetValues;
4241   CalcValues;
4242 end;
4243
4244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4245 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4246 var
4247   f: TglBitmapFormat;
4248 begin
4249   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4250     result := TFormatDescriptor.Get(f);
4251     if (result.glInternalFormat = aInternalFormat) then
4252       exit;
4253   end;
4254   result := TFormatDescriptor.Get(tfEmpty);
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 class procedure TFormatDescriptor.Init;
4261 begin
4262   if not Assigned(FormatDescriptorCS) then
4263     FormatDescriptorCS := TCriticalSection.Create;
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4268 begin
4269   FormatDescriptorCS.Enter;
4270   try
4271     result := FormatDescriptors[aFormat];
4272     if not Assigned(result) then begin
4273       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4274       FormatDescriptors[aFormat] := result;
4275     end;
4276   finally
4277     FormatDescriptorCS.Leave;
4278   end;
4279 end;
4280
4281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4282 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4283 begin
4284   result := Get(Get(aFormat).WithAlpha);
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4289 var
4290   ft: TglBitmapFormat;
4291 begin
4292   // find matching format with OpenGL support
4293   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4294     result := Get(ft);
4295     if (result.MaskMatch(aMask))      and
4296        (result.glFormat <> 0)         and
4297        (result.glInternalFormat <> 0) and
4298        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4299     then
4300       exit;
4301   end;
4302
4303   // find matching format without OpenGL Support
4304   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4305     result := Get(ft);
4306     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4307       exit;
4308   end;
4309
4310   result := TFormatDescriptor.Get(tfEmpty);
4311 end;
4312
4313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4314 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4315 var
4316   ft: TglBitmapFormat;
4317 begin
4318   // find matching format with OpenGL support
4319   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4320     result := Get(ft);
4321     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4322        glBitmapRec4ubCompare(result.Precision, aPrec) and
4323        (result.glFormat <> 0)         and
4324        (result.glInternalFormat <> 0) and
4325        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4326     then
4327       exit;
4328   end;
4329
4330   // find matching format without OpenGL Support
4331   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4332     result := Get(ft);
4333     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4334        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4335        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4336       exit;
4337   end;
4338
4339   result := TFormatDescriptor.Get(tfEmpty);
4340 end;
4341
4342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4343 class procedure TFormatDescriptor.Clear;
4344 var
4345   f: TglBitmapFormat;
4346 begin
4347   FormatDescriptorCS.Enter;
4348   try
4349     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4350       FreeAndNil(FormatDescriptors[f]);
4351   finally
4352     FormatDescriptorCS.Leave;
4353   end;
4354 end;
4355
4356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4357 class procedure TFormatDescriptor.Finalize;
4358 begin
4359   Clear;
4360   FreeAndNil(FormatDescriptorCS);
4361 end;
4362
4363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4364 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4366 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4367 var
4368   i: Integer;
4369 begin
4370   for i := 0 to 3 do begin
4371     fShift.arr[i] := 0;
4372     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4373       aMask.arr[i] := aMask.arr[i] shr 1;
4374       inc(fShift.arr[i]);
4375     end;
4376     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4377   end;
4378   CalcValues;
4379 end;
4380
4381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4382 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4383 begin
4384   fBitsPerPixel := aBBP;
4385   fPrecision    := aPrec;
4386   fShift        := aShift;
4387   CalcValues;
4388 end;
4389
4390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4391 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4392 var
4393   data: QWord;
4394 begin
4395   data :=
4396     ((aPixel.Data.r and Range.r) shl Shift.r) or
4397     ((aPixel.Data.g and Range.g) shl Shift.g) or
4398     ((aPixel.Data.b and Range.b) shl Shift.b) or
4399     ((aPixel.Data.a and Range.a) shl Shift.a);
4400   case BitsPerPixel of
4401     8:           aData^  := data;
4402    16:     PWord(aData)^ := data;
4403    32: PCardinal(aData)^ := data;
4404    64:    PQWord(aData)^ := data;
4405   else
4406     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4407   end;
4408   inc(aData, Round(BytesPerPixel));
4409 end;
4410
4411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4412 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4413 var
4414   data: QWord;
4415   i: Integer;
4416 begin
4417   case BitsPerPixel of
4418      8: data :=           aData^;
4419     16: data :=     PWord(aData)^;
4420     32: data := PCardinal(aData)^;
4421     64: data :=    PQWord(aData)^;
4422   else
4423     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4424   end;
4425   for i := 0 to 3 do
4426     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4427   inc(aData, Round(BytesPerPixel));
4428 end;
4429
4430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4431 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4433 procedure TbmpColorTableFormat.SetValues;
4434 begin
4435   inherited SetValues;
4436   fShift := glBitmapRec4ub(8, 8, 8, 0);
4437 end;
4438
4439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4440 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4441 begin
4442   fFormat       := aFormat;
4443   fBitsPerPixel := aBPP;
4444   fPrecision    := aPrec;
4445   fShift        := aShift;
4446   CalcValues;
4447 end;
4448
4449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4450 procedure TbmpColorTableFormat.CalcValues;
4451 begin
4452   inherited CalcValues;
4453 end;
4454
4455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4456 procedure TbmpColorTableFormat.CreateColorTable;
4457 var
4458   i: Integer;
4459 begin
4460   SetLength(fColorTable, 256);
4461   if not HasColor then begin
4462     // alpha
4463     for i := 0 to High(fColorTable) do begin
4464       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4465       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4466       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4467       fColorTable[i].a := 0;
4468     end;
4469   end else begin
4470     // normal
4471     for i := 0 to High(fColorTable) do begin
4472       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4473       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4474       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4475       fColorTable[i].a := 0;
4476     end;
4477   end;
4478 end;
4479
4480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4481 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4482 begin
4483   if (BitsPerPixel <> 8) then
4484     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4485   if not HasColor then
4486     // alpha
4487     aData^ := aPixel.Data.a
4488   else
4489     // normal
4490     aData^ := Round(
4491       ((aPixel.Data.r and Range.r) shl Shift.r) or
4492       ((aPixel.Data.g and Range.g) shl Shift.g) or
4493       ((aPixel.Data.b and Range.b) shl Shift.b));
4494   inc(aData);
4495 end;
4496
4497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4498 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4499 begin
4500   if (BitsPerPixel <> 8) then
4501     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4502   with fColorTable[aData^] do begin
4503     aPixel.Data.r := r;
4504     aPixel.Data.g := g;
4505     aPixel.Data.b := b;
4506     aPixel.Data.a := a;
4507   end;
4508   inc(aData, 1);
4509 end;
4510
4511 destructor TbmpColorTableFormat.Destroy;
4512 begin
4513   SetLength(fColorTable, 0);
4514   inherited Destroy;
4515 end;
4516
4517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4518 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4520 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4521 var
4522   i: Integer;
4523 begin
4524   for i := 0 to 3 do begin
4525     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4526       if (aSourceFD.Range.arr[i] > 0) then
4527         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4528       else
4529         aPixel.Data.arr[i] := 0;
4530     end;
4531   end;
4532 end;
4533
4534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4535 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4536 begin
4537   with aFuncRec do begin
4538     if (Source.Range.r   > 0) then
4539       Dest.Data.r := Source.Data.r;
4540     if (Source.Range.g > 0) then
4541       Dest.Data.g := Source.Data.g;
4542     if (Source.Range.b  > 0) then
4543       Dest.Data.b := Source.Data.b;
4544     if (Source.Range.a > 0) then
4545       Dest.Data.a := Source.Data.a;
4546   end;
4547 end;
4548
4549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4550 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4551 var
4552   i: Integer;
4553 begin
4554   with aFuncRec do begin
4555     for i := 0 to 3 do
4556       if (Source.Range.arr[i] > 0) then
4557         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4558   end;
4559 end;
4560
4561 type
4562   TShiftData = packed record
4563     case Integer of
4564       0: (r, g, b, a: SmallInt);
4565       1: (arr: array[0..3] of SmallInt);
4566   end;
4567   PShiftData = ^TShiftData;
4568
4569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4570 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4571 var
4572   i: Integer;
4573 begin
4574   with aFuncRec do
4575     for i := 0 to 3 do
4576       if (Source.Range.arr[i] > 0) then
4577         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4578 end;
4579
4580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4581 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4582 begin
4583   with aFuncRec do begin
4584     Dest.Data := Source.Data;
4585     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4586       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4587       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4588       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4589     end;
4590     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4591       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4592     end;
4593   end;
4594 end;
4595
4596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4597 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4598 var
4599   i: Integer;
4600 begin
4601   with aFuncRec do begin
4602     for i := 0 to 3 do
4603       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4604   end;
4605 end;
4606
4607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4608 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4609 var
4610   Temp: Single;
4611 begin
4612   with FuncRec do begin
4613     if (FuncRec.Args = nil) then begin //source has no alpha
4614       Temp :=
4615         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4616         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4617         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4618       Dest.Data.a := Round(Dest.Range.a * Temp);
4619     end else
4620       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4621   end;
4622 end;
4623
4624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4625 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4626 type
4627   PglBitmapPixelData = ^TglBitmapPixelData;
4628 begin
4629   with FuncRec do begin
4630     Dest.Data.r := Source.Data.r;
4631     Dest.Data.g := Source.Data.g;
4632     Dest.Data.b := Source.Data.b;
4633
4634     with PglBitmapPixelData(Args)^ do
4635       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4636           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4637           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4638         Dest.Data.a := 0
4639       else
4640         Dest.Data.a := Dest.Range.a;
4641   end;
4642 end;
4643
4644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4645 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4646 begin
4647   with FuncRec do begin
4648     Dest.Data.r := Source.Data.r;
4649     Dest.Data.g := Source.Data.g;
4650     Dest.Data.b := Source.Data.b;
4651     Dest.Data.a := PCardinal(Args)^;
4652   end;
4653 end;
4654
4655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4656 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4657 type
4658   PRGBPix = ^TRGBPix;
4659   TRGBPix = array [0..2] of byte;
4660 var
4661   Temp: Byte;
4662 begin
4663   while aWidth > 0 do begin
4664     Temp := PRGBPix(aData)^[0];
4665     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4666     PRGBPix(aData)^[2] := Temp;
4667
4668     if aHasAlpha then
4669       Inc(aData, 4)
4670     else
4671       Inc(aData, 3);
4672     dec(aWidth);
4673   end;
4674 end;
4675
4676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4677 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4679 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4680 begin
4681   result := TFormatDescriptor.Get(Format);
4682 end;
4683
4684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4685 function TglBitmap.GetWidth: Integer;
4686 begin
4687   if (ffX in fDimension.Fields) then
4688     result := fDimension.X
4689   else
4690     result := -1;
4691 end;
4692
4693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4694 function TglBitmap.GetHeight: Integer;
4695 begin
4696   if (ffY in fDimension.Fields) then
4697     result := fDimension.Y
4698   else
4699     result := -1;
4700 end;
4701
4702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4703 function TglBitmap.GetFileWidth: Integer;
4704 begin
4705   result := Max(1, Width);
4706 end;
4707
4708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4709 function TglBitmap.GetFileHeight: Integer;
4710 begin
4711   result := Max(1, Height);
4712 end;
4713
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4716 begin
4717   if fCustomData = aValue then
4718     exit;
4719   fCustomData := aValue;
4720 end;
4721
4722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4723 procedure TglBitmap.SetCustomName(const aValue: String);
4724 begin
4725   if fCustomName = aValue then
4726     exit;
4727   fCustomName := aValue;
4728 end;
4729
4730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4731 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4732 begin
4733   if fCustomNameW = aValue then
4734     exit;
4735   fCustomNameW := aValue;
4736 end;
4737
4738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4739 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4740 begin
4741   if fFreeDataOnDestroy = aValue then
4742     exit;
4743   fFreeDataOnDestroy := aValue;
4744 end;
4745
4746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4747 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4748 begin
4749   if fDeleteTextureOnFree = aValue then
4750     exit;
4751   fDeleteTextureOnFree := aValue;
4752 end;
4753
4754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4755 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4756 begin
4757   if fFormat = aValue then
4758     exit;
4759   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4760     raise EglBitmapUnsupportedFormat.Create(Format);
4761   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4762 end;
4763
4764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4765 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4766 begin
4767   if fFreeDataAfterGenTexture = aValue then
4768     exit;
4769   fFreeDataAfterGenTexture := aValue;
4770 end;
4771
4772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4773 procedure TglBitmap.SetID(const aValue: Cardinal);
4774 begin
4775   if fID = aValue then
4776     exit;
4777   fID := aValue;
4778 end;
4779
4780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4781 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4782 begin
4783   if fMipMap = aValue then
4784     exit;
4785   fMipMap := aValue;
4786 end;
4787
4788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4789 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4790 begin
4791   if fTarget = aValue then
4792     exit;
4793   fTarget := aValue;
4794 end;
4795
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4798 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4799 var
4800   MaxAnisotropic: Integer;
4801 {$IFEND}
4802 begin
4803   fAnisotropic := aValue;
4804   if (ID > 0) then begin
4805 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4806     if GL_EXT_texture_filter_anisotropic then begin
4807       if fAnisotropic > 0 then begin
4808         Bind(false);
4809         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4810         if aValue > MaxAnisotropic then
4811           fAnisotropic := MaxAnisotropic;
4812         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4813       end;
4814     end else begin
4815       fAnisotropic := 0;
4816     end;
4817 {$ELSE}
4818     fAnisotropic := 0;
4819 {$IFEND}
4820   end;
4821 end;
4822
4823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4824 procedure TglBitmap.CreateID;
4825 begin
4826   if (ID <> 0) then
4827     glDeleteTextures(1, @fID);
4828   glGenTextures(1, @fID);
4829   Bind(false);
4830 end;
4831
4832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4833 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
4834 begin
4835   // Set Up Parameters
4836   SetWrap(fWrapS, fWrapT, fWrapR);
4837   SetFilter(fFilterMin, fFilterMag);
4838   SetAnisotropic(fAnisotropic);
4839
4840 {$IFNDEF OPENGL_ES}
4841   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4842   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4843     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4844 {$ENDIF}
4845
4846 {$IFNDEF OPENGL_ES}
4847   // Mip Maps Generation Mode
4848   aBuildWithGlu := false;
4849   if (MipMap = mmMipmap) then begin
4850     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4851       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4852     else
4853       aBuildWithGlu := true;
4854   end else if (MipMap = mmMipmapGlu) then
4855     aBuildWithGlu := true;
4856 {$ELSE}
4857   if (MipMap = mmMipmap) then
4858     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
4859 {$ENDIF}
4860 end;
4861
4862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4863 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4864   const aWidth: Integer; const aHeight: Integer);
4865 var
4866   s: Single;
4867 begin
4868   if (Data <> aData) then begin
4869     if (Assigned(Data)) then
4870       FreeMem(Data);
4871     fData := aData;
4872   end;
4873
4874   if not Assigned(fData) then begin
4875     fPixelSize := 0;
4876     fRowSize   := 0;
4877   end else begin
4878     FillChar(fDimension, SizeOf(fDimension), 0);
4879     if aWidth <> -1 then begin
4880       fDimension.Fields := fDimension.Fields + [ffX];
4881       fDimension.X := aWidth;
4882     end;
4883
4884     if aHeight <> -1 then begin
4885       fDimension.Fields := fDimension.Fields + [ffY];
4886       fDimension.Y := aHeight;
4887     end;
4888
4889     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4890     fFormat    := aFormat;
4891     fPixelSize := Ceil(s);
4892     fRowSize   := Ceil(s * aWidth);
4893   end;
4894 end;
4895
4896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4897 function TglBitmap.FlipHorz: Boolean;
4898 begin
4899   result := false;
4900 end;
4901
4902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4903 function TglBitmap.FlipVert: Boolean;
4904 begin
4905   result := false;
4906 end;
4907
4908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4909 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4911 procedure TglBitmap.AfterConstruction;
4912 begin
4913   inherited AfterConstruction;
4914
4915   fID         := 0;
4916   fTarget     := 0;
4917 {$IFNDEF OPENGL_ES}
4918   fIsResident := false;
4919 {$ENDIF}
4920
4921   fMipMap                  := glBitmapDefaultMipmap;
4922   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4923   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4924
4925   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4926   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4927 {$IFNDEF OPENGL_ES}
4928   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4929 {$ENDIF}
4930 end;
4931
4932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4933 procedure TglBitmap.BeforeDestruction;
4934 var
4935   NewData: PByte;
4936 begin
4937   if fFreeDataOnDestroy then begin
4938     NewData := nil;
4939     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4940   end;
4941   if (fID > 0) and fDeleteTextureOnFree then
4942     glDeleteTextures(1, @fID);
4943   inherited BeforeDestruction;
4944 end;
4945
4946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4947 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4948 var
4949   TempPos: Integer;
4950 begin
4951   if not Assigned(aResType) then begin
4952     TempPos   := Pos('.', aResource);
4953     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4954     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4955   end;
4956 end;
4957
4958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4959 procedure TglBitmap.LoadFromFile(const aFilename: String);
4960 var
4961   fs: TFileStream;
4962 begin
4963   if not FileExists(aFilename) then
4964     raise EglBitmap.Create('file does not exist: ' + aFilename);
4965   fFilename := aFilename;
4966   fs := TFileStream.Create(fFilename, fmOpenRead);
4967   try
4968     fs.Position := 0;
4969     LoadFromStream(fs);
4970   finally
4971     fs.Free;
4972   end;
4973 end;
4974
4975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4976 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4977 begin
4978   {$IFDEF GLB_SUPPORT_PNG_READ}
4979   if not LoadPNG(aStream) then
4980   {$ENDIF}
4981   {$IFDEF GLB_SUPPORT_JPEG_READ}
4982   if not LoadJPEG(aStream) then
4983   {$ENDIF}
4984   if not LoadDDS(aStream) then
4985   if not LoadTGA(aStream) then
4986   if not LoadBMP(aStream) then
4987   if not LoadRAW(aStream) then
4988     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4993   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4994 var
4995   tmpData: PByte;
4996   size: Integer;
4997 begin
4998   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4999   GetMem(tmpData, size);
5000   try
5001     FillChar(tmpData^, size, #$FF);
5002     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5003   except
5004     if Assigned(tmpData) then
5005       FreeMem(tmpData);
5006     raise;
5007   end;
5008   AddFunc(Self, aFunc, false, aFormat, aArgs);
5009 end;
5010
5011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5012 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
5013 var
5014   rs: TResourceStream;
5015 begin
5016   PrepareResType(aResource, aResType);
5017   rs := TResourceStream.Create(aInstance, aResource, aResType);
5018   try
5019     LoadFromStream(rs);
5020   finally
5021     rs.Free;
5022   end;
5023 end;
5024
5025 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5026 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5027 var
5028   rs: TResourceStream;
5029 begin
5030   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5031   try
5032     LoadFromStream(rs);
5033   finally
5034     rs.Free;
5035   end;
5036 end;
5037
5038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5039 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
5040 var
5041   fs: TFileStream;
5042 begin
5043   fs := TFileStream.Create(aFileName, fmCreate);
5044   try
5045     fs.Position := 0;
5046     SaveToStream(fs, aFileType);
5047   finally
5048     fs.Free;
5049   end;
5050 end;
5051
5052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5053 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
5054 begin
5055   case aFileType of
5056     {$IFDEF GLB_SUPPORT_PNG_WRITE}
5057     ftPNG:  SavePNG(aStream);
5058     {$ENDIF}
5059     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5060     ftJPEG: SaveJPEG(aStream);
5061     {$ENDIF}
5062     ftDDS:  SaveDDS(aStream);
5063     ftTGA:  SaveTGA(aStream);
5064     ftBMP:  SaveBMP(aStream);
5065     ftRAW:  SaveRAW(aStream);
5066   end;
5067 end;
5068
5069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5070 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
5071 begin
5072   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
5073 end;
5074
5075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5076 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
5077   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
5078 var
5079   DestData, TmpData, SourceData: pByte;
5080   TempHeight, TempWidth: Integer;
5081   SourceFD, DestFD: TFormatDescriptor;
5082   SourceMD, DestMD: Pointer;
5083
5084   FuncRec: TglBitmapFunctionRec;
5085 begin
5086   Assert(Assigned(Data));
5087   Assert(Assigned(aSource));
5088   Assert(Assigned(aSource.Data));
5089
5090   result := false;
5091   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
5092     SourceFD := TFormatDescriptor.Get(aSource.Format);
5093     DestFD   := TFormatDescriptor.Get(aFormat);
5094
5095     if (SourceFD.IsCompressed) then
5096       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
5097     if (DestFD.IsCompressed) then
5098       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
5099
5100     // inkompatible Formats so CreateTemp
5101     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
5102       aCreateTemp := true;
5103
5104     // Values
5105     TempHeight := Max(1, aSource.Height);
5106     TempWidth  := Max(1, aSource.Width);
5107
5108     FuncRec.Sender := Self;
5109     FuncRec.Args   := aArgs;
5110
5111     TmpData := nil;
5112     if aCreateTemp then begin
5113       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5114       DestData := TmpData;
5115     end else
5116       DestData := Data;
5117
5118     try
5119       SourceFD.PreparePixel(FuncRec.Source);
5120       DestFD.PreparePixel  (FuncRec.Dest);
5121
5122       SourceMD := SourceFD.CreateMappingData;
5123       DestMD   := DestFD.CreateMappingData;
5124
5125       FuncRec.Size            := aSource.Dimension;
5126       FuncRec.Position.Fields := FuncRec.Size.Fields;
5127
5128       try
5129         SourceData := aSource.Data;
5130         FuncRec.Position.Y := 0;
5131         while FuncRec.Position.Y < TempHeight do begin
5132           FuncRec.Position.X := 0;
5133           while FuncRec.Position.X < TempWidth do begin
5134             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5135             aFunc(FuncRec);
5136             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5137             inc(FuncRec.Position.X);
5138           end;
5139           inc(FuncRec.Position.Y);
5140         end;
5141
5142         // Updating Image or InternalFormat
5143         if aCreateTemp then
5144           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5145         else if (aFormat <> fFormat) then
5146           Format := aFormat;
5147
5148         result := true;
5149       finally
5150         SourceFD.FreeMappingData(SourceMD);
5151         DestFD.FreeMappingData(DestMD);
5152       end;
5153     except
5154       if aCreateTemp and Assigned(TmpData) then
5155         FreeMem(TmpData);
5156       raise;
5157     end;
5158   end;
5159 end;
5160
5161 {$IFDEF GLB_SDL}
5162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5163 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5164 var
5165   Row, RowSize: Integer;
5166   SourceData, TmpData: PByte;
5167   TempDepth: Integer;
5168   FormatDesc: TFormatDescriptor;
5169
5170   function GetRowPointer(Row: Integer): pByte;
5171   begin
5172     result := aSurface.pixels;
5173     Inc(result, Row * RowSize);
5174   end;
5175
5176 begin
5177   result := false;
5178
5179   FormatDesc := TFormatDescriptor.Get(Format);
5180   if FormatDesc.IsCompressed then
5181     raise EglBitmapUnsupportedFormat.Create(Format);
5182
5183   if Assigned(Data) then begin
5184     case Trunc(FormatDesc.PixelSize) of
5185       1: TempDepth :=  8;
5186       2: TempDepth := 16;
5187       3: TempDepth := 24;
5188       4: TempDepth := 32;
5189     else
5190       raise EglBitmapUnsupportedFormat.Create(Format);
5191     end;
5192
5193     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5194       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5195     SourceData := Data;
5196     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5197
5198     for Row := 0 to FileHeight-1 do begin
5199       TmpData := GetRowPointer(Row);
5200       if Assigned(TmpData) then begin
5201         Move(SourceData^, TmpData^, RowSize);
5202         inc(SourceData, RowSize);
5203       end;
5204     end;
5205     result := true;
5206   end;
5207 end;
5208
5209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5210 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5211 var
5212   pSource, pData, pTempData: PByte;
5213   Row, RowSize, TempWidth, TempHeight: Integer;
5214   IntFormat: TglBitmapFormat;
5215   fd: TFormatDescriptor;
5216   Mask: TglBitmapMask;
5217
5218   function GetRowPointer(Row: Integer): pByte;
5219   begin
5220     result := aSurface^.pixels;
5221     Inc(result, Row * RowSize);
5222   end;
5223
5224 begin
5225   result := false;
5226   if (Assigned(aSurface)) then begin
5227     with aSurface^.format^ do begin
5228       Mask.r := RMask;
5229       Mask.g := GMask;
5230       Mask.b := BMask;
5231       Mask.a := AMask;
5232       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5233       if (IntFormat = tfEmpty) then
5234         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5235     end;
5236
5237     fd := TFormatDescriptor.Get(IntFormat);
5238     TempWidth  := aSurface^.w;
5239     TempHeight := aSurface^.h;
5240     RowSize := fd.GetSize(TempWidth, 1);
5241     GetMem(pData, TempHeight * RowSize);
5242     try
5243       pTempData := pData;
5244       for Row := 0 to TempHeight -1 do begin
5245         pSource := GetRowPointer(Row);
5246         if (Assigned(pSource)) then begin
5247           Move(pSource^, pTempData^, RowSize);
5248           Inc(pTempData, RowSize);
5249         end;
5250       end;
5251       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5252       result := true;
5253     except
5254       if Assigned(pData) then
5255         FreeMem(pData);
5256       raise;
5257     end;
5258   end;
5259 end;
5260
5261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5262 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5263 var
5264   Row, Col, AlphaInterleave: Integer;
5265   pSource, pDest: PByte;
5266
5267   function GetRowPointer(Row: Integer): pByte;
5268   begin
5269     result := aSurface.pixels;
5270     Inc(result, Row * Width);
5271   end;
5272
5273 begin
5274   result := false;
5275   if Assigned(Data) then begin
5276     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5277       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5278
5279       AlphaInterleave := 0;
5280       case Format of
5281         tfLuminance8Alpha8ub2:
5282           AlphaInterleave := 1;
5283         tfBGRA8ub4, tfRGBA8ub4:
5284           AlphaInterleave := 3;
5285       end;
5286
5287       pSource := Data;
5288       for Row := 0 to Height -1 do begin
5289         pDest := GetRowPointer(Row);
5290         if Assigned(pDest) then begin
5291           for Col := 0 to Width -1 do begin
5292             Inc(pSource, AlphaInterleave);
5293             pDest^ := pSource^;
5294             Inc(pDest);
5295             Inc(pSource);
5296           end;
5297         end;
5298       end;
5299       result := true;
5300     end;
5301   end;
5302 end;
5303
5304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5305 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5306 var
5307   bmp: TglBitmap2D;
5308 begin
5309   bmp := TglBitmap2D.Create;
5310   try
5311     bmp.AssignFromSurface(aSurface);
5312     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5313   finally
5314     bmp.Free;
5315   end;
5316 end;
5317 {$ENDIF}
5318
5319 {$IFDEF GLB_DELPHI}
5320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5321 function CreateGrayPalette: HPALETTE;
5322 var
5323   Idx: Integer;
5324   Pal: PLogPalette;
5325 begin
5326   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5327
5328   Pal.palVersion := $300;
5329   Pal.palNumEntries := 256;
5330
5331   for Idx := 0 to Pal.palNumEntries - 1 do begin
5332     Pal.palPalEntry[Idx].peRed   := Idx;
5333     Pal.palPalEntry[Idx].peGreen := Idx;
5334     Pal.palPalEntry[Idx].peBlue  := Idx;
5335     Pal.palPalEntry[Idx].peFlags := 0;
5336   end;
5337   Result := CreatePalette(Pal^);
5338   FreeMem(Pal);
5339 end;
5340
5341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5342 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5343 var
5344   Row: Integer;
5345   pSource, pData: PByte;
5346 begin
5347   result := false;
5348   if Assigned(Data) then begin
5349     if Assigned(aBitmap) then begin
5350       aBitmap.Width  := Width;
5351       aBitmap.Height := Height;
5352
5353       case Format of
5354         tfAlpha8ub1, tfLuminance8ub1: begin
5355           aBitmap.PixelFormat := pf8bit;
5356           aBitmap.Palette     := CreateGrayPalette;
5357         end;
5358         tfRGB5A1us1:
5359           aBitmap.PixelFormat := pf15bit;
5360         tfR5G6B5us1:
5361           aBitmap.PixelFormat := pf16bit;
5362         tfRGB8ub3, tfBGR8ub3:
5363           aBitmap.PixelFormat := pf24bit;
5364         tfRGBA8ub4, tfBGRA8ub4:
5365           aBitmap.PixelFormat := pf32bit;
5366       else
5367         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5368       end;
5369
5370       pSource := Data;
5371       for Row := 0 to FileHeight -1 do begin
5372         pData := aBitmap.Scanline[Row];
5373         Move(pSource^, pData^, fRowSize);
5374         Inc(pSource, fRowSize);
5375         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5376           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5377       end;
5378       result := true;
5379     end;
5380   end;
5381 end;
5382
5383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5384 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5385 var
5386   pSource, pData, pTempData: PByte;
5387   Row, RowSize, TempWidth, TempHeight: Integer;
5388   IntFormat: TglBitmapFormat;
5389 begin
5390   result := false;
5391
5392   if (Assigned(aBitmap)) then begin
5393     case aBitmap.PixelFormat of
5394       pf8bit:
5395         IntFormat := tfLuminance8ub1;
5396       pf15bit:
5397         IntFormat := tfRGB5A1us1;
5398       pf16bit:
5399         IntFormat := tfR5G6B5us1;
5400       pf24bit:
5401         IntFormat := tfBGR8ub3;
5402       pf32bit:
5403         IntFormat := tfBGRA8ub4;
5404     else
5405       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5406     end;
5407
5408     TempWidth  := aBitmap.Width;
5409     TempHeight := aBitmap.Height;
5410     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5411     GetMem(pData, TempHeight * RowSize);
5412     try
5413       pTempData := pData;
5414       for Row := 0 to TempHeight -1 do begin
5415         pSource := aBitmap.Scanline[Row];
5416         if (Assigned(pSource)) then begin
5417           Move(pSource^, pTempData^, RowSize);
5418           Inc(pTempData, RowSize);
5419         end;
5420       end;
5421       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5422       result := true;
5423     except
5424       if Assigned(pData) then
5425         FreeMem(pData);
5426       raise;
5427     end;
5428   end;
5429 end;
5430
5431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5432 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5433 var
5434   Row, Col, AlphaInterleave: Integer;
5435   pSource, pDest: PByte;
5436 begin
5437   result := false;
5438
5439   if Assigned(Data) then begin
5440     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5441       if Assigned(aBitmap) then begin
5442         aBitmap.PixelFormat := pf8bit;
5443         aBitmap.Palette     := CreateGrayPalette;
5444         aBitmap.Width       := Width;
5445         aBitmap.Height      := Height;
5446
5447         case Format of
5448           tfLuminance8Alpha8ub2:
5449             AlphaInterleave := 1;
5450           tfRGBA8ub4, tfBGRA8ub4:
5451             AlphaInterleave := 3;
5452           else
5453             AlphaInterleave := 0;
5454         end;
5455
5456         // Copy Data
5457         pSource := Data;
5458
5459         for Row := 0 to Height -1 do begin
5460           pDest := aBitmap.Scanline[Row];
5461           if Assigned(pDest) then begin
5462             for Col := 0 to Width -1 do begin
5463               Inc(pSource, AlphaInterleave);
5464               pDest^ := pSource^;
5465               Inc(pDest);
5466               Inc(pSource);
5467             end;
5468           end;
5469         end;
5470         result := true;
5471       end;
5472     end;
5473   end;
5474 end;
5475
5476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5477 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5478 var
5479   tex: TglBitmap2D;
5480 begin
5481   tex := TglBitmap2D.Create;
5482   try
5483     tex.AssignFromBitmap(ABitmap);
5484     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5485   finally
5486     tex.Free;
5487   end;
5488 end;
5489 {$ENDIF}
5490
5491 {$IFDEF GLB_LAZARUS}
5492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5493 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5494 var
5495   rid: TRawImageDescription;
5496   FormatDesc: TFormatDescriptor;
5497 begin
5498   if not Assigned(Data) then
5499     raise EglBitmap.Create('no pixel data assigned. load data before save');
5500
5501   result := false;
5502   if not Assigned(aImage) or (Format = tfEmpty) then
5503     exit;
5504   FormatDesc := TFormatDescriptor.Get(Format);
5505   if FormatDesc.IsCompressed then
5506     exit;
5507
5508   FillChar(rid{%H-}, SizeOf(rid), 0);
5509   if FormatDesc.IsGrayscale then
5510     rid.Format := ricfGray
5511   else
5512     rid.Format := ricfRGBA;
5513
5514   rid.Width        := Width;
5515   rid.Height       := Height;
5516   rid.Depth        := FormatDesc.BitsPerPixel;
5517   rid.BitOrder     := riboBitsInOrder;
5518   rid.ByteOrder    := riboLSBFirst;
5519   rid.LineOrder    := riloTopToBottom;
5520   rid.LineEnd      := rileTight;
5521   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5522   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5523   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5524   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5525   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5526   rid.RedShift     := FormatDesc.Shift.r;
5527   rid.GreenShift   := FormatDesc.Shift.g;
5528   rid.BlueShift    := FormatDesc.Shift.b;
5529   rid.AlphaShift   := FormatDesc.Shift.a;
5530
5531   rid.MaskBitsPerPixel  := 0;
5532   rid.PaletteColorCount := 0;
5533
5534   aImage.DataDescription := rid;
5535   aImage.CreateData;
5536
5537   if not Assigned(aImage.PixelData) then
5538     raise EglBitmap.Create('error while creating LazIntfImage');
5539   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5540
5541   result := true;
5542 end;
5543
5544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5545 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5546 var
5547   f: TglBitmapFormat;
5548   FormatDesc: TFormatDescriptor;
5549   ImageData: PByte;
5550   ImageSize: Integer;
5551   CanCopy: Boolean;
5552   Mask: TglBitmapRec4ul;
5553
5554   procedure CopyConvert;
5555   var
5556     bfFormat: TbmpBitfieldFormat;
5557     pSourceLine, pDestLine: PByte;
5558     pSourceMD, pDestMD: Pointer;
5559     Shift, Prec: TglBitmapRec4ub;
5560     x, y: Integer;
5561     pixel: TglBitmapPixelData;
5562   begin
5563     bfFormat  := TbmpBitfieldFormat.Create;
5564     with aImage.DataDescription do begin
5565       Prec.r := RedPrec;
5566       Prec.g := GreenPrec;
5567       Prec.b := BluePrec;
5568       Prec.a := AlphaPrec;
5569       Shift.r := RedShift;
5570       Shift.g := GreenShift;
5571       Shift.b := BlueShift;
5572       Shift.a := AlphaShift;
5573       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5574     end;
5575     pSourceMD := bfFormat.CreateMappingData;
5576     pDestMD   := FormatDesc.CreateMappingData;
5577     try
5578       for y := 0 to aImage.Height-1 do begin
5579         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5580         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5581         for x := 0 to aImage.Width-1 do begin
5582           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5583           FormatDesc.Map(pixel, pDestLine, pDestMD);
5584         end;
5585       end;
5586     finally
5587       FormatDesc.FreeMappingData(pDestMD);
5588       bfFormat.FreeMappingData(pSourceMD);
5589       bfFormat.Free;
5590     end;
5591   end;
5592
5593 begin
5594   result := false;
5595   if not Assigned(aImage) then
5596     exit;
5597
5598   with aImage.DataDescription do begin
5599     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5600     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5601     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5602     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5603   end;
5604   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5605   f          := FormatDesc.Format;
5606   if (f = tfEmpty) then
5607     exit;
5608
5609   CanCopy :=
5610     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5611     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5612
5613   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5614   ImageData := GetMem(ImageSize);
5615   try
5616     if CanCopy then
5617       Move(aImage.PixelData^, ImageData^, ImageSize)
5618     else
5619       CopyConvert;
5620     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5621   except
5622     if Assigned(ImageData) then
5623       FreeMem(ImageData);
5624     raise;
5625   end;
5626
5627   result := true;
5628 end;
5629
5630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5631 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5632 var
5633   rid: TRawImageDescription;
5634   FormatDesc: TFormatDescriptor;
5635   Pixel: TglBitmapPixelData;
5636   x, y: Integer;
5637   srcMD: Pointer;
5638   src, dst: PByte;
5639 begin
5640   result := false;
5641   if not Assigned(aImage) or (Format = tfEmpty) then
5642     exit;
5643   FormatDesc := TFormatDescriptor.Get(Format);
5644   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5645     exit;
5646
5647   FillChar(rid{%H-}, SizeOf(rid), 0);
5648   rid.Format       := ricfGray;
5649   rid.Width        := Width;
5650   rid.Height       := Height;
5651   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5652   rid.BitOrder     := riboBitsInOrder;
5653   rid.ByteOrder    := riboLSBFirst;
5654   rid.LineOrder    := riloTopToBottom;
5655   rid.LineEnd      := rileTight;
5656   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5657   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5658   rid.GreenPrec    := 0;
5659   rid.BluePrec     := 0;
5660   rid.AlphaPrec    := 0;
5661   rid.RedShift     := 0;
5662   rid.GreenShift   := 0;
5663   rid.BlueShift    := 0;
5664   rid.AlphaShift   := 0;
5665
5666   rid.MaskBitsPerPixel  := 0;
5667   rid.PaletteColorCount := 0;
5668
5669   aImage.DataDescription := rid;
5670   aImage.CreateData;
5671
5672   srcMD := FormatDesc.CreateMappingData;
5673   try
5674     FormatDesc.PreparePixel(Pixel);
5675     src := Data;
5676     dst := aImage.PixelData;
5677     for y := 0 to Height-1 do
5678       for x := 0 to Width-1 do begin
5679         FormatDesc.Unmap(src, Pixel, srcMD);
5680         case rid.BitsPerPixel of
5681            8: begin
5682             dst^ := Pixel.Data.a;
5683             inc(dst);
5684           end;
5685           16: begin
5686             PWord(dst)^ := Pixel.Data.a;
5687             inc(dst, 2);
5688           end;
5689           24: begin
5690             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5691             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5692             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5693             inc(dst, 3);
5694           end;
5695           32: begin
5696             PCardinal(dst)^ := Pixel.Data.a;
5697             inc(dst, 4);
5698           end;
5699         else
5700           raise EglBitmapUnsupportedFormat.Create(Format);
5701         end;
5702       end;
5703   finally
5704     FormatDesc.FreeMappingData(srcMD);
5705   end;
5706   result := true;
5707 end;
5708
5709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5710 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5711 var
5712   tex: TglBitmap2D;
5713 begin
5714   tex := TglBitmap2D.Create;
5715   try
5716     tex.AssignFromLazIntfImage(aImage);
5717     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5718   finally
5719     tex.Free;
5720   end;
5721 end;
5722 {$ENDIF}
5723
5724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5725 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5726   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5727 var
5728   rs: TResourceStream;
5729 begin
5730   PrepareResType(aResource, aResType);
5731   rs := TResourceStream.Create(aInstance, aResource, aResType);
5732   try
5733     result := AddAlphaFromStream(rs, aFunc, aArgs);
5734   finally
5735     rs.Free;
5736   end;
5737 end;
5738
5739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5740 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5741   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5742 var
5743   rs: TResourceStream;
5744 begin
5745   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5746   try
5747     result := AddAlphaFromStream(rs, aFunc, aArgs);
5748   finally
5749     rs.Free;
5750   end;
5751 end;
5752
5753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5754 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5755 begin
5756   if TFormatDescriptor.Get(Format).IsCompressed then
5757     raise EglBitmapUnsupportedFormat.Create(Format);
5758   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5759 end;
5760
5761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5762 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5763 var
5764   FS: TFileStream;
5765 begin
5766   FS := TFileStream.Create(aFileName, fmOpenRead);
5767   try
5768     result := AddAlphaFromStream(FS, aFunc, aArgs);
5769   finally
5770     FS.Free;
5771   end;
5772 end;
5773
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5776 var
5777   tex: TglBitmap2D;
5778 begin
5779   tex := TglBitmap2D.Create(aStream);
5780   try
5781     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5782   finally
5783     tex.Free;
5784   end;
5785 end;
5786
5787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5788 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5789 var
5790   DestData, DestData2, SourceData: pByte;
5791   TempHeight, TempWidth: Integer;
5792   SourceFD, DestFD: TFormatDescriptor;
5793   SourceMD, DestMD, DestMD2: Pointer;
5794
5795   FuncRec: TglBitmapFunctionRec;
5796 begin
5797   result := false;
5798
5799   Assert(Assigned(Data));
5800   Assert(Assigned(aBitmap));
5801   Assert(Assigned(aBitmap.Data));
5802
5803   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5804     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5805
5806     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5807     DestFD   := TFormatDescriptor.Get(Format);
5808
5809     if not Assigned(aFunc) then begin
5810       aFunc        := glBitmapAlphaFunc;
5811       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5812     end else
5813       FuncRec.Args := aArgs;
5814
5815     // Values
5816     TempHeight := aBitmap.FileHeight;
5817     TempWidth  := aBitmap.FileWidth;
5818
5819     FuncRec.Sender          := Self;
5820     FuncRec.Size            := Dimension;
5821     FuncRec.Position.Fields := FuncRec.Size.Fields;
5822
5823     DestData   := Data;
5824     DestData2  := Data;
5825     SourceData := aBitmap.Data;
5826
5827     // Mapping
5828     SourceFD.PreparePixel(FuncRec.Source);
5829     DestFD.PreparePixel  (FuncRec.Dest);
5830
5831     SourceMD := SourceFD.CreateMappingData;
5832     DestMD   := DestFD.CreateMappingData;
5833     DestMD2  := DestFD.CreateMappingData;
5834     try
5835       FuncRec.Position.Y := 0;
5836       while FuncRec.Position.Y < TempHeight do begin
5837         FuncRec.Position.X := 0;
5838         while FuncRec.Position.X < TempWidth do begin
5839           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5840           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5841           aFunc(FuncRec);
5842           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5843           inc(FuncRec.Position.X);
5844         end;
5845         inc(FuncRec.Position.Y);
5846       end;
5847     finally
5848       SourceFD.FreeMappingData(SourceMD);
5849       DestFD.FreeMappingData(DestMD);
5850       DestFD.FreeMappingData(DestMD2);
5851     end;
5852   end;
5853 end;
5854
5855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5856 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5857 begin
5858   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5859 end;
5860
5861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5862 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5863 var
5864   PixelData: TglBitmapPixelData;
5865 begin
5866   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5867   result := AddAlphaFromColorKeyFloat(
5868     aRed   / PixelData.Range.r,
5869     aGreen / PixelData.Range.g,
5870     aBlue  / PixelData.Range.b,
5871     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5872 end;
5873
5874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5875 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5876 var
5877   values: array[0..2] of Single;
5878   tmp: Cardinal;
5879   i: Integer;
5880   PixelData: TglBitmapPixelData;
5881 begin
5882   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5883   with PixelData do begin
5884     values[0] := aRed;
5885     values[1] := aGreen;
5886     values[2] := aBlue;
5887
5888     for i := 0 to 2 do begin
5889       tmp          := Trunc(Range.arr[i] * aDeviation);
5890       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5891       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5892     end;
5893     Data.a  := 0;
5894     Range.a := 0;
5895   end;
5896   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5897 end;
5898
5899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5900 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5901 begin
5902   result := AddAlphaFromValueFloat(aAlpha / $FF);
5903 end;
5904
5905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5906 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5907 var
5908   PixelData: TglBitmapPixelData;
5909 begin
5910   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5911   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5912 end;
5913
5914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5915 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5916 var
5917   PixelData: TglBitmapPixelData;
5918 begin
5919   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5920   with PixelData do
5921     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5922   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5923 end;
5924
5925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5926 function TglBitmap.RemoveAlpha: Boolean;
5927 var
5928   FormatDesc: TFormatDescriptor;
5929 begin
5930   result := false;
5931   FormatDesc := TFormatDescriptor.Get(Format);
5932   if Assigned(Data) then begin
5933     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5934       raise EglBitmapUnsupportedFormat.Create(Format);
5935     result := ConvertTo(FormatDesc.WithoutAlpha);
5936   end;
5937 end;
5938
5939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5940 function TglBitmap.Clone: TglBitmap;
5941 var
5942   Temp: TglBitmap;
5943   TempPtr: PByte;
5944   Size: Integer;
5945 begin
5946   result := nil;
5947   Temp := (ClassType.Create as TglBitmap);
5948   try
5949     // copy texture data if assigned
5950     if Assigned(Data) then begin
5951       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5952       GetMem(TempPtr, Size);
5953       try
5954         Move(Data^, TempPtr^, Size);
5955         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5956       except
5957         if Assigned(TempPtr) then
5958           FreeMem(TempPtr);
5959         raise;
5960       end;
5961     end else begin
5962       TempPtr := nil;
5963       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5964     end;
5965
5966         // copy properties
5967     Temp.fID                      := ID;
5968     Temp.fTarget                  := Target;
5969     Temp.fFormat                  := Format;
5970     Temp.fMipMap                  := MipMap;
5971     Temp.fAnisotropic             := Anisotropic;
5972     Temp.fBorderColor             := fBorderColor;
5973     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5974     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5975     Temp.fFilterMin               := fFilterMin;
5976     Temp.fFilterMag               := fFilterMag;
5977     Temp.fWrapS                   := fWrapS;
5978     Temp.fWrapT                   := fWrapT;
5979     Temp.fWrapR                   := fWrapR;
5980     Temp.fFilename                := fFilename;
5981     Temp.fCustomName              := fCustomName;
5982     Temp.fCustomNameW             := fCustomNameW;
5983     Temp.fCustomData              := fCustomData;
5984
5985     result := Temp;
5986   except
5987     FreeAndNil(Temp);
5988     raise;
5989   end;
5990 end;
5991
5992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5993 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5994 var
5995   SourceFD, DestFD: TFormatDescriptor;
5996   SourcePD, DestPD: TglBitmapPixelData;
5997   ShiftData: TShiftData;
5998
5999   function DataIsIdentical: Boolean;
6000   begin
6001     result := SourceFD.MaskMatch(DestFD.Mask);
6002   end;
6003
6004   function CanCopyDirect: Boolean;
6005   begin
6006     result :=
6007       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6008       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6009       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6010       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6011   end;
6012
6013   function CanShift: Boolean;
6014   begin
6015     result :=
6016       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6017       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6018       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6019       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6020   end;
6021
6022   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6023   begin
6024     result := 0;
6025     while (aSource > aDest) and (aSource > 0) do begin
6026       inc(result);
6027       aSource := aSource shr 1;
6028     end;
6029   end;
6030
6031 begin
6032   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6033     SourceFD := TFormatDescriptor.Get(Format);
6034     DestFD   := TFormatDescriptor.Get(aFormat);
6035
6036     if DataIsIdentical then begin
6037       result := true;
6038       Format := aFormat;
6039       exit;
6040     end;
6041
6042     SourceFD.PreparePixel(SourcePD);
6043     DestFD.PreparePixel  (DestPD);
6044
6045     if CanCopyDirect then
6046       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
6047     else if CanShift then begin
6048       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6049       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6050       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6051       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6052       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6053     end else
6054       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6055   end else
6056     result := true;
6057 end;
6058
6059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6060 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
6061 begin
6062   if aUseRGB or aUseAlpha then
6063     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
6064       ((Byte(aUseAlpha) and 1) shl 1) or
6065        (Byte(aUseRGB)   and 1)      ));
6066 end;
6067
6068 {$IFNDEF OPENGL_ES}
6069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6070 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
6071 begin
6072   fBorderColor[0] := aRed;
6073   fBorderColor[1] := aGreen;
6074   fBorderColor[2] := aBlue;
6075   fBorderColor[3] := aAlpha;
6076   if (ID > 0) then begin
6077     Bind(false);
6078     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6079   end;
6080 end;
6081 {$ENDIF}
6082
6083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6084 procedure TglBitmap.FreeData;
6085 var
6086   TempPtr: PByte;
6087 begin
6088   TempPtr := nil;
6089   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
6090 end;
6091
6092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6093 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
6094   const aAlpha: Byte);
6095 begin
6096   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
6097 end;
6098
6099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6100 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
6101 var
6102   PixelData: TglBitmapPixelData;
6103 begin
6104   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6105   FillWithColorFloat(
6106     aRed   / PixelData.Range.r,
6107     aGreen / PixelData.Range.g,
6108     aBlue  / PixelData.Range.b,
6109     aAlpha / PixelData.Range.a);
6110 end;
6111
6112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6113 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
6114 var
6115   PixelData: TglBitmapPixelData;
6116 begin
6117   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6118   with PixelData do begin
6119     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6120     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6121     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6122     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6123   end;
6124   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6125 end;
6126
6127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6128 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6129 begin
6130   //check MIN filter
6131   case aMin of
6132     GL_NEAREST:
6133       fFilterMin := GL_NEAREST;
6134     GL_LINEAR:
6135       fFilterMin := GL_LINEAR;
6136     GL_NEAREST_MIPMAP_NEAREST:
6137       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6138     GL_LINEAR_MIPMAP_NEAREST:
6139       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6140     GL_NEAREST_MIPMAP_LINEAR:
6141       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6142     GL_LINEAR_MIPMAP_LINEAR:
6143       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6144     else
6145       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6146   end;
6147
6148   //check MAG filter
6149   case aMag of
6150     GL_NEAREST:
6151       fFilterMag := GL_NEAREST;
6152     GL_LINEAR:
6153       fFilterMag := GL_LINEAR;
6154     else
6155       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6156   end;
6157
6158   //apply filter
6159   if (ID > 0) then begin
6160     Bind(false);
6161     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6162
6163     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
6164       case fFilterMin of
6165         GL_NEAREST, GL_LINEAR:
6166           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6167         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6168           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6169         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6170           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6171       end;
6172     end else
6173       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6174   end;
6175 end;
6176
6177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6178 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6179
6180   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6181   begin
6182     case aValue of
6183 {$IFNDEF OPENGL_ES}
6184       GL_CLAMP:
6185         aTarget := GL_CLAMP;
6186 {$ENDIF}
6187
6188       GL_REPEAT:
6189         aTarget := GL_REPEAT;
6190
6191       GL_CLAMP_TO_EDGE: begin
6192 {$IFNDEF OPENGL_ES}
6193         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
6194           aTarget := GL_CLAMP
6195         else
6196 {$ENDIF}
6197           aTarget := GL_CLAMP_TO_EDGE;
6198       end;
6199
6200 {$IFNDEF OPENGL_ES}
6201       GL_CLAMP_TO_BORDER: begin
6202         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6203           aTarget := GL_CLAMP_TO_BORDER
6204         else
6205           aTarget := GL_CLAMP;
6206       end;
6207 {$ENDIF}
6208
6209 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
6210       GL_MIRRORED_REPEAT: begin
6211   {$IFNDEF OPENGL_ES}
6212         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6213   {$ELSE}
6214         if GL_VERSION_2_0 then
6215   {$ENDIF}
6216           aTarget := GL_MIRRORED_REPEAT
6217         else
6218           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6219       end;
6220 {$IFEND}
6221     else
6222       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6223     end;
6224   end;
6225
6226 begin
6227   CheckAndSetWrap(S, fWrapS);
6228   CheckAndSetWrap(T, fWrapT);
6229   CheckAndSetWrap(R, fWrapR);
6230
6231   if (ID > 0) then begin
6232     Bind(false);
6233     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6234     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6235 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6236     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
6237     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6238 {$IFEND}
6239   end;
6240 end;
6241
6242 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6244 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6245
6246   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6247   begin
6248     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6249        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6250       fSwizzle[aIndex] := aValue
6251     else
6252       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6253   end;
6254
6255 begin
6256 {$IFNDEF OPENGL_ES}
6257   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6258     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6259 {$ELSE}
6260   if not GL_VERSION_3_0 then
6261     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6262 {$ENDIF}
6263   CheckAndSetValue(r, 0);
6264   CheckAndSetValue(g, 1);
6265   CheckAndSetValue(b, 2);
6266   CheckAndSetValue(a, 3);
6267
6268   if (ID > 0) then begin
6269     Bind(false);
6270 {$IFNDEF OPENGL_ES}
6271     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6272 {$ELSE}
6273     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
6274     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
6275     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
6276     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
6277 {$ENDIF}
6278   end;
6279 end;
6280 {$IFEND}
6281
6282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6283 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6284 begin
6285   if aEnableTextureUnit then
6286     glEnable(Target);
6287   if (ID > 0) then
6288     glBindTexture(Target, ID);
6289 end;
6290
6291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6292 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6293 begin
6294   if aDisableTextureUnit then
6295     glDisable(Target);
6296   glBindTexture(Target, 0);
6297 end;
6298
6299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6300 constructor TglBitmap.Create;
6301 begin
6302   if (ClassType = TglBitmap) then
6303     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6304 {$IFDEF GLB_NATIVE_OGL}
6305   glbReadOpenGLExtensions;
6306 {$ENDIF}
6307   inherited Create;
6308   fFormat            := glBitmapGetDefaultFormat;
6309   fFreeDataOnDestroy := true;
6310 end;
6311
6312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6313 constructor TglBitmap.Create(const aFileName: String);
6314 begin
6315   Create;
6316   LoadFromFile(aFileName);
6317 end;
6318
6319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6320 constructor TglBitmap.Create(const aStream: TStream);
6321 begin
6322   Create;
6323   LoadFromStream(aStream);
6324 end;
6325
6326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6327 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6328 var
6329   ImageSize: Integer;
6330 begin
6331   Create;
6332   if not Assigned(aData) then begin
6333     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6334     GetMem(aData, ImageSize);
6335     try
6336       FillChar(aData^, ImageSize, #$FF);
6337       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6338     except
6339       if Assigned(aData) then
6340         FreeMem(aData);
6341       raise;
6342     end;
6343   end else begin
6344     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6345     fFreeDataOnDestroy := false;
6346   end;
6347 end;
6348
6349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6350 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6351 begin
6352   Create;
6353   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6354 end;
6355
6356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6357 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6358 begin
6359   Create;
6360   LoadFromResource(aInstance, aResource, aResType);
6361 end;
6362
6363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6365 begin
6366   Create;
6367   LoadFromResourceID(aInstance, aResourceID, aResType);
6368 end;
6369
6370 {$IFDEF GLB_SUPPORT_PNG_READ}
6371 {$IF DEFINED(GLB_LAZ_PNG)}
6372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6373 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6375 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6376 const
6377   MAGIC_LEN = 8;
6378   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6379 var
6380   reader: TLazReaderPNG;
6381   intf: TLazIntfImage;
6382   StreamPos: Int64;
6383   magic: String[MAGIC_LEN];
6384 begin
6385   result := true;
6386   StreamPos := aStream.Position;
6387
6388   SetLength(magic, MAGIC_LEN);
6389   aStream.Read(magic[1], MAGIC_LEN);
6390   aStream.Position := StreamPos;
6391   if (magic <> PNG_MAGIC) then begin
6392     result := false;
6393     exit;
6394   end;
6395
6396   intf   := TLazIntfImage.Create(0, 0);
6397   reader := TLazReaderPNG.Create;
6398   try try
6399     reader.UpdateDescription := true;
6400     reader.ImageRead(aStream, intf);
6401     AssignFromLazIntfImage(intf);
6402   except
6403     result := false;
6404     aStream.Position := StreamPos;
6405     exit;
6406   end;
6407   finally
6408     reader.Free;
6409     intf.Free;
6410   end;
6411 end;
6412
6413 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6415 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6416 var
6417   Surface: PSDL_Surface;
6418   RWops: PSDL_RWops;
6419 begin
6420   result := false;
6421   RWops := glBitmapCreateRWops(aStream);
6422   try
6423     if IMG_isPNG(RWops) > 0 then begin
6424       Surface := IMG_LoadPNG_RW(RWops);
6425       try
6426         AssignFromSurface(Surface);
6427         result := true;
6428       finally
6429         SDL_FreeSurface(Surface);
6430       end;
6431     end;
6432   finally
6433     SDL_FreeRW(RWops);
6434   end;
6435 end;
6436
6437 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6439 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6440 begin
6441   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6442 end;
6443
6444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6445 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6446 var
6447   StreamPos: Int64;
6448   signature: array [0..7] of byte;
6449   png: png_structp;
6450   png_info: png_infop;
6451
6452   TempHeight, TempWidth: Integer;
6453   Format: TglBitmapFormat;
6454
6455   png_data: pByte;
6456   png_rows: array of pByte;
6457   Row, LineSize: Integer;
6458 begin
6459   result := false;
6460
6461   if not init_libPNG then
6462     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6463
6464   try
6465     // signature
6466     StreamPos := aStream.Position;
6467     aStream.Read(signature{%H-}, 8);
6468     aStream.Position := StreamPos;
6469
6470     if png_check_sig(@signature, 8) <> 0 then begin
6471       // png read struct
6472       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6473       if png = nil then
6474         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6475
6476       // png info
6477       png_info := png_create_info_struct(png);
6478       if png_info = nil then begin
6479         png_destroy_read_struct(@png, nil, nil);
6480         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6481       end;
6482
6483       // set read callback
6484       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6485
6486       // read informations
6487       png_read_info(png, png_info);
6488
6489       // size
6490       TempHeight := png_get_image_height(png, png_info);
6491       TempWidth := png_get_image_width(png, png_info);
6492
6493       // format
6494       case png_get_color_type(png, png_info) of
6495         PNG_COLOR_TYPE_GRAY:
6496           Format := tfLuminance8ub1;
6497         PNG_COLOR_TYPE_GRAY_ALPHA:
6498           Format := tfLuminance8Alpha8us1;
6499         PNG_COLOR_TYPE_RGB:
6500           Format := tfRGB8ub3;
6501         PNG_COLOR_TYPE_RGB_ALPHA:
6502           Format := tfRGBA8ub4;
6503         else
6504           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6505       end;
6506
6507       // cut upper 8 bit from 16 bit formats
6508       if png_get_bit_depth(png, png_info) > 8 then
6509         png_set_strip_16(png);
6510
6511       // expand bitdepth smaller than 8
6512       if png_get_bit_depth(png, png_info) < 8 then
6513         png_set_expand(png);
6514
6515       // allocating mem for scanlines
6516       LineSize := png_get_rowbytes(png, png_info);
6517       GetMem(png_data, TempHeight * LineSize);
6518       try
6519         SetLength(png_rows, TempHeight);
6520         for Row := Low(png_rows) to High(png_rows) do begin
6521           png_rows[Row] := png_data;
6522           Inc(png_rows[Row], Row * LineSize);
6523         end;
6524
6525         // read complete image into scanlines
6526         png_read_image(png, @png_rows[0]);
6527
6528         // read end
6529         png_read_end(png, png_info);
6530
6531         // destroy read struct
6532         png_destroy_read_struct(@png, @png_info, nil);
6533
6534         SetLength(png_rows, 0);
6535
6536         // set new data
6537         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6538
6539         result := true;
6540       except
6541         if Assigned(png_data) then
6542           FreeMem(png_data);
6543         raise;
6544       end;
6545     end;
6546   finally
6547     quit_libPNG;
6548   end;
6549 end;
6550
6551 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6553 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6554 var
6555   StreamPos: Int64;
6556   Png: TPNGObject;
6557   Header: String[8];
6558   Row, Col, PixSize, LineSize: Integer;
6559   NewImage, pSource, pDest, pAlpha: pByte;
6560   PngFormat: TglBitmapFormat;
6561   FormatDesc: TFormatDescriptor;
6562
6563 const
6564   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6565
6566 begin
6567   result := false;
6568
6569   StreamPos := aStream.Position;
6570   aStream.Read(Header[0], SizeOf(Header));
6571   aStream.Position := StreamPos;
6572
6573   {Test if the header matches}
6574   if Header = PngHeader then begin
6575     Png := TPNGObject.Create;
6576     try
6577       Png.LoadFromStream(aStream);
6578
6579       case Png.Header.ColorType of
6580         COLOR_GRAYSCALE:
6581           PngFormat := tfLuminance8ub1;
6582         COLOR_GRAYSCALEALPHA:
6583           PngFormat := tfLuminance8Alpha8us1;
6584         COLOR_RGB:
6585           PngFormat := tfBGR8ub3;
6586         COLOR_RGBALPHA:
6587           PngFormat := tfBGRA8ub4;
6588         else
6589           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6590       end;
6591
6592       FormatDesc := TFormatDescriptor.Get(PngFormat);
6593       PixSize    := Round(FormatDesc.PixelSize);
6594       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6595
6596       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6597       try
6598         pDest := NewImage;
6599
6600         case Png.Header.ColorType of
6601           COLOR_RGB, COLOR_GRAYSCALE:
6602             begin
6603               for Row := 0 to Png.Height -1 do begin
6604                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6605                 Inc(pDest, LineSize);
6606               end;
6607             end;
6608           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6609             begin
6610               PixSize := PixSize -1;
6611
6612               for Row := 0 to Png.Height -1 do begin
6613                 pSource := Png.Scanline[Row];
6614                 pAlpha := pByte(Png.AlphaScanline[Row]);
6615
6616                 for Col := 0 to Png.Width -1 do begin
6617                   Move (pSource^, pDest^, PixSize);
6618                   Inc(pSource, PixSize);
6619                   Inc(pDest, PixSize);
6620
6621                   pDest^ := pAlpha^;
6622                   inc(pAlpha);
6623                   Inc(pDest);
6624                 end;
6625               end;
6626             end;
6627           else
6628             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6629         end;
6630
6631         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6632
6633         result := true;
6634       except
6635         if Assigned(NewImage) then
6636           FreeMem(NewImage);
6637         raise;
6638       end;
6639     finally
6640       Png.Free;
6641     end;
6642   end;
6643 end;
6644 {$IFEND}
6645 {$ENDIF}
6646
6647 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6648 {$IFDEF GLB_LIB_PNG}
6649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6650 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6651 begin
6652   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6653 end;
6654 {$ENDIF}
6655
6656 {$IF DEFINED(GLB_LAZ_PNG)}
6657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6658 procedure TglBitmap.SavePNG(const aStream: TStream);
6659 var
6660   png: TPortableNetworkGraphic;
6661   intf: TLazIntfImage;
6662   raw: TRawImage;
6663 begin
6664   png  := TPortableNetworkGraphic.Create;
6665   intf := TLazIntfImage.Create(0, 0);
6666   try
6667     if not AssignToLazIntfImage(intf) then
6668       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6669     intf.GetRawImage(raw);
6670     png.LoadFromRawImage(raw, false);
6671     png.SaveToStream(aStream);
6672   finally
6673     png.Free;
6674     intf.Free;
6675   end;
6676 end;
6677
6678 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6680 procedure TglBitmap.SavePNG(const aStream: TStream);
6681 var
6682   png: png_structp;
6683   png_info: png_infop;
6684   png_rows: array of pByte;
6685   LineSize: Integer;
6686   ColorType: Integer;
6687   Row: Integer;
6688   FormatDesc: TFormatDescriptor;
6689 begin
6690   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6691     raise EglBitmapUnsupportedFormat.Create(Format);
6692
6693   if not init_libPNG then
6694     raise Exception.Create('unable to initialize libPNG.');
6695
6696   try
6697     case Format of
6698       tfAlpha8ub1, tfLuminance8ub1:
6699         ColorType := PNG_COLOR_TYPE_GRAY;
6700       tfLuminance8Alpha8us1:
6701         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6702       tfBGR8ub3, tfRGB8ub3:
6703         ColorType := PNG_COLOR_TYPE_RGB;
6704       tfBGRA8ub4, tfRGBA8ub4:
6705         ColorType := PNG_COLOR_TYPE_RGBA;
6706       else
6707         raise EglBitmapUnsupportedFormat.Create(Format);
6708     end;
6709
6710     FormatDesc := TFormatDescriptor.Get(Format);
6711     LineSize := FormatDesc.GetSize(Width, 1);
6712
6713     // creating array for scanline
6714     SetLength(png_rows, Height);
6715     try
6716       for Row := 0 to Height - 1 do begin
6717         png_rows[Row] := Data;
6718         Inc(png_rows[Row], Row * LineSize)
6719       end;
6720
6721       // write struct
6722       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6723       if png = nil then
6724         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6725
6726       // create png info
6727       png_info := png_create_info_struct(png);
6728       if png_info = nil then begin
6729         png_destroy_write_struct(@png, nil);
6730         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6731       end;
6732
6733       // set read callback
6734       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6735
6736       // set compression
6737       png_set_compression_level(png, 6);
6738
6739       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6740         png_set_bgr(png);
6741
6742       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6743       png_write_info(png, png_info);
6744       png_write_image(png, @png_rows[0]);
6745       png_write_end(png, png_info);
6746       png_destroy_write_struct(@png, @png_info);
6747     finally
6748       SetLength(png_rows, 0);
6749     end;
6750   finally
6751     quit_libPNG;
6752   end;
6753 end;
6754
6755 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6757 procedure TglBitmap.SavePNG(const aStream: TStream);
6758 var
6759   Png: TPNGObject;
6760
6761   pSource, pDest: pByte;
6762   X, Y, PixSize: Integer;
6763   ColorType: Cardinal;
6764   Alpha: Boolean;
6765
6766   pTemp: pByte;
6767   Temp: Byte;
6768 begin
6769   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6770     raise EglBitmapUnsupportedFormat.Create(Format);
6771
6772   case Format of
6773     tfAlpha8ub1, tfLuminance8ub1: begin
6774       ColorType := COLOR_GRAYSCALE;
6775       PixSize   := 1;
6776       Alpha     := false;
6777     end;
6778     tfLuminance8Alpha8us1: begin
6779       ColorType := COLOR_GRAYSCALEALPHA;
6780       PixSize   := 1;
6781       Alpha     := true;
6782     end;
6783     tfBGR8ub3, tfRGB8ub3: begin
6784       ColorType := COLOR_RGB;
6785       PixSize   := 3;
6786       Alpha     := false;
6787     end;
6788     tfBGRA8ub4, tfRGBA8ub4: begin
6789       ColorType := COLOR_RGBALPHA;
6790       PixSize   := 3;
6791       Alpha     := true
6792     end;
6793   else
6794     raise EglBitmapUnsupportedFormat.Create(Format);
6795   end;
6796
6797   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6798   try
6799     // Copy ImageData
6800     pSource := Data;
6801     for Y := 0 to Height -1 do begin
6802       pDest := png.ScanLine[Y];
6803       for X := 0 to Width -1 do begin
6804         Move(pSource^, pDest^, PixSize);
6805         Inc(pDest, PixSize);
6806         Inc(pSource, PixSize);
6807         if Alpha then begin
6808           png.AlphaScanline[Y]^[X] := pSource^;
6809           Inc(pSource);
6810         end;
6811       end;
6812
6813       // convert RGB line to BGR
6814       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6815         pTemp := png.ScanLine[Y];
6816         for X := 0 to Width -1 do begin
6817           Temp := pByteArray(pTemp)^[0];
6818           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6819           pByteArray(pTemp)^[2] := Temp;
6820           Inc(pTemp, 3);
6821         end;
6822       end;
6823     end;
6824
6825     // Save to Stream
6826     Png.CompressionLevel := 6;
6827     Png.SaveToStream(aStream);
6828   finally
6829     FreeAndNil(Png);
6830   end;
6831 end;
6832 {$IFEND}
6833 {$ENDIF}
6834
6835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6836 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6838 {$IFDEF GLB_LIB_JPEG}
6839 type
6840   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6841   glBitmap_libJPEG_source_mgr = record
6842     pub: jpeg_source_mgr;
6843
6844     SrcStream: TStream;
6845     SrcBuffer: array [1..4096] of byte;
6846   end;
6847
6848   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6849   glBitmap_libJPEG_dest_mgr = record
6850     pub: jpeg_destination_mgr;
6851
6852     DestStream: TStream;
6853     DestBuffer: array [1..4096] of byte;
6854   end;
6855
6856 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6857 begin
6858   //DUMMY
6859 end;
6860
6861
6862 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6863 begin
6864   //DUMMY
6865 end;
6866
6867
6868 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6869 begin
6870   //DUMMY
6871 end;
6872
6873 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6874 begin
6875   //DUMMY
6876 end;
6877
6878
6879 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6880 begin
6881   //DUMMY
6882 end;
6883
6884
6885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6886 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6887 var
6888   src: glBitmap_libJPEG_source_mgr_ptr;
6889   bytes: integer;
6890 begin
6891   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6892
6893   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6894         if (bytes <= 0) then begin
6895                 src^.SrcBuffer[1] := $FF;
6896                 src^.SrcBuffer[2] := JPEG_EOI;
6897                 bytes := 2;
6898         end;
6899
6900         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6901         src^.pub.bytes_in_buffer := bytes;
6902
6903   result := true;
6904 end;
6905
6906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6907 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6908 var
6909   src: glBitmap_libJPEG_source_mgr_ptr;
6910 begin
6911   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6912
6913   if num_bytes > 0 then begin
6914     // wanted byte isn't in buffer so set stream position and read buffer
6915     if num_bytes > src^.pub.bytes_in_buffer then begin
6916       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6917       src^.pub.fill_input_buffer(cinfo);
6918     end else begin
6919       // wanted byte is in buffer so only skip
6920                 inc(src^.pub.next_input_byte, num_bytes);
6921                 dec(src^.pub.bytes_in_buffer, num_bytes);
6922     end;
6923   end;
6924 end;
6925
6926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6927 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6928 var
6929   dest: glBitmap_libJPEG_dest_mgr_ptr;
6930 begin
6931   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6932
6933   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6934     // write complete buffer
6935     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6936
6937     // reset buffer
6938     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6939     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6940   end;
6941
6942   result := true;
6943 end;
6944
6945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6946 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6947 var
6948   Idx: Integer;
6949   dest: glBitmap_libJPEG_dest_mgr_ptr;
6950 begin
6951   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6952
6953   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6954     // check for endblock
6955     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6956       // write endblock
6957       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6958
6959       // leave
6960       break;
6961     end else
6962       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6963   end;
6964 end;
6965 {$ENDIF}
6966
6967 {$IFDEF GLB_SUPPORT_JPEG_READ}
6968 {$IF DEFINED(GLB_LAZ_JPEG)}
6969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6970 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6971 const
6972   MAGIC_LEN = 2;
6973   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6974 var
6975   intf: TLazIntfImage;
6976   reader: TFPReaderJPEG;
6977   StreamPos: Int64;
6978   magic: String[MAGIC_LEN];
6979 begin
6980   result := true;
6981   StreamPos := aStream.Position;
6982
6983   SetLength(magic, MAGIC_LEN);
6984   aStream.Read(magic[1], MAGIC_LEN);
6985   aStream.Position := StreamPos;
6986   if (magic <> JPEG_MAGIC) then begin
6987     result := false;
6988     exit;
6989   end;
6990
6991   reader := TFPReaderJPEG.Create;
6992   intf := TLazIntfImage.Create(0, 0);
6993   try try
6994     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6995     reader.ImageRead(aStream, intf);
6996     AssignFromLazIntfImage(intf);
6997   except
6998     result := false;
6999     aStream.Position := StreamPos;
7000     exit;
7001   end;
7002   finally
7003     reader.Free;
7004     intf.Free;
7005   end;
7006 end;
7007
7008 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
7009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7010 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7011 var
7012   Surface: PSDL_Surface;
7013   RWops: PSDL_RWops;
7014 begin
7015   result := false;
7016
7017   RWops := glBitmapCreateRWops(aStream);
7018   try
7019     if IMG_isJPG(RWops) > 0 then begin
7020       Surface := IMG_LoadJPG_RW(RWops);
7021       try
7022         AssignFromSurface(Surface);
7023         result := true;
7024       finally
7025         SDL_FreeSurface(Surface);
7026       end;
7027     end;
7028   finally
7029     SDL_FreeRW(RWops);
7030   end;
7031 end;
7032
7033 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7035 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7036 var
7037   StreamPos: Int64;
7038   Temp: array[0..1]of Byte;
7039
7040   jpeg: jpeg_decompress_struct;
7041   jpeg_err: jpeg_error_mgr;
7042
7043   IntFormat: TglBitmapFormat;
7044   pImage: pByte;
7045   TempHeight, TempWidth: Integer;
7046
7047   pTemp: pByte;
7048   Row: Integer;
7049
7050   FormatDesc: TFormatDescriptor;
7051 begin
7052   result := false;
7053
7054   if not init_libJPEG then
7055     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
7056
7057   try
7058     // reading first two bytes to test file and set cursor back to begin
7059     StreamPos := aStream.Position;
7060     aStream.Read({%H-}Temp[0], 2);
7061     aStream.Position := StreamPos;
7062
7063     // if Bitmap then read file.
7064     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7065       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
7066       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7067
7068       // error managment
7069       jpeg.err := jpeg_std_error(@jpeg_err);
7070       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7071       jpeg_err.output_message := glBitmap_libJPEG_output_message;
7072
7073       // decompression struct
7074       jpeg_create_decompress(@jpeg);
7075
7076       // allocation space for streaming methods
7077       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
7078
7079       // seeting up custom functions
7080       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
7081         pub.init_source       := glBitmap_libJPEG_init_source;
7082         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
7083         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
7084         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
7085         pub.term_source       := glBitmap_libJPEG_term_source;
7086
7087         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
7088         pub.next_input_byte := nil;   // until buffer loaded
7089
7090         SrcStream := aStream;
7091       end;
7092
7093       // set global decoding state
7094       jpeg.global_state := DSTATE_START;
7095
7096       // read header of jpeg
7097       jpeg_read_header(@jpeg, false);
7098
7099       // setting output parameter
7100       case jpeg.jpeg_color_space of
7101         JCS_GRAYSCALE:
7102           begin
7103             jpeg.out_color_space := JCS_GRAYSCALE;
7104             IntFormat := tfLuminance8ub1;
7105           end;
7106         else
7107           jpeg.out_color_space := JCS_RGB;
7108           IntFormat := tfRGB8ub3;
7109       end;
7110
7111       // reading image
7112       jpeg_start_decompress(@jpeg);
7113
7114       TempHeight := jpeg.output_height;
7115       TempWidth := jpeg.output_width;
7116
7117       FormatDesc := TFormatDescriptor.Get(IntFormat);
7118
7119       // creating new image
7120       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
7121       try
7122         pTemp := pImage;
7123
7124         for Row := 0 to TempHeight -1 do begin
7125           jpeg_read_scanlines(@jpeg, @pTemp, 1);
7126           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
7127         end;
7128
7129         // finish decompression
7130         jpeg_finish_decompress(@jpeg);
7131
7132         // destroy decompression
7133         jpeg_destroy_decompress(@jpeg);
7134
7135         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7136
7137         result := true;
7138       except
7139         if Assigned(pImage) then
7140           FreeMem(pImage);
7141         raise;
7142       end;
7143     end;
7144   finally
7145     quit_libJPEG;
7146   end;
7147 end;
7148
7149 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7151 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7152 var
7153   bmp: TBitmap;
7154   jpg: TJPEGImage;
7155   StreamPos: Int64;
7156   Temp: array[0..1]of Byte;
7157 begin
7158   result := false;
7159
7160   // reading first two bytes to test file and set cursor back to begin
7161   StreamPos := aStream.Position;
7162   aStream.Read(Temp[0], 2);
7163   aStream.Position := StreamPos;
7164
7165   // if Bitmap then read file.
7166   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7167     bmp := TBitmap.Create;
7168     try
7169       jpg := TJPEGImage.Create;
7170       try
7171         jpg.LoadFromStream(aStream);
7172         bmp.Assign(jpg);
7173         result := AssignFromBitmap(bmp);
7174       finally
7175         jpg.Free;
7176       end;
7177     finally
7178       bmp.Free;
7179     end;
7180   end;
7181 end;
7182 {$IFEND}
7183 {$ENDIF}
7184
7185 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7186 {$IF DEFINED(GLB_LAZ_JPEG)}
7187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7188 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7189 var
7190   jpeg: TJPEGImage;
7191   intf: TLazIntfImage;
7192   raw: TRawImage;
7193 begin
7194   jpeg := TJPEGImage.Create;
7195   intf := TLazIntfImage.Create(0, 0);
7196   try
7197     if not AssignToLazIntfImage(intf) then
7198       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7199     intf.GetRawImage(raw);
7200     jpeg.LoadFromRawImage(raw, false);
7201     jpeg.SaveToStream(aStream);
7202   finally
7203     intf.Free;
7204     jpeg.Free;
7205   end;
7206 end;
7207
7208 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7210 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7211 var
7212   jpeg: jpeg_compress_struct;
7213   jpeg_err: jpeg_error_mgr;
7214   Row: Integer;
7215   pTemp, pTemp2: pByte;
7216
7217   procedure CopyRow(pDest, pSource: pByte);
7218   var
7219     X: Integer;
7220   begin
7221     for X := 0 to Width - 1 do begin
7222       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7223       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7224       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7225       Inc(pDest, 3);
7226       Inc(pSource, 3);
7227     end;
7228   end;
7229
7230 begin
7231   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7232     raise EglBitmapUnsupportedFormat.Create(Format);
7233
7234   if not init_libJPEG then
7235     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7236
7237   try
7238     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7239     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7240
7241     // error managment
7242     jpeg.err := jpeg_std_error(@jpeg_err);
7243     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7244     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7245
7246     // compression struct
7247     jpeg_create_compress(@jpeg);
7248
7249     // allocation space for streaming methods
7250     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7251
7252     // seeting up custom functions
7253     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7254       pub.init_destination    := glBitmap_libJPEG_init_destination;
7255       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7256       pub.term_destination    := glBitmap_libJPEG_term_destination;
7257
7258       pub.next_output_byte  := @DestBuffer[1];
7259       pub.free_in_buffer    := Length(DestBuffer);
7260
7261       DestStream := aStream;
7262     end;
7263
7264     // very important state
7265     jpeg.global_state := CSTATE_START;
7266     jpeg.image_width  := Width;
7267     jpeg.image_height := Height;
7268     case Format of
7269       tfAlpha8ub1, tfLuminance8ub1: begin
7270         jpeg.input_components := 1;
7271         jpeg.in_color_space   := JCS_GRAYSCALE;
7272       end;
7273       tfRGB8ub3, tfBGR8ub3: begin
7274         jpeg.input_components := 3;
7275         jpeg.in_color_space   := JCS_RGB;
7276       end;
7277     end;
7278
7279     jpeg_set_defaults(@jpeg);
7280     jpeg_set_quality(@jpeg, 95, true);
7281     jpeg_start_compress(@jpeg, true);
7282     pTemp := Data;
7283
7284     if Format = tfBGR8ub3 then
7285       GetMem(pTemp2, fRowSize)
7286     else
7287       pTemp2 := pTemp;
7288
7289     try
7290       for Row := 0 to jpeg.image_height -1 do begin
7291         // prepare row
7292         if Format = tfBGR8ub3 then
7293           CopyRow(pTemp2, pTemp)
7294         else
7295           pTemp2 := pTemp;
7296
7297         // write row
7298         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7299         inc(pTemp, fRowSize);
7300       end;
7301     finally
7302       // free memory
7303       if Format = tfBGR8ub3 then
7304         FreeMem(pTemp2);
7305     end;
7306     jpeg_finish_compress(@jpeg);
7307     jpeg_destroy_compress(@jpeg);
7308   finally
7309     quit_libJPEG;
7310   end;
7311 end;
7312
7313 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7315 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7316 var
7317   Bmp: TBitmap;
7318   Jpg: TJPEGImage;
7319 begin
7320   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7321     raise EglBitmapUnsupportedFormat.Create(Format);
7322
7323   Bmp := TBitmap.Create;
7324   try
7325     Jpg := TJPEGImage.Create;
7326     try
7327       AssignToBitmap(Bmp);
7328       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7329         Jpg.Grayscale   := true;
7330         Jpg.PixelFormat := jf8Bit;
7331       end;
7332       Jpg.Assign(Bmp);
7333       Jpg.SaveToStream(aStream);
7334     finally
7335       FreeAndNil(Jpg);
7336     end;
7337   finally
7338     FreeAndNil(Bmp);
7339   end;
7340 end;
7341 {$IFEND}
7342 {$ENDIF}
7343
7344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7345 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7347 type
7348   RawHeader = packed record
7349     Magic:        String[5];
7350     Version:      Byte;
7351     Width:        Integer;
7352     Height:       Integer;
7353     DataSize:     Integer;
7354     BitsPerPixel: Integer;
7355     Precision:    TglBitmapRec4ub;
7356     Shift:        TglBitmapRec4ub;
7357   end;
7358
7359 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7360 var
7361   header: RawHeader;
7362   StartPos: Int64;
7363   fd: TFormatDescriptor;
7364   buf: PByte;
7365 begin
7366   result := false;
7367   StartPos := aStream.Position;
7368   aStream.Read(header{%H-}, SizeOf(header));
7369   if (header.Magic <> 'glBMP') then begin
7370     aStream.Position := StartPos;
7371     exit;
7372   end;
7373
7374   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7375   if (fd.Format = tfEmpty) then
7376     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7377
7378   buf := GetMemory(header.DataSize);
7379   aStream.Read(buf^, header.DataSize);
7380   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7381
7382   result := true;
7383 end;
7384
7385 procedure TglBitmap.SaveRAW(const aStream: TStream);
7386 var
7387   header: RawHeader;
7388   fd: TFormatDescriptor;
7389 begin
7390   fd := TFormatDescriptor.Get(Format);
7391   header.Magic        := 'glBMP';
7392   header.Version      := 1;
7393   header.Width        := Width;
7394   header.Height       := Height;
7395   header.DataSize     := fd.GetSize(fDimension);
7396   header.BitsPerPixel := fd.BitsPerPixel;
7397   header.Precision    := fd.Precision;
7398   header.Shift        := fd.Shift;
7399   aStream.Write(header, SizeOf(header));
7400   aStream.Write(Data^,  header.DataSize);
7401 end;
7402
7403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7404 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7406 const
7407   BMP_MAGIC          = $4D42;
7408
7409   BMP_COMP_RGB       = 0;
7410   BMP_COMP_RLE8      = 1;
7411   BMP_COMP_RLE4      = 2;
7412   BMP_COMP_BITFIELDS = 3;
7413
7414 type
7415   TBMPHeader = packed record
7416     bfType: Word;
7417     bfSize: Cardinal;
7418     bfReserved1: Word;
7419     bfReserved2: Word;
7420     bfOffBits: Cardinal;
7421   end;
7422
7423   TBMPInfo = packed record
7424     biSize: Cardinal;
7425     biWidth: Longint;
7426     biHeight: Longint;
7427     biPlanes: Word;
7428     biBitCount: Word;
7429     biCompression: Cardinal;
7430     biSizeImage: Cardinal;
7431     biXPelsPerMeter: Longint;
7432     biYPelsPerMeter: Longint;
7433     biClrUsed: Cardinal;
7434     biClrImportant: Cardinal;
7435   end;
7436
7437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7438 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7439
7440   //////////////////////////////////////////////////////////////////////////////////////////////////
7441   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7442   begin
7443     result := tfEmpty;
7444     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7445     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7446
7447     //Read Compression
7448     case aInfo.biCompression of
7449       BMP_COMP_RLE4,
7450       BMP_COMP_RLE8: begin
7451         raise EglBitmap.Create('RLE compression is not supported');
7452       end;
7453       BMP_COMP_BITFIELDS: begin
7454         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7455           aStream.Read(aMask.r, SizeOf(aMask.r));
7456           aStream.Read(aMask.g, SizeOf(aMask.g));
7457           aStream.Read(aMask.b, SizeOf(aMask.b));
7458           aStream.Read(aMask.a, SizeOf(aMask.a));
7459         end else
7460           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7461       end;
7462     end;
7463
7464     //get suitable format
7465     case aInfo.biBitCount of
7466        8: result := tfLuminance8ub1;
7467       16: result := tfX1RGB5us1;
7468       24: result := tfBGR8ub3;
7469       32: result := tfXRGB8ui1;
7470     end;
7471   end;
7472
7473   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7474   var
7475     i, c: Integer;
7476     ColorTable: TbmpColorTable;
7477   begin
7478     result := nil;
7479     if (aInfo.biBitCount >= 16) then
7480       exit;
7481     aFormat := tfLuminance8ub1;
7482     c := aInfo.biClrUsed;
7483     if (c = 0) then
7484       c := 1 shl aInfo.biBitCount;
7485     SetLength(ColorTable, c);
7486     for i := 0 to c-1 do begin
7487       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7488       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7489         aFormat := tfRGB8ub3;
7490     end;
7491
7492     result := TbmpColorTableFormat.Create;
7493     result.BitsPerPixel := aInfo.biBitCount;
7494     result.ColorTable   := ColorTable;
7495     result.CalcValues;
7496   end;
7497
7498   //////////////////////////////////////////////////////////////////////////////////////////////////
7499   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7500   var
7501     FormatDesc: TFormatDescriptor;
7502   begin
7503     result := nil;
7504     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7505       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7506       if (FormatDesc.Format = tfEmpty) then
7507         exit;
7508       aFormat := FormatDesc.Format;
7509       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7510         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7511       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7512         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7513
7514       result := TbmpBitfieldFormat.Create;
7515       result.SetCustomValues(aInfo.biBitCount, aMask);
7516     end;
7517   end;
7518
7519 var
7520   //simple types
7521   StartPos: Int64;
7522   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7523   PaddingBuff: Cardinal;
7524   LineBuf, ImageData, TmpData: PByte;
7525   SourceMD, DestMD: Pointer;
7526   BmpFormat: TglBitmapFormat;
7527
7528   //records
7529   Mask: TglBitmapRec4ul;
7530   Header: TBMPHeader;
7531   Info: TBMPInfo;
7532
7533   //classes
7534   SpecialFormat: TFormatDescriptor;
7535   FormatDesc: TFormatDescriptor;
7536
7537   //////////////////////////////////////////////////////////////////////////////////////////////////
7538   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7539   var
7540     i: Integer;
7541     Pixel: TglBitmapPixelData;
7542   begin
7543     aStream.Read(aLineBuf^, rbLineSize);
7544     SpecialFormat.PreparePixel(Pixel);
7545     for i := 0 to Info.biWidth-1 do begin
7546       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7547       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7548       FormatDesc.Map(Pixel, aData, DestMD);
7549     end;
7550   end;
7551
7552 begin
7553   result        := false;
7554   BmpFormat     := tfEmpty;
7555   SpecialFormat := nil;
7556   LineBuf       := nil;
7557   SourceMD      := nil;
7558   DestMD        := nil;
7559
7560   // Header
7561   StartPos := aStream.Position;
7562   aStream.Read(Header{%H-}, SizeOf(Header));
7563
7564   if Header.bfType = BMP_MAGIC then begin
7565     try try
7566       BmpFormat        := ReadInfo(Info, Mask);
7567       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7568       if not Assigned(SpecialFormat) then
7569         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7570       aStream.Position := StartPos + Header.bfOffBits;
7571
7572       if (BmpFormat <> tfEmpty) then begin
7573         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7574         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7575         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7576         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7577
7578         //get Memory
7579         DestMD    := FormatDesc.CreateMappingData;
7580         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7581         GetMem(ImageData, ImageSize);
7582         if Assigned(SpecialFormat) then begin
7583           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7584           SourceMD := SpecialFormat.CreateMappingData;
7585         end;
7586
7587         //read Data
7588         try try
7589           FillChar(ImageData^, ImageSize, $FF);
7590           TmpData := ImageData;
7591           if (Info.biHeight > 0) then
7592             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7593           for i := 0 to Abs(Info.biHeight)-1 do begin
7594             if Assigned(SpecialFormat) then
7595               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7596             else
7597               aStream.Read(TmpData^, wbLineSize);   //else only read data
7598             if (Info.biHeight > 0) then
7599               dec(TmpData, wbLineSize)
7600             else
7601               inc(TmpData, wbLineSize);
7602             aStream.Read(PaddingBuff{%H-}, Padding);
7603           end;
7604           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7605           result := true;
7606         finally
7607           if Assigned(LineBuf) then
7608             FreeMem(LineBuf);
7609           if Assigned(SourceMD) then
7610             SpecialFormat.FreeMappingData(SourceMD);
7611           FormatDesc.FreeMappingData(DestMD);
7612         end;
7613         except
7614           if Assigned(ImageData) then
7615             FreeMem(ImageData);
7616           raise;
7617         end;
7618       end else
7619         raise EglBitmap.Create('LoadBMP - No suitable format found');
7620     except
7621       aStream.Position := StartPos;
7622       raise;
7623     end;
7624     finally
7625       FreeAndNil(SpecialFormat);
7626     end;
7627   end
7628     else aStream.Position := StartPos;
7629 end;
7630
7631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7632 procedure TglBitmap.SaveBMP(const aStream: TStream);
7633 var
7634   Header: TBMPHeader;
7635   Info: TBMPInfo;
7636   Converter: TFormatDescriptor;
7637   FormatDesc: TFormatDescriptor;
7638   SourceFD, DestFD: Pointer;
7639   pData, srcData, dstData, ConvertBuffer: pByte;
7640
7641   Pixel: TglBitmapPixelData;
7642   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7643   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7644
7645   PaddingBuff: Cardinal;
7646
7647   function GetLineWidth : Integer;
7648   begin
7649     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7650   end;
7651
7652 begin
7653   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7654     raise EglBitmapUnsupportedFormat.Create(Format);
7655
7656   Converter  := nil;
7657   FormatDesc := TFormatDescriptor.Get(Format);
7658   ImageSize  := FormatDesc.GetSize(Dimension);
7659
7660   FillChar(Header{%H-}, SizeOf(Header), 0);
7661   Header.bfType      := BMP_MAGIC;
7662   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7663   Header.bfReserved1 := 0;
7664   Header.bfReserved2 := 0;
7665   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7666
7667   FillChar(Info{%H-}, SizeOf(Info), 0);
7668   Info.biSize        := SizeOf(Info);
7669   Info.biWidth       := Width;
7670   Info.biHeight      := Height;
7671   Info.biPlanes      := 1;
7672   Info.biCompression := BMP_COMP_RGB;
7673   Info.biSizeImage   := ImageSize;
7674
7675   try
7676     case Format of
7677       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7678       begin
7679         Info.biBitCount  :=  8;
7680         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7681         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7682         Converter := TbmpColorTableFormat.Create;
7683         with (Converter as TbmpColorTableFormat) do begin
7684           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7685           CreateColorTable;
7686         end;
7687       end;
7688
7689       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7690       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7691       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7692       begin
7693         Info.biBitCount    := 16;
7694         Info.biCompression := BMP_COMP_BITFIELDS;
7695       end;
7696
7697       tfBGR8ub3, tfRGB8ub3:
7698       begin
7699         Info.biBitCount := 24;
7700         if (Format = tfRGB8ub3) then
7701           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7702       end;
7703
7704       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7705       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7706       begin
7707         Info.biBitCount    := 32;
7708         Info.biCompression := BMP_COMP_BITFIELDS;
7709       end;
7710     else
7711       raise EglBitmapUnsupportedFormat.Create(Format);
7712     end;
7713     Info.biXPelsPerMeter := 2835;
7714     Info.biYPelsPerMeter := 2835;
7715
7716     // prepare bitmasks
7717     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7718       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7719       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7720
7721       RedMask    := FormatDesc.Mask.r;
7722       GreenMask  := FormatDesc.Mask.g;
7723       BlueMask   := FormatDesc.Mask.b;
7724       AlphaMask  := FormatDesc.Mask.a;
7725     end;
7726
7727     // headers
7728     aStream.Write(Header, SizeOf(Header));
7729     aStream.Write(Info, SizeOf(Info));
7730
7731     // colortable
7732     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7733       with (Converter as TbmpColorTableFormat) do
7734         aStream.Write(ColorTable[0].b,
7735           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7736
7737     // bitmasks
7738     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7739       aStream.Write(RedMask,   SizeOf(Cardinal));
7740       aStream.Write(GreenMask, SizeOf(Cardinal));
7741       aStream.Write(BlueMask,  SizeOf(Cardinal));
7742       aStream.Write(AlphaMask, SizeOf(Cardinal));
7743     end;
7744
7745     // image data
7746     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7747     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7748     Padding     := GetLineWidth - wbLineSize;
7749     PaddingBuff := 0;
7750
7751     pData := Data;
7752     inc(pData, (Height-1) * rbLineSize);
7753
7754     // prepare row buffer. But only for RGB because RGBA supports color masks
7755     // so it's possible to change color within the image.
7756     if Assigned(Converter) then begin
7757       FormatDesc.PreparePixel(Pixel);
7758       GetMem(ConvertBuffer, wbLineSize);
7759       SourceFD := FormatDesc.CreateMappingData;
7760       DestFD   := Converter.CreateMappingData;
7761     end else
7762       ConvertBuffer := nil;
7763
7764     try
7765       for LineIdx := 0 to Height - 1 do begin
7766         // preparing row
7767         if Assigned(Converter) then begin
7768           srcData := pData;
7769           dstData := ConvertBuffer;
7770           for PixelIdx := 0 to Info.biWidth-1 do begin
7771             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7772             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7773             Converter.Map(Pixel, dstData, DestFD);
7774           end;
7775           aStream.Write(ConvertBuffer^, wbLineSize);
7776         end else begin
7777           aStream.Write(pData^, rbLineSize);
7778         end;
7779         dec(pData, rbLineSize);
7780         if (Padding > 0) then
7781           aStream.Write(PaddingBuff, Padding);
7782       end;
7783     finally
7784       // destroy row buffer
7785       if Assigned(ConvertBuffer) then begin
7786         FormatDesc.FreeMappingData(SourceFD);
7787         Converter.FreeMappingData(DestFD);
7788         FreeMem(ConvertBuffer);
7789       end;
7790     end;
7791   finally
7792     if Assigned(Converter) then
7793       Converter.Free;
7794   end;
7795 end;
7796
7797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7798 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7800 type
7801   TTGAHeader = packed record
7802     ImageID: Byte;
7803     ColorMapType: Byte;
7804     ImageType: Byte;
7805     //ColorMapSpec: Array[0..4] of Byte;
7806     ColorMapStart: Word;
7807     ColorMapLength: Word;
7808     ColorMapEntrySize: Byte;
7809     OrigX: Word;
7810     OrigY: Word;
7811     Width: Word;
7812     Height: Word;
7813     Bpp: Byte;
7814     ImageDesc: Byte;
7815   end;
7816
7817 const
7818   TGA_UNCOMPRESSED_RGB  =  2;
7819   TGA_UNCOMPRESSED_GRAY =  3;
7820   TGA_COMPRESSED_RGB    = 10;
7821   TGA_COMPRESSED_GRAY   = 11;
7822
7823   TGA_NONE_COLOR_TABLE  = 0;
7824
7825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7826 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7827 var
7828   Header: TTGAHeader;
7829   ImageData: System.PByte;
7830   StartPosition: Int64;
7831   PixelSize, LineSize: Integer;
7832   tgaFormat: TglBitmapFormat;
7833   FormatDesc: TFormatDescriptor;
7834   Counter: packed record
7835     X, Y: packed record
7836       low, high, dir: Integer;
7837     end;
7838   end;
7839
7840 const
7841   CACHE_SIZE = $4000;
7842
7843   ////////////////////////////////////////////////////////////////////////////////////////
7844   procedure ReadUncompressed;
7845   var
7846     i, j: Integer;
7847     buf, tmp1, tmp2: System.PByte;
7848   begin
7849     buf := nil;
7850     if (Counter.X.dir < 0) then
7851       GetMem(buf, LineSize);
7852     try
7853       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7854         tmp1 := ImageData;
7855         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7856         if (Counter.X.dir < 0) then begin               //flip X
7857           aStream.Read(buf^, LineSize);
7858           tmp2 := buf;
7859           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7860           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7861             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7862               tmp1^ := tmp2^;
7863               inc(tmp1);
7864               inc(tmp2);
7865             end;
7866             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7867           end;
7868         end else
7869           aStream.Read(tmp1^, LineSize);
7870         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7871       end;
7872     finally
7873       if Assigned(buf) then
7874         FreeMem(buf);
7875     end;
7876   end;
7877
7878   ////////////////////////////////////////////////////////////////////////////////////////
7879   procedure ReadCompressed;
7880
7881     /////////////////////////////////////////////////////////////////
7882     var
7883       TmpData: System.PByte;
7884       LinePixelsRead: Integer;
7885     procedure CheckLine;
7886     begin
7887       if (LinePixelsRead >= Header.Width) then begin
7888         LinePixelsRead := 0;
7889         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7890         TmpData := ImageData;
7891         inc(TmpData, Counter.Y.low * LineSize);           //set line
7892         if (Counter.X.dir < 0) then                       //if x flipped then
7893           inc(TmpData, LineSize - PixelSize);             //set last pixel
7894       end;
7895     end;
7896
7897     /////////////////////////////////////////////////////////////////
7898     var
7899       Cache: PByte;
7900       CacheSize, CachePos: Integer;
7901     procedure CachedRead(out Buffer; Count: Integer);
7902     var
7903       BytesRead: Integer;
7904     begin
7905       if (CachePos + Count > CacheSize) then begin
7906         //if buffer overflow save non read bytes
7907         BytesRead := 0;
7908         if (CacheSize - CachePos > 0) then begin
7909           BytesRead := CacheSize - CachePos;
7910           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7911           inc(CachePos, BytesRead);
7912         end;
7913
7914         //load cache from file
7915         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7916         aStream.Read(Cache^, CacheSize);
7917         CachePos := 0;
7918
7919         //read rest of requested bytes
7920         if (Count - BytesRead > 0) then begin
7921           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7922           inc(CachePos, Count - BytesRead);
7923         end;
7924       end else begin
7925         //if no buffer overflow just read the data
7926         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7927         inc(CachePos, Count);
7928       end;
7929     end;
7930
7931     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7932     begin
7933       case PixelSize of
7934         1: begin
7935           aBuffer^ := aData^;
7936           inc(aBuffer, Counter.X.dir);
7937         end;
7938         2: begin
7939           PWord(aBuffer)^ := PWord(aData)^;
7940           inc(aBuffer, 2 * Counter.X.dir);
7941         end;
7942         3: begin
7943           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7944           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7945           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7946           inc(aBuffer, 3 * Counter.X.dir);
7947         end;
7948         4: begin
7949           PCardinal(aBuffer)^ := PCardinal(aData)^;
7950           inc(aBuffer, 4 * Counter.X.dir);
7951         end;
7952       end;
7953     end;
7954
7955   var
7956     TotalPixelsToRead, TotalPixelsRead: Integer;
7957     Temp: Byte;
7958     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7959     PixelRepeat: Boolean;
7960     PixelsToRead, PixelCount: Integer;
7961   begin
7962     CacheSize := 0;
7963     CachePos  := 0;
7964
7965     TotalPixelsToRead := Header.Width * Header.Height;
7966     TotalPixelsRead   := 0;
7967     LinePixelsRead    := 0;
7968
7969     GetMem(Cache, CACHE_SIZE);
7970     try
7971       TmpData := ImageData;
7972       inc(TmpData, Counter.Y.low * LineSize);           //set line
7973       if (Counter.X.dir < 0) then                       //if x flipped then
7974         inc(TmpData, LineSize - PixelSize);             //set last pixel
7975
7976       repeat
7977         //read CommandByte
7978         CachedRead(Temp, 1);
7979         PixelRepeat  := (Temp and $80) > 0;
7980         PixelsToRead := (Temp and $7F) + 1;
7981         inc(TotalPixelsRead, PixelsToRead);
7982
7983         if PixelRepeat then
7984           CachedRead(buf[0], PixelSize);
7985         while (PixelsToRead > 0) do begin
7986           CheckLine;
7987           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7988           while (PixelCount > 0) do begin
7989             if not PixelRepeat then
7990               CachedRead(buf[0], PixelSize);
7991             PixelToBuffer(@buf[0], TmpData);
7992             inc(LinePixelsRead);
7993             dec(PixelsToRead);
7994             dec(PixelCount);
7995           end;
7996         end;
7997       until (TotalPixelsRead >= TotalPixelsToRead);
7998     finally
7999       FreeMem(Cache);
8000     end;
8001   end;
8002
8003   function IsGrayFormat: Boolean;
8004   begin
8005     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
8006   end;
8007
8008 begin
8009   result := false;
8010
8011   // reading header to test file and set cursor back to begin
8012   StartPosition := aStream.Position;
8013   aStream.Read(Header{%H-}, SizeOf(Header));
8014
8015   // no colormapped files
8016   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
8017     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
8018   begin
8019     try
8020       if Header.ImageID <> 0 then       // skip image ID
8021         aStream.Position := aStream.Position + Header.ImageID;
8022
8023       tgaFormat := tfEmpty;
8024       case Header.Bpp of
8025          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
8026                0: tgaFormat := tfLuminance8ub1;
8027                8: tgaFormat := tfAlpha8ub1;
8028             end;
8029
8030         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
8031                0: tgaFormat := tfLuminance16us1;
8032                8: tgaFormat := tfLuminance8Alpha8ub2;
8033             end else case (Header.ImageDesc and $F) of
8034                0: tgaFormat := tfX1RGB5us1;
8035                1: tgaFormat := tfA1RGB5us1;
8036                4: tgaFormat := tfARGB4us1;
8037             end;
8038
8039         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
8040                0: tgaFormat := tfBGR8ub3;
8041             end;
8042
8043         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
8044                0: tgaFormat := tfDepth32ui1;
8045             end else case (Header.ImageDesc and $F) of
8046                0: tgaFormat := tfX2RGB10ui1;
8047                2: tgaFormat := tfA2RGB10ui1;
8048                8: tgaFormat := tfARGB8ui1;
8049             end;
8050       end;
8051
8052       if (tgaFormat = tfEmpty) then
8053         raise EglBitmap.Create('LoadTga - unsupported format');
8054
8055       FormatDesc := TFormatDescriptor.Get(tgaFormat);
8056       PixelSize  := FormatDesc.GetSize(1, 1);
8057       LineSize   := FormatDesc.GetSize(Header.Width, 1);
8058
8059       GetMem(ImageData, LineSize * Header.Height);
8060       try
8061         //column direction
8062         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
8063           Counter.X.low  := Header.Height-1;;
8064           Counter.X.high := 0;
8065           Counter.X.dir  := -1;
8066         end else begin
8067           Counter.X.low  := 0;
8068           Counter.X.high := Header.Height-1;
8069           Counter.X.dir  := 1;
8070         end;
8071
8072         // Row direction
8073         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
8074           Counter.Y.low  := 0;
8075           Counter.Y.high := Header.Height-1;
8076           Counter.Y.dir  := 1;
8077         end else begin
8078           Counter.Y.low  := Header.Height-1;;
8079           Counter.Y.high := 0;
8080           Counter.Y.dir  := -1;
8081         end;
8082
8083         // Read Image
8084         case Header.ImageType of
8085           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
8086             ReadUncompressed;
8087           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
8088             ReadCompressed;
8089         end;
8090
8091         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
8092         result := true;
8093       except
8094         if Assigned(ImageData) then
8095           FreeMem(ImageData);
8096         raise;
8097       end;
8098     finally
8099       aStream.Position := StartPosition;
8100     end;
8101   end
8102     else aStream.Position := StartPosition;
8103 end;
8104
8105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8106 procedure TglBitmap.SaveTGA(const aStream: TStream);
8107 var
8108   Header: TTGAHeader;
8109   Size: Integer;
8110   FormatDesc: TFormatDescriptor;
8111 begin
8112   if not (ftTGA in FormatGetSupportedFiles(Format)) then
8113     raise EglBitmapUnsupportedFormat.Create(Format);
8114
8115   //prepare header
8116   FormatDesc := TFormatDescriptor.Get(Format);
8117   FillChar(Header{%H-}, SizeOf(Header), 0);
8118   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
8119   Header.Bpp       := FormatDesc.BitsPerPixel;
8120   Header.Width     := Width;
8121   Header.Height    := Height;
8122   Header.ImageDesc := Header.ImageDesc or $20; //flip y
8123   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
8124     Header.ImageType := TGA_UNCOMPRESSED_GRAY
8125   else
8126     Header.ImageType := TGA_UNCOMPRESSED_RGB;
8127   aStream.Write(Header, SizeOf(Header));
8128
8129   // write Data
8130   Size := FormatDesc.GetSize(Dimension);
8131   aStream.Write(Data^, Size);
8132 end;
8133
8134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8135 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8137 const
8138   DDS_MAGIC: Cardinal         = $20534444;
8139
8140   // DDS_header.dwFlags
8141   DDSD_CAPS                   = $00000001;
8142   DDSD_HEIGHT                 = $00000002;
8143   DDSD_WIDTH                  = $00000004;
8144   DDSD_PIXELFORMAT            = $00001000;
8145
8146   // DDS_header.sPixelFormat.dwFlags
8147   DDPF_ALPHAPIXELS            = $00000001;
8148   DDPF_ALPHA                  = $00000002;
8149   DDPF_FOURCC                 = $00000004;
8150   DDPF_RGB                    = $00000040;
8151   DDPF_LUMINANCE              = $00020000;
8152
8153   // DDS_header.sCaps.dwCaps1
8154   DDSCAPS_TEXTURE             = $00001000;
8155
8156   // DDS_header.sCaps.dwCaps2
8157   DDSCAPS2_CUBEMAP            = $00000200;
8158
8159   D3DFMT_DXT1                 = $31545844;
8160   D3DFMT_DXT3                 = $33545844;
8161   D3DFMT_DXT5                 = $35545844;
8162
8163 type
8164   TDDSPixelFormat = packed record
8165     dwSize: Cardinal;
8166     dwFlags: Cardinal;
8167     dwFourCC: Cardinal;
8168     dwRGBBitCount: Cardinal;
8169     dwRBitMask: Cardinal;
8170     dwGBitMask: Cardinal;
8171     dwBBitMask: Cardinal;
8172     dwABitMask: Cardinal;
8173   end;
8174
8175   TDDSCaps = packed record
8176     dwCaps1: Cardinal;
8177     dwCaps2: Cardinal;
8178     dwDDSX: Cardinal;
8179     dwReserved: Cardinal;
8180   end;
8181
8182   TDDSHeader = packed record
8183     dwSize: Cardinal;
8184     dwFlags: Cardinal;
8185     dwHeight: Cardinal;
8186     dwWidth: Cardinal;
8187     dwPitchOrLinearSize: Cardinal;
8188     dwDepth: Cardinal;
8189     dwMipMapCount: Cardinal;
8190     dwReserved: array[0..10] of Cardinal;
8191     PixelFormat: TDDSPixelFormat;
8192     Caps: TDDSCaps;
8193     dwReserved2: Cardinal;
8194   end;
8195
8196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8197 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8198 var
8199   Header: TDDSHeader;
8200   Converter: TbmpBitfieldFormat;
8201
8202   function GetDDSFormat: TglBitmapFormat;
8203   var
8204     fd: TFormatDescriptor;
8205     i: Integer;
8206     Mask: TglBitmapRec4ul;
8207     Range: TglBitmapRec4ui;
8208     match: Boolean;
8209   begin
8210     result := tfEmpty;
8211     with Header.PixelFormat do begin
8212       // Compresses
8213       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8214         case Header.PixelFormat.dwFourCC of
8215           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8216           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8217           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8218         end;
8219       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
8220         // prepare masks
8221         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8222           Mask.r := dwRBitMask;
8223           Mask.g := dwGBitMask;
8224           Mask.b := dwBBitMask;
8225         end else begin
8226           Mask.r := dwRBitMask;
8227           Mask.g := dwRBitMask;
8228           Mask.b := dwRBitMask;
8229         end;
8230         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
8231           Mask.a := dwABitMask
8232         else
8233           Mask.a := 0;;
8234
8235         //find matching format
8236         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
8237         result := fd.Format;
8238         if (result <> tfEmpty) then
8239           exit;
8240
8241         //find format with same Range
8242         for i := 0 to 3 do
8243           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
8244         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8245           fd := TFormatDescriptor.Get(result);
8246           match := true;
8247           for i := 0 to 3 do
8248             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8249               match := false;
8250               break;
8251             end;
8252           if match then
8253             break;
8254         end;
8255
8256         //no format with same range found -> use default
8257         if (result = tfEmpty) then begin
8258           if (dwABitMask > 0) then
8259             result := tfRGBA8ui1
8260           else
8261             result := tfRGB8ub3;
8262         end;
8263
8264         Converter := TbmpBitfieldFormat.Create;
8265         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
8266       end;
8267     end;
8268   end;
8269
8270 var
8271   StreamPos: Int64;
8272   x, y, LineSize, RowSize, Magic: Cardinal;
8273   NewImage, TmpData, RowData, SrcData: System.PByte;
8274   SourceMD, DestMD: Pointer;
8275   Pixel: TglBitmapPixelData;
8276   ddsFormat: TglBitmapFormat;
8277   FormatDesc: TFormatDescriptor;
8278
8279 begin
8280   result    := false;
8281   Converter := nil;
8282   StreamPos := aStream.Position;
8283
8284   // Magic
8285   aStream.Read(Magic{%H-}, sizeof(Magic));
8286   if (Magic <> DDS_MAGIC) then begin
8287     aStream.Position := StreamPos;
8288     exit;
8289   end;
8290
8291   //Header
8292   aStream.Read(Header{%H-}, sizeof(Header));
8293   if (Header.dwSize <> SizeOf(Header)) or
8294      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8295         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8296   begin
8297     aStream.Position := StreamPos;
8298     exit;
8299   end;
8300
8301   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8302     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8303
8304   ddsFormat := GetDDSFormat;
8305   try
8306     if (ddsFormat = tfEmpty) then
8307       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8308
8309     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8310     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8311     GetMem(NewImage, Header.dwHeight * LineSize);
8312     try
8313       TmpData := NewImage;
8314
8315       //Converter needed
8316       if Assigned(Converter) then begin
8317         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8318         GetMem(RowData, RowSize);
8319         SourceMD := Converter.CreateMappingData;
8320         DestMD   := FormatDesc.CreateMappingData;
8321         try
8322           for y := 0 to Header.dwHeight-1 do begin
8323             TmpData := NewImage;
8324             inc(TmpData, y * LineSize);
8325             SrcData := RowData;
8326             aStream.Read(SrcData^, RowSize);
8327             for x := 0 to Header.dwWidth-1 do begin
8328               Converter.Unmap(SrcData, Pixel, SourceMD);
8329               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8330               FormatDesc.Map(Pixel, TmpData, DestMD);
8331             end;
8332           end;
8333         finally
8334           Converter.FreeMappingData(SourceMD);
8335           FormatDesc.FreeMappingData(DestMD);
8336           FreeMem(RowData);
8337         end;
8338       end else
8339
8340       // Compressed
8341       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8342         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8343         for Y := 0 to Header.dwHeight-1 do begin
8344           aStream.Read(TmpData^, RowSize);
8345           Inc(TmpData, LineSize);
8346         end;
8347       end else
8348
8349       // Uncompressed
8350       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8351         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8352         for Y := 0 to Header.dwHeight-1 do begin
8353           aStream.Read(TmpData^, RowSize);
8354           Inc(TmpData, LineSize);
8355         end;
8356       end else
8357         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8358
8359       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8360       result := true;
8361     except
8362       if Assigned(NewImage) then
8363         FreeMem(NewImage);
8364       raise;
8365     end;
8366   finally
8367     FreeAndNil(Converter);
8368   end;
8369 end;
8370
8371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8372 procedure TglBitmap.SaveDDS(const aStream: TStream);
8373 var
8374   Header: TDDSHeader;
8375   FormatDesc: TFormatDescriptor;
8376 begin
8377   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8378     raise EglBitmapUnsupportedFormat.Create(Format);
8379
8380   FormatDesc := TFormatDescriptor.Get(Format);
8381
8382   // Generell
8383   FillChar(Header{%H-}, SizeOf(Header), 0);
8384   Header.dwSize  := SizeOf(Header);
8385   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8386
8387   Header.dwWidth  := Max(1, Width);
8388   Header.dwHeight := Max(1, Height);
8389
8390   // Caps
8391   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8392
8393   // Pixelformat
8394   Header.PixelFormat.dwSize := sizeof(Header);
8395   if (FormatDesc.IsCompressed) then begin
8396     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8397     case Format of
8398       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8399       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8400       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8401     end;
8402   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8403     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8404     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8405     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8406   end else if FormatDesc.IsGrayscale then begin
8407     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8408     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8409     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8410     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8411   end else begin
8412     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8413     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8414     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8415     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8416     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8417     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8418   end;
8419
8420   if (FormatDesc.HasAlpha) then
8421     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8422
8423   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8424   aStream.Write(Header, SizeOf(Header));
8425   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8426 end;
8427
8428 {$IFNDEF OPENGL_ES}
8429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8430 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8432 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8433   const aWidth: Integer; const aHeight: Integer);
8434 var
8435   pTemp: pByte;
8436   Size: Integer;
8437 begin
8438   if (aHeight > 1) then begin
8439     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8440     GetMem(pTemp, Size);
8441     try
8442       Move(aData^, pTemp^, Size);
8443       FreeMem(aData);
8444       aData := nil;
8445     except
8446       FreeMem(pTemp);
8447       raise;
8448     end;
8449   end else
8450     pTemp := aData;
8451   inherited SetDataPointer(pTemp, aFormat, aWidth);
8452 end;
8453
8454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8455 function TglBitmap1D.FlipHorz: Boolean;
8456 var
8457   Col: Integer;
8458   pTempDest, pDest, pSource: PByte;
8459 begin
8460   result := inherited FlipHorz;
8461   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8462     pSource := Data;
8463     GetMem(pDest, fRowSize);
8464     try
8465       pTempDest := pDest;
8466       Inc(pTempDest, fRowSize);
8467       for Col := 0 to Width-1 do begin
8468         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8469         Move(pSource^, pTempDest^, fPixelSize);
8470         Inc(pSource, fPixelSize);
8471       end;
8472       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8473       result := true;
8474     except
8475       if Assigned(pDest) then
8476         FreeMem(pDest);
8477       raise;
8478     end;
8479   end;
8480 end;
8481
8482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8483 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8484 var
8485   FormatDesc: TFormatDescriptor;
8486 begin
8487   // Upload data
8488   FormatDesc := TFormatDescriptor.Get(Format);
8489   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8490     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8491
8492   if FormatDesc.IsCompressed then begin
8493     if not Assigned(glCompressedTexImage1D) then
8494       raise EglBitmap.Create('compressed formats not supported by video adapter');
8495     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8496   end else if aBuildWithGlu then
8497     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8498   else
8499     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8500
8501   // Free Data
8502   if (FreeDataAfterGenTexture) then
8503     FreeData;
8504 end;
8505
8506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8507 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8508 var
8509   BuildWithGlu, TexRec: Boolean;
8510   TexSize: Integer;
8511 begin
8512   if Assigned(Data) then begin
8513     // Check Texture Size
8514     if (aTestTextureSize) then begin
8515       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8516
8517       if (Width > TexSize) then
8518         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8519
8520       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8521                 (Target = GL_TEXTURE_RECTANGLE);
8522       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8523         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8524     end;
8525
8526     CreateId;
8527     SetupParameters(BuildWithGlu);
8528     UploadData(BuildWithGlu);
8529     glAreTexturesResident(1, @fID, @fIsResident);
8530   end;
8531 end;
8532
8533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8534 procedure TglBitmap1D.AfterConstruction;
8535 begin
8536   inherited;
8537   Target := GL_TEXTURE_1D;
8538 end;
8539 {$ENDIF}
8540
8541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8542 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8544 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8545 begin
8546   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8547     result := fLines[aIndex]
8548   else
8549     result := nil;
8550 end;
8551
8552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8553 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8554   const aWidth: Integer; const aHeight: Integer);
8555 var
8556   Idx, LineWidth: Integer;
8557 begin
8558   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8559
8560   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8561     // Assigning Data
8562     if Assigned(Data) then begin
8563       SetLength(fLines, GetHeight);
8564       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8565
8566       for Idx := 0 to GetHeight-1 do begin
8567         fLines[Idx] := Data;
8568         Inc(fLines[Idx], Idx * LineWidth);
8569       end;
8570     end
8571       else SetLength(fLines, 0);
8572   end else begin
8573     SetLength(fLines, 0);
8574   end;
8575 end;
8576
8577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8578 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8579 var
8580   FormatDesc: TFormatDescriptor;
8581 begin
8582   FormatDesc := TFormatDescriptor.Get(Format);
8583   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8584     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8585
8586   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8587
8588   if FormatDesc.IsCompressed then begin
8589     if not Assigned(glCompressedTexImage2D) then
8590       raise EglBitmap.Create('compressed formats not supported by video adapter');
8591     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8592 {$IFNDEF OPENGL_ES}
8593   end else if aBuildWithGlu then begin
8594     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8595       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8596 {$ENDIF}
8597   end else begin
8598     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8599       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8600   end;
8601
8602   // Freigeben
8603   if (FreeDataAfterGenTexture) then
8604     FreeData;
8605 end;
8606
8607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8608 procedure TglBitmap2D.AfterConstruction;
8609 begin
8610   inherited;
8611   Target := GL_TEXTURE_2D;
8612 end;
8613
8614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8615 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8616 var
8617   Temp: pByte;
8618   Size, w, h: Integer;
8619   FormatDesc: TFormatDescriptor;
8620 begin
8621   FormatDesc := TFormatDescriptor.Get(aFormat);
8622   if FormatDesc.IsCompressed then
8623     raise EglBitmapUnsupportedFormat.Create(aFormat);
8624
8625   w    := aRight  - aLeft;
8626   h    := aBottom - aTop;
8627   Size := FormatDesc.GetSize(w, h);
8628   GetMem(Temp, Size);
8629   try
8630     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8631     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8632     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8633     FlipVert;
8634   except
8635     if Assigned(Temp) then
8636       FreeMem(Temp);
8637     raise;
8638   end;
8639 end;
8640
8641 {$IFNDEF OPENGL_ES}
8642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8643 procedure TglBitmap2D.GetDataFromTexture;
8644 var
8645   Temp: PByte;
8646   TempWidth, TempHeight: Integer;
8647   TempIntFormat: GLint;
8648   IntFormat: TglBitmapFormat;
8649   FormatDesc: TFormatDescriptor;
8650 begin
8651   Bind;
8652
8653   // Request Data
8654   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8655   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8656   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8657
8658   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8659   IntFormat  := FormatDesc.Format;
8660
8661   // Getting data from OpenGL
8662   FormatDesc := TFormatDescriptor.Get(IntFormat);
8663   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8664   try
8665     if FormatDesc.IsCompressed then begin
8666       if not Assigned(glGetCompressedTexImage) then
8667         raise EglBitmap.Create('compressed formats not supported by video adapter');
8668       glGetCompressedTexImage(Target, 0, Temp)
8669     end else
8670       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8671     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8672   except
8673     if Assigned(Temp) then
8674       FreeMem(Temp);
8675     raise;
8676   end;
8677 end;
8678 {$ENDIF}
8679
8680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8681 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8682 var
8683   {$IFNDEF OPENGL_ES}
8684   BuildWithGlu, TexRec: Boolean;
8685   {$ENDIF}
8686   PotTex: Boolean;
8687   TexSize: Integer;
8688 begin
8689   if Assigned(Data) then begin
8690     // Check Texture Size
8691     if (aTestTextureSize) then begin
8692       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8693
8694       if ((Height > TexSize) or (Width > TexSize)) then
8695         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8696
8697       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8698 {$IF NOT DEFINED(OPENGL_ES)}
8699       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8700       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8701         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8702 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8703       if not PotTex and not GL_OES_texture_npot then
8704         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8705 {$ELSE}
8706       if not PotTex then
8707         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8708 {$IFEND}
8709     end;
8710
8711     CreateId;
8712     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8713     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8714 {$IFNDEF OPENGL_ES}
8715     glAreTexturesResident(1, @fID, @fIsResident);
8716 {$ENDIF}
8717   end;
8718 end;
8719
8720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8721 function TglBitmap2D.FlipHorz: Boolean;
8722 var
8723   Col, Row: Integer;
8724   TempDestData, DestData, SourceData: PByte;
8725   ImgSize: Integer;
8726 begin
8727   result := inherited FlipHorz;
8728   if Assigned(Data) then begin
8729     SourceData := Data;
8730     ImgSize := Height * fRowSize;
8731     GetMem(DestData, ImgSize);
8732     try
8733       TempDestData := DestData;
8734       Dec(TempDestData, fRowSize + fPixelSize);
8735       for Row := 0 to Height -1 do begin
8736         Inc(TempDestData, fRowSize * 2);
8737         for Col := 0 to Width -1 do begin
8738           Move(SourceData^, TempDestData^, fPixelSize);
8739           Inc(SourceData, fPixelSize);
8740           Dec(TempDestData, fPixelSize);
8741         end;
8742       end;
8743       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8744       result := true;
8745     except
8746       if Assigned(DestData) then
8747         FreeMem(DestData);
8748       raise;
8749     end;
8750   end;
8751 end;
8752
8753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8754 function TglBitmap2D.FlipVert: Boolean;
8755 var
8756   Row: Integer;
8757   TempDestData, DestData, SourceData: PByte;
8758 begin
8759   result := inherited FlipVert;
8760   if Assigned(Data) then begin
8761     SourceData := Data;
8762     GetMem(DestData, Height * fRowSize);
8763     try
8764       TempDestData := DestData;
8765       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8766       for Row := 0 to Height -1 do begin
8767         Move(SourceData^, TempDestData^, fRowSize);
8768         Dec(TempDestData, fRowSize);
8769         Inc(SourceData, fRowSize);
8770       end;
8771       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8772       result := true;
8773     except
8774       if Assigned(DestData) then
8775         FreeMem(DestData);
8776       raise;
8777     end;
8778   end;
8779 end;
8780
8781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8782 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8784 type
8785   TMatrixItem = record
8786     X, Y: Integer;
8787     W: Single;
8788   end;
8789
8790   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8791   TglBitmapToNormalMapRec = Record
8792     Scale: Single;
8793     Heights: array of Single;
8794     MatrixU : array of TMatrixItem;
8795     MatrixV : array of TMatrixItem;
8796   end;
8797
8798 const
8799   ONE_OVER_255 = 1 / 255;
8800
8801   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8802 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8803 var
8804   Val: Single;
8805 begin
8806   with FuncRec do begin
8807     Val :=
8808       Source.Data.r * LUMINANCE_WEIGHT_R +
8809       Source.Data.g * LUMINANCE_WEIGHT_G +
8810       Source.Data.b * LUMINANCE_WEIGHT_B;
8811     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8812   end;
8813 end;
8814
8815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8816 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8817 begin
8818   with FuncRec do
8819     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8820 end;
8821
8822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8823 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8824 type
8825   TVec = Array[0..2] of Single;
8826 var
8827   Idx: Integer;
8828   du, dv: Double;
8829   Len: Single;
8830   Vec: TVec;
8831
8832   function GetHeight(X, Y: Integer): Single;
8833   begin
8834     with FuncRec do begin
8835       X := Max(0, Min(Size.X -1, X));
8836       Y := Max(0, Min(Size.Y -1, Y));
8837       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8838     end;
8839   end;
8840
8841 begin
8842   with FuncRec do begin
8843     with PglBitmapToNormalMapRec(Args)^ do begin
8844       du := 0;
8845       for Idx := Low(MatrixU) to High(MatrixU) do
8846         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8847
8848       dv := 0;
8849       for Idx := Low(MatrixU) to High(MatrixU) do
8850         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8851
8852       Vec[0] := -du * Scale;
8853       Vec[1] := -dv * Scale;
8854       Vec[2] := 1;
8855     end;
8856
8857     // Normalize
8858     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8859     if Len <> 0 then begin
8860       Vec[0] := Vec[0] * Len;
8861       Vec[1] := Vec[1] * Len;
8862       Vec[2] := Vec[2] * Len;
8863     end;
8864
8865     // Farbe zuweisem
8866     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8867     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8868     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8869   end;
8870 end;
8871
8872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8873 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8874 var
8875   Rec: TglBitmapToNormalMapRec;
8876
8877   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8878   begin
8879     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8880       Matrix[Index].X := X;
8881       Matrix[Index].Y := Y;
8882       Matrix[Index].W := W;
8883     end;
8884   end;
8885
8886 begin
8887   if TFormatDescriptor.Get(Format).IsCompressed then
8888     raise EglBitmapUnsupportedFormat.Create(Format);
8889
8890   if aScale > 100 then
8891     Rec.Scale := 100
8892   else if aScale < -100 then
8893     Rec.Scale := -100
8894   else
8895     Rec.Scale := aScale;
8896
8897   SetLength(Rec.Heights, Width * Height);
8898   try
8899     case aFunc of
8900       nm4Samples: begin
8901         SetLength(Rec.MatrixU, 2);
8902         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8903         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8904
8905         SetLength(Rec.MatrixV, 2);
8906         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8907         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8908       end;
8909
8910       nmSobel: begin
8911         SetLength(Rec.MatrixU, 6);
8912         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8913         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8914         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8915         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8916         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8917         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8918
8919         SetLength(Rec.MatrixV, 6);
8920         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8921         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8922         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8923         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8924         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8925         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8926       end;
8927
8928       nm3x3: begin
8929         SetLength(Rec.MatrixU, 6);
8930         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8931         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8932         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8933         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8934         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8935         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8936
8937         SetLength(Rec.MatrixV, 6);
8938         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8939         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8940         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8941         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8942         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8943         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8944       end;
8945
8946       nm5x5: begin
8947         SetLength(Rec.MatrixU, 20);
8948         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8949         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8950         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8951         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8952         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8953         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8954         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8955         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8956         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8957         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8958         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8959         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8960         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8961         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8962         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8963         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8964         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8965         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8966         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8967         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8968
8969         SetLength(Rec.MatrixV, 20);
8970         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8971         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8972         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8973         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8974         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8975         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8976         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8977         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8978         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8979         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8980         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8981         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8982         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8983         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8984         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8985         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8986         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8987         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8988         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8989         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8990       end;
8991     end;
8992
8993     // Daten Sammeln
8994     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8995       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8996     else
8997       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8998     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8999   finally
9000     SetLength(Rec.Heights, 0);
9001   end;
9002 end;
9003
9004 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9006 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9008 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
9009 begin
9010   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
9011 end;
9012
9013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9014 procedure TglBitmapCubeMap.AfterConstruction;
9015 begin
9016   inherited;
9017
9018 {$IFNDEF OPENGL_ES}
9019   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
9020     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9021 {$ELSE}
9022   if not (GL_VERSION_2_0) then
9023     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9024 {$ENDIF}
9025
9026   SetWrap;
9027   Target   := GL_TEXTURE_CUBE_MAP;
9028 {$IFNDEF OPENGL_ES}
9029   fGenMode := GL_REFLECTION_MAP;
9030 {$ENDIF}
9031 end;
9032
9033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9034 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
9035 var
9036   {$IFNDEF OPENGL_ES}
9037   BuildWithGlu: Boolean;
9038   {$ENDIF}
9039   TexSize: Integer;
9040 begin
9041   if (aTestTextureSize) then begin
9042     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
9043
9044     if (Height > TexSize) or (Width > TexSize) then
9045       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
9046
9047 {$IF NOT DEFINED(OPENGL_ES)}
9048     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
9049       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9050 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
9051     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
9052       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9053 {$ELSE}
9054     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
9055       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9056 {$IFEND}
9057   end;
9058
9059   if (ID = 0) then
9060     CreateID;
9061   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
9062   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
9063 end;
9064
9065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9066 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
9067 begin
9068   inherited Bind (aEnableTextureUnit);
9069 {$IFNDEF OPENGL_ES}
9070   if aEnableTexCoordsGen then begin
9071     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
9072     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
9073     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
9074     glEnable(GL_TEXTURE_GEN_S);
9075     glEnable(GL_TEXTURE_GEN_T);
9076     glEnable(GL_TEXTURE_GEN_R);
9077   end;
9078 {$ENDIF}
9079 end;
9080
9081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9082 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
9083 begin
9084   inherited Unbind(aDisableTextureUnit);
9085 {$IFNDEF OPENGL_ES}
9086   if aDisableTexCoordsGen then begin
9087     glDisable(GL_TEXTURE_GEN_S);
9088     glDisable(GL_TEXTURE_GEN_T);
9089     glDisable(GL_TEXTURE_GEN_R);
9090   end;
9091 {$ENDIF}
9092 end;
9093 {$IFEND}
9094
9095 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9097 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9099 type
9100   TVec = Array[0..2] of Single;
9101   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9102
9103   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
9104   TglBitmapNormalMapRec = record
9105     HalfSize : Integer;
9106     Func: TglBitmapNormalMapGetVectorFunc;
9107   end;
9108
9109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9110 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9111 begin
9112   aVec[0] := aHalfSize;
9113   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9114   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
9115 end;
9116
9117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9118 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9119 begin
9120   aVec[0] := - aHalfSize;
9121   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9122   aVec[2] := aPosition.X + 0.5 - aHalfSize;
9123 end;
9124
9125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9126 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9127 begin
9128   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9129   aVec[1] := aHalfSize;
9130   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
9131 end;
9132
9133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9134 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9135 begin
9136   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9137   aVec[1] := - aHalfSize;
9138   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
9139 end;
9140
9141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9142 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9143 begin
9144   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9145   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9146   aVec[2] := aHalfSize;
9147 end;
9148
9149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9150 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9151 begin
9152   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
9153   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9154   aVec[2] := - aHalfSize;
9155 end;
9156
9157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9158 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
9159 var
9160   i: Integer;
9161   Vec: TVec;
9162   Len: Single;
9163 begin
9164   with FuncRec do begin
9165     with PglBitmapNormalMapRec(Args)^ do begin
9166       Func(Vec, Position, HalfSize);
9167
9168       // Normalize
9169       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9170       if Len <> 0 then begin
9171         Vec[0] := Vec[0] * Len;
9172         Vec[1] := Vec[1] * Len;
9173         Vec[2] := Vec[2] * Len;
9174       end;
9175
9176       // Scale Vector and AddVectro
9177       Vec[0] := Vec[0] * 0.5 + 0.5;
9178       Vec[1] := Vec[1] * 0.5 + 0.5;
9179       Vec[2] := Vec[2] * 0.5 + 0.5;
9180     end;
9181
9182     // Set Color
9183     for i := 0 to 2 do
9184       Dest.Data.arr[i] := Round(Vec[i] * 255);
9185   end;
9186 end;
9187
9188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9189 procedure TglBitmapNormalMap.AfterConstruction;
9190 begin
9191   inherited;
9192 {$IFNDEF OPENGL_ES}
9193   fGenMode := GL_NORMAL_MAP;
9194 {$ENDIF}
9195 end;
9196
9197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9198 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9199 var
9200   Rec: TglBitmapNormalMapRec;
9201   SizeRec: TglBitmapPixelPosition;
9202 begin
9203   Rec.HalfSize := aSize div 2;
9204   FreeDataAfterGenTexture := false;
9205
9206   SizeRec.Fields := [ffX, ffY];
9207   SizeRec.X := aSize;
9208   SizeRec.Y := aSize;
9209
9210   // Positive X
9211   Rec.Func := glBitmapNormalMapPosX;
9212   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9213   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9214
9215   // Negative X
9216   Rec.Func := glBitmapNormalMapNegX;
9217   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9218   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9219
9220   // Positive Y
9221   Rec.Func := glBitmapNormalMapPosY;
9222   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9223   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9224
9225   // Negative Y
9226   Rec.Func := glBitmapNormalMapNegY;
9227   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9228   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9229
9230   // Positive Z
9231   Rec.Func := glBitmapNormalMapPosZ;
9232   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9233   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9234
9235   // Negative Z
9236   Rec.Func := glBitmapNormalMapNegZ;
9237   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9238   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9239 end;
9240 {$IFEND}
9241
9242 initialization
9243   glBitmapSetDefaultFormat (tfEmpty);
9244   glBitmapSetDefaultMipmap (mmMipmap);
9245   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9246   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9247 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
9248   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9249 {$IFEND}
9250
9251   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9252   glBitmapSetDefaultDeleteTextureOnFree    (true);
9253
9254   TFormatDescriptor.Init;
9255
9256 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9257   OpenGLInitialized := false;
9258   InitOpenGLCS := TCriticalSection.Create;
9259 {$ENDIF}
9260
9261 finalization
9262   TFormatDescriptor.Finalize;
9263
9264 {$IFDEF GLB_NATIVE_OGL}
9265   if Assigned(GL_LibHandle) then
9266     glbFreeLibrary(GL_LibHandle);
9267
9268 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9269   if Assigned(GLU_LibHandle) then
9270     glbFreeLibrary(GLU_LibHandle);
9271   FreeAndNil(InitOpenGLCS);
9272 {$ENDIF}
9273 {$ENDIF}
9274
9275 end.