uglcBitmap.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 uglcBitmap;
 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   TglcBitmapFormat    = TglBitmapFormat;
1323   TglcBitmap2D        = TglBitmap2D;
1324 {$IF NOT DEFINED(OPENGL_ES)}
1325   TglcBitmap1D        = TglBitmap1D;
1326   TglcBitmapCubeMap   = TglBitmapCubeMap;
1327   TglcBitmapNormalMap = TglBitmapNormalMap;
1328 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
1329   TglcBitmapCubeMap   = TglBitmapCubeMap;
1330   TglcBitmapNormalMap = TglBitmapNormalMap;
1331 {$IFEND}
1332
1333 const
1334   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1335
1336 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1337 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1338 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1339 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1340 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1341 procedure glBitmapSetDefaultWrap(
1342   const S: Cardinal = GL_CLAMP_TO_EDGE;
1343   const T: Cardinal = GL_CLAMP_TO_EDGE;
1344   const R: Cardinal = GL_CLAMP_TO_EDGE);
1345
1346 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1347 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1348 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1349 function glBitmapGetDefaultFormat: TglBitmapFormat;
1350 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1351 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1352
1353 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1354 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1355 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1356 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1357 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1358 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1359
1360 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1361
1362 var
1363   glBitmapDefaultDeleteTextureOnFree: Boolean;
1364   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1365   glBitmapDefaultFormat: TglBitmapFormat;
1366   glBitmapDefaultMipmap: TglBitmapMipMap;
1367   glBitmapDefaultFilterMin: Cardinal;
1368   glBitmapDefaultFilterMag: Cardinal;
1369   glBitmapDefaultWrapS: Cardinal;
1370   glBitmapDefaultWrapT: Cardinal;
1371   glBitmapDefaultWrapR: Cardinal;
1372   glDefaultSwizzle: array[0..3] of GLenum;
1373
1374 {$IFDEF GLB_DELPHI}
1375 function CreateGrayPalette: HPALETTE;
1376 {$ENDIF}
1377
1378 implementation
1379
1380 uses
1381   Math, syncobjs, typinfo
1382   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1383
1384 ////////////////////////////////////////////////////////////////////////////////////////////////////
1385 type
1386   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1387   public
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1390
1391     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1392     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1393
1394     function CreateMappingData: Pointer; virtual;
1395     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1396
1397     function IsEmpty: Boolean; virtual;
1398     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1399
1400     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1401
1402     constructor Create; virtual;
1403   public
1404     class procedure Init;
1405     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1406     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1407     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1408     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1409     class procedure Clear;
1410     class procedure Finalize;
1411   end;
1412   TFormatDescriptorClass = class of TFormatDescriptor;
1413
1414   TfdEmpty = class(TFormatDescriptor);
1415
1416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1417   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1418     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1419     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1420   end;
1421
1422   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425   end;
1426
1427   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1428     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1429     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1430   end;
1431
1432   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435   end;
1436
1437   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1438     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1439     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1440   end;
1441
1442   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1443     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1444     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1445   end;
1446
1447   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
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   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1458   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1459     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1460     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1461   end;
1462
1463   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1464     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1465     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1466   end;
1467
1468   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1469     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1470     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1471   end;
1472
1473   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1474     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1475     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1476   end;
1477
1478   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1479     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1480     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1481   end;
1482
1483   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1484     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1485     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1486   end;
1487
1488   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1489     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1490     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1491   end;
1492
1493   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1494     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1495     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1496   end;
1497
1498   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1499     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1500     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1501   end;
1502
1503   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1515     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1516     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1517   end;
1518
1519   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1520     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1521     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1522   end;
1523
1524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1525   TfdAlpha4ub1 = class(TfdAlphaUB1)
1526     procedure SetValues; override;
1527   end;
1528
1529   TfdAlpha8ub1 = class(TfdAlphaUB1)
1530     procedure SetValues; override;
1531   end;
1532
1533   TfdAlpha16us1 = class(TfdAlphaUS1)
1534     procedure SetValues; override;
1535   end;
1536
1537   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1538     procedure SetValues; override;
1539   end;
1540
1541   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1542     procedure SetValues; override;
1543   end;
1544
1545   TfdLuminance16us1 = class(TfdLuminanceUS1)
1546     procedure SetValues; override;
1547   end;
1548
1549   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1550     procedure SetValues; override;
1551   end;
1552
1553   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1554     procedure SetValues; override;
1555   end;
1556
1557   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1558     procedure SetValues; override;
1559   end;
1560
1561   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1562     procedure SetValues; override;
1563   end;
1564
1565   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1566     procedure SetValues; override;
1567   end;
1568
1569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1570   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1571     procedure SetValues; override;
1572   end;
1573
1574   TfdRGBX4us1 = class(TfdUniversalUS1)
1575     procedure SetValues; override;
1576   end;
1577
1578   TfdXRGB4us1 = class(TfdUniversalUS1)
1579     procedure SetValues; override;
1580   end;
1581
1582   TfdR5G6B5us1 = class(TfdUniversalUS1)
1583     procedure SetValues; override;
1584   end;
1585
1586   TfdRGB5X1us1 = class(TfdUniversalUS1)
1587     procedure SetValues; override;
1588   end;
1589
1590   TfdX1RGB5us1 = class(TfdUniversalUS1)
1591     procedure SetValues; override;
1592   end;
1593
1594   TfdRGB8ub3 = class(TfdRGBub3)
1595     procedure SetValues; override;
1596   end;
1597
1598   TfdRGBX8ui1 = class(TfdUniversalUI1)
1599     procedure SetValues; override;
1600   end;
1601
1602   TfdXRGB8ui1 = class(TfdUniversalUI1)
1603     procedure SetValues; override;
1604   end;
1605
1606   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1607     procedure SetValues; override;
1608   end;
1609
1610   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1611     procedure SetValues; override;
1612   end;
1613
1614   TfdRGB16us3 = class(TfdRGBus3)
1615     procedure SetValues; override;
1616   end;
1617
1618   TfdRGBA4us1 = class(TfdUniversalUS1)
1619     procedure SetValues; override;
1620   end;
1621
1622   TfdARGB4us1 = class(TfdUniversalUS1)
1623     procedure SetValues; override;
1624   end;
1625
1626   TfdRGB5A1us1 = class(TfdUniversalUS1)
1627     procedure SetValues; override;
1628   end;
1629
1630   TfdA1RGB5us1 = class(TfdUniversalUS1)
1631     procedure SetValues; override;
1632   end;
1633
1634   TfdRGBA8ui1 = class(TfdUniversalUI1)
1635     procedure SetValues; override;
1636   end;
1637
1638   TfdARGB8ui1 = class(TfdUniversalUI1)
1639     procedure SetValues; override;
1640   end;
1641
1642   TfdRGBA8ub4 = class(TfdRGBAub4)
1643     procedure SetValues; override;
1644   end;
1645
1646   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1647     procedure SetValues; override;
1648   end;
1649
1650   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1651     procedure SetValues; override;
1652   end;
1653
1654   TfdRGBA16us4 = class(TfdRGBAus4)
1655     procedure SetValues; override;
1656   end;
1657
1658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1659   TfdBGRX4us1 = class(TfdUniversalUS1)
1660     procedure SetValues; override;
1661   end;
1662
1663   TfdXBGR4us1 = class(TfdUniversalUS1)
1664     procedure SetValues; override;
1665   end;
1666
1667   TfdB5G6R5us1 = class(TfdUniversalUS1)
1668     procedure SetValues; override;
1669   end;
1670
1671   TfdBGR5X1us1 = class(TfdUniversalUS1)
1672     procedure SetValues; override;
1673   end;
1674
1675   TfdX1BGR5us1 = class(TfdUniversalUS1)
1676     procedure SetValues; override;
1677   end;
1678
1679   TfdBGR8ub3 = class(TfdBGRub3)
1680     procedure SetValues; override;
1681   end;
1682
1683   TfdBGRX8ui1 = class(TfdUniversalUI1)
1684     procedure SetValues; override;
1685   end;
1686
1687   TfdXBGR8ui1 = class(TfdUniversalUI1)
1688     procedure SetValues; override;
1689   end;
1690
1691   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1692     procedure SetValues; override;
1693   end;
1694
1695   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1696     procedure SetValues; override;
1697   end;
1698
1699   TfdBGR16us3 = class(TfdBGRus3)
1700     procedure SetValues; override;
1701   end;
1702
1703   TfdBGRA4us1 = class(TfdUniversalUS1)
1704     procedure SetValues; override;
1705   end;
1706
1707   TfdABGR4us1 = class(TfdUniversalUS1)
1708     procedure SetValues; override;
1709   end;
1710
1711   TfdBGR5A1us1 = class(TfdUniversalUS1)
1712     procedure SetValues; override;
1713   end;
1714
1715   TfdA1BGR5us1 = class(TfdUniversalUS1)
1716     procedure SetValues; override;
1717   end;
1718
1719   TfdBGRA8ui1 = class(TfdUniversalUI1)
1720     procedure SetValues; override;
1721   end;
1722
1723   TfdABGR8ui1 = class(TfdUniversalUI1)
1724     procedure SetValues; override;
1725   end;
1726
1727   TfdBGRA8ub4 = class(TfdBGRAub4)
1728     procedure SetValues; override;
1729   end;
1730
1731   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1732     procedure SetValues; override;
1733   end;
1734
1735   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1736     procedure SetValues; override;
1737   end;
1738
1739   TfdBGRA16us4 = class(TfdBGRAus4)
1740     procedure SetValues; override;
1741   end;
1742
1743   TfdDepth16us1 = class(TfdDepthUS1)
1744     procedure SetValues; override;
1745   end;
1746
1747   TfdDepth24ui1 = class(TfdDepthUI1)
1748     procedure SetValues; override;
1749   end;
1750
1751   TfdDepth32ui1 = class(TfdDepthUI1)
1752     procedure SetValues; override;
1753   end;
1754
1755   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1756     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1757     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1758     procedure SetValues; override;
1759   end;
1760
1761   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1762     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1763     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1764     procedure SetValues; override;
1765   end;
1766
1767   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1768     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1769     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1770     procedure SetValues; override;
1771   end;
1772
1773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774   TbmpBitfieldFormat = class(TFormatDescriptor)
1775   public
1776     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1777     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1778     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1779     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1780   end;
1781
1782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1783   TbmpColorTableEnty = packed record
1784     b, g, r, a: Byte;
1785   end;
1786   TbmpColorTable = array of TbmpColorTableEnty;
1787   TbmpColorTableFormat = class(TFormatDescriptor)
1788   private
1789     fBitsPerPixel: Integer;
1790     fColorTable: TbmpColorTable;
1791   protected
1792     procedure SetValues; override;
1793   public
1794     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1795     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1796
1797     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1798     procedure CalcValues;
1799     procedure CreateColorTable;
1800
1801     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1802     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1803     destructor Destroy; override;
1804   end;
1805
1806 const
1807   LUMINANCE_WEIGHT_R = 0.30;
1808   LUMINANCE_WEIGHT_G = 0.59;
1809   LUMINANCE_WEIGHT_B = 0.11;
1810
1811   ALPHA_WEIGHT_R = 0.30;
1812   ALPHA_WEIGHT_G = 0.59;
1813   ALPHA_WEIGHT_B = 0.11;
1814
1815   DEPTH_WEIGHT_R = 0.333333333;
1816   DEPTH_WEIGHT_G = 0.333333333;
1817   DEPTH_WEIGHT_B = 0.333333333;
1818
1819   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1820     TfdEmpty,
1821
1822     TfdAlpha4ub1,
1823     TfdAlpha8ub1,
1824     TfdAlpha16us1,
1825
1826     TfdLuminance4ub1,
1827     TfdLuminance8ub1,
1828     TfdLuminance16us1,
1829
1830     TfdLuminance4Alpha4ub2,
1831     TfdLuminance6Alpha2ub2,
1832     TfdLuminance8Alpha8ub2,
1833     TfdLuminance12Alpha4us2,
1834     TfdLuminance16Alpha16us2,
1835
1836     TfdR3G3B2ub1,
1837     TfdRGBX4us1,
1838     TfdXRGB4us1,
1839     TfdR5G6B5us1,
1840     TfdRGB5X1us1,
1841     TfdX1RGB5us1,
1842     TfdRGB8ub3,
1843     TfdRGBX8ui1,
1844     TfdXRGB8ui1,
1845     TfdRGB10X2ui1,
1846     TfdX2RGB10ui1,
1847     TfdRGB16us3,
1848
1849     TfdRGBA4us1,
1850     TfdARGB4us1,
1851     TfdRGB5A1us1,
1852     TfdA1RGB5us1,
1853     TfdRGBA8ui1,
1854     TfdARGB8ui1,
1855     TfdRGBA8ub4,
1856     TfdRGB10A2ui1,
1857     TfdA2RGB10ui1,
1858     TfdRGBA16us4,
1859
1860     TfdBGRX4us1,
1861     TfdXBGR4us1,
1862     TfdB5G6R5us1,
1863     TfdBGR5X1us1,
1864     TfdX1BGR5us1,
1865     TfdBGR8ub3,
1866     TfdBGRX8ui1,
1867     TfdXBGR8ui1,
1868     TfdBGR10X2ui1,
1869     TfdX2BGR10ui1,
1870     TfdBGR16us3,
1871
1872     TfdBGRA4us1,
1873     TfdABGR4us1,
1874     TfdBGR5A1us1,
1875     TfdA1BGR5us1,
1876     TfdBGRA8ui1,
1877     TfdABGR8ui1,
1878     TfdBGRA8ub4,
1879     TfdBGR10A2ui1,
1880     TfdA2BGR10ui1,
1881     TfdBGRA16us4,
1882
1883     TfdDepth16us1,
1884     TfdDepth24ui1,
1885     TfdDepth32ui1,
1886
1887     TfdS3tcDtx1RGBA,
1888     TfdS3tcDtx3RGBA,
1889     TfdS3tcDtx5RGBA
1890   );
1891
1892 var
1893   FormatDescriptorCS: TCriticalSection;
1894   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1895
1896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1897 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1898 begin
1899   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1900 end;
1901
1902 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1903 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1904 begin
1905   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1906 end;
1907
1908 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1909 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1910 begin
1911   result.Fields := [];
1912
1913   if X >= 0 then
1914     result.Fields := result.Fields + [ffX];
1915   if Y >= 0 then
1916     result.Fields := result.Fields + [ffY];
1917
1918   result.X := Max(0, X);
1919   result.Y := Max(0, Y);
1920 end;
1921
1922 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1923 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1924 begin
1925   result.r := r;
1926   result.g := g;
1927   result.b := b;
1928   result.a := a;
1929 end;
1930
1931 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1932 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1933 begin
1934   result.r := r;
1935   result.g := g;
1936   result.b := b;
1937   result.a := a;
1938 end;
1939
1940 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1941 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1942 begin
1943   result.r := r;
1944   result.g := g;
1945   result.b := b;
1946   result.a := a;
1947 end;
1948
1949 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1950 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1951 var
1952   i: Integer;
1953 begin
1954   result := false;
1955   for i := 0 to high(r1.arr) do
1956     if (r1.arr[i] <> r2.arr[i]) then
1957       exit;
1958   result := true;
1959 end;
1960
1961 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1962 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1963 var
1964   i: Integer;
1965 begin
1966   result := false;
1967   for i := 0 to high(r1.arr) do
1968     if (r1.arr[i] <> r2.arr[i]) then
1969       exit;
1970   result := true;
1971 end;
1972
1973 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1974 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1975 var
1976   desc: TFormatDescriptor;
1977   p, tmp: PByte;
1978   x, y, i: Integer;
1979   md: Pointer;
1980   px: TglBitmapPixelData;
1981 begin
1982   result := nil;
1983   desc := TFormatDescriptor.Get(aFormat);
1984   if (desc.IsCompressed) or (desc.glFormat = 0) then
1985     exit;
1986
1987   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1988   md := desc.CreateMappingData;
1989   try
1990     tmp := p;
1991     desc.PreparePixel(px);
1992     for y := 0 to 4 do
1993       for x := 0 to 4 do begin
1994         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1995         for i := 0 to 3 do begin
1996           if ((y < 3) and (y = i)) or
1997              ((y = 3) and (i < 3)) or
1998              ((y = 4) and (i = 3))
1999           then
2000             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
2001           else if ((y < 4) and (i = 3)) or
2002                   ((y = 4) and (i < 3))
2003           then
2004             px.Data.arr[i] := px.Range.arr[i]
2005           else
2006             px.Data.arr[i] := 0; //px.Range.arr[i];
2007         end;
2008         desc.Map(px, tmp, md);
2009       end;
2010   finally
2011     desc.FreeMappingData(md);
2012   end;
2013
2014   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
2015   result.FreeDataOnDestroy       := true;
2016   result.FreeDataAfterGenTexture := false;
2017   result.SetFilter(GL_NEAREST, GL_NEAREST);
2018 end;
2019
2020 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2021 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
2022 begin
2023   result.r := r;
2024   result.g := g;
2025   result.b := b;
2026   result.a := a;
2027 end;
2028
2029 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2030 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
2031 begin
2032   result := [];
2033
2034   if (aFormat in [
2035         //8bpp
2036         tfAlpha4ub1, tfAlpha8ub1,
2037         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
2038
2039         //16bpp
2040         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2041         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
2042         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
2043
2044         //24bpp
2045         tfBGR8ub3, tfRGB8ub3,
2046
2047         //32bpp
2048         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
2049         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2050   then
2051     result := result + [ ftBMP ];
2052
2053   if (aFormat in [
2054         //8bbp
2055         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2056
2057         //16bbp
2058         tfAlpha16us1, tfLuminance16us1,
2059         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2060         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2061
2062         //24bbp
2063         tfBGR8ub3,
2064
2065         //32bbp
2066         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2067         tfDepth24ui1, tfDepth32ui1])
2068   then
2069     result := result + [ftTGA];
2070
2071   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2072     result := result + [ftDDS];
2073
2074 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2075   if aFormat in [
2076       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2077       tfRGB8ub3, tfRGBA8ui1,
2078       tfBGR8ub3, tfBGRA8ui1] then
2079     result := result + [ftPNG];
2080 {$ENDIF}
2081
2082 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2083   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2084     result := result + [ftJPEG];
2085 {$ENDIF}
2086 end;
2087
2088 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 function IsPowerOfTwo(aNumber: Integer): Boolean;
2090 begin
2091   while (aNumber and 1) = 0 do
2092     aNumber := aNumber shr 1;
2093   result := aNumber = 1;
2094 end;
2095
2096 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2097 function GetTopMostBit(aBitSet: QWord): Integer;
2098 begin
2099   result := 0;
2100   while aBitSet > 0 do begin
2101     inc(result);
2102     aBitSet := aBitSet shr 1;
2103   end;
2104 end;
2105
2106 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2107 function CountSetBits(aBitSet: QWord): Integer;
2108 begin
2109   result := 0;
2110   while aBitSet > 0 do begin
2111     if (aBitSet and 1) = 1 then
2112       inc(result);
2113     aBitSet := aBitSet shr 1;
2114   end;
2115 end;
2116
2117 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2118 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2119 begin
2120   result := Trunc(
2121     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2122     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2123     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2124 end;
2125
2126 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2127 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2128 begin
2129   result := Trunc(
2130     DEPTH_WEIGHT_R * aPixel.Data.r +
2131     DEPTH_WEIGHT_G * aPixel.Data.g +
2132     DEPTH_WEIGHT_B * aPixel.Data.b);
2133 end;
2134
2135 {$IFDEF GLB_NATIVE_OGL}
2136 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2137 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2138 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2139 var
2140   GL_LibHandle: Pointer = nil;
2141
2142 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2143 begin
2144   if not Assigned(aLibHandle) then
2145     aLibHandle := GL_LibHandle;
2146
2147 {$IF DEFINED(GLB_WIN)}
2148   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2149   if Assigned(result) then
2150     exit;
2151
2152   if Assigned(wglGetProcAddress) then
2153     result := wglGetProcAddress(aProcName);
2154 {$ELSEIF DEFINED(GLB_LINUX)}
2155   if Assigned(glXGetProcAddress) then begin
2156     result := glXGetProcAddress(aProcName);
2157     if Assigned(result) then
2158       exit;
2159   end;
2160
2161   if Assigned(glXGetProcAddressARB) then begin
2162     result := glXGetProcAddressARB(aProcName);
2163     if Assigned(result) then
2164       exit;
2165   end;
2166
2167   result := dlsym(aLibHandle, aProcName);
2168 {$IFEND}
2169   if not Assigned(result) and aRaiseOnErr then
2170     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2171 end;
2172
2173 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2174 var
2175   GLU_LibHandle: Pointer = nil;
2176   OpenGLInitialized: Boolean;
2177   InitOpenGLCS: TCriticalSection;
2178
2179 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2180 procedure glbInitOpenGL;
2181
2182   ////////////////////////////////////////////////////////////////////////////////
2183   function glbLoadLibrary(const aName: PChar): Pointer;
2184   begin
2185     {$IF DEFINED(GLB_WIN)}
2186     result := {%H-}Pointer(LoadLibrary(aName));
2187     {$ELSEIF DEFINED(GLB_LINUX)}
2188     result := dlopen(Name, RTLD_LAZY);
2189     {$ELSE}
2190     result := nil;
2191     {$IFEND}
2192   end;
2193
2194   ////////////////////////////////////////////////////////////////////////////////
2195   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2196   begin
2197     result := false;
2198     if not Assigned(aLibHandle) then
2199       exit;
2200
2201     {$IF DEFINED(GLB_WIN)}
2202     Result := FreeLibrary({%H-}HINST(aLibHandle));
2203     {$ELSEIF DEFINED(GLB_LINUX)}
2204     Result := dlclose(aLibHandle) = 0;
2205     {$IFEND}
2206   end;
2207
2208 begin
2209   if Assigned(GL_LibHandle) then
2210     glbFreeLibrary(GL_LibHandle);
2211
2212   if Assigned(GLU_LibHandle) then
2213     glbFreeLibrary(GLU_LibHandle);
2214
2215   GL_LibHandle := glbLoadLibrary(libopengl);
2216   if not Assigned(GL_LibHandle) then
2217     raise EglBitmap.Create('unable to load library: ' + libopengl);
2218
2219   GLU_LibHandle := glbLoadLibrary(libglu);
2220   if not Assigned(GLU_LibHandle) then
2221     raise EglBitmap.Create('unable to load library: ' + libglu);
2222
2223 {$IF DEFINED(GLB_WIN)}
2224   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2225 {$ELSEIF DEFINED(GLB_LINUX)}
2226   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2227   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2228 {$IFEND}
2229
2230   glEnable := glbGetProcAddress('glEnable');
2231   glDisable := glbGetProcAddress('glDisable');
2232   glGetString := glbGetProcAddress('glGetString');
2233   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2234   glTexParameteri := glbGetProcAddress('glTexParameteri');
2235   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2236   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2237   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2238   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2239   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2240   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2241   glTexGeni := glbGetProcAddress('glTexGeni');
2242   glGenTextures := glbGetProcAddress('glGenTextures');
2243   glBindTexture := glbGetProcAddress('glBindTexture');
2244   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2245   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2246   glReadPixels := glbGetProcAddress('glReadPixels');
2247   glPixelStorei := glbGetProcAddress('glPixelStorei');
2248   glTexImage1D := glbGetProcAddress('glTexImage1D');
2249   glTexImage2D := glbGetProcAddress('glTexImage2D');
2250   glGetTexImage := glbGetProcAddress('glGetTexImage');
2251
2252   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2253   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2254 end;
2255 {$ENDIF}
2256
2257 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2258 procedure glbReadOpenGLExtensions;
2259 var
2260   Buffer: AnsiString;
2261   MajorVersion, MinorVersion: Integer;
2262
2263   ///////////////////////////////////////////////////////////////////////////////////////////
2264   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2265   var
2266     Separator: Integer;
2267   begin
2268     aMinor := 0;
2269     aMajor := 0;
2270
2271     Separator := Pos(AnsiString('.'), aBuffer);
2272     if (Separator > 1) and (Separator < Length(aBuffer)) and
2273        (aBuffer[Separator - 1] in ['0'..'9']) and
2274        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2275
2276       Dec(Separator);
2277       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2278         Dec(Separator);
2279
2280       Delete(aBuffer, 1, Separator);
2281       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2282
2283       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2284         Inc(Separator);
2285
2286       Delete(aBuffer, Separator, 255);
2287       Separator := Pos(AnsiString('.'), aBuffer);
2288
2289       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2290       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2291     end;
2292   end;
2293
2294   ///////////////////////////////////////////////////////////////////////////////////////////
2295   function CheckExtension(const Extension: AnsiString): Boolean;
2296   var
2297     ExtPos: Integer;
2298   begin
2299     ExtPos := Pos(Extension, Buffer);
2300     result := ExtPos > 0;
2301     if result then
2302       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2303   end;
2304
2305   ///////////////////////////////////////////////////////////////////////////////////////////
2306   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2307   begin
2308     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2309   end;
2310
2311 begin
2312 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2313   InitOpenGLCS.Enter;
2314   try
2315     if not OpenGLInitialized then begin
2316       glbInitOpenGL;
2317       OpenGLInitialized := true;
2318     end;
2319   finally
2320     InitOpenGLCS.Leave;
2321   end;
2322 {$ENDIF}
2323
2324   // Version
2325   Buffer := glGetString(GL_VERSION);
2326   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2327
2328   GL_VERSION_1_2 := CheckVersion(1, 2);
2329   GL_VERSION_1_3 := CheckVersion(1, 3);
2330   GL_VERSION_1_4 := CheckVersion(1, 4);
2331   GL_VERSION_2_0 := CheckVersion(2, 0);
2332   GL_VERSION_3_3 := CheckVersion(3, 3);
2333
2334   // Extensions
2335   Buffer := glGetString(GL_EXTENSIONS);
2336   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2337   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2338   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2339   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2340   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2341   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2342   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2343   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2344   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2345   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2346   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2347   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2348   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2349   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2350
2351   if GL_VERSION_1_3 then begin
2352     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2353     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2354     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2355   end else begin
2356     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2357     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2358     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2359   end;
2360 end;
2361 {$ENDIF}
2362
2363 {$IFDEF GLB_SDL_IMAGE}
2364 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2368 begin
2369   result := TStream(context^.unknown.data1).Seek(offset, whence);
2370 end;
2371
2372 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2373 begin
2374   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2375 end;
2376
2377 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2378 begin
2379   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2380 end;
2381
2382 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2383 begin
2384   result := 0;
2385 end;
2386
2387 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2388 begin
2389   result := SDL_AllocRW;
2390
2391   if result = nil then
2392     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2393
2394   result^.seek := glBitmapRWseek;
2395   result^.read := glBitmapRWread;
2396   result^.write := glBitmapRWwrite;
2397   result^.close := glBitmapRWclose;
2398   result^.unknown.data1 := Stream;
2399 end;
2400 {$ENDIF}
2401
2402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2404 begin
2405   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2406 end;
2407
2408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2409 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2410 begin
2411   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2412 end;
2413
2414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2415 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2416 begin
2417   glBitmapDefaultMipmap := aValue;
2418 end;
2419
2420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2421 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2422 begin
2423   glBitmapDefaultFormat := aFormat;
2424 end;
2425
2426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2428 begin
2429   glBitmapDefaultFilterMin := aMin;
2430   glBitmapDefaultFilterMag := aMag;
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2435 begin
2436   glBitmapDefaultWrapS := S;
2437   glBitmapDefaultWrapT := T;
2438   glBitmapDefaultWrapR := R;
2439 end;
2440
2441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2442 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2443 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2444 begin
2445   glDefaultSwizzle[0] := r;
2446   glDefaultSwizzle[1] := g;
2447   glDefaultSwizzle[2] := b;
2448   glDefaultSwizzle[3] := a;
2449 end;
2450 {$IFEND}
2451
2452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2454 begin
2455   result := glBitmapDefaultDeleteTextureOnFree;
2456 end;
2457
2458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2460 begin
2461   result := glBitmapDefaultFreeDataAfterGenTextures;
2462 end;
2463
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2466 begin
2467   result := glBitmapDefaultMipmap;
2468 end;
2469
2470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2471 function glBitmapGetDefaultFormat: TglBitmapFormat;
2472 begin
2473   result := glBitmapDefaultFormat;
2474 end;
2475
2476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2477 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2478 begin
2479   aMin := glBitmapDefaultFilterMin;
2480   aMag := glBitmapDefaultFilterMag;
2481 end;
2482
2483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2484 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2485 begin
2486   S := glBitmapDefaultWrapS;
2487   T := glBitmapDefaultWrapT;
2488   R := glBitmapDefaultWrapR;
2489 end;
2490
2491 {$IFNDEF OPENGL_ES}
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2494 begin
2495   r := glDefaultSwizzle[0];
2496   g := glDefaultSwizzle[1];
2497   b := glDefaultSwizzle[2];
2498   a := glDefaultSwizzle[3];
2499 end;
2500 {$ENDIF}
2501
2502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2503 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2505 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2506 var
2507   w, h: Integer;
2508 begin
2509   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2510     w := Max(1, aSize.X);
2511     h := Max(1, aSize.Y);
2512     result := GetSize(w, h);
2513   end else
2514     result := 0;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2519 begin
2520   result := 0;
2521   if (aWidth <= 0) or (aHeight <= 0) then
2522     exit;
2523   result := Ceil(aWidth * aHeight * BytesPerPixel);
2524 end;
2525
2526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 function TFormatDescriptor.CreateMappingData: Pointer;
2528 begin
2529   result := nil;
2530 end;
2531
2532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2533 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2534 begin
2535   //DUMMY
2536 end;
2537
2538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2539 function TFormatDescriptor.IsEmpty: Boolean;
2540 begin
2541   result := (fFormat = tfEmpty);
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2546 var
2547   i: Integer;
2548   m: TglBitmapRec4ul;
2549 begin
2550   result := false;
2551   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2552     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2553   m := Mask;
2554   for i := 0 to 3 do
2555     if (aMask.arr[i] <> m.arr[i]) then
2556       exit;
2557   result := true;
2558 end;
2559
2560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2561 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2562 begin
2563   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2564   aPixel.Data   := Range;
2565   aPixel.Format := fFormat;
2566   aPixel.Range  := Range;
2567 end;
2568
2569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 constructor TFormatDescriptor.Create;
2571 begin
2572   inherited Create;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   aData^ := aPixel.Data.a;
2581   inc(aData);
2582 end;
2583
2584 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2585 begin
2586   aPixel.Data.r := 0;
2587   aPixel.Data.g := 0;
2588   aPixel.Data.b := 0;
2589   aPixel.Data.a := aData^;
2590   inc(aData);
2591 end;
2592
2593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2594 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2595 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2596 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2597 begin
2598   aData^ := LuminanceWeight(aPixel);
2599   inc(aData);
2600 end;
2601
2602 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2603 begin
2604   aPixel.Data.r := aData^;
2605   aPixel.Data.g := aData^;
2606   aPixel.Data.b := aData^;
2607   aPixel.Data.a := 0;
2608   inc(aData);
2609 end;
2610
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2615 var
2616   i: Integer;
2617 begin
2618   aData^ := 0;
2619   for i := 0 to 3 do
2620     if (Range.arr[i] > 0) then
2621       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2622   inc(aData);
2623 end;
2624
2625 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2626 var
2627   i: Integer;
2628 begin
2629   for i := 0 to 3 do
2630     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2631   inc(aData);
2632 end;
2633
2634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2635 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2637 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2638 begin
2639   inherited Map(aPixel, aData, aMapData);
2640   aData^ := aPixel.Data.a;
2641   inc(aData);
2642 end;
2643
2644 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2645 begin
2646   inherited Unmap(aData, aPixel, aMapData);
2647   aPixel.Data.a := aData^;
2648   inc(aData);
2649 end;
2650
2651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2654 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2655 begin
2656   aData^ := aPixel.Data.r;
2657   inc(aData);
2658   aData^ := aPixel.Data.g;
2659   inc(aData);
2660   aData^ := aPixel.Data.b;
2661   inc(aData);
2662 end;
2663
2664 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2665 begin
2666   aPixel.Data.r := aData^;
2667   inc(aData);
2668   aPixel.Data.g := aData^;
2669   inc(aData);
2670   aPixel.Data.b := aData^;
2671   inc(aData);
2672   aPixel.Data.a := 0;
2673 end;
2674
2675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2679 begin
2680   aData^ := aPixel.Data.b;
2681   inc(aData);
2682   aData^ := aPixel.Data.g;
2683   inc(aData);
2684   aData^ := aPixel.Data.r;
2685   inc(aData);
2686 end;
2687
2688 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2689 begin
2690   aPixel.Data.b := aData^;
2691   inc(aData);
2692   aPixel.Data.g := aData^;
2693   inc(aData);
2694   aPixel.Data.r := aData^;
2695   inc(aData);
2696   aPixel.Data.a := 0;
2697 end;
2698
2699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2702 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2703 begin
2704   inherited Map(aPixel, aData, aMapData);
2705   aData^ := aPixel.Data.a;
2706   inc(aData);
2707 end;
2708
2709 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2710 begin
2711   inherited Unmap(aData, aPixel, aMapData);
2712   aPixel.Data.a := aData^;
2713   inc(aData);
2714 end;
2715
2716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2717 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2719 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2720 begin
2721   inherited Map(aPixel, aData, aMapData);
2722   aData^ := aPixel.Data.a;
2723   inc(aData);
2724 end;
2725
2726 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2727 begin
2728   inherited Unmap(aData, aPixel, aMapData);
2729   aPixel.Data.a := aData^;
2730   inc(aData);
2731 end;
2732
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2737 begin
2738   PWord(aData)^ := aPixel.Data.a;
2739   inc(aData, 2);
2740 end;
2741
2742 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2743 begin
2744   aPixel.Data.r := 0;
2745   aPixel.Data.g := 0;
2746   aPixel.Data.b := 0;
2747   aPixel.Data.a := PWord(aData)^;
2748   inc(aData, 2);
2749 end;
2750
2751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2752 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2754 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2755 begin
2756   PWord(aData)^ := LuminanceWeight(aPixel);
2757   inc(aData, 2);
2758 end;
2759
2760 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2761 begin
2762   aPixel.Data.r := PWord(aData)^;
2763   aPixel.Data.g := PWord(aData)^;
2764   aPixel.Data.b := PWord(aData)^;
2765   aPixel.Data.a := 0;
2766   inc(aData, 2);
2767 end;
2768
2769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2770 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2772 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2773 var
2774   i: Integer;
2775 begin
2776   PWord(aData)^ := 0;
2777   for i := 0 to 3 do
2778     if (Range.arr[i] > 0) then
2779       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2780   inc(aData, 2);
2781 end;
2782
2783 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2784 var
2785   i: Integer;
2786 begin
2787   for i := 0 to 3 do
2788     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2789   inc(aData, 2);
2790 end;
2791
2792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2793 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2795 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2796 begin
2797   PWord(aData)^ := DepthWeight(aPixel);
2798   inc(aData, 2);
2799 end;
2800
2801 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2802 begin
2803   aPixel.Data.r := PWord(aData)^;
2804   aPixel.Data.g := PWord(aData)^;
2805   aPixel.Data.b := PWord(aData)^;
2806   aPixel.Data.a := PWord(aData)^;;
2807   inc(aData, 2);
2808 end;
2809
2810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2811 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2813 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2814 begin
2815   inherited Map(aPixel, aData, aMapData);
2816   PWord(aData)^ := aPixel.Data.a;
2817   inc(aData, 2);
2818 end;
2819
2820 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2821 begin
2822   inherited Unmap(aData, aPixel, aMapData);
2823   aPixel.Data.a := PWord(aData)^;
2824   inc(aData, 2);
2825 end;
2826
2827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2828 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2830 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2831 begin
2832   PWord(aData)^ := aPixel.Data.r;
2833   inc(aData, 2);
2834   PWord(aData)^ := aPixel.Data.g;
2835   inc(aData, 2);
2836   PWord(aData)^ := aPixel.Data.b;
2837   inc(aData, 2);
2838 end;
2839
2840 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2841 begin
2842   aPixel.Data.r := PWord(aData)^;
2843   inc(aData, 2);
2844   aPixel.Data.g := PWord(aData)^;
2845   inc(aData, 2);
2846   aPixel.Data.b := PWord(aData)^;
2847   inc(aData, 2);
2848   aPixel.Data.a := 0;
2849 end;
2850
2851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2852 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2855 begin
2856   PWord(aData)^ := aPixel.Data.b;
2857   inc(aData, 2);
2858   PWord(aData)^ := aPixel.Data.g;
2859   inc(aData, 2);
2860   PWord(aData)^ := aPixel.Data.r;
2861   inc(aData, 2);
2862 end;
2863
2864 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2865 begin
2866   aPixel.Data.b := PWord(aData)^;
2867   inc(aData, 2);
2868   aPixel.Data.g := PWord(aData)^;
2869   inc(aData, 2);
2870   aPixel.Data.r := PWord(aData)^;
2871   inc(aData, 2);
2872   aPixel.Data.a := 0;
2873 end;
2874
2875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2876 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2878 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2879 begin
2880   inherited Map(aPixel, aData, aMapData);
2881   PWord(aData)^ := aPixel.Data.a;
2882   inc(aData, 2);
2883 end;
2884
2885 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2886 begin
2887   inherited Unmap(aData, aPixel, aMapData);
2888   aPixel.Data.a := PWord(aData)^;
2889   inc(aData, 2);
2890 end;
2891
2892 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2893 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2895 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2896 begin
2897   PWord(aData)^ := aPixel.Data.a;
2898   inc(aData, 2);
2899   inherited Map(aPixel, aData, aMapData);
2900 end;
2901
2902 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2903 begin
2904   aPixel.Data.a := PWord(aData)^;
2905   inc(aData, 2);
2906   inherited Unmap(aData, aPixel, aMapData);
2907 end;
2908
2909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2913 begin
2914   inherited Map(aPixel, aData, aMapData);
2915   PWord(aData)^ := aPixel.Data.a;
2916   inc(aData, 2);
2917 end;
2918
2919 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2920 begin
2921   inherited Unmap(aData, aPixel, aMapData);
2922   aPixel.Data.a := PWord(aData)^;
2923   inc(aData, 2);
2924 end;
2925
2926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2927 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2929 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2930 begin
2931   PWord(aData)^ := aPixel.Data.a;
2932   inc(aData, 2);
2933   inherited Map(aPixel, aData, aMapData);
2934 end;
2935
2936 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2937 begin
2938   aPixel.Data.a := PWord(aData)^;
2939   inc(aData, 2);
2940   inherited Unmap(aData, aPixel, aMapData);
2941 end;
2942
2943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2944 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2946 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2947 var
2948   i: Integer;
2949 begin
2950   PCardinal(aData)^ := 0;
2951   for i := 0 to 3 do
2952     if (Range.arr[i] > 0) then
2953       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2954   inc(aData, 4);
2955 end;
2956
2957 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2958 var
2959   i: Integer;
2960 begin
2961   for i := 0 to 3 do
2962     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2963   inc(aData, 2);
2964 end;
2965
2966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2967 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2969 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2970 begin
2971   PCardinal(aData)^ := DepthWeight(aPixel);
2972   inc(aData, 4);
2973 end;
2974
2975 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2976 begin
2977   aPixel.Data.r := PCardinal(aData)^;
2978   aPixel.Data.g := PCardinal(aData)^;
2979   aPixel.Data.b := PCardinal(aData)^;
2980   aPixel.Data.a := PCardinal(aData)^;
2981   inc(aData, 4);
2982 end;
2983
2984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2987 procedure TfdAlpha4ub1.SetValues;
2988 begin
2989   inherited SetValues;
2990   fBitsPerPixel     := 8;
2991   fFormat           := tfAlpha4ub1;
2992   fWithAlpha        := tfAlpha4ub1;
2993   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2994   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2995 {$IFNDEF OPENGL_ES}
2996   fOpenGLFormat     := tfAlpha4ub1;
2997   fglFormat         := GL_ALPHA;
2998   fglInternalFormat := GL_ALPHA4;
2999   fglDataFormat     := GL_UNSIGNED_BYTE;
3000 {$ELSE}
3001   fOpenGLFormat     := tfAlpha8ub1;
3002 {$ENDIF}
3003 end;
3004
3005 procedure TfdAlpha8ub1.SetValues;
3006 begin
3007   inherited SetValues;
3008   fBitsPerPixel     := 8;
3009   fFormat           := tfAlpha8ub1;
3010   fWithAlpha        := tfAlpha8ub1;
3011   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
3012   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3013   fOpenGLFormat     := tfAlpha8ub1;
3014   fglFormat         := GL_ALPHA;
3015   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
3016   fglDataFormat     := GL_UNSIGNED_BYTE;
3017 end;
3018
3019 procedure TfdAlpha16us1.SetValues;
3020 begin
3021   inherited SetValues;
3022   fBitsPerPixel     := 16;
3023   fFormat           := tfAlpha16us1;
3024   fWithAlpha        := tfAlpha16us1;
3025   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
3026   fShift            := glBitmapRec4ub(0, 0, 0,  0);
3027 {$IFNDEF OPENGL_ES}
3028   fOpenGLFormat     := tfAlpha16us1;
3029   fglFormat         := GL_ALPHA;
3030   fglInternalFormat := GL_ALPHA16;
3031   fglDataFormat     := GL_UNSIGNED_SHORT;
3032 {$ELSE}
3033   fOpenGLFormat     := tfAlpha8ub1;
3034 {$ENDIF}
3035 end;
3036
3037 procedure TfdLuminance4ub1.SetValues;
3038 begin
3039   inherited SetValues;
3040   fBitsPerPixel     := 8;
3041   fFormat           := tfLuminance4ub1;
3042   fWithAlpha        := tfLuminance4Alpha4ub2;
3043   fWithoutAlpha     := tfLuminance4ub1;
3044   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3045   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3046 {$IFNDEF OPENGL_ES}
3047   fOpenGLFormat     := tfLuminance4ub1;
3048   fglFormat         := GL_LUMINANCE;
3049   fglInternalFormat := GL_LUMINANCE4;
3050   fglDataFormat     := GL_UNSIGNED_BYTE;
3051 {$ELSE}
3052   fOpenGLFormat     := tfLuminance8ub1;
3053 {$ENDIF}
3054 end;
3055
3056 procedure TfdLuminance8ub1.SetValues;
3057 begin
3058   inherited SetValues;
3059   fBitsPerPixel     := 8;
3060   fFormat           := tfLuminance8ub1;
3061   fWithAlpha        := tfLuminance8Alpha8ub2;
3062   fWithoutAlpha     := tfLuminance8ub1;
3063   fOpenGLFormat     := tfLuminance8ub1;
3064   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3065   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3066   fglFormat         := GL_LUMINANCE;
3067   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
3068   fglDataFormat     := GL_UNSIGNED_BYTE;
3069 end;
3070
3071 procedure TfdLuminance16us1.SetValues;
3072 begin
3073   inherited SetValues;
3074   fBitsPerPixel     := 16;
3075   fFormat           := tfLuminance16us1;
3076   fWithAlpha        := tfLuminance16Alpha16us2;
3077   fWithoutAlpha     := tfLuminance16us1;
3078   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3079   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3080 {$IFNDEF OPENGL_ES}
3081   fOpenGLFormat     := tfLuminance16us1;
3082   fglFormat         := GL_LUMINANCE;
3083   fglInternalFormat := GL_LUMINANCE16;
3084   fglDataFormat     := GL_UNSIGNED_SHORT;
3085 {$ELSE}
3086   fOpenGLFormat     := tfLuminance8ub1;
3087 {$ENDIF}
3088 end;
3089
3090 procedure TfdLuminance4Alpha4ub2.SetValues;
3091 begin
3092   inherited SetValues;
3093   fBitsPerPixel     := 16;
3094   fFormat           := tfLuminance4Alpha4ub2;
3095   fWithAlpha        := tfLuminance4Alpha4ub2;
3096   fWithoutAlpha     := tfLuminance4ub1;
3097   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3098   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3099 {$IFNDEF OPENGL_ES}
3100   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3101   fglFormat         := GL_LUMINANCE_ALPHA;
3102   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3103   fglDataFormat     := GL_UNSIGNED_BYTE;
3104 {$ELSE}
3105   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3106 {$ENDIF}
3107 end;
3108
3109 procedure TfdLuminance6Alpha2ub2.SetValues;
3110 begin
3111   inherited SetValues;
3112   fBitsPerPixel     := 16;
3113   fFormat           := tfLuminance6Alpha2ub2;
3114   fWithAlpha        := tfLuminance6Alpha2ub2;
3115   fWithoutAlpha     := tfLuminance8ub1;
3116   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3117   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3118 {$IFNDEF OPENGL_ES}
3119   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3120   fglFormat         := GL_LUMINANCE_ALPHA;
3121   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3122   fglDataFormat     := GL_UNSIGNED_BYTE;
3123 {$ELSE}
3124   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3125 {$ENDIF}
3126 end;
3127
3128 procedure TfdLuminance8Alpha8ub2.SetValues;
3129 begin
3130   inherited SetValues;
3131   fBitsPerPixel     := 16;
3132   fFormat           := tfLuminance8Alpha8ub2;
3133   fWithAlpha        := tfLuminance8Alpha8ub2;
3134   fWithoutAlpha     := tfLuminance8ub1;
3135   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3136   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3137   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3138   fglFormat         := GL_LUMINANCE_ALPHA;
3139   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
3140   fglDataFormat     := GL_UNSIGNED_BYTE;
3141 end;
3142
3143 procedure TfdLuminance12Alpha4us2.SetValues;
3144 begin
3145   inherited SetValues;
3146   fBitsPerPixel     := 32;
3147   fFormat           := tfLuminance12Alpha4us2;
3148   fWithAlpha        := tfLuminance12Alpha4us2;
3149   fWithoutAlpha     := tfLuminance16us1;
3150   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3151   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3152 {$IFNDEF OPENGL_ES}
3153   fOpenGLFormat     := tfLuminance12Alpha4us2;
3154   fglFormat         := GL_LUMINANCE_ALPHA;
3155   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3156   fglDataFormat     := GL_UNSIGNED_SHORT;
3157 {$ELSE}
3158   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3159 {$ENDIF}
3160 end;
3161
3162 procedure TfdLuminance16Alpha16us2.SetValues;
3163 begin
3164   inherited SetValues;
3165   fBitsPerPixel     := 32;
3166   fFormat           := tfLuminance16Alpha16us2;
3167   fWithAlpha        := tfLuminance16Alpha16us2;
3168   fWithoutAlpha     := tfLuminance16us1;
3169   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3170   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3171 {$IFNDEF OPENGL_ES}
3172   fOpenGLFormat     := tfLuminance16Alpha16us2;
3173   fglFormat         := GL_LUMINANCE_ALPHA;
3174   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3175   fglDataFormat     := GL_UNSIGNED_SHORT;
3176 {$ELSE}
3177   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3178 {$ENDIF}
3179 end;
3180
3181 procedure TfdR3G3B2ub1.SetValues;
3182 begin
3183   inherited SetValues;
3184   fBitsPerPixel     := 8;
3185   fFormat           := tfR3G3B2ub1;
3186   fWithAlpha        := tfRGBA4us1;
3187   fWithoutAlpha     := tfR3G3B2ub1;
3188   fRGBInverted      := tfEmpty;
3189   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3190   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3191 {$IFNDEF OPENGL_ES}
3192   fOpenGLFormat     := tfR3G3B2ub1;
3193   fglFormat         := GL_RGB;
3194   fglInternalFormat := GL_R3_G3_B2;
3195   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3196 {$ELSE}
3197   fOpenGLFormat     := tfR5G6B5us1;
3198 {$ENDIF}
3199 end;
3200
3201 procedure TfdRGBX4us1.SetValues;
3202 begin
3203   inherited SetValues;
3204   fBitsPerPixel     := 16;
3205   fFormat           := tfRGBX4us1;
3206   fWithAlpha        := tfRGBA4us1;
3207   fWithoutAlpha     := tfRGBX4us1;
3208   fRGBInverted      := tfBGRX4us1;
3209   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3210   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3211 {$IFNDEF OPENGL_ES}
3212   fOpenGLFormat     := tfRGBX4us1;
3213   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3214   fglInternalFormat := GL_RGB4;
3215   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3216 {$ELSE}
3217   fOpenGLFormat     := tfR5G6B5us1;
3218 {$ENDIF}
3219 end;
3220
3221 procedure TfdXRGB4us1.SetValues;
3222 begin
3223   inherited SetValues;
3224   fBitsPerPixel     := 16;
3225   fFormat           := tfXRGB4us1;
3226   fWithAlpha        := tfARGB4us1;
3227   fWithoutAlpha     := tfXRGB4us1;
3228   fRGBInverted      := tfXBGR4us1;
3229   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3230   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3231 {$IFNDEF OPENGL_ES}
3232   fOpenGLFormat     := tfXRGB4us1;
3233   fglFormat         := GL_BGRA;
3234   fglInternalFormat := GL_RGB4;
3235   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3236 {$ELSE}
3237   fOpenGLFormat     := tfR5G6B5us1;
3238 {$ENDIF}
3239 end;
3240
3241 procedure TfdR5G6B5us1.SetValues;
3242 begin
3243   inherited SetValues;
3244   fBitsPerPixel     := 16;
3245   fFormat           := tfR5G6B5us1;
3246   fWithAlpha        := tfRGB5A1us1;
3247   fWithoutAlpha     := tfR5G6B5us1;
3248   fRGBInverted      := tfB5G6R5us1;
3249   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3250   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3251 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3252   fOpenGLFormat     := tfR5G6B5us1;
3253   fglFormat         := GL_RGB;
3254   fglInternalFormat := GL_RGB565;
3255   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3256 {$ELSE}
3257   fOpenGLFormat     := tfRGB8ub3;
3258 {$IFEND}
3259 end;
3260
3261 procedure TfdRGB5X1us1.SetValues;
3262 begin
3263   inherited SetValues;
3264   fBitsPerPixel     := 16;
3265   fFormat           := tfRGB5X1us1;
3266   fWithAlpha        := tfRGB5A1us1;
3267   fWithoutAlpha     := tfRGB5X1us1;
3268   fRGBInverted      := tfBGR5X1us1;
3269   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3270   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3271 {$IFNDEF OPENGL_ES}
3272   fOpenGLFormat     := tfRGB5X1us1;
3273   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3274   fglInternalFormat := GL_RGB5;
3275   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3276 {$ELSE}
3277   fOpenGLFormat     := tfR5G6B5us1;
3278 {$ENDIF}
3279 end;
3280
3281 procedure TfdX1RGB5us1.SetValues;
3282 begin
3283   inherited SetValues;
3284   fBitsPerPixel     := 16;
3285   fFormat           := tfX1RGB5us1;
3286   fWithAlpha        := tfA1RGB5us1;
3287   fWithoutAlpha     := tfX1RGB5us1;
3288   fRGBInverted      := tfX1BGR5us1;
3289   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3290   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3291 {$IFNDEF OPENGL_ES}
3292   fOpenGLFormat     := tfX1RGB5us1;
3293   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3294   fglInternalFormat := GL_RGB5;
3295   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3296 {$ELSE}
3297   fOpenGLFormat     := tfR5G6B5us1;
3298 {$ENDIF}
3299 end;
3300
3301 procedure TfdRGB8ub3.SetValues;
3302 begin
3303   inherited SetValues;
3304   fBitsPerPixel     := 24;
3305   fFormat           := tfRGB8ub3;
3306   fWithAlpha        := tfRGBA8ub4;
3307   fWithoutAlpha     := tfRGB8ub3;
3308   fRGBInverted      := tfBGR8ub3;
3309   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3310   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3311   fOpenGLFormat     := tfRGB8ub3;
3312   fglFormat         := GL_RGB;
3313   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
3314   fglDataFormat     := GL_UNSIGNED_BYTE;
3315 end;
3316
3317 procedure TfdRGBX8ui1.SetValues;
3318 begin
3319   inherited SetValues;
3320   fBitsPerPixel     := 32;
3321   fFormat           := tfRGBX8ui1;
3322   fWithAlpha        := tfRGBA8ui1;
3323   fWithoutAlpha     := tfRGBX8ui1;
3324   fRGBInverted      := tfBGRX8ui1;
3325   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3326   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3327 {$IFNDEF OPENGL_ES}
3328   fOpenGLFormat     := tfRGBX8ui1;
3329   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3330   fglInternalFormat := GL_RGB8;
3331   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3332 {$ELSE}
3333   fOpenGLFormat     := tfRGB8ub3;
3334 {$ENDIF}
3335 end;
3336
3337 procedure TfdXRGB8ui1.SetValues;
3338 begin
3339   inherited SetValues;
3340   fBitsPerPixel     := 32;
3341   fFormat           := tfXRGB8ui1;
3342   fWithAlpha        := tfXRGB8ui1;
3343   fWithoutAlpha     := tfXRGB8ui1;
3344   fOpenGLFormat     := tfXRGB8ui1;
3345   fRGBInverted      := tfXBGR8ui1;
3346   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3347   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3348 {$IFNDEF OPENGL_ES}
3349   fOpenGLFormat     := tfXRGB8ui1;
3350   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3351   fglInternalFormat := GL_RGB8;
3352   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3353 {$ELSE}
3354   fOpenGLFormat     := tfRGB8ub3;
3355 {$ENDIF}
3356 end;
3357
3358 procedure TfdRGB10X2ui1.SetValues;
3359 begin
3360   inherited SetValues;
3361   fBitsPerPixel     := 32;
3362   fFormat           := tfRGB10X2ui1;
3363   fWithAlpha        := tfRGB10A2ui1;
3364   fWithoutAlpha     := tfRGB10X2ui1;
3365   fRGBInverted      := tfBGR10X2ui1;
3366   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3367   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3368 {$IFNDEF OPENGL_ES}
3369   fOpenGLFormat     := tfRGB10X2ui1;
3370   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3371   fglInternalFormat := GL_RGB10;
3372   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3373 {$ELSE}
3374   fOpenGLFormat     := tfRGB16us3;
3375 {$ENDIF}
3376 end;
3377
3378 procedure TfdX2RGB10ui1.SetValues;
3379 begin
3380   inherited SetValues;
3381   fBitsPerPixel     := 32;
3382   fFormat           := tfX2RGB10ui1;
3383   fWithAlpha        := tfA2RGB10ui1;
3384   fWithoutAlpha     := tfX2RGB10ui1;
3385   fRGBInverted      := tfX2BGR10ui1;
3386   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3387   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3388 {$IFNDEF OPENGL_ES}
3389   fOpenGLFormat     := tfX2RGB10ui1;
3390   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3391   fglInternalFormat := GL_RGB10;
3392   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3393 {$ELSE}
3394   fOpenGLFormat     := tfRGB16us3;
3395 {$ENDIF}
3396 end;
3397
3398 procedure TfdRGB16us3.SetValues;
3399 begin
3400   inherited SetValues;
3401   fBitsPerPixel     := 48;
3402   fFormat           := tfRGB16us3;
3403   fWithAlpha        := tfRGBA16us4;
3404   fWithoutAlpha     := tfRGB16us3;
3405   fRGBInverted      := tfBGR16us3;
3406   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3407   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3408 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3409   fOpenGLFormat     := tfRGB16us3;
3410   fglFormat         := GL_RGB;
3411   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3412   fglDataFormat     := GL_UNSIGNED_SHORT;
3413 {$ELSE}
3414   fOpenGLFormat     := tfRGB8ub3;
3415 {$IFEND}
3416 end;
3417
3418 procedure TfdRGBA4us1.SetValues;
3419 begin
3420   inherited SetValues;
3421   fBitsPerPixel     := 16;
3422   fFormat           := tfRGBA4us1;
3423   fWithAlpha        := tfRGBA4us1;
3424   fWithoutAlpha     := tfRGBX4us1;
3425   fOpenGLFormat     := tfRGBA4us1;
3426   fRGBInverted      := tfBGRA4us1;
3427   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3428   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3429   fglFormat         := GL_RGBA;
3430   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3431   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3432 end;
3433
3434 procedure TfdARGB4us1.SetValues;
3435 begin
3436   inherited SetValues;
3437   fBitsPerPixel     := 16;
3438   fFormat           := tfARGB4us1;
3439   fWithAlpha        := tfARGB4us1;
3440   fWithoutAlpha     := tfXRGB4us1;
3441   fRGBInverted      := tfABGR4us1;
3442   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3443   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3444 {$IFNDEF OPENGL_ES}
3445   fOpenGLFormat     := tfARGB4us1;
3446   fglFormat         := GL_BGRA;
3447   fglInternalFormat := GL_RGBA4;
3448   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3449 {$ELSE}
3450   fOpenGLFormat     := tfRGBA4us1;
3451 {$ENDIF}
3452 end;
3453
3454 procedure TfdRGB5A1us1.SetValues;
3455 begin
3456   inherited SetValues;
3457   fBitsPerPixel     := 16;
3458   fFormat           := tfRGB5A1us1;
3459   fWithAlpha        := tfRGB5A1us1;
3460   fWithoutAlpha     := tfRGB5X1us1;
3461   fOpenGLFormat     := tfRGB5A1us1;
3462   fRGBInverted      := tfBGR5A1us1;
3463   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3464   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3465   fglFormat         := GL_RGBA;
3466   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3467   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3468 end;
3469
3470 procedure TfdA1RGB5us1.SetValues;
3471 begin
3472   inherited SetValues;
3473   fBitsPerPixel     := 16;
3474   fFormat           := tfA1RGB5us1;
3475   fWithAlpha        := tfA1RGB5us1;
3476   fWithoutAlpha     := tfX1RGB5us1;
3477   fRGBInverted      := tfA1BGR5us1;
3478   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3479   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3480 {$IFNDEF OPENGL_ES}
3481   fOpenGLFormat     := tfA1RGB5us1;
3482   fglFormat         := GL_BGRA;
3483   fglInternalFormat := GL_RGB5_A1;
3484   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3485 {$ELSE}
3486   fOpenGLFormat     := tfRGB5A1us1;
3487 {$ENDIF}
3488 end;
3489
3490 procedure TfdRGBA8ui1.SetValues;
3491 begin
3492   inherited SetValues;
3493   fBitsPerPixel     := 32;
3494   fFormat           := tfRGBA8ui1;
3495   fWithAlpha        := tfRGBA8ui1;
3496   fWithoutAlpha     := tfRGBX8ui1;
3497   fRGBInverted      := tfBGRA8ui1;
3498   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3499   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3500 {$IFNDEF OPENGL_ES}
3501   fOpenGLFormat     := tfRGBA8ui1;
3502   fglFormat         := GL_RGBA;
3503   fglInternalFormat := GL_RGBA8;
3504   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3505 {$ELSE}
3506   fOpenGLFormat     := tfRGBA8ub4;
3507 {$ENDIF}
3508 end;
3509
3510 procedure TfdARGB8ui1.SetValues;
3511 begin
3512   inherited SetValues;
3513   fBitsPerPixel     := 32;
3514   fFormat           := tfARGB8ui1;
3515   fWithAlpha        := tfARGB8ui1;
3516   fWithoutAlpha     := tfXRGB8ui1;
3517   fRGBInverted      := tfABGR8ui1;
3518   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3519   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3520 {$IFNDEF OPENGL_ES}
3521   fOpenGLFormat     := tfARGB8ui1;
3522   fglFormat         := GL_BGRA;
3523   fglInternalFormat := GL_RGBA8;
3524   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3525 {$ELSE}
3526   fOpenGLFormat     := tfRGBA8ub4;
3527 {$ENDIF}
3528 end;
3529
3530 procedure TfdRGBA8ub4.SetValues;
3531 begin
3532   inherited SetValues;
3533   fBitsPerPixel     := 32;
3534   fFormat           := tfRGBA8ub4;
3535   fWithAlpha        := tfRGBA8ub4;
3536   fWithoutAlpha     := tfRGB8ub3;
3537   fOpenGLFormat     := tfRGBA8ub4;
3538   fRGBInverted      := tfBGRA8ub4;
3539   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3540   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3541   fglFormat         := GL_RGBA;
3542   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3543   fglDataFormat     := GL_UNSIGNED_BYTE;
3544 end;
3545
3546 procedure TfdRGB10A2ui1.SetValues;
3547 begin
3548   inherited SetValues;
3549   fBitsPerPixel     := 32;
3550   fFormat           := tfRGB10A2ui1;
3551   fWithAlpha        := tfRGB10A2ui1;
3552   fWithoutAlpha     := tfRGB10X2ui1;
3553   fRGBInverted      := tfBGR10A2ui1;
3554   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3555   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3556 {$IFNDEF OPENGL_ES}
3557   fOpenGLFormat     := tfRGB10A2ui1;
3558   fglFormat         := GL_RGBA;
3559   fglInternalFormat := GL_RGB10_A2;
3560   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3561 {$ELSE}
3562   fOpenGLFormat     := tfA2RGB10ui1;
3563 {$ENDIF}
3564 end;
3565
3566 procedure TfdA2RGB10ui1.SetValues;
3567 begin
3568   inherited SetValues;
3569   fBitsPerPixel     := 32;
3570   fFormat           := tfA2RGB10ui1;
3571   fWithAlpha        := tfA2RGB10ui1;
3572   fWithoutAlpha     := tfX2RGB10ui1;
3573   fRGBInverted      := tfA2BGR10ui1;
3574   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3575   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3576 {$IF NOT DEFINED(OPENGL_ES)}
3577   fOpenGLFormat     := tfA2RGB10ui1;
3578   fglFormat         := GL_BGRA;
3579   fglInternalFormat := GL_RGB10_A2;
3580   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3581 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3582   fOpenGLFormat     := tfA2RGB10ui1;
3583   fglFormat         := GL_RGBA;
3584   fglInternalFormat := GL_RGB10_A2;
3585   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3586 {$ELSE}
3587   fOpenGLFormat     := tfRGBA8ui1;
3588 {$IFEND}
3589 end;
3590
3591 procedure TfdRGBA16us4.SetValues;
3592 begin
3593   inherited SetValues;
3594   fBitsPerPixel     := 64;
3595   fFormat           := tfRGBA16us4;
3596   fWithAlpha        := tfRGBA16us4;
3597   fWithoutAlpha     := tfRGB16us3;
3598   fRGBInverted      := tfBGRA16us4;
3599   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3600   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3601 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3602   fOpenGLFormat     := tfRGBA16us4;
3603   fglFormat         := GL_RGBA;
3604   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3605   fglDataFormat     := GL_UNSIGNED_SHORT;
3606 {$ELSE}
3607   fOpenGLFormat     := tfRGBA8ub4;
3608 {$IFEND}
3609 end;
3610
3611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3614 procedure TfdBGRX4us1.SetValues;
3615 begin
3616   inherited SetValues;
3617   fBitsPerPixel     := 16;
3618   fFormat           := tfBGRX4us1;
3619   fWithAlpha        := tfBGRA4us1;
3620   fWithoutAlpha     := tfBGRX4us1;
3621   fRGBInverted      := tfRGBX4us1;
3622   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3623   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3624 {$IFNDEF OPENGL_ES}
3625   fOpenGLFormat     := tfBGRX4us1;
3626   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3627   fglInternalFormat := GL_RGB4;
3628   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3629 {$ELSE}
3630   fOpenGLFormat     := tfR5G6B5us1;
3631 {$ENDIF}
3632 end;
3633
3634 procedure TfdXBGR4us1.SetValues;
3635 begin
3636   inherited SetValues;
3637   fBitsPerPixel     := 16;
3638   fFormat           := tfXBGR4us1;
3639   fWithAlpha        := tfABGR4us1;
3640   fWithoutAlpha     := tfXBGR4us1;
3641   fRGBInverted      := tfXRGB4us1;
3642   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3643   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3644 {$IFNDEF OPENGL_ES}
3645   fOpenGLFormat     := tfXBGR4us1;
3646   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3647   fglInternalFormat := GL_RGB4;
3648   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3649 {$ELSE}
3650   fOpenGLFormat     := tfR5G6B5us1;
3651 {$ENDIF}
3652 end;
3653
3654 procedure TfdB5G6R5us1.SetValues;
3655 begin
3656   inherited SetValues;
3657   fBitsPerPixel     := 16;
3658   fFormat           := tfB5G6R5us1;
3659   fWithAlpha        := tfBGR5A1us1;
3660   fWithoutAlpha     := tfB5G6R5us1;
3661   fRGBInverted      := tfR5G6B5us1;
3662   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3663   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3664 {$IFNDEF OPENGL_ES}
3665   fOpenGLFormat     := tfB5G6R5us1;
3666   fglFormat         := GL_RGB;
3667   fglInternalFormat := GL_RGB565;
3668   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3669 {$ELSE}
3670   fOpenGLFormat     := tfR5G6B5us1;
3671 {$ENDIF}
3672 end;
3673
3674 procedure TfdBGR5X1us1.SetValues;
3675 begin
3676   inherited SetValues;
3677   fBitsPerPixel     := 16;
3678   fFormat           := tfBGR5X1us1;
3679   fWithAlpha        := tfBGR5A1us1;
3680   fWithoutAlpha     := tfBGR5X1us1;
3681   fRGBInverted      := tfRGB5X1us1;
3682   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3683   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3684 {$IFNDEF OPENGL_ES}
3685   fOpenGLFormat     := tfBGR5X1us1;
3686   fglFormat         := GL_BGRA;
3687   fglInternalFormat := GL_RGB5;
3688   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3689 {$ELSE}
3690   fOpenGLFormat     := tfR5G6B5us1;
3691 {$ENDIF}
3692 end;
3693
3694 procedure TfdX1BGR5us1.SetValues;
3695 begin
3696   inherited SetValues;
3697   fBitsPerPixel     := 16;
3698   fFormat           := tfX1BGR5us1;
3699   fWithAlpha        := tfA1BGR5us1;
3700   fWithoutAlpha     := tfX1BGR5us1;
3701   fRGBInverted      := tfX1RGB5us1;
3702   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3703   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3704 {$IFNDEF OPENGL_ES}
3705   fOpenGLFormat     := tfX1BGR5us1;
3706   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3707   fglInternalFormat := GL_RGB5;
3708   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3709 {$ELSE}
3710   fOpenGLFormat     := tfR5G6B5us1;
3711 {$ENDIF}
3712 end;
3713
3714 procedure TfdBGR8ub3.SetValues;
3715 begin
3716   inherited SetValues;
3717   fBitsPerPixel     := 24;
3718   fFormat           := tfBGR8ub3;
3719   fWithAlpha        := tfBGRA8ub4;
3720   fWithoutAlpha     := tfBGR8ub3;
3721   fRGBInverted      := tfRGB8ub3;
3722   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3723   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3724 {$IFNDEF OPENGL_ES}
3725   fOpenGLFormat     := tfBGR8ub3;
3726   fglFormat         := GL_BGR;
3727   fglInternalFormat := GL_RGB8;
3728   fglDataFormat     := GL_UNSIGNED_BYTE;
3729 {$ELSE}
3730   fOpenGLFormat     := tfRGB8ub3;
3731 {$ENDIF}
3732 end;
3733
3734 procedure TfdBGRX8ui1.SetValues;
3735 begin
3736   inherited SetValues;
3737   fBitsPerPixel     := 32;
3738   fFormat           := tfBGRX8ui1;
3739   fWithAlpha        := tfBGRA8ui1;
3740   fWithoutAlpha     := tfBGRX8ui1;
3741   fRGBInverted      := tfRGBX8ui1;
3742   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3743   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3744 {$IFNDEF OPENGL_ES}
3745   fOpenGLFormat     := tfBGRX8ui1;
3746   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3747   fglInternalFormat := GL_RGB8;
3748   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3749 {$ELSE}
3750   fOpenGLFormat     := tfRGB8ub3;
3751 {$ENDIF}
3752 end;
3753
3754 procedure TfdXBGR8ui1.SetValues;
3755 begin
3756   inherited SetValues;
3757   fBitsPerPixel     := 32;
3758   fFormat           := tfXBGR8ui1;
3759   fWithAlpha        := tfABGR8ui1;
3760   fWithoutAlpha     := tfXBGR8ui1;
3761   fRGBInverted      := tfXRGB8ui1;
3762   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3763   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3764 {$IFNDEF OPENGL_ES}
3765   fOpenGLFormat     := tfXBGR8ui1;
3766   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3767   fglInternalFormat := GL_RGB8;
3768   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3769 {$ELSE}
3770   fOpenGLFormat     := tfRGB8ub3;
3771 {$ENDIF}
3772 end;
3773
3774 procedure TfdBGR10X2ui1.SetValues;
3775 begin
3776   inherited SetValues;
3777   fBitsPerPixel     := 32;
3778   fFormat           := tfBGR10X2ui1;
3779   fWithAlpha        := tfBGR10A2ui1;
3780   fWithoutAlpha     := tfBGR10X2ui1;
3781   fRGBInverted      := tfRGB10X2ui1;
3782   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3783   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3784 {$IFNDEF OPENGL_ES}
3785   fOpenGLFormat     := tfBGR10X2ui1;
3786   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3787   fglInternalFormat := GL_RGB10;
3788   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3789 {$ELSE}
3790   fOpenGLFormat     := tfRGB16us3;
3791 {$ENDIF}
3792 end;
3793
3794 procedure TfdX2BGR10ui1.SetValues;
3795 begin
3796   inherited SetValues;
3797   fBitsPerPixel     := 32;
3798   fFormat           := tfX2BGR10ui1;
3799   fWithAlpha        := tfA2BGR10ui1;
3800   fWithoutAlpha     := tfX2BGR10ui1;
3801   fRGBInverted      := tfX2RGB10ui1;
3802   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3803   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3804 {$IFNDEF OPENGL_ES}
3805   fOpenGLFormat     := tfX2BGR10ui1;
3806   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3807   fglInternalFormat := GL_RGB10;
3808   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3809 {$ELSE}
3810   fOpenGLFormat     := tfRGB16us3;
3811 {$ENDIF}
3812 end;
3813
3814 procedure TfdBGR16us3.SetValues;
3815 begin
3816   inherited SetValues;
3817   fBitsPerPixel     := 48;
3818   fFormat           := tfBGR16us3;
3819   fWithAlpha        := tfBGRA16us4;
3820   fWithoutAlpha     := tfBGR16us3;
3821   fRGBInverted      := tfRGB16us3;
3822   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3823   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3824 {$IFNDEF OPENGL_ES}
3825   fOpenGLFormat     := tfBGR16us3;
3826   fglFormat         := GL_BGR;
3827   fglInternalFormat := GL_RGB16;
3828   fglDataFormat     := GL_UNSIGNED_SHORT;
3829 {$ELSE}
3830   fOpenGLFormat     := tfRGB16us3;
3831 {$ENDIF}
3832 end;
3833
3834 procedure TfdBGRA4us1.SetValues;
3835 begin
3836   inherited SetValues;
3837   fBitsPerPixel     := 16;
3838   fFormat           := tfBGRA4us1;
3839   fWithAlpha        := tfBGRA4us1;
3840   fWithoutAlpha     := tfBGRX4us1;
3841   fRGBInverted      := tfRGBA4us1;
3842   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3843   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3844 {$IFNDEF OPENGL_ES}
3845   fOpenGLFormat     := tfBGRA4us1;
3846   fglFormat         := GL_BGRA;
3847   fglInternalFormat := GL_RGBA4;
3848   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3849 {$ELSE}
3850   fOpenGLFormat     := tfRGBA4us1;
3851 {$ENDIF}
3852 end;
3853
3854 procedure TfdABGR4us1.SetValues;
3855 begin
3856   inherited SetValues;
3857   fBitsPerPixel     := 16;
3858   fFormat           := tfABGR4us1;
3859   fWithAlpha        := tfABGR4us1;
3860   fWithoutAlpha     := tfXBGR4us1;
3861   fRGBInverted      := tfARGB4us1;
3862   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3863   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3864 {$IFNDEF OPENGL_ES}
3865   fOpenGLFormat     := tfABGR4us1;
3866   fglFormat         := GL_RGBA;
3867   fglInternalFormat := GL_RGBA4;
3868   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3869 {$ELSE}
3870   fOpenGLFormat     := tfRGBA4us1;
3871 {$ENDIF}
3872 end;
3873
3874 procedure TfdBGR5A1us1.SetValues;
3875 begin
3876   inherited SetValues;
3877   fBitsPerPixel     := 16;
3878   fFormat           := tfBGR5A1us1;
3879   fWithAlpha        := tfBGR5A1us1;
3880   fWithoutAlpha     := tfBGR5X1us1;
3881   fRGBInverted      := tfRGB5A1us1;
3882   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3883   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3884 {$IFNDEF OPENGL_ES}
3885   fOpenGLFormat     := tfBGR5A1us1;
3886   fglFormat         := GL_BGRA;
3887   fglInternalFormat := GL_RGB5_A1;
3888   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3889 {$ELSE}
3890   fOpenGLFormat     := tfRGB5A1us1;
3891 {$ENDIF}
3892 end;
3893
3894 procedure TfdA1BGR5us1.SetValues;
3895 begin
3896   inherited SetValues;
3897   fBitsPerPixel     := 16;
3898   fFormat           := tfA1BGR5us1;
3899   fWithAlpha        := tfA1BGR5us1;
3900   fWithoutAlpha     := tfX1BGR5us1;
3901   fRGBInverted      := tfA1RGB5us1;
3902   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3903   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3904 {$IFNDEF OPENGL_ES}
3905   fOpenGLFormat     := tfA1BGR5us1;
3906   fglFormat         := GL_RGBA;
3907   fglInternalFormat := GL_RGB5_A1;
3908   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3909 {$ELSE}
3910   fOpenGLFormat     := tfRGB5A1us1;
3911 {$ENDIF}
3912 end;
3913
3914 procedure TfdBGRA8ui1.SetValues;
3915 begin
3916   inherited SetValues;
3917   fBitsPerPixel     := 32;
3918   fFormat           := tfBGRA8ui1;
3919   fWithAlpha        := tfBGRA8ui1;
3920   fWithoutAlpha     := tfBGRX8ui1;
3921   fRGBInverted      := tfRGBA8ui1;
3922   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3923   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3924 {$IFNDEF OPENGL_ES}
3925   fOpenGLFormat     := tfBGRA8ui1;
3926   fglFormat         := GL_BGRA;
3927   fglInternalFormat := GL_RGBA8;
3928   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3929 {$ELSE}
3930   fOpenGLFormat     := tfRGBA8ub4;
3931 {$ENDIF}
3932 end;
3933
3934 procedure TfdABGR8ui1.SetValues;
3935 begin
3936   inherited SetValues;
3937   fBitsPerPixel     := 32;
3938   fFormat           := tfABGR8ui1;
3939   fWithAlpha        := tfABGR8ui1;
3940   fWithoutAlpha     := tfXBGR8ui1;
3941   fRGBInverted      := tfARGB8ui1;
3942   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3943   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3944 {$IFNDEF OPENGL_ES}
3945   fOpenGLFormat     := tfABGR8ui1;
3946   fglFormat         := GL_RGBA;
3947   fglInternalFormat := GL_RGBA8;
3948   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3949 {$ELSE}
3950   fOpenGLFormat     := tfRGBA8ub4
3951 {$ENDIF}
3952 end;
3953
3954 procedure TfdBGRA8ub4.SetValues;
3955 begin
3956   inherited SetValues;
3957   fBitsPerPixel     := 32;
3958   fFormat           := tfBGRA8ub4;
3959   fWithAlpha        := tfBGRA8ub4;
3960   fWithoutAlpha     := tfBGR8ub3;
3961   fRGBInverted      := tfRGBA8ub4;
3962   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3963   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3964 {$IFNDEF OPENGL_ES}
3965   fOpenGLFormat     := tfBGRA8ub4;
3966   fglFormat         := GL_BGRA;
3967   fglInternalFormat := GL_RGBA8;
3968   fglDataFormat     := GL_UNSIGNED_BYTE;
3969 {$ELSE}
3970   fOpenGLFormat     := tfRGBA8ub4;
3971 {$ENDIF}
3972 end;
3973
3974 procedure TfdBGR10A2ui1.SetValues;
3975 begin
3976   inherited SetValues;
3977   fBitsPerPixel     := 32;
3978   fFormat           := tfBGR10A2ui1;
3979   fWithAlpha        := tfBGR10A2ui1;
3980   fWithoutAlpha     := tfBGR10X2ui1;
3981   fRGBInverted      := tfRGB10A2ui1;
3982   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3983   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3984 {$IFNDEF OPENGL_ES}
3985   fOpenGLFormat     := tfBGR10A2ui1;
3986   fglFormat         := GL_BGRA;
3987   fglInternalFormat := GL_RGB10_A2;
3988   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3989 {$ELSE}
3990   fOpenGLFormat     := tfA2RGB10ui1;
3991 {$ENDIF}
3992 end;
3993
3994 procedure TfdA2BGR10ui1.SetValues;
3995 begin
3996   inherited SetValues;
3997   fBitsPerPixel     := 32;
3998   fFormat           := tfA2BGR10ui1;
3999   fWithAlpha        := tfA2BGR10ui1;
4000   fWithoutAlpha     := tfX2BGR10ui1;
4001   fRGBInverted      := tfA2RGB10ui1;
4002   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
4003   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
4004 {$IFNDEF OPENGL_ES}
4005   fOpenGLFormat     := tfA2BGR10ui1;
4006   fglFormat         := GL_RGBA;
4007   fglInternalFormat := GL_RGB10_A2;
4008   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
4009 {$ELSE}
4010   fOpenGLFormat     := tfA2RGB10ui1;
4011 {$ENDIF}
4012 end;
4013
4014 procedure TfdBGRA16us4.SetValues;
4015 begin
4016   inherited SetValues;
4017   fBitsPerPixel     := 64;
4018   fFormat           := tfBGRA16us4;
4019   fWithAlpha        := tfBGRA16us4;
4020   fWithoutAlpha     := tfBGR16us3;
4021   fRGBInverted      := tfRGBA16us4;
4022   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4023   fShift            := glBitmapRec4ub(32, 16,  0, 48);
4024 {$IFNDEF OPENGL_ES}
4025   fOpenGLFormat     := tfBGRA16us4;
4026   fglFormat         := GL_BGRA;
4027   fglInternalFormat := GL_RGBA16;
4028   fglDataFormat     := GL_UNSIGNED_SHORT;
4029 {$ELSE}
4030   fOpenGLFormat     := tfRGBA16us4;
4031 {$ENDIF}
4032 end;
4033
4034 procedure TfdDepth16us1.SetValues;
4035 begin
4036   inherited SetValues;
4037   fBitsPerPixel     := 16;
4038   fFormat           := tfDepth16us1;
4039   fWithoutAlpha     := tfDepth16us1;
4040   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4041   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4042 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
4043   fOpenGLFormat     := tfDepth16us1;
4044   fglFormat         := GL_DEPTH_COMPONENT;
4045   fglInternalFormat := GL_DEPTH_COMPONENT16;
4046   fglDataFormat     := GL_UNSIGNED_SHORT;
4047 {$IFEND}
4048 end;
4049
4050 procedure TfdDepth24ui1.SetValues;
4051 begin
4052   inherited SetValues;
4053   fBitsPerPixel     := 32;
4054   fFormat           := tfDepth24ui1;
4055   fWithoutAlpha     := tfDepth24ui1;
4056   fOpenGLFormat     := tfDepth24ui1;
4057   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4058   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4059 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
4060   fOpenGLFormat     := tfDepth24ui1;
4061   fglFormat         := GL_DEPTH_COMPONENT;
4062   fglInternalFormat := GL_DEPTH_COMPONENT24;
4063   fglDataFormat     := GL_UNSIGNED_INT;
4064 {$IFEND}
4065 end;
4066
4067 procedure TfdDepth32ui1.SetValues;
4068 begin
4069   inherited SetValues;
4070   fBitsPerPixel     := 32;
4071   fFormat           := tfDepth32ui1;
4072   fWithoutAlpha     := tfDepth32ui1;
4073   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4074   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4075 {$IF NOT DEFINED(OPENGL_ES)}
4076   fOpenGLFormat     := tfDepth32ui1;
4077   fglFormat         := GL_DEPTH_COMPONENT;
4078   fglInternalFormat := GL_DEPTH_COMPONENT32;
4079   fglDataFormat     := GL_UNSIGNED_INT;
4080 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
4081   fOpenGLFormat     := tfDepth24ui1;
4082 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
4083   fOpenGLFormat     := tfDepth16us1;
4084 {$IFEND}
4085 end;
4086
4087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4088 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4090 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4091 begin
4092   raise EglBitmap.Create('mapping for compressed formats is not supported');
4093 end;
4094
4095 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4096 begin
4097   raise EglBitmap.Create('mapping for compressed formats is not supported');
4098 end;
4099
4100 procedure TfdS3tcDtx1RGBA.SetValues;
4101 begin
4102   inherited SetValues;
4103   fFormat           := tfS3tcDtx1RGBA;
4104   fWithAlpha        := tfS3tcDtx1RGBA;
4105   fUncompressed     := tfRGB5A1us1;
4106   fBitsPerPixel     := 4;
4107   fIsCompressed     := true;
4108 {$IFNDEF OPENGL_ES}
4109   fOpenGLFormat     := tfS3tcDtx1RGBA;
4110   fglFormat         := GL_COMPRESSED_RGBA;
4111   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4112   fglDataFormat     := GL_UNSIGNED_BYTE;
4113 {$ELSE}
4114   fOpenGLFormat     := fUncompressed;
4115 {$ENDIF}
4116 end;
4117
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4121 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4122 begin
4123   raise EglBitmap.Create('mapping for compressed formats is not supported');
4124 end;
4125
4126 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4127 begin
4128   raise EglBitmap.Create('mapping for compressed formats is not supported');
4129 end;
4130
4131 procedure TfdS3tcDtx3RGBA.SetValues;
4132 begin
4133   inherited SetValues;
4134   fFormat           := tfS3tcDtx3RGBA;
4135   fWithAlpha        := tfS3tcDtx3RGBA;
4136   fUncompressed     := tfRGBA8ub4;
4137   fBitsPerPixel     := 8;
4138   fIsCompressed     := true;
4139 {$IFNDEF OPENGL_ES}
4140   fOpenGLFormat     := tfS3tcDtx3RGBA;
4141   fglFormat         := GL_COMPRESSED_RGBA;
4142   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4143   fglDataFormat     := GL_UNSIGNED_BYTE;
4144 {$ELSE}
4145   fOpenGLFormat     := fUncompressed;
4146 {$ENDIF}
4147 end;
4148
4149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4150 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4153 begin
4154   raise EglBitmap.Create('mapping for compressed formats is not supported');
4155 end;
4156
4157 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4158 begin
4159   raise EglBitmap.Create('mapping for compressed formats is not supported');
4160 end;
4161
4162 procedure TfdS3tcDtx5RGBA.SetValues;
4163 begin
4164   inherited SetValues;
4165   fFormat           := tfS3tcDtx3RGBA;
4166   fWithAlpha        := tfS3tcDtx3RGBA;
4167   fUncompressed     := tfRGBA8ub4;
4168   fBitsPerPixel     := 8;
4169   fIsCompressed     := true;
4170 {$IFNDEF OPENGL_ES}
4171   fOpenGLFormat     := tfS3tcDtx3RGBA;
4172   fglFormat         := GL_COMPRESSED_RGBA;
4173   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4174   fglDataFormat     := GL_UNSIGNED_BYTE;
4175 {$ELSE}
4176   fOpenGLFormat     := fUncompressed;
4177 {$ENDIF}
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4183 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
4184 begin
4185   result := (fPrecision.r > 0);
4186 end;
4187
4188 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
4189 begin
4190   result := (fPrecision.g > 0);
4191 end;
4192
4193 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
4194 begin
4195   result := (fPrecision.b > 0);
4196 end;
4197
4198 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
4199 begin
4200   result := (fPrecision.a > 0);
4201 end;
4202
4203 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
4204 begin
4205   result := HasRed or HasGreen or HasBlue;
4206 end;
4207
4208 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
4209 begin
4210   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
4211 end;
4212
4213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4214 procedure TglBitmapFormatDescriptor.SetValues;
4215 begin
4216   fFormat       := tfEmpty;
4217   fWithAlpha    := tfEmpty;
4218   fWithoutAlpha := tfEmpty;
4219   fOpenGLFormat := tfEmpty;
4220   fRGBInverted  := tfEmpty;
4221   fUncompressed := tfEmpty;
4222
4223   fBitsPerPixel := 0;
4224   fIsCompressed := false;
4225
4226   fglFormat         := 0;
4227   fglInternalFormat := 0;
4228   fglDataFormat     := 0;
4229
4230   FillChar(fPrecision, 0, SizeOf(fPrecision));
4231   FillChar(fShift,     0, SizeOf(fShift));
4232 end;
4233
4234 procedure TglBitmapFormatDescriptor.CalcValues;
4235 var
4236   i: Integer;
4237 begin
4238   fBytesPerPixel := fBitsPerPixel / 8;
4239   fChannelCount  := 0;
4240   for i := 0 to 3 do begin
4241     if (fPrecision.arr[i] > 0) then
4242       inc(fChannelCount);
4243     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
4244     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
4245   end;
4246 end;
4247
4248 constructor TglBitmapFormatDescriptor.Create;
4249 begin
4250   inherited Create;
4251   SetValues;
4252   CalcValues;
4253 end;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4257 var
4258   f: TglBitmapFormat;
4259 begin
4260   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4261     result := TFormatDescriptor.Get(f);
4262     if (result.glInternalFormat = aInternalFormat) then
4263       exit;
4264   end;
4265   result := TFormatDescriptor.Get(tfEmpty);
4266 end;
4267
4268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4269 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4271 class procedure TFormatDescriptor.Init;
4272 begin
4273   if not Assigned(FormatDescriptorCS) then
4274     FormatDescriptorCS := TCriticalSection.Create;
4275 end;
4276
4277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4278 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4279 begin
4280   FormatDescriptorCS.Enter;
4281   try
4282     result := FormatDescriptors[aFormat];
4283     if not Assigned(result) then begin
4284       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4285       FormatDescriptors[aFormat] := result;
4286     end;
4287   finally
4288     FormatDescriptorCS.Leave;
4289   end;
4290 end;
4291
4292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4293 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4294 begin
4295   result := Get(Get(aFormat).WithAlpha);
4296 end;
4297
4298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4299 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4300 var
4301   ft: TglBitmapFormat;
4302 begin
4303   // find matching format with OpenGL support
4304   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4305     result := Get(ft);
4306     if (result.MaskMatch(aMask))      and
4307        (result.glFormat <> 0)         and
4308        (result.glInternalFormat <> 0) and
4309        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4310     then
4311       exit;
4312   end;
4313
4314   // find matching format without OpenGL Support
4315   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4316     result := Get(ft);
4317     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4318       exit;
4319   end;
4320
4321   result := TFormatDescriptor.Get(tfEmpty);
4322 end;
4323
4324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4325 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4326 var
4327   ft: TglBitmapFormat;
4328 begin
4329   // find matching format with OpenGL support
4330   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4331     result := Get(ft);
4332     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4333        glBitmapRec4ubCompare(result.Precision, aPrec) and
4334        (result.glFormat <> 0)         and
4335        (result.glInternalFormat <> 0) and
4336        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4337     then
4338       exit;
4339   end;
4340
4341   // find matching format without OpenGL Support
4342   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4343     result := Get(ft);
4344     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4345        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4346        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4347       exit;
4348   end;
4349
4350   result := TFormatDescriptor.Get(tfEmpty);
4351 end;
4352
4353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4354 class procedure TFormatDescriptor.Clear;
4355 var
4356   f: TglBitmapFormat;
4357 begin
4358   FormatDescriptorCS.Enter;
4359   try
4360     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4361       FreeAndNil(FormatDescriptors[f]);
4362   finally
4363     FormatDescriptorCS.Leave;
4364   end;
4365 end;
4366
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 class procedure TFormatDescriptor.Finalize;
4369 begin
4370   Clear;
4371   FreeAndNil(FormatDescriptorCS);
4372 end;
4373
4374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4375 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4378 var
4379   i: Integer;
4380 begin
4381   for i := 0 to 3 do begin
4382     fShift.arr[i] := 0;
4383     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4384       aMask.arr[i] := aMask.arr[i] shr 1;
4385       inc(fShift.arr[i]);
4386     end;
4387     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4388   end;
4389   CalcValues;
4390 end;
4391
4392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4393 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4394 begin
4395   fBitsPerPixel := aBBP;
4396   fPrecision    := aPrec;
4397   fShift        := aShift;
4398   CalcValues;
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4403 var
4404   data: QWord;
4405 begin
4406   data :=
4407     ((aPixel.Data.r and Range.r) shl Shift.r) or
4408     ((aPixel.Data.g and Range.g) shl Shift.g) or
4409     ((aPixel.Data.b and Range.b) shl Shift.b) or
4410     ((aPixel.Data.a and Range.a) shl Shift.a);
4411   case BitsPerPixel of
4412     8:           aData^  := data;
4413    16:     PWord(aData)^ := data;
4414    32: PCardinal(aData)^ := data;
4415    64:    PQWord(aData)^ := data;
4416   else
4417     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4418   end;
4419   inc(aData, Round(BytesPerPixel));
4420 end;
4421
4422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4423 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4424 var
4425   data: QWord;
4426   i: Integer;
4427 begin
4428   case BitsPerPixel of
4429      8: data :=           aData^;
4430     16: data :=     PWord(aData)^;
4431     32: data := PCardinal(aData)^;
4432     64: data :=    PQWord(aData)^;
4433   else
4434     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4435   end;
4436   for i := 0 to 3 do
4437     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4438   inc(aData, Round(BytesPerPixel));
4439 end;
4440
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4444 procedure TbmpColorTableFormat.SetValues;
4445 begin
4446   inherited SetValues;
4447   fShift := glBitmapRec4ub(8, 8, 8, 0);
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4452 begin
4453   fFormat       := aFormat;
4454   fBitsPerPixel := aBPP;
4455   fPrecision    := aPrec;
4456   fShift        := aShift;
4457   CalcValues;
4458 end;
4459
4460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4461 procedure TbmpColorTableFormat.CalcValues;
4462 begin
4463   inherited CalcValues;
4464 end;
4465
4466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 procedure TbmpColorTableFormat.CreateColorTable;
4468 var
4469   i: Integer;
4470 begin
4471   SetLength(fColorTable, 256);
4472   if not HasColor then begin
4473     // alpha
4474     for i := 0 to High(fColorTable) do begin
4475       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4476       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4477       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4478       fColorTable[i].a := 0;
4479     end;
4480   end else begin
4481     // normal
4482     for i := 0 to High(fColorTable) do begin
4483       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4484       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4485       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4486       fColorTable[i].a := 0;
4487     end;
4488   end;
4489 end;
4490
4491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4492 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4493 begin
4494   if (BitsPerPixel <> 8) then
4495     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4496   if not HasColor then
4497     // alpha
4498     aData^ := aPixel.Data.a
4499   else
4500     // normal
4501     aData^ := Round(
4502       ((aPixel.Data.r and Range.r) shl Shift.r) or
4503       ((aPixel.Data.g and Range.g) shl Shift.g) or
4504       ((aPixel.Data.b and Range.b) shl Shift.b));
4505   inc(aData);
4506 end;
4507
4508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4509 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4510 begin
4511   if (BitsPerPixel <> 8) then
4512     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4513   with fColorTable[aData^] do begin
4514     aPixel.Data.r := r;
4515     aPixel.Data.g := g;
4516     aPixel.Data.b := b;
4517     aPixel.Data.a := a;
4518   end;
4519   inc(aData, 1);
4520 end;
4521
4522 destructor TbmpColorTableFormat.Destroy;
4523 begin
4524   SetLength(fColorTable, 0);
4525   inherited Destroy;
4526 end;
4527
4528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4529 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4531 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4532 var
4533   i: Integer;
4534 begin
4535   for i := 0 to 3 do begin
4536     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4537       if (aSourceFD.Range.arr[i] > 0) then
4538         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4539       else
4540         aPixel.Data.arr[i] := 0;
4541     end;
4542   end;
4543 end;
4544
4545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4546 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4547 begin
4548   with aFuncRec do begin
4549     if (Source.Range.r   > 0) then
4550       Dest.Data.r := Source.Data.r;
4551     if (Source.Range.g > 0) then
4552       Dest.Data.g := Source.Data.g;
4553     if (Source.Range.b  > 0) then
4554       Dest.Data.b := Source.Data.b;
4555     if (Source.Range.a > 0) then
4556       Dest.Data.a := Source.Data.a;
4557   end;
4558 end;
4559
4560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4561 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4562 var
4563   i: Integer;
4564 begin
4565   with aFuncRec do begin
4566     for i := 0 to 3 do
4567       if (Source.Range.arr[i] > 0) then
4568         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4569   end;
4570 end;
4571
4572 type
4573   TShiftData = packed record
4574     case Integer of
4575       0: (r, g, b, a: SmallInt);
4576       1: (arr: array[0..3] of SmallInt);
4577   end;
4578   PShiftData = ^TShiftData;
4579
4580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4581 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4582 var
4583   i: Integer;
4584 begin
4585   with aFuncRec do
4586     for i := 0 to 3 do
4587       if (Source.Range.arr[i] > 0) then
4588         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4589 end;
4590
4591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4592 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4593 begin
4594   with aFuncRec do begin
4595     Dest.Data := Source.Data;
4596     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4597       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4598       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4599       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4600     end;
4601     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4602       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4603     end;
4604   end;
4605 end;
4606
4607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4608 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4609 var
4610   i: Integer;
4611 begin
4612   with aFuncRec do begin
4613     for i := 0 to 3 do
4614       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4615   end;
4616 end;
4617
4618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4619 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4620 var
4621   Temp: Single;
4622 begin
4623   with FuncRec do begin
4624     if (FuncRec.Args = nil) then begin //source has no alpha
4625       Temp :=
4626         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4627         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4628         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4629       Dest.Data.a := Round(Dest.Range.a * Temp);
4630     end else
4631       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4632   end;
4633 end;
4634
4635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4636 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4637 type
4638   PglBitmapPixelData = ^TglBitmapPixelData;
4639 begin
4640   with FuncRec do begin
4641     Dest.Data.r := Source.Data.r;
4642     Dest.Data.g := Source.Data.g;
4643     Dest.Data.b := Source.Data.b;
4644
4645     with PglBitmapPixelData(Args)^ do
4646       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4647           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4648           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4649         Dest.Data.a := 0
4650       else
4651         Dest.Data.a := Dest.Range.a;
4652   end;
4653 end;
4654
4655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4656 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4657 begin
4658   with FuncRec do begin
4659     Dest.Data.r := Source.Data.r;
4660     Dest.Data.g := Source.Data.g;
4661     Dest.Data.b := Source.Data.b;
4662     Dest.Data.a := PCardinal(Args)^;
4663   end;
4664 end;
4665
4666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4667 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4668 type
4669   PRGBPix = ^TRGBPix;
4670   TRGBPix = array [0..2] of byte;
4671 var
4672   Temp: Byte;
4673 begin
4674   while aWidth > 0 do begin
4675     Temp := PRGBPix(aData)^[0];
4676     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4677     PRGBPix(aData)^[2] := Temp;
4678
4679     if aHasAlpha then
4680       Inc(aData, 4)
4681     else
4682       Inc(aData, 3);
4683     dec(aWidth);
4684   end;
4685 end;
4686
4687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4688 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4690 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4691 begin
4692   result := TFormatDescriptor.Get(Format);
4693 end;
4694
4695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4696 function TglBitmap.GetWidth: Integer;
4697 begin
4698   if (ffX in fDimension.Fields) then
4699     result := fDimension.X
4700   else
4701     result := -1;
4702 end;
4703
4704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4705 function TglBitmap.GetHeight: Integer;
4706 begin
4707   if (ffY in fDimension.Fields) then
4708     result := fDimension.Y
4709   else
4710     result := -1;
4711 end;
4712
4713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4714 function TglBitmap.GetFileWidth: Integer;
4715 begin
4716   result := Max(1, Width);
4717 end;
4718
4719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4720 function TglBitmap.GetFileHeight: Integer;
4721 begin
4722   result := Max(1, Height);
4723 end;
4724
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4727 begin
4728   if fCustomData = aValue then
4729     exit;
4730   fCustomData := aValue;
4731 end;
4732
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 procedure TglBitmap.SetCustomName(const aValue: String);
4735 begin
4736   if fCustomName = aValue then
4737     exit;
4738   fCustomName := aValue;
4739 end;
4740
4741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4742 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4743 begin
4744   if fCustomNameW = aValue then
4745     exit;
4746   fCustomNameW := aValue;
4747 end;
4748
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4751 begin
4752   if fFreeDataOnDestroy = aValue then
4753     exit;
4754   fFreeDataOnDestroy := aValue;
4755 end;
4756
4757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4758 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4759 begin
4760   if fDeleteTextureOnFree = aValue then
4761     exit;
4762   fDeleteTextureOnFree := aValue;
4763 end;
4764
4765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4766 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4767 begin
4768   if fFormat = aValue then
4769     exit;
4770   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4771     raise EglBitmapUnsupportedFormat.Create(Format);
4772   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4773 end;
4774
4775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4776 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4777 begin
4778   if fFreeDataAfterGenTexture = aValue then
4779     exit;
4780   fFreeDataAfterGenTexture := aValue;
4781 end;
4782
4783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4784 procedure TglBitmap.SetID(const aValue: Cardinal);
4785 begin
4786   if fID = aValue then
4787     exit;
4788   fID := aValue;
4789 end;
4790
4791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4792 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4793 begin
4794   if fMipMap = aValue then
4795     exit;
4796   fMipMap := aValue;
4797 end;
4798
4799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4800 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4801 begin
4802   if fTarget = aValue then
4803     exit;
4804   fTarget := aValue;
4805 end;
4806
4807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4808 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4809 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4810 var
4811   MaxAnisotropic: Integer;
4812 {$IFEND}
4813 begin
4814   fAnisotropic := aValue;
4815   if (ID > 0) then begin
4816 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4817     if GL_EXT_texture_filter_anisotropic then begin
4818       if fAnisotropic > 0 then begin
4819         Bind(false);
4820         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4821         if aValue > MaxAnisotropic then
4822           fAnisotropic := MaxAnisotropic;
4823         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4824       end;
4825     end else begin
4826       fAnisotropic := 0;
4827     end;
4828 {$ELSE}
4829     fAnisotropic := 0;
4830 {$IFEND}
4831   end;
4832 end;
4833
4834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4835 procedure TglBitmap.CreateID;
4836 begin
4837   if (ID <> 0) then
4838     glDeleteTextures(1, @fID);
4839   glGenTextures(1, @fID);
4840   Bind(false);
4841 end;
4842
4843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4844 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
4845 begin
4846   // Set Up Parameters
4847   SetWrap(fWrapS, fWrapT, fWrapR);
4848   SetFilter(fFilterMin, fFilterMag);
4849   SetAnisotropic(fAnisotropic);
4850
4851 {$IFNDEF OPENGL_ES}
4852   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4853   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4854     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4855 {$ENDIF}
4856
4857 {$IFNDEF OPENGL_ES}
4858   // Mip Maps Generation Mode
4859   aBuildWithGlu := false;
4860   if (MipMap = mmMipmap) then begin
4861     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4862       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4863     else
4864       aBuildWithGlu := true;
4865   end else if (MipMap = mmMipmapGlu) then
4866     aBuildWithGlu := true;
4867 {$ELSE}
4868   if (MipMap = mmMipmap) then
4869     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
4870 {$ENDIF}
4871 end;
4872
4873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4874 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4875   const aWidth: Integer; const aHeight: Integer);
4876 var
4877   s: Single;
4878 begin
4879   if (Data <> aData) then begin
4880     if (Assigned(Data)) then
4881       FreeMem(Data);
4882     fData := aData;
4883   end;
4884
4885   if not Assigned(fData) then begin
4886     fPixelSize := 0;
4887     fRowSize   := 0;
4888   end else begin
4889     FillChar(fDimension, SizeOf(fDimension), 0);
4890     if aWidth <> -1 then begin
4891       fDimension.Fields := fDimension.Fields + [ffX];
4892       fDimension.X := aWidth;
4893     end;
4894
4895     if aHeight <> -1 then begin
4896       fDimension.Fields := fDimension.Fields + [ffY];
4897       fDimension.Y := aHeight;
4898     end;
4899
4900     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4901     fFormat    := aFormat;
4902     fPixelSize := Ceil(s);
4903     fRowSize   := Ceil(s * aWidth);
4904   end;
4905 end;
4906
4907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4908 function TglBitmap.FlipHorz: Boolean;
4909 begin
4910   result := false;
4911 end;
4912
4913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4914 function TglBitmap.FlipVert: Boolean;
4915 begin
4916   result := false;
4917 end;
4918
4919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4920 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4922 procedure TglBitmap.AfterConstruction;
4923 begin
4924   inherited AfterConstruction;
4925
4926   fID         := 0;
4927   fTarget     := 0;
4928 {$IFNDEF OPENGL_ES}
4929   fIsResident := false;
4930 {$ENDIF}
4931
4932   fMipMap                  := glBitmapDefaultMipmap;
4933   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4934   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4935
4936   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4937   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4938 {$IFNDEF OPENGL_ES}
4939   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4940 {$ENDIF}
4941 end;
4942
4943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4944 procedure TglBitmap.BeforeDestruction;
4945 var
4946   NewData: PByte;
4947 begin
4948   if fFreeDataOnDestroy then begin
4949     NewData := nil;
4950     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4951   end;
4952   if (fID > 0) and fDeleteTextureOnFree then
4953     glDeleteTextures(1, @fID);
4954   inherited BeforeDestruction;
4955 end;
4956
4957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4958 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4959 var
4960   TempPos: Integer;
4961 begin
4962   if not Assigned(aResType) then begin
4963     TempPos   := Pos('.', aResource);
4964     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4965     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4966   end;
4967 end;
4968
4969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4970 procedure TglBitmap.LoadFromFile(const aFilename: String);
4971 var
4972   fs: TFileStream;
4973 begin
4974   if not FileExists(aFilename) then
4975     raise EglBitmap.Create('file does not exist: ' + aFilename);
4976   fFilename := aFilename;
4977   fs := TFileStream.Create(fFilename, fmOpenRead);
4978   try
4979     fs.Position := 0;
4980     LoadFromStream(fs);
4981   finally
4982     fs.Free;
4983   end;
4984 end;
4985
4986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4987 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4988 begin
4989   {$IFDEF GLB_SUPPORT_PNG_READ}
4990   if not LoadPNG(aStream) then
4991   {$ENDIF}
4992   {$IFDEF GLB_SUPPORT_JPEG_READ}
4993   if not LoadJPEG(aStream) then
4994   {$ENDIF}
4995   if not LoadDDS(aStream) then
4996   if not LoadTGA(aStream) then
4997   if not LoadBMP(aStream) then
4998   if not LoadRAW(aStream) then
4999     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
5000 end;
5001
5002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5003 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
5004   const aFormat: TglBitmapFormat; const aArgs: Pointer);
5005 var
5006   tmpData: PByte;
5007   size: Integer;
5008 begin
5009   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5010   GetMem(tmpData, size);
5011   try
5012     FillChar(tmpData^, size, #$FF);
5013     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5014   except
5015     if Assigned(tmpData) then
5016       FreeMem(tmpData);
5017     raise;
5018   end;
5019   AddFunc(Self, aFunc, false, aFormat, aArgs);
5020 end;
5021
5022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5023 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
5024 var
5025   rs: TResourceStream;
5026 begin
5027   PrepareResType(aResource, aResType);
5028   rs := TResourceStream.Create(aInstance, aResource, aResType);
5029   try
5030     LoadFromStream(rs);
5031   finally
5032     rs.Free;
5033   end;
5034 end;
5035
5036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5037 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5038 var
5039   rs: TResourceStream;
5040 begin
5041   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5042   try
5043     LoadFromStream(rs);
5044   finally
5045     rs.Free;
5046   end;
5047 end;
5048
5049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5050 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
5051 var
5052   fs: TFileStream;
5053 begin
5054   fs := TFileStream.Create(aFileName, fmCreate);
5055   try
5056     fs.Position := 0;
5057     SaveToStream(fs, aFileType);
5058   finally
5059     fs.Free;
5060   end;
5061 end;
5062
5063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5064 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
5065 begin
5066   case aFileType of
5067     {$IFDEF GLB_SUPPORT_PNG_WRITE}
5068     ftPNG:  SavePNG(aStream);
5069     {$ENDIF}
5070     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5071     ftJPEG: SaveJPEG(aStream);
5072     {$ENDIF}
5073     ftDDS:  SaveDDS(aStream);
5074     ftTGA:  SaveTGA(aStream);
5075     ftBMP:  SaveBMP(aStream);
5076     ftRAW:  SaveRAW(aStream);
5077   end;
5078 end;
5079
5080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5081 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
5082 begin
5083   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
5084 end;
5085
5086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5087 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
5088   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
5089 var
5090   DestData, TmpData, SourceData: pByte;
5091   TempHeight, TempWidth: Integer;
5092   SourceFD, DestFD: TFormatDescriptor;
5093   SourceMD, DestMD: Pointer;
5094
5095   FuncRec: TglBitmapFunctionRec;
5096 begin
5097   Assert(Assigned(Data));
5098   Assert(Assigned(aSource));
5099   Assert(Assigned(aSource.Data));
5100
5101   result := false;
5102   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
5103     SourceFD := TFormatDescriptor.Get(aSource.Format);
5104     DestFD   := TFormatDescriptor.Get(aFormat);
5105
5106     if (SourceFD.IsCompressed) then
5107       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
5108     if (DestFD.IsCompressed) then
5109       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
5110
5111     // inkompatible Formats so CreateTemp
5112     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
5113       aCreateTemp := true;
5114
5115     // Values
5116     TempHeight := Max(1, aSource.Height);
5117     TempWidth  := Max(1, aSource.Width);
5118
5119     FuncRec.Sender := Self;
5120     FuncRec.Args   := aArgs;
5121
5122     TmpData := nil;
5123     if aCreateTemp then begin
5124       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5125       DestData := TmpData;
5126     end else
5127       DestData := Data;
5128
5129     try
5130       SourceFD.PreparePixel(FuncRec.Source);
5131       DestFD.PreparePixel  (FuncRec.Dest);
5132
5133       SourceMD := SourceFD.CreateMappingData;
5134       DestMD   := DestFD.CreateMappingData;
5135
5136       FuncRec.Size            := aSource.Dimension;
5137       FuncRec.Position.Fields := FuncRec.Size.Fields;
5138
5139       try
5140         SourceData := aSource.Data;
5141         FuncRec.Position.Y := 0;
5142         while FuncRec.Position.Y < TempHeight do begin
5143           FuncRec.Position.X := 0;
5144           while FuncRec.Position.X < TempWidth do begin
5145             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5146             aFunc(FuncRec);
5147             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5148             inc(FuncRec.Position.X);
5149           end;
5150           inc(FuncRec.Position.Y);
5151         end;
5152
5153         // Updating Image or InternalFormat
5154         if aCreateTemp then
5155           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5156         else if (aFormat <> fFormat) then
5157           Format := aFormat;
5158
5159         result := true;
5160       finally
5161         SourceFD.FreeMappingData(SourceMD);
5162         DestFD.FreeMappingData(DestMD);
5163       end;
5164     except
5165       if aCreateTemp and Assigned(TmpData) then
5166         FreeMem(TmpData);
5167       raise;
5168     end;
5169   end;
5170 end;
5171
5172 {$IFDEF GLB_SDL}
5173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5174 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5175 var
5176   Row, RowSize: Integer;
5177   SourceData, TmpData: PByte;
5178   TempDepth: Integer;
5179   FormatDesc: TFormatDescriptor;
5180
5181   function GetRowPointer(Row: Integer): pByte;
5182   begin
5183     result := aSurface.pixels;
5184     Inc(result, Row * RowSize);
5185   end;
5186
5187 begin
5188   result := false;
5189
5190   FormatDesc := TFormatDescriptor.Get(Format);
5191   if FormatDesc.IsCompressed then
5192     raise EglBitmapUnsupportedFormat.Create(Format);
5193
5194   if Assigned(Data) then begin
5195     case Trunc(FormatDesc.PixelSize) of
5196       1: TempDepth :=  8;
5197       2: TempDepth := 16;
5198       3: TempDepth := 24;
5199       4: TempDepth := 32;
5200     else
5201       raise EglBitmapUnsupportedFormat.Create(Format);
5202     end;
5203
5204     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5205       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5206     SourceData := Data;
5207     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5208
5209     for Row := 0 to FileHeight-1 do begin
5210       TmpData := GetRowPointer(Row);
5211       if Assigned(TmpData) then begin
5212         Move(SourceData^, TmpData^, RowSize);
5213         inc(SourceData, RowSize);
5214       end;
5215     end;
5216     result := true;
5217   end;
5218 end;
5219
5220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5221 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5222 var
5223   pSource, pData, pTempData: PByte;
5224   Row, RowSize, TempWidth, TempHeight: Integer;
5225   IntFormat: TglBitmapFormat;
5226   fd: TFormatDescriptor;
5227   Mask: TglBitmapMask;
5228
5229   function GetRowPointer(Row: Integer): pByte;
5230   begin
5231     result := aSurface^.pixels;
5232     Inc(result, Row * RowSize);
5233   end;
5234
5235 begin
5236   result := false;
5237   if (Assigned(aSurface)) then begin
5238     with aSurface^.format^ do begin
5239       Mask.r := RMask;
5240       Mask.g := GMask;
5241       Mask.b := BMask;
5242       Mask.a := AMask;
5243       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5244       if (IntFormat = tfEmpty) then
5245         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5246     end;
5247
5248     fd := TFormatDescriptor.Get(IntFormat);
5249     TempWidth  := aSurface^.w;
5250     TempHeight := aSurface^.h;
5251     RowSize := fd.GetSize(TempWidth, 1);
5252     GetMem(pData, TempHeight * RowSize);
5253     try
5254       pTempData := pData;
5255       for Row := 0 to TempHeight -1 do begin
5256         pSource := GetRowPointer(Row);
5257         if (Assigned(pSource)) then begin
5258           Move(pSource^, pTempData^, RowSize);
5259           Inc(pTempData, RowSize);
5260         end;
5261       end;
5262       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5263       result := true;
5264     except
5265       if Assigned(pData) then
5266         FreeMem(pData);
5267       raise;
5268     end;
5269   end;
5270 end;
5271
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5274 var
5275   Row, Col, AlphaInterleave: Integer;
5276   pSource, pDest: PByte;
5277
5278   function GetRowPointer(Row: Integer): pByte;
5279   begin
5280     result := aSurface.pixels;
5281     Inc(result, Row * Width);
5282   end;
5283
5284 begin
5285   result := false;
5286   if Assigned(Data) then begin
5287     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5288       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5289
5290       AlphaInterleave := 0;
5291       case Format of
5292         tfLuminance8Alpha8ub2:
5293           AlphaInterleave := 1;
5294         tfBGRA8ub4, tfRGBA8ub4:
5295           AlphaInterleave := 3;
5296       end;
5297
5298       pSource := Data;
5299       for Row := 0 to Height -1 do begin
5300         pDest := GetRowPointer(Row);
5301         if Assigned(pDest) then begin
5302           for Col := 0 to Width -1 do begin
5303             Inc(pSource, AlphaInterleave);
5304             pDest^ := pSource^;
5305             Inc(pDest);
5306             Inc(pSource);
5307           end;
5308         end;
5309       end;
5310       result := true;
5311     end;
5312   end;
5313 end;
5314
5315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5316 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5317 var
5318   bmp: TglBitmap2D;
5319 begin
5320   bmp := TglBitmap2D.Create;
5321   try
5322     bmp.AssignFromSurface(aSurface);
5323     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5324   finally
5325     bmp.Free;
5326   end;
5327 end;
5328 {$ENDIF}
5329
5330 {$IFDEF GLB_DELPHI}
5331 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5332 function CreateGrayPalette: HPALETTE;
5333 var
5334   Idx: Integer;
5335   Pal: PLogPalette;
5336 begin
5337   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5338
5339   Pal.palVersion := $300;
5340   Pal.palNumEntries := 256;
5341
5342   for Idx := 0 to Pal.palNumEntries - 1 do begin
5343     Pal.palPalEntry[Idx].peRed   := Idx;
5344     Pal.palPalEntry[Idx].peGreen := Idx;
5345     Pal.palPalEntry[Idx].peBlue  := Idx;
5346     Pal.palPalEntry[Idx].peFlags := 0;
5347   end;
5348   Result := CreatePalette(Pal^);
5349   FreeMem(Pal);
5350 end;
5351
5352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5353 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5354 var
5355   Row: Integer;
5356   pSource, pData: PByte;
5357 begin
5358   result := false;
5359   if Assigned(Data) then begin
5360     if Assigned(aBitmap) then begin
5361       aBitmap.Width  := Width;
5362       aBitmap.Height := Height;
5363
5364       case Format of
5365         tfAlpha8ub1, tfLuminance8ub1: begin
5366           aBitmap.PixelFormat := pf8bit;
5367           aBitmap.Palette     := CreateGrayPalette;
5368         end;
5369         tfRGB5A1us1:
5370           aBitmap.PixelFormat := pf15bit;
5371         tfR5G6B5us1:
5372           aBitmap.PixelFormat := pf16bit;
5373         tfRGB8ub3, tfBGR8ub3:
5374           aBitmap.PixelFormat := pf24bit;
5375         tfRGBA8ub4, tfBGRA8ub4:
5376           aBitmap.PixelFormat := pf32bit;
5377       else
5378         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5379       end;
5380
5381       pSource := Data;
5382       for Row := 0 to FileHeight -1 do begin
5383         pData := aBitmap.Scanline[Row];
5384         Move(pSource^, pData^, fRowSize);
5385         Inc(pSource, fRowSize);
5386         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5387           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5388       end;
5389       result := true;
5390     end;
5391   end;
5392 end;
5393
5394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5395 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5396 var
5397   pSource, pData, pTempData: PByte;
5398   Row, RowSize, TempWidth, TempHeight: Integer;
5399   IntFormat: TglBitmapFormat;
5400 begin
5401   result := false;
5402
5403   if (Assigned(aBitmap)) then begin
5404     case aBitmap.PixelFormat of
5405       pf8bit:
5406         IntFormat := tfLuminance8ub1;
5407       pf15bit:
5408         IntFormat := tfRGB5A1us1;
5409       pf16bit:
5410         IntFormat := tfR5G6B5us1;
5411       pf24bit:
5412         IntFormat := tfBGR8ub3;
5413       pf32bit:
5414         IntFormat := tfBGRA8ub4;
5415     else
5416       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5417     end;
5418
5419     TempWidth  := aBitmap.Width;
5420     TempHeight := aBitmap.Height;
5421     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5422     GetMem(pData, TempHeight * RowSize);
5423     try
5424       pTempData := pData;
5425       for Row := 0 to TempHeight -1 do begin
5426         pSource := aBitmap.Scanline[Row];
5427         if (Assigned(pSource)) then begin
5428           Move(pSource^, pTempData^, RowSize);
5429           Inc(pTempData, RowSize);
5430         end;
5431       end;
5432       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5433       result := true;
5434     except
5435       if Assigned(pData) then
5436         FreeMem(pData);
5437       raise;
5438     end;
5439   end;
5440 end;
5441
5442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5443 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5444 var
5445   Row, Col, AlphaInterleave: Integer;
5446   pSource, pDest: PByte;
5447 begin
5448   result := false;
5449
5450   if Assigned(Data) then begin
5451     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5452       if Assigned(aBitmap) then begin
5453         aBitmap.PixelFormat := pf8bit;
5454         aBitmap.Palette     := CreateGrayPalette;
5455         aBitmap.Width       := Width;
5456         aBitmap.Height      := Height;
5457
5458         case Format of
5459           tfLuminance8Alpha8ub2:
5460             AlphaInterleave := 1;
5461           tfRGBA8ub4, tfBGRA8ub4:
5462             AlphaInterleave := 3;
5463           else
5464             AlphaInterleave := 0;
5465         end;
5466
5467         // Copy Data
5468         pSource := Data;
5469
5470         for Row := 0 to Height -1 do begin
5471           pDest := aBitmap.Scanline[Row];
5472           if Assigned(pDest) then begin
5473             for Col := 0 to Width -1 do begin
5474               Inc(pSource, AlphaInterleave);
5475               pDest^ := pSource^;
5476               Inc(pDest);
5477               Inc(pSource);
5478             end;
5479           end;
5480         end;
5481         result := true;
5482       end;
5483     end;
5484   end;
5485 end;
5486
5487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5488 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5489 var
5490   tex: TglBitmap2D;
5491 begin
5492   tex := TglBitmap2D.Create;
5493   try
5494     tex.AssignFromBitmap(ABitmap);
5495     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5496   finally
5497     tex.Free;
5498   end;
5499 end;
5500 {$ENDIF}
5501
5502 {$IFDEF GLB_LAZARUS}
5503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5504 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5505 var
5506   rid: TRawImageDescription;
5507   FormatDesc: TFormatDescriptor;
5508 begin
5509   if not Assigned(Data) then
5510     raise EglBitmap.Create('no pixel data assigned. load data before save');
5511
5512   result := false;
5513   if not Assigned(aImage) or (Format = tfEmpty) then
5514     exit;
5515   FormatDesc := TFormatDescriptor.Get(Format);
5516   if FormatDesc.IsCompressed then
5517     exit;
5518
5519   FillChar(rid{%H-}, SizeOf(rid), 0);
5520   if FormatDesc.IsGrayscale then
5521     rid.Format := ricfGray
5522   else
5523     rid.Format := ricfRGBA;
5524
5525   rid.Width        := Width;
5526   rid.Height       := Height;
5527   rid.Depth        := FormatDesc.BitsPerPixel;
5528   rid.BitOrder     := riboBitsInOrder;
5529   rid.ByteOrder    := riboLSBFirst;
5530   rid.LineOrder    := riloTopToBottom;
5531   rid.LineEnd      := rileTight;
5532   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5533   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5534   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5535   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5536   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5537   rid.RedShift     := FormatDesc.Shift.r;
5538   rid.GreenShift   := FormatDesc.Shift.g;
5539   rid.BlueShift    := FormatDesc.Shift.b;
5540   rid.AlphaShift   := FormatDesc.Shift.a;
5541
5542   rid.MaskBitsPerPixel  := 0;
5543   rid.PaletteColorCount := 0;
5544
5545   aImage.DataDescription := rid;
5546   aImage.CreateData;
5547
5548   if not Assigned(aImage.PixelData) then
5549     raise EglBitmap.Create('error while creating LazIntfImage');
5550   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5551
5552   result := true;
5553 end;
5554
5555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5556 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5557 var
5558   f: TglBitmapFormat;
5559   FormatDesc: TFormatDescriptor;
5560   ImageData: PByte;
5561   ImageSize: Integer;
5562   CanCopy: Boolean;
5563   Mask: TglBitmapRec4ul;
5564
5565   procedure CopyConvert;
5566   var
5567     bfFormat: TbmpBitfieldFormat;
5568     pSourceLine, pDestLine: PByte;
5569     pSourceMD, pDestMD: Pointer;
5570     Shift, Prec: TglBitmapRec4ub;
5571     x, y: Integer;
5572     pixel: TglBitmapPixelData;
5573   begin
5574     bfFormat  := TbmpBitfieldFormat.Create;
5575     with aImage.DataDescription do begin
5576       Prec.r := RedPrec;
5577       Prec.g := GreenPrec;
5578       Prec.b := BluePrec;
5579       Prec.a := AlphaPrec;
5580       Shift.r := RedShift;
5581       Shift.g := GreenShift;
5582       Shift.b := BlueShift;
5583       Shift.a := AlphaShift;
5584       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5585     end;
5586     pSourceMD := bfFormat.CreateMappingData;
5587     pDestMD   := FormatDesc.CreateMappingData;
5588     try
5589       for y := 0 to aImage.Height-1 do begin
5590         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5591         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5592         for x := 0 to aImage.Width-1 do begin
5593           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5594           FormatDesc.Map(pixel, pDestLine, pDestMD);
5595         end;
5596       end;
5597     finally
5598       FormatDesc.FreeMappingData(pDestMD);
5599       bfFormat.FreeMappingData(pSourceMD);
5600       bfFormat.Free;
5601     end;
5602   end;
5603
5604 begin
5605   result := false;
5606   if not Assigned(aImage) then
5607     exit;
5608
5609   with aImage.DataDescription do begin
5610     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5611     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5612     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5613     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5614   end;
5615   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5616   f          := FormatDesc.Format;
5617   if (f = tfEmpty) then
5618     exit;
5619
5620   CanCopy :=
5621     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5622     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5623
5624   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5625   ImageData := GetMem(ImageSize);
5626   try
5627     if CanCopy then
5628       Move(aImage.PixelData^, ImageData^, ImageSize)
5629     else
5630       CopyConvert;
5631     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5632   except
5633     if Assigned(ImageData) then
5634       FreeMem(ImageData);
5635     raise;
5636   end;
5637
5638   result := true;
5639 end;
5640
5641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5642 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5643 var
5644   rid: TRawImageDescription;
5645   FormatDesc: TFormatDescriptor;
5646   Pixel: TglBitmapPixelData;
5647   x, y: Integer;
5648   srcMD: Pointer;
5649   src, dst: PByte;
5650 begin
5651   result := false;
5652   if not Assigned(aImage) or (Format = tfEmpty) then
5653     exit;
5654   FormatDesc := TFormatDescriptor.Get(Format);
5655   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5656     exit;
5657
5658   FillChar(rid{%H-}, SizeOf(rid), 0);
5659   rid.Format       := ricfGray;
5660   rid.Width        := Width;
5661   rid.Height       := Height;
5662   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5663   rid.BitOrder     := riboBitsInOrder;
5664   rid.ByteOrder    := riboLSBFirst;
5665   rid.LineOrder    := riloTopToBottom;
5666   rid.LineEnd      := rileTight;
5667   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5668   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5669   rid.GreenPrec    := 0;
5670   rid.BluePrec     := 0;
5671   rid.AlphaPrec    := 0;
5672   rid.RedShift     := 0;
5673   rid.GreenShift   := 0;
5674   rid.BlueShift    := 0;
5675   rid.AlphaShift   := 0;
5676
5677   rid.MaskBitsPerPixel  := 0;
5678   rid.PaletteColorCount := 0;
5679
5680   aImage.DataDescription := rid;
5681   aImage.CreateData;
5682
5683   srcMD := FormatDesc.CreateMappingData;
5684   try
5685     FormatDesc.PreparePixel(Pixel);
5686     src := Data;
5687     dst := aImage.PixelData;
5688     for y := 0 to Height-1 do
5689       for x := 0 to Width-1 do begin
5690         FormatDesc.Unmap(src, Pixel, srcMD);
5691         case rid.BitsPerPixel of
5692            8: begin
5693             dst^ := Pixel.Data.a;
5694             inc(dst);
5695           end;
5696           16: begin
5697             PWord(dst)^ := Pixel.Data.a;
5698             inc(dst, 2);
5699           end;
5700           24: begin
5701             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5702             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5703             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5704             inc(dst, 3);
5705           end;
5706           32: begin
5707             PCardinal(dst)^ := Pixel.Data.a;
5708             inc(dst, 4);
5709           end;
5710         else
5711           raise EglBitmapUnsupportedFormat.Create(Format);
5712         end;
5713       end;
5714   finally
5715     FormatDesc.FreeMappingData(srcMD);
5716   end;
5717   result := true;
5718 end;
5719
5720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5721 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5722 var
5723   tex: TglBitmap2D;
5724 begin
5725   tex := TglBitmap2D.Create;
5726   try
5727     tex.AssignFromLazIntfImage(aImage);
5728     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5729   finally
5730     tex.Free;
5731   end;
5732 end;
5733 {$ENDIF}
5734
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5737   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5738 var
5739   rs: TResourceStream;
5740 begin
5741   PrepareResType(aResource, aResType);
5742   rs := TResourceStream.Create(aInstance, aResource, aResType);
5743   try
5744     result := AddAlphaFromStream(rs, aFunc, aArgs);
5745   finally
5746     rs.Free;
5747   end;
5748 end;
5749
5750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5751 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5752   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5753 var
5754   rs: TResourceStream;
5755 begin
5756   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5757   try
5758     result := AddAlphaFromStream(rs, aFunc, aArgs);
5759   finally
5760     rs.Free;
5761   end;
5762 end;
5763
5764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5765 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5766 begin
5767   if TFormatDescriptor.Get(Format).IsCompressed then
5768     raise EglBitmapUnsupportedFormat.Create(Format);
5769   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5770 end;
5771
5772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5773 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5774 var
5775   FS: TFileStream;
5776 begin
5777   FS := TFileStream.Create(aFileName, fmOpenRead);
5778   try
5779     result := AddAlphaFromStream(FS, aFunc, aArgs);
5780   finally
5781     FS.Free;
5782   end;
5783 end;
5784
5785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5786 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5787 var
5788   tex: TglBitmap2D;
5789 begin
5790   tex := TglBitmap2D.Create(aStream);
5791   try
5792     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5793   finally
5794     tex.Free;
5795   end;
5796 end;
5797
5798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5799 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5800 var
5801   DestData, DestData2, SourceData: pByte;
5802   TempHeight, TempWidth: Integer;
5803   SourceFD, DestFD: TFormatDescriptor;
5804   SourceMD, DestMD, DestMD2: Pointer;
5805
5806   FuncRec: TglBitmapFunctionRec;
5807 begin
5808   result := false;
5809
5810   Assert(Assigned(Data));
5811   Assert(Assigned(aBitmap));
5812   Assert(Assigned(aBitmap.Data));
5813
5814   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5815     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5816
5817     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5818     DestFD   := TFormatDescriptor.Get(Format);
5819
5820     if not Assigned(aFunc) then begin
5821       aFunc        := glBitmapAlphaFunc;
5822       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5823     end else
5824       FuncRec.Args := aArgs;
5825
5826     // Values
5827     TempHeight := aBitmap.FileHeight;
5828     TempWidth  := aBitmap.FileWidth;
5829
5830     FuncRec.Sender          := Self;
5831     FuncRec.Size            := Dimension;
5832     FuncRec.Position.Fields := FuncRec.Size.Fields;
5833
5834     DestData   := Data;
5835     DestData2  := Data;
5836     SourceData := aBitmap.Data;
5837
5838     // Mapping
5839     SourceFD.PreparePixel(FuncRec.Source);
5840     DestFD.PreparePixel  (FuncRec.Dest);
5841
5842     SourceMD := SourceFD.CreateMappingData;
5843     DestMD   := DestFD.CreateMappingData;
5844     DestMD2  := DestFD.CreateMappingData;
5845     try
5846       FuncRec.Position.Y := 0;
5847       while FuncRec.Position.Y < TempHeight do begin
5848         FuncRec.Position.X := 0;
5849         while FuncRec.Position.X < TempWidth do begin
5850           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5851           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5852           aFunc(FuncRec);
5853           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5854           inc(FuncRec.Position.X);
5855         end;
5856         inc(FuncRec.Position.Y);
5857       end;
5858     finally
5859       SourceFD.FreeMappingData(SourceMD);
5860       DestFD.FreeMappingData(DestMD);
5861       DestFD.FreeMappingData(DestMD2);
5862     end;
5863   end;
5864 end;
5865
5866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5867 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5868 begin
5869   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5870 end;
5871
5872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5873 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5874 var
5875   PixelData: TglBitmapPixelData;
5876 begin
5877   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5878   result := AddAlphaFromColorKeyFloat(
5879     aRed   / PixelData.Range.r,
5880     aGreen / PixelData.Range.g,
5881     aBlue  / PixelData.Range.b,
5882     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5883 end;
5884
5885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5886 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5887 var
5888   values: array[0..2] of Single;
5889   tmp: Cardinal;
5890   i: Integer;
5891   PixelData: TglBitmapPixelData;
5892 begin
5893   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5894   with PixelData do begin
5895     values[0] := aRed;
5896     values[1] := aGreen;
5897     values[2] := aBlue;
5898
5899     for i := 0 to 2 do begin
5900       tmp          := Trunc(Range.arr[i] * aDeviation);
5901       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5902       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5903     end;
5904     Data.a  := 0;
5905     Range.a := 0;
5906   end;
5907   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5908 end;
5909
5910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5911 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5912 begin
5913   result := AddAlphaFromValueFloat(aAlpha / $FF);
5914 end;
5915
5916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5917 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5918 var
5919   PixelData: TglBitmapPixelData;
5920 begin
5921   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5922   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5923 end;
5924
5925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5926 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5927 var
5928   PixelData: TglBitmapPixelData;
5929 begin
5930   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5931   with PixelData do
5932     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5933   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5934 end;
5935
5936 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5937 function TglBitmap.RemoveAlpha: Boolean;
5938 var
5939   FormatDesc: TFormatDescriptor;
5940 begin
5941   result := false;
5942   FormatDesc := TFormatDescriptor.Get(Format);
5943   if Assigned(Data) then begin
5944     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5945       raise EglBitmapUnsupportedFormat.Create(Format);
5946     result := ConvertTo(FormatDesc.WithoutAlpha);
5947   end;
5948 end;
5949
5950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5951 function TglBitmap.Clone: TglBitmap;
5952 var
5953   Temp: TglBitmap;
5954   TempPtr: PByte;
5955   Size: Integer;
5956 begin
5957   result := nil;
5958   Temp := (ClassType.Create as TglBitmap);
5959   try
5960     // copy texture data if assigned
5961     if Assigned(Data) then begin
5962       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5963       GetMem(TempPtr, Size);
5964       try
5965         Move(Data^, TempPtr^, Size);
5966         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5967       except
5968         if Assigned(TempPtr) then
5969           FreeMem(TempPtr);
5970         raise;
5971       end;
5972     end else begin
5973       TempPtr := nil;
5974       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5975     end;
5976
5977         // copy properties
5978     Temp.fID                      := ID;
5979     Temp.fTarget                  := Target;
5980     Temp.fFormat                  := Format;
5981     Temp.fMipMap                  := MipMap;
5982     Temp.fAnisotropic             := Anisotropic;
5983     Temp.fBorderColor             := fBorderColor;
5984     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5985     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5986     Temp.fFilterMin               := fFilterMin;
5987     Temp.fFilterMag               := fFilterMag;
5988     Temp.fWrapS                   := fWrapS;
5989     Temp.fWrapT                   := fWrapT;
5990     Temp.fWrapR                   := fWrapR;
5991     Temp.fFilename                := fFilename;
5992     Temp.fCustomName              := fCustomName;
5993     Temp.fCustomNameW             := fCustomNameW;
5994     Temp.fCustomData              := fCustomData;
5995
5996     result := Temp;
5997   except
5998     FreeAndNil(Temp);
5999     raise;
6000   end;
6001 end;
6002
6003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6004 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6005 var
6006   SourceFD, DestFD: TFormatDescriptor;
6007   SourcePD, DestPD: TglBitmapPixelData;
6008   ShiftData: TShiftData;
6009
6010   function DataIsIdentical: Boolean;
6011   begin
6012     result := SourceFD.MaskMatch(DestFD.Mask);
6013   end;
6014
6015   function CanCopyDirect: Boolean;
6016   begin
6017     result :=
6018       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6019       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6020       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6021       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6022   end;
6023
6024   function CanShift: Boolean;
6025   begin
6026     result :=
6027       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6028       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6029       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6030       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6031   end;
6032
6033   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6034   begin
6035     result := 0;
6036     while (aSource > aDest) and (aSource > 0) do begin
6037       inc(result);
6038       aSource := aSource shr 1;
6039     end;
6040   end;
6041
6042 begin
6043   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6044     SourceFD := TFormatDescriptor.Get(Format);
6045     DestFD   := TFormatDescriptor.Get(aFormat);
6046
6047     if DataIsIdentical then begin
6048       result := true;
6049       Format := aFormat;
6050       exit;
6051     end;
6052
6053     SourceFD.PreparePixel(SourcePD);
6054     DestFD.PreparePixel  (DestPD);
6055
6056     if CanCopyDirect then
6057       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
6058     else if CanShift then begin
6059       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6060       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6061       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6062       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6063       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6064     end else
6065       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6066   end else
6067     result := true;
6068 end;
6069
6070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6071 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
6072 begin
6073   if aUseRGB or aUseAlpha then
6074     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
6075       ((Byte(aUseAlpha) and 1) shl 1) or
6076        (Byte(aUseRGB)   and 1)      ));
6077 end;
6078
6079 {$IFNDEF OPENGL_ES}
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
6082 begin
6083   fBorderColor[0] := aRed;
6084   fBorderColor[1] := aGreen;
6085   fBorderColor[2] := aBlue;
6086   fBorderColor[3] := aAlpha;
6087   if (ID > 0) then begin
6088     Bind(false);
6089     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6090   end;
6091 end;
6092 {$ENDIF}
6093
6094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6095 procedure TglBitmap.FreeData;
6096 var
6097   TempPtr: PByte;
6098 begin
6099   TempPtr := nil;
6100   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
6101 end;
6102
6103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6104 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
6105   const aAlpha: Byte);
6106 begin
6107   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
6108 end;
6109
6110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6111 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
6112 var
6113   PixelData: TglBitmapPixelData;
6114 begin
6115   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6116   FillWithColorFloat(
6117     aRed   / PixelData.Range.r,
6118     aGreen / PixelData.Range.g,
6119     aBlue  / PixelData.Range.b,
6120     aAlpha / PixelData.Range.a);
6121 end;
6122
6123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6124 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
6125 var
6126   PixelData: TglBitmapPixelData;
6127 begin
6128   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6129   with PixelData do begin
6130     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6131     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6132     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6133     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6134   end;
6135   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6136 end;
6137
6138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6139 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6140 begin
6141   //check MIN filter
6142   case aMin of
6143     GL_NEAREST:
6144       fFilterMin := GL_NEAREST;
6145     GL_LINEAR:
6146       fFilterMin := GL_LINEAR;
6147     GL_NEAREST_MIPMAP_NEAREST:
6148       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6149     GL_LINEAR_MIPMAP_NEAREST:
6150       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6151     GL_NEAREST_MIPMAP_LINEAR:
6152       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6153     GL_LINEAR_MIPMAP_LINEAR:
6154       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6155     else
6156       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6157   end;
6158
6159   //check MAG filter
6160   case aMag of
6161     GL_NEAREST:
6162       fFilterMag := GL_NEAREST;
6163     GL_LINEAR:
6164       fFilterMag := GL_LINEAR;
6165     else
6166       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6167   end;
6168
6169   //apply filter
6170   if (ID > 0) then begin
6171     Bind(false);
6172     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6173
6174     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
6175       case fFilterMin of
6176         GL_NEAREST, GL_LINEAR:
6177           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6178         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6179           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6180         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6181           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6182       end;
6183     end else
6184       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6185   end;
6186 end;
6187
6188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6189 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6190
6191   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6192   begin
6193     case aValue of
6194 {$IFNDEF OPENGL_ES}
6195       GL_CLAMP:
6196         aTarget := GL_CLAMP;
6197 {$ENDIF}
6198
6199       GL_REPEAT:
6200         aTarget := GL_REPEAT;
6201
6202       GL_CLAMP_TO_EDGE: begin
6203 {$IFNDEF OPENGL_ES}
6204         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
6205           aTarget := GL_CLAMP
6206         else
6207 {$ENDIF}
6208           aTarget := GL_CLAMP_TO_EDGE;
6209       end;
6210
6211 {$IFNDEF OPENGL_ES}
6212       GL_CLAMP_TO_BORDER: begin
6213         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6214           aTarget := GL_CLAMP_TO_BORDER
6215         else
6216           aTarget := GL_CLAMP;
6217       end;
6218 {$ENDIF}
6219
6220 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
6221       GL_MIRRORED_REPEAT: begin
6222   {$IFNDEF OPENGL_ES}
6223         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6224   {$ELSE}
6225         if GL_VERSION_2_0 then
6226   {$ENDIF}
6227           aTarget := GL_MIRRORED_REPEAT
6228         else
6229           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6230       end;
6231 {$IFEND}
6232     else
6233       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6234     end;
6235   end;
6236
6237 begin
6238   CheckAndSetWrap(S, fWrapS);
6239   CheckAndSetWrap(T, fWrapT);
6240   CheckAndSetWrap(R, fWrapR);
6241
6242   if (ID > 0) then begin
6243     Bind(false);
6244     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6245     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6246 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6247     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
6248     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6249 {$IFEND}
6250   end;
6251 end;
6252
6253 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6255 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6256
6257   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6258   begin
6259     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6260        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6261       fSwizzle[aIndex] := aValue
6262     else
6263       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6264   end;
6265
6266 begin
6267 {$IFNDEF OPENGL_ES}
6268   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6269     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6270 {$ELSE}
6271   if not GL_VERSION_3_0 then
6272     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6273 {$ENDIF}
6274   CheckAndSetValue(r, 0);
6275   CheckAndSetValue(g, 1);
6276   CheckAndSetValue(b, 2);
6277   CheckAndSetValue(a, 3);
6278
6279   if (ID > 0) then begin
6280     Bind(false);
6281 {$IFNDEF OPENGL_ES}
6282     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6283 {$ELSE}
6284     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
6285     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
6286     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
6287     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
6288 {$ENDIF}
6289   end;
6290 end;
6291 {$IFEND}
6292
6293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6294 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6295 begin
6296   if aEnableTextureUnit then
6297     glEnable(Target);
6298   if (ID > 0) then
6299     glBindTexture(Target, ID);
6300 end;
6301
6302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6303 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6304 begin
6305   if aDisableTextureUnit then
6306     glDisable(Target);
6307   glBindTexture(Target, 0);
6308 end;
6309
6310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6311 constructor TglBitmap.Create;
6312 begin
6313   if (ClassType = TglBitmap) then
6314     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6315 {$IFDEF GLB_NATIVE_OGL}
6316   glbReadOpenGLExtensions;
6317 {$ENDIF}
6318   inherited Create;
6319   fFormat            := glBitmapGetDefaultFormat;
6320   fFreeDataOnDestroy := true;
6321 end;
6322
6323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6324 constructor TglBitmap.Create(const aFileName: String);
6325 begin
6326   Create;
6327   LoadFromFile(aFileName);
6328 end;
6329
6330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6331 constructor TglBitmap.Create(const aStream: TStream);
6332 begin
6333   Create;
6334   LoadFromStream(aStream);
6335 end;
6336
6337 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6338 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6339 var
6340   ImageSize: Integer;
6341 begin
6342   Create;
6343   if not Assigned(aData) then begin
6344     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6345     GetMem(aData, ImageSize);
6346     try
6347       FillChar(aData^, ImageSize, #$FF);
6348       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6349     except
6350       if Assigned(aData) then
6351         FreeMem(aData);
6352       raise;
6353     end;
6354   end else begin
6355     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6356     fFreeDataOnDestroy := false;
6357   end;
6358 end;
6359
6360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6361 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6362 begin
6363   Create;
6364   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6365 end;
6366
6367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6368 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6369 begin
6370   Create;
6371   LoadFromResource(aInstance, aResource, aResType);
6372 end;
6373
6374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6375 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6376 begin
6377   Create;
6378   LoadFromResourceID(aInstance, aResourceID, aResType);
6379 end;
6380
6381 {$IFDEF GLB_SUPPORT_PNG_READ}
6382 {$IF DEFINED(GLB_LAZ_PNG)}
6383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6384 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6386 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6387 const
6388   MAGIC_LEN = 8;
6389   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6390 var
6391   reader: TLazReaderPNG;
6392   intf: TLazIntfImage;
6393   StreamPos: Int64;
6394   magic: String[MAGIC_LEN];
6395 begin
6396   result := true;
6397   StreamPos := aStream.Position;
6398
6399   SetLength(magic, MAGIC_LEN);
6400   aStream.Read(magic[1], MAGIC_LEN);
6401   aStream.Position := StreamPos;
6402   if (magic <> PNG_MAGIC) then begin
6403     result := false;
6404     exit;
6405   end;
6406
6407   intf   := TLazIntfImage.Create(0, 0);
6408   reader := TLazReaderPNG.Create;
6409   try try
6410     reader.UpdateDescription := true;
6411     reader.ImageRead(aStream, intf);
6412     AssignFromLazIntfImage(intf);
6413   except
6414     result := false;
6415     aStream.Position := StreamPos;
6416     exit;
6417   end;
6418   finally
6419     reader.Free;
6420     intf.Free;
6421   end;
6422 end;
6423
6424 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6426 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6427 var
6428   Surface: PSDL_Surface;
6429   RWops: PSDL_RWops;
6430 begin
6431   result := false;
6432   RWops := glBitmapCreateRWops(aStream);
6433   try
6434     if IMG_isPNG(RWops) > 0 then begin
6435       Surface := IMG_LoadPNG_RW(RWops);
6436       try
6437         AssignFromSurface(Surface);
6438         result := true;
6439       finally
6440         SDL_FreeSurface(Surface);
6441       end;
6442     end;
6443   finally
6444     SDL_FreeRW(RWops);
6445   end;
6446 end;
6447
6448 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6450 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6451 begin
6452   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6453 end;
6454
6455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6456 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6457 var
6458   StreamPos: Int64;
6459   signature: array [0..7] of byte;
6460   png: png_structp;
6461   png_info: png_infop;
6462
6463   TempHeight, TempWidth: Integer;
6464   Format: TglBitmapFormat;
6465
6466   png_data: pByte;
6467   png_rows: array of pByte;
6468   Row, LineSize: Integer;
6469 begin
6470   result := false;
6471
6472   if not init_libPNG then
6473     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6474
6475   try
6476     // signature
6477     StreamPos := aStream.Position;
6478     aStream.Read(signature{%H-}, 8);
6479     aStream.Position := StreamPos;
6480
6481     if png_check_sig(@signature, 8) <> 0 then begin
6482       // png read struct
6483       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6484       if png = nil then
6485         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6486
6487       // png info
6488       png_info := png_create_info_struct(png);
6489       if png_info = nil then begin
6490         png_destroy_read_struct(@png, nil, nil);
6491         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6492       end;
6493
6494       // set read callback
6495       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6496
6497       // read informations
6498       png_read_info(png, png_info);
6499
6500       // size
6501       TempHeight := png_get_image_height(png, png_info);
6502       TempWidth := png_get_image_width(png, png_info);
6503
6504       // format
6505       case png_get_color_type(png, png_info) of
6506         PNG_COLOR_TYPE_GRAY:
6507           Format := tfLuminance8ub1;
6508         PNG_COLOR_TYPE_GRAY_ALPHA:
6509           Format := tfLuminance8Alpha8us1;
6510         PNG_COLOR_TYPE_RGB:
6511           Format := tfRGB8ub3;
6512         PNG_COLOR_TYPE_RGB_ALPHA:
6513           Format := tfRGBA8ub4;
6514         else
6515           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6516       end;
6517
6518       // cut upper 8 bit from 16 bit formats
6519       if png_get_bit_depth(png, png_info) > 8 then
6520         png_set_strip_16(png);
6521
6522       // expand bitdepth smaller than 8
6523       if png_get_bit_depth(png, png_info) < 8 then
6524         png_set_expand(png);
6525
6526       // allocating mem for scanlines
6527       LineSize := png_get_rowbytes(png, png_info);
6528       GetMem(png_data, TempHeight * LineSize);
6529       try
6530         SetLength(png_rows, TempHeight);
6531         for Row := Low(png_rows) to High(png_rows) do begin
6532           png_rows[Row] := png_data;
6533           Inc(png_rows[Row], Row * LineSize);
6534         end;
6535
6536         // read complete image into scanlines
6537         png_read_image(png, @png_rows[0]);
6538
6539         // read end
6540         png_read_end(png, png_info);
6541
6542         // destroy read struct
6543         png_destroy_read_struct(@png, @png_info, nil);
6544
6545         SetLength(png_rows, 0);
6546
6547         // set new data
6548         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6549
6550         result := true;
6551       except
6552         if Assigned(png_data) then
6553           FreeMem(png_data);
6554         raise;
6555       end;
6556     end;
6557   finally
6558     quit_libPNG;
6559   end;
6560 end;
6561
6562 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6564 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6565 var
6566   StreamPos: Int64;
6567   Png: TPNGObject;
6568   Header: String[8];
6569   Row, Col, PixSize, LineSize: Integer;
6570   NewImage, pSource, pDest, pAlpha: pByte;
6571   PngFormat: TglBitmapFormat;
6572   FormatDesc: TFormatDescriptor;
6573
6574 const
6575   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6576
6577 begin
6578   result := false;
6579
6580   StreamPos := aStream.Position;
6581   aStream.Read(Header[0], SizeOf(Header));
6582   aStream.Position := StreamPos;
6583
6584   {Test if the header matches}
6585   if Header = PngHeader then begin
6586     Png := TPNGObject.Create;
6587     try
6588       Png.LoadFromStream(aStream);
6589
6590       case Png.Header.ColorType of
6591         COLOR_GRAYSCALE:
6592           PngFormat := tfLuminance8ub1;
6593         COLOR_GRAYSCALEALPHA:
6594           PngFormat := tfLuminance8Alpha8us1;
6595         COLOR_RGB:
6596           PngFormat := tfBGR8ub3;
6597         COLOR_RGBALPHA:
6598           PngFormat := tfBGRA8ub4;
6599         else
6600           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6601       end;
6602
6603       FormatDesc := TFormatDescriptor.Get(PngFormat);
6604       PixSize    := Round(FormatDesc.PixelSize);
6605       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6606
6607       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6608       try
6609         pDest := NewImage;
6610
6611         case Png.Header.ColorType of
6612           COLOR_RGB, COLOR_GRAYSCALE:
6613             begin
6614               for Row := 0 to Png.Height -1 do begin
6615                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6616                 Inc(pDest, LineSize);
6617               end;
6618             end;
6619           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6620             begin
6621               PixSize := PixSize -1;
6622
6623               for Row := 0 to Png.Height -1 do begin
6624                 pSource := Png.Scanline[Row];
6625                 pAlpha := pByte(Png.AlphaScanline[Row]);
6626
6627                 for Col := 0 to Png.Width -1 do begin
6628                   Move (pSource^, pDest^, PixSize);
6629                   Inc(pSource, PixSize);
6630                   Inc(pDest, PixSize);
6631
6632                   pDest^ := pAlpha^;
6633                   inc(pAlpha);
6634                   Inc(pDest);
6635                 end;
6636               end;
6637             end;
6638           else
6639             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6640         end;
6641
6642         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6643
6644         result := true;
6645       except
6646         if Assigned(NewImage) then
6647           FreeMem(NewImage);
6648         raise;
6649       end;
6650     finally
6651       Png.Free;
6652     end;
6653   end;
6654 end;
6655 {$IFEND}
6656 {$ENDIF}
6657
6658 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6659 {$IFDEF GLB_LIB_PNG}
6660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6661 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6662 begin
6663   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6664 end;
6665 {$ENDIF}
6666
6667 {$IF DEFINED(GLB_LAZ_PNG)}
6668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6669 procedure TglBitmap.SavePNG(const aStream: TStream);
6670 var
6671   png: TPortableNetworkGraphic;
6672   intf: TLazIntfImage;
6673   raw: TRawImage;
6674 begin
6675   png  := TPortableNetworkGraphic.Create;
6676   intf := TLazIntfImage.Create(0, 0);
6677   try
6678     if not AssignToLazIntfImage(intf) then
6679       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6680     intf.GetRawImage(raw);
6681     png.LoadFromRawImage(raw, false);
6682     png.SaveToStream(aStream);
6683   finally
6684     png.Free;
6685     intf.Free;
6686   end;
6687 end;
6688
6689 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6691 procedure TglBitmap.SavePNG(const aStream: TStream);
6692 var
6693   png: png_structp;
6694   png_info: png_infop;
6695   png_rows: array of pByte;
6696   LineSize: Integer;
6697   ColorType: Integer;
6698   Row: Integer;
6699   FormatDesc: TFormatDescriptor;
6700 begin
6701   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6702     raise EglBitmapUnsupportedFormat.Create(Format);
6703
6704   if not init_libPNG then
6705     raise Exception.Create('unable to initialize libPNG.');
6706
6707   try
6708     case Format of
6709       tfAlpha8ub1, tfLuminance8ub1:
6710         ColorType := PNG_COLOR_TYPE_GRAY;
6711       tfLuminance8Alpha8us1:
6712         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6713       tfBGR8ub3, tfRGB8ub3:
6714         ColorType := PNG_COLOR_TYPE_RGB;
6715       tfBGRA8ub4, tfRGBA8ub4:
6716         ColorType := PNG_COLOR_TYPE_RGBA;
6717       else
6718         raise EglBitmapUnsupportedFormat.Create(Format);
6719     end;
6720
6721     FormatDesc := TFormatDescriptor.Get(Format);
6722     LineSize := FormatDesc.GetSize(Width, 1);
6723
6724     // creating array for scanline
6725     SetLength(png_rows, Height);
6726     try
6727       for Row := 0 to Height - 1 do begin
6728         png_rows[Row] := Data;
6729         Inc(png_rows[Row], Row * LineSize)
6730       end;
6731
6732       // write struct
6733       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6734       if png = nil then
6735         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6736
6737       // create png info
6738       png_info := png_create_info_struct(png);
6739       if png_info = nil then begin
6740         png_destroy_write_struct(@png, nil);
6741         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6742       end;
6743
6744       // set read callback
6745       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6746
6747       // set compression
6748       png_set_compression_level(png, 6);
6749
6750       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6751         png_set_bgr(png);
6752
6753       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6754       png_write_info(png, png_info);
6755       png_write_image(png, @png_rows[0]);
6756       png_write_end(png, png_info);
6757       png_destroy_write_struct(@png, @png_info);
6758     finally
6759       SetLength(png_rows, 0);
6760     end;
6761   finally
6762     quit_libPNG;
6763   end;
6764 end;
6765
6766 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6768 procedure TglBitmap.SavePNG(const aStream: TStream);
6769 var
6770   Png: TPNGObject;
6771
6772   pSource, pDest: pByte;
6773   X, Y, PixSize: Integer;
6774   ColorType: Cardinal;
6775   Alpha: Boolean;
6776
6777   pTemp: pByte;
6778   Temp: Byte;
6779 begin
6780   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6781     raise EglBitmapUnsupportedFormat.Create(Format);
6782
6783   case Format of
6784     tfAlpha8ub1, tfLuminance8ub1: begin
6785       ColorType := COLOR_GRAYSCALE;
6786       PixSize   := 1;
6787       Alpha     := false;
6788     end;
6789     tfLuminance8Alpha8us1: begin
6790       ColorType := COLOR_GRAYSCALEALPHA;
6791       PixSize   := 1;
6792       Alpha     := true;
6793     end;
6794     tfBGR8ub3, tfRGB8ub3: begin
6795       ColorType := COLOR_RGB;
6796       PixSize   := 3;
6797       Alpha     := false;
6798     end;
6799     tfBGRA8ub4, tfRGBA8ub4: begin
6800       ColorType := COLOR_RGBALPHA;
6801       PixSize   := 3;
6802       Alpha     := true
6803     end;
6804   else
6805     raise EglBitmapUnsupportedFormat.Create(Format);
6806   end;
6807
6808   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6809   try
6810     // Copy ImageData
6811     pSource := Data;
6812     for Y := 0 to Height -1 do begin
6813       pDest := png.ScanLine[Y];
6814       for X := 0 to Width -1 do begin
6815         Move(pSource^, pDest^, PixSize);
6816         Inc(pDest, PixSize);
6817         Inc(pSource, PixSize);
6818         if Alpha then begin
6819           png.AlphaScanline[Y]^[X] := pSource^;
6820           Inc(pSource);
6821         end;
6822       end;
6823
6824       // convert RGB line to BGR
6825       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6826         pTemp := png.ScanLine[Y];
6827         for X := 0 to Width -1 do begin
6828           Temp := pByteArray(pTemp)^[0];
6829           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6830           pByteArray(pTemp)^[2] := Temp;
6831           Inc(pTemp, 3);
6832         end;
6833       end;
6834     end;
6835
6836     // Save to Stream
6837     Png.CompressionLevel := 6;
6838     Png.SaveToStream(aStream);
6839   finally
6840     FreeAndNil(Png);
6841   end;
6842 end;
6843 {$IFEND}
6844 {$ENDIF}
6845
6846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6847 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6849 {$IFDEF GLB_LIB_JPEG}
6850 type
6851   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6852   glBitmap_libJPEG_source_mgr = record
6853     pub: jpeg_source_mgr;
6854
6855     SrcStream: TStream;
6856     SrcBuffer: array [1..4096] of byte;
6857   end;
6858
6859   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6860   glBitmap_libJPEG_dest_mgr = record
6861     pub: jpeg_destination_mgr;
6862
6863     DestStream: TStream;
6864     DestBuffer: array [1..4096] of byte;
6865   end;
6866
6867 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6868 begin
6869   //DUMMY
6870 end;
6871
6872
6873 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6874 begin
6875   //DUMMY
6876 end;
6877
6878
6879 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6880 begin
6881   //DUMMY
6882 end;
6883
6884 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6885 begin
6886   //DUMMY
6887 end;
6888
6889
6890 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6891 begin
6892   //DUMMY
6893 end;
6894
6895
6896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6897 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6898 var
6899   src: glBitmap_libJPEG_source_mgr_ptr;
6900   bytes: integer;
6901 begin
6902   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6903
6904   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6905         if (bytes <= 0) then begin
6906                 src^.SrcBuffer[1] := $FF;
6907                 src^.SrcBuffer[2] := JPEG_EOI;
6908                 bytes := 2;
6909         end;
6910
6911         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6912         src^.pub.bytes_in_buffer := bytes;
6913
6914   result := true;
6915 end;
6916
6917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6918 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6919 var
6920   src: glBitmap_libJPEG_source_mgr_ptr;
6921 begin
6922   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6923
6924   if num_bytes > 0 then begin
6925     // wanted byte isn't in buffer so set stream position and read buffer
6926     if num_bytes > src^.pub.bytes_in_buffer then begin
6927       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6928       src^.pub.fill_input_buffer(cinfo);
6929     end else begin
6930       // wanted byte is in buffer so only skip
6931                 inc(src^.pub.next_input_byte, num_bytes);
6932                 dec(src^.pub.bytes_in_buffer, num_bytes);
6933     end;
6934   end;
6935 end;
6936
6937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6938 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6939 var
6940   dest: glBitmap_libJPEG_dest_mgr_ptr;
6941 begin
6942   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6943
6944   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6945     // write complete buffer
6946     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6947
6948     // reset buffer
6949     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6950     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6951   end;
6952
6953   result := true;
6954 end;
6955
6956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6957 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6958 var
6959   Idx: Integer;
6960   dest: glBitmap_libJPEG_dest_mgr_ptr;
6961 begin
6962   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6963
6964   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6965     // check for endblock
6966     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6967       // write endblock
6968       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6969
6970       // leave
6971       break;
6972     end else
6973       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6974   end;
6975 end;
6976 {$ENDIF}
6977
6978 {$IFDEF GLB_SUPPORT_JPEG_READ}
6979 {$IF DEFINED(GLB_LAZ_JPEG)}
6980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6981 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6982 const
6983   MAGIC_LEN = 2;
6984   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6985 var
6986   intf: TLazIntfImage;
6987   reader: TFPReaderJPEG;
6988   StreamPos: Int64;
6989   magic: String[MAGIC_LEN];
6990 begin
6991   result := true;
6992   StreamPos := aStream.Position;
6993
6994   SetLength(magic, MAGIC_LEN);
6995   aStream.Read(magic[1], MAGIC_LEN);
6996   aStream.Position := StreamPos;
6997   if (magic <> JPEG_MAGIC) then begin
6998     result := false;
6999     exit;
7000   end;
7001
7002   reader := TFPReaderJPEG.Create;
7003   intf := TLazIntfImage.Create(0, 0);
7004   try try
7005     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
7006     reader.ImageRead(aStream, intf);
7007     AssignFromLazIntfImage(intf);
7008   except
7009     result := false;
7010     aStream.Position := StreamPos;
7011     exit;
7012   end;
7013   finally
7014     reader.Free;
7015     intf.Free;
7016   end;
7017 end;
7018
7019 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
7020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7021 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7022 var
7023   Surface: PSDL_Surface;
7024   RWops: PSDL_RWops;
7025 begin
7026   result := false;
7027
7028   RWops := glBitmapCreateRWops(aStream);
7029   try
7030     if IMG_isJPG(RWops) > 0 then begin
7031       Surface := IMG_LoadJPG_RW(RWops);
7032       try
7033         AssignFromSurface(Surface);
7034         result := true;
7035       finally
7036         SDL_FreeSurface(Surface);
7037       end;
7038     end;
7039   finally
7040     SDL_FreeRW(RWops);
7041   end;
7042 end;
7043
7044 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7046 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7047 var
7048   StreamPos: Int64;
7049   Temp: array[0..1]of Byte;
7050
7051   jpeg: jpeg_decompress_struct;
7052   jpeg_err: jpeg_error_mgr;
7053
7054   IntFormat: TglBitmapFormat;
7055   pImage: pByte;
7056   TempHeight, TempWidth: Integer;
7057
7058   pTemp: pByte;
7059   Row: Integer;
7060
7061   FormatDesc: TFormatDescriptor;
7062 begin
7063   result := false;
7064
7065   if not init_libJPEG then
7066     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
7067
7068   try
7069     // reading first two bytes to test file and set cursor back to begin
7070     StreamPos := aStream.Position;
7071     aStream.Read({%H-}Temp[0], 2);
7072     aStream.Position := StreamPos;
7073
7074     // if Bitmap then read file.
7075     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7076       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
7077       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7078
7079       // error managment
7080       jpeg.err := jpeg_std_error(@jpeg_err);
7081       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7082       jpeg_err.output_message := glBitmap_libJPEG_output_message;
7083
7084       // decompression struct
7085       jpeg_create_decompress(@jpeg);
7086
7087       // allocation space for streaming methods
7088       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
7089
7090       // seeting up custom functions
7091       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
7092         pub.init_source       := glBitmap_libJPEG_init_source;
7093         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
7094         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
7095         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
7096         pub.term_source       := glBitmap_libJPEG_term_source;
7097
7098         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
7099         pub.next_input_byte := nil;   // until buffer loaded
7100
7101         SrcStream := aStream;
7102       end;
7103
7104       // set global decoding state
7105       jpeg.global_state := DSTATE_START;
7106
7107       // read header of jpeg
7108       jpeg_read_header(@jpeg, false);
7109
7110       // setting output parameter
7111       case jpeg.jpeg_color_space of
7112         JCS_GRAYSCALE:
7113           begin
7114             jpeg.out_color_space := JCS_GRAYSCALE;
7115             IntFormat := tfLuminance8ub1;
7116           end;
7117         else
7118           jpeg.out_color_space := JCS_RGB;
7119           IntFormat := tfRGB8ub3;
7120       end;
7121
7122       // reading image
7123       jpeg_start_decompress(@jpeg);
7124
7125       TempHeight := jpeg.output_height;
7126       TempWidth := jpeg.output_width;
7127
7128       FormatDesc := TFormatDescriptor.Get(IntFormat);
7129
7130       // creating new image
7131       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
7132       try
7133         pTemp := pImage;
7134
7135         for Row := 0 to TempHeight -1 do begin
7136           jpeg_read_scanlines(@jpeg, @pTemp, 1);
7137           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
7138         end;
7139
7140         // finish decompression
7141         jpeg_finish_decompress(@jpeg);
7142
7143         // destroy decompression
7144         jpeg_destroy_decompress(@jpeg);
7145
7146         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7147
7148         result := true;
7149       except
7150         if Assigned(pImage) then
7151           FreeMem(pImage);
7152         raise;
7153       end;
7154     end;
7155   finally
7156     quit_libJPEG;
7157   end;
7158 end;
7159
7160 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7162 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7163 var
7164   bmp: TBitmap;
7165   jpg: TJPEGImage;
7166   StreamPos: Int64;
7167   Temp: array[0..1]of Byte;
7168 begin
7169   result := false;
7170
7171   // reading first two bytes to test file and set cursor back to begin
7172   StreamPos := aStream.Position;
7173   aStream.Read(Temp[0], 2);
7174   aStream.Position := StreamPos;
7175
7176   // if Bitmap then read file.
7177   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7178     bmp := TBitmap.Create;
7179     try
7180       jpg := TJPEGImage.Create;
7181       try
7182         jpg.LoadFromStream(aStream);
7183         bmp.Assign(jpg);
7184         result := AssignFromBitmap(bmp);
7185       finally
7186         jpg.Free;
7187       end;
7188     finally
7189       bmp.Free;
7190     end;
7191   end;
7192 end;
7193 {$IFEND}
7194 {$ENDIF}
7195
7196 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7197 {$IF DEFINED(GLB_LAZ_JPEG)}
7198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7199 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7200 var
7201   jpeg: TJPEGImage;
7202   intf: TLazIntfImage;
7203   raw: TRawImage;
7204 begin
7205   jpeg := TJPEGImage.Create;
7206   intf := TLazIntfImage.Create(0, 0);
7207   try
7208     if not AssignToLazIntfImage(intf) then
7209       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7210     intf.GetRawImage(raw);
7211     jpeg.LoadFromRawImage(raw, false);
7212     jpeg.SaveToStream(aStream);
7213   finally
7214     intf.Free;
7215     jpeg.Free;
7216   end;
7217 end;
7218
7219 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7221 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7222 var
7223   jpeg: jpeg_compress_struct;
7224   jpeg_err: jpeg_error_mgr;
7225   Row: Integer;
7226   pTemp, pTemp2: pByte;
7227
7228   procedure CopyRow(pDest, pSource: pByte);
7229   var
7230     X: Integer;
7231   begin
7232     for X := 0 to Width - 1 do begin
7233       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7234       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7235       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7236       Inc(pDest, 3);
7237       Inc(pSource, 3);
7238     end;
7239   end;
7240
7241 begin
7242   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7243     raise EglBitmapUnsupportedFormat.Create(Format);
7244
7245   if not init_libJPEG then
7246     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7247
7248   try
7249     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7250     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7251
7252     // error managment
7253     jpeg.err := jpeg_std_error(@jpeg_err);
7254     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7255     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7256
7257     // compression struct
7258     jpeg_create_compress(@jpeg);
7259
7260     // allocation space for streaming methods
7261     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7262
7263     // seeting up custom functions
7264     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7265       pub.init_destination    := glBitmap_libJPEG_init_destination;
7266       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7267       pub.term_destination    := glBitmap_libJPEG_term_destination;
7268
7269       pub.next_output_byte  := @DestBuffer[1];
7270       pub.free_in_buffer    := Length(DestBuffer);
7271
7272       DestStream := aStream;
7273     end;
7274
7275     // very important state
7276     jpeg.global_state := CSTATE_START;
7277     jpeg.image_width  := Width;
7278     jpeg.image_height := Height;
7279     case Format of
7280       tfAlpha8ub1, tfLuminance8ub1: begin
7281         jpeg.input_components := 1;
7282         jpeg.in_color_space   := JCS_GRAYSCALE;
7283       end;
7284       tfRGB8ub3, tfBGR8ub3: begin
7285         jpeg.input_components := 3;
7286         jpeg.in_color_space   := JCS_RGB;
7287       end;
7288     end;
7289
7290     jpeg_set_defaults(@jpeg);
7291     jpeg_set_quality(@jpeg, 95, true);
7292     jpeg_start_compress(@jpeg, true);
7293     pTemp := Data;
7294
7295     if Format = tfBGR8ub3 then
7296       GetMem(pTemp2, fRowSize)
7297     else
7298       pTemp2 := pTemp;
7299
7300     try
7301       for Row := 0 to jpeg.image_height -1 do begin
7302         // prepare row
7303         if Format = tfBGR8ub3 then
7304           CopyRow(pTemp2, pTemp)
7305         else
7306           pTemp2 := pTemp;
7307
7308         // write row
7309         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7310         inc(pTemp, fRowSize);
7311       end;
7312     finally
7313       // free memory
7314       if Format = tfBGR8ub3 then
7315         FreeMem(pTemp2);
7316     end;
7317     jpeg_finish_compress(@jpeg);
7318     jpeg_destroy_compress(@jpeg);
7319   finally
7320     quit_libJPEG;
7321   end;
7322 end;
7323
7324 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7325 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7326 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7327 var
7328   Bmp: TBitmap;
7329   Jpg: TJPEGImage;
7330 begin
7331   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7332     raise EglBitmapUnsupportedFormat.Create(Format);
7333
7334   Bmp := TBitmap.Create;
7335   try
7336     Jpg := TJPEGImage.Create;
7337     try
7338       AssignToBitmap(Bmp);
7339       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7340         Jpg.Grayscale   := true;
7341         Jpg.PixelFormat := jf8Bit;
7342       end;
7343       Jpg.Assign(Bmp);
7344       Jpg.SaveToStream(aStream);
7345     finally
7346       FreeAndNil(Jpg);
7347     end;
7348   finally
7349     FreeAndNil(Bmp);
7350   end;
7351 end;
7352 {$IFEND}
7353 {$ENDIF}
7354
7355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7356 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7358 type
7359   RawHeader = packed record
7360     Magic:        String[5];
7361     Version:      Byte;
7362     Width:        Integer;
7363     Height:       Integer;
7364     DataSize:     Integer;
7365     BitsPerPixel: Integer;
7366     Precision:    TglBitmapRec4ub;
7367     Shift:        TglBitmapRec4ub;
7368   end;
7369
7370 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7371 var
7372   header: RawHeader;
7373   StartPos: Int64;
7374   fd: TFormatDescriptor;
7375   buf: PByte;
7376 begin
7377   result := false;
7378   StartPos := aStream.Position;
7379   aStream.Read(header{%H-}, SizeOf(header));
7380   if (header.Magic <> 'glBMP') then begin
7381     aStream.Position := StartPos;
7382     exit;
7383   end;
7384
7385   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7386   if (fd.Format = tfEmpty) then
7387     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7388
7389   buf := GetMemory(header.DataSize);
7390   aStream.Read(buf^, header.DataSize);
7391   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7392
7393   result := true;
7394 end;
7395
7396 procedure TglBitmap.SaveRAW(const aStream: TStream);
7397 var
7398   header: RawHeader;
7399   fd: TFormatDescriptor;
7400 begin
7401   fd := TFormatDescriptor.Get(Format);
7402   header.Magic        := 'glBMP';
7403   header.Version      := 1;
7404   header.Width        := Width;
7405   header.Height       := Height;
7406   header.DataSize     := fd.GetSize(fDimension);
7407   header.BitsPerPixel := fd.BitsPerPixel;
7408   header.Precision    := fd.Precision;
7409   header.Shift        := fd.Shift;
7410   aStream.Write(header, SizeOf(header));
7411   aStream.Write(Data^,  header.DataSize);
7412 end;
7413
7414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7415 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7417 const
7418   BMP_MAGIC          = $4D42;
7419
7420   BMP_COMP_RGB       = 0;
7421   BMP_COMP_RLE8      = 1;
7422   BMP_COMP_RLE4      = 2;
7423   BMP_COMP_BITFIELDS = 3;
7424
7425 type
7426   TBMPHeader = packed record
7427     bfType: Word;
7428     bfSize: Cardinal;
7429     bfReserved1: Word;
7430     bfReserved2: Word;
7431     bfOffBits: Cardinal;
7432   end;
7433
7434   TBMPInfo = packed record
7435     biSize: Cardinal;
7436     biWidth: Longint;
7437     biHeight: Longint;
7438     biPlanes: Word;
7439     biBitCount: Word;
7440     biCompression: Cardinal;
7441     biSizeImage: Cardinal;
7442     biXPelsPerMeter: Longint;
7443     biYPelsPerMeter: Longint;
7444     biClrUsed: Cardinal;
7445     biClrImportant: Cardinal;
7446   end;
7447
7448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7449 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7450
7451   //////////////////////////////////////////////////////////////////////////////////////////////////
7452   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7453   begin
7454     result := tfEmpty;
7455     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7456     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7457
7458     //Read Compression
7459     case aInfo.biCompression of
7460       BMP_COMP_RLE4,
7461       BMP_COMP_RLE8: begin
7462         raise EglBitmap.Create('RLE compression is not supported');
7463       end;
7464       BMP_COMP_BITFIELDS: begin
7465         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7466           aStream.Read(aMask.r, SizeOf(aMask.r));
7467           aStream.Read(aMask.g, SizeOf(aMask.g));
7468           aStream.Read(aMask.b, SizeOf(aMask.b));
7469           aStream.Read(aMask.a, SizeOf(aMask.a));
7470         end else
7471           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7472       end;
7473     end;
7474
7475     //get suitable format
7476     case aInfo.biBitCount of
7477        8: result := tfLuminance8ub1;
7478       16: result := tfX1RGB5us1;
7479       24: result := tfBGR8ub3;
7480       32: result := tfXRGB8ui1;
7481     end;
7482   end;
7483
7484   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7485   var
7486     i, c: Integer;
7487     ColorTable: TbmpColorTable;
7488   begin
7489     result := nil;
7490     if (aInfo.biBitCount >= 16) then
7491       exit;
7492     aFormat := tfLuminance8ub1;
7493     c := aInfo.biClrUsed;
7494     if (c = 0) then
7495       c := 1 shl aInfo.biBitCount;
7496     SetLength(ColorTable, c);
7497     for i := 0 to c-1 do begin
7498       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7499       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7500         aFormat := tfRGB8ub3;
7501     end;
7502
7503     result := TbmpColorTableFormat.Create;
7504     result.BitsPerPixel := aInfo.biBitCount;
7505     result.ColorTable   := ColorTable;
7506     result.CalcValues;
7507   end;
7508
7509   //////////////////////////////////////////////////////////////////////////////////////////////////
7510   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7511   var
7512     FormatDesc: TFormatDescriptor;
7513   begin
7514     result := nil;
7515     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7516       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7517       if (FormatDesc.Format = tfEmpty) then
7518         exit;
7519       aFormat := FormatDesc.Format;
7520       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7521         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7522       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7523         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7524
7525       result := TbmpBitfieldFormat.Create;
7526       result.SetCustomValues(aInfo.biBitCount, aMask);
7527     end;
7528   end;
7529
7530 var
7531   //simple types
7532   StartPos: Int64;
7533   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7534   PaddingBuff: Cardinal;
7535   LineBuf, ImageData, TmpData: PByte;
7536   SourceMD, DestMD: Pointer;
7537   BmpFormat: TglBitmapFormat;
7538
7539   //records
7540   Mask: TglBitmapRec4ul;
7541   Header: TBMPHeader;
7542   Info: TBMPInfo;
7543
7544   //classes
7545   SpecialFormat: TFormatDescriptor;
7546   FormatDesc: TFormatDescriptor;
7547
7548   //////////////////////////////////////////////////////////////////////////////////////////////////
7549   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7550   var
7551     i: Integer;
7552     Pixel: TglBitmapPixelData;
7553   begin
7554     aStream.Read(aLineBuf^, rbLineSize);
7555     SpecialFormat.PreparePixel(Pixel);
7556     for i := 0 to Info.biWidth-1 do begin
7557       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7558       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7559       FormatDesc.Map(Pixel, aData, DestMD);
7560     end;
7561   end;
7562
7563 begin
7564   result        := false;
7565   BmpFormat     := tfEmpty;
7566   SpecialFormat := nil;
7567   LineBuf       := nil;
7568   SourceMD      := nil;
7569   DestMD        := nil;
7570
7571   // Header
7572   StartPos := aStream.Position;
7573   aStream.Read(Header{%H-}, SizeOf(Header));
7574
7575   if Header.bfType = BMP_MAGIC then begin
7576     try try
7577       BmpFormat        := ReadInfo(Info, Mask);
7578       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7579       if not Assigned(SpecialFormat) then
7580         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7581       aStream.Position := StartPos + Header.bfOffBits;
7582
7583       if (BmpFormat <> tfEmpty) then begin
7584         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7585         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7586         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7587         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7588
7589         //get Memory
7590         DestMD    := FormatDesc.CreateMappingData;
7591         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7592         GetMem(ImageData, ImageSize);
7593         if Assigned(SpecialFormat) then begin
7594           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7595           SourceMD := SpecialFormat.CreateMappingData;
7596         end;
7597
7598         //read Data
7599         try try
7600           FillChar(ImageData^, ImageSize, $FF);
7601           TmpData := ImageData;
7602           if (Info.biHeight > 0) then
7603             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7604           for i := 0 to Abs(Info.biHeight)-1 do begin
7605             if Assigned(SpecialFormat) then
7606               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7607             else
7608               aStream.Read(TmpData^, wbLineSize);   //else only read data
7609             if (Info.biHeight > 0) then
7610               dec(TmpData, wbLineSize)
7611             else
7612               inc(TmpData, wbLineSize);
7613             aStream.Read(PaddingBuff{%H-}, Padding);
7614           end;
7615           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7616           result := true;
7617         finally
7618           if Assigned(LineBuf) then
7619             FreeMem(LineBuf);
7620           if Assigned(SourceMD) then
7621             SpecialFormat.FreeMappingData(SourceMD);
7622           FormatDesc.FreeMappingData(DestMD);
7623         end;
7624         except
7625           if Assigned(ImageData) then
7626             FreeMem(ImageData);
7627           raise;
7628         end;
7629       end else
7630         raise EglBitmap.Create('LoadBMP - No suitable format found');
7631     except
7632       aStream.Position := StartPos;
7633       raise;
7634     end;
7635     finally
7636       FreeAndNil(SpecialFormat);
7637     end;
7638   end
7639     else aStream.Position := StartPos;
7640 end;
7641
7642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7643 procedure TglBitmap.SaveBMP(const aStream: TStream);
7644 var
7645   Header: TBMPHeader;
7646   Info: TBMPInfo;
7647   Converter: TFormatDescriptor;
7648   FormatDesc: TFormatDescriptor;
7649   SourceFD, DestFD: Pointer;
7650   pData, srcData, dstData, ConvertBuffer: pByte;
7651
7652   Pixel: TglBitmapPixelData;
7653   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7654   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7655
7656   PaddingBuff: Cardinal;
7657
7658   function GetLineWidth : Integer;
7659   begin
7660     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7661   end;
7662
7663 begin
7664   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7665     raise EglBitmapUnsupportedFormat.Create(Format);
7666
7667   Converter  := nil;
7668   FormatDesc := TFormatDescriptor.Get(Format);
7669   ImageSize  := FormatDesc.GetSize(Dimension);
7670
7671   FillChar(Header{%H-}, SizeOf(Header), 0);
7672   Header.bfType      := BMP_MAGIC;
7673   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7674   Header.bfReserved1 := 0;
7675   Header.bfReserved2 := 0;
7676   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7677
7678   FillChar(Info{%H-}, SizeOf(Info), 0);
7679   Info.biSize        := SizeOf(Info);
7680   Info.biWidth       := Width;
7681   Info.biHeight      := Height;
7682   Info.biPlanes      := 1;
7683   Info.biCompression := BMP_COMP_RGB;
7684   Info.biSizeImage   := ImageSize;
7685
7686   try
7687     case Format of
7688       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7689       begin
7690         Info.biBitCount  :=  8;
7691         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7692         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7693         Converter := TbmpColorTableFormat.Create;
7694         with (Converter as TbmpColorTableFormat) do begin
7695           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7696           CreateColorTable;
7697         end;
7698       end;
7699
7700       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7701       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7702       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7703       begin
7704         Info.biBitCount    := 16;
7705         Info.biCompression := BMP_COMP_BITFIELDS;
7706       end;
7707
7708       tfBGR8ub3, tfRGB8ub3:
7709       begin
7710         Info.biBitCount := 24;
7711         if (Format = tfRGB8ub3) then
7712           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7713       end;
7714
7715       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7716       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7717       begin
7718         Info.biBitCount    := 32;
7719         Info.biCompression := BMP_COMP_BITFIELDS;
7720       end;
7721     else
7722       raise EglBitmapUnsupportedFormat.Create(Format);
7723     end;
7724     Info.biXPelsPerMeter := 2835;
7725     Info.biYPelsPerMeter := 2835;
7726
7727     // prepare bitmasks
7728     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7729       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7730       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7731
7732       RedMask    := FormatDesc.Mask.r;
7733       GreenMask  := FormatDesc.Mask.g;
7734       BlueMask   := FormatDesc.Mask.b;
7735       AlphaMask  := FormatDesc.Mask.a;
7736     end;
7737
7738     // headers
7739     aStream.Write(Header, SizeOf(Header));
7740     aStream.Write(Info, SizeOf(Info));
7741
7742     // colortable
7743     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7744       with (Converter as TbmpColorTableFormat) do
7745         aStream.Write(ColorTable[0].b,
7746           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7747
7748     // bitmasks
7749     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7750       aStream.Write(RedMask,   SizeOf(Cardinal));
7751       aStream.Write(GreenMask, SizeOf(Cardinal));
7752       aStream.Write(BlueMask,  SizeOf(Cardinal));
7753       aStream.Write(AlphaMask, SizeOf(Cardinal));
7754     end;
7755
7756     // image data
7757     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7758     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7759     Padding     := GetLineWidth - wbLineSize;
7760     PaddingBuff := 0;
7761
7762     pData := Data;
7763     inc(pData, (Height-1) * rbLineSize);
7764
7765     // prepare row buffer. But only for RGB because RGBA supports color masks
7766     // so it's possible to change color within the image.
7767     if Assigned(Converter) then begin
7768       FormatDesc.PreparePixel(Pixel);
7769       GetMem(ConvertBuffer, wbLineSize);
7770       SourceFD := FormatDesc.CreateMappingData;
7771       DestFD   := Converter.CreateMappingData;
7772     end else
7773       ConvertBuffer := nil;
7774
7775     try
7776       for LineIdx := 0 to Height - 1 do begin
7777         // preparing row
7778         if Assigned(Converter) then begin
7779           srcData := pData;
7780           dstData := ConvertBuffer;
7781           for PixelIdx := 0 to Info.biWidth-1 do begin
7782             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7783             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7784             Converter.Map(Pixel, dstData, DestFD);
7785           end;
7786           aStream.Write(ConvertBuffer^, wbLineSize);
7787         end else begin
7788           aStream.Write(pData^, rbLineSize);
7789         end;
7790         dec(pData, rbLineSize);
7791         if (Padding > 0) then
7792           aStream.Write(PaddingBuff, Padding);
7793       end;
7794     finally
7795       // destroy row buffer
7796       if Assigned(ConvertBuffer) then begin
7797         FormatDesc.FreeMappingData(SourceFD);
7798         Converter.FreeMappingData(DestFD);
7799         FreeMem(ConvertBuffer);
7800       end;
7801     end;
7802   finally
7803     if Assigned(Converter) then
7804       Converter.Free;
7805   end;
7806 end;
7807
7808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7809 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7811 type
7812   TTGAHeader = packed record
7813     ImageID: Byte;
7814     ColorMapType: Byte;
7815     ImageType: Byte;
7816     //ColorMapSpec: Array[0..4] of Byte;
7817     ColorMapStart: Word;
7818     ColorMapLength: Word;
7819     ColorMapEntrySize: Byte;
7820     OrigX: Word;
7821     OrigY: Word;
7822     Width: Word;
7823     Height: Word;
7824     Bpp: Byte;
7825     ImageDesc: Byte;
7826   end;
7827
7828 const
7829   TGA_UNCOMPRESSED_RGB  =  2;
7830   TGA_UNCOMPRESSED_GRAY =  3;
7831   TGA_COMPRESSED_RGB    = 10;
7832   TGA_COMPRESSED_GRAY   = 11;
7833
7834   TGA_NONE_COLOR_TABLE  = 0;
7835
7836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7837 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7838 var
7839   Header: TTGAHeader;
7840   ImageData: System.PByte;
7841   StartPosition: Int64;
7842   PixelSize, LineSize: Integer;
7843   tgaFormat: TglBitmapFormat;
7844   FormatDesc: TFormatDescriptor;
7845   Counter: packed record
7846     X, Y: packed record
7847       low, high, dir: Integer;
7848     end;
7849   end;
7850
7851 const
7852   CACHE_SIZE = $4000;
7853
7854   ////////////////////////////////////////////////////////////////////////////////////////
7855   procedure ReadUncompressed;
7856   var
7857     i, j: Integer;
7858     buf, tmp1, tmp2: System.PByte;
7859   begin
7860     buf := nil;
7861     if (Counter.X.dir < 0) then
7862       GetMem(buf, LineSize);
7863     try
7864       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7865         tmp1 := ImageData;
7866         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7867         if (Counter.X.dir < 0) then begin               //flip X
7868           aStream.Read(buf^, LineSize);
7869           tmp2 := buf;
7870           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7871           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7872             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7873               tmp1^ := tmp2^;
7874               inc(tmp1);
7875               inc(tmp2);
7876             end;
7877             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7878           end;
7879         end else
7880           aStream.Read(tmp1^, LineSize);
7881         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7882       end;
7883     finally
7884       if Assigned(buf) then
7885         FreeMem(buf);
7886     end;
7887   end;
7888
7889   ////////////////////////////////////////////////////////////////////////////////////////
7890   procedure ReadCompressed;
7891
7892     /////////////////////////////////////////////////////////////////
7893     var
7894       TmpData: System.PByte;
7895       LinePixelsRead: Integer;
7896     procedure CheckLine;
7897     begin
7898       if (LinePixelsRead >= Header.Width) then begin
7899         LinePixelsRead := 0;
7900         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7901         TmpData := ImageData;
7902         inc(TmpData, Counter.Y.low * LineSize);           //set line
7903         if (Counter.X.dir < 0) then                       //if x flipped then
7904           inc(TmpData, LineSize - PixelSize);             //set last pixel
7905       end;
7906     end;
7907
7908     /////////////////////////////////////////////////////////////////
7909     var
7910       Cache: PByte;
7911       CacheSize, CachePos: Integer;
7912     procedure CachedRead(out Buffer; Count: Integer);
7913     var
7914       BytesRead: Integer;
7915     begin
7916       if (CachePos + Count > CacheSize) then begin
7917         //if buffer overflow save non read bytes
7918         BytesRead := 0;
7919         if (CacheSize - CachePos > 0) then begin
7920           BytesRead := CacheSize - CachePos;
7921           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7922           inc(CachePos, BytesRead);
7923         end;
7924
7925         //load cache from file
7926         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7927         aStream.Read(Cache^, CacheSize);
7928         CachePos := 0;
7929
7930         //read rest of requested bytes
7931         if (Count - BytesRead > 0) then begin
7932           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7933           inc(CachePos, Count - BytesRead);
7934         end;
7935       end else begin
7936         //if no buffer overflow just read the data
7937         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7938         inc(CachePos, Count);
7939       end;
7940     end;
7941
7942     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7943     begin
7944       case PixelSize of
7945         1: begin
7946           aBuffer^ := aData^;
7947           inc(aBuffer, Counter.X.dir);
7948         end;
7949         2: begin
7950           PWord(aBuffer)^ := PWord(aData)^;
7951           inc(aBuffer, 2 * Counter.X.dir);
7952         end;
7953         3: begin
7954           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7955           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7956           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7957           inc(aBuffer, 3 * Counter.X.dir);
7958         end;
7959         4: begin
7960           PCardinal(aBuffer)^ := PCardinal(aData)^;
7961           inc(aBuffer, 4 * Counter.X.dir);
7962         end;
7963       end;
7964     end;
7965
7966   var
7967     TotalPixelsToRead, TotalPixelsRead: Integer;
7968     Temp: Byte;
7969     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7970     PixelRepeat: Boolean;
7971     PixelsToRead, PixelCount: Integer;
7972   begin
7973     CacheSize := 0;
7974     CachePos  := 0;
7975
7976     TotalPixelsToRead := Header.Width * Header.Height;
7977     TotalPixelsRead   := 0;
7978     LinePixelsRead    := 0;
7979
7980     GetMem(Cache, CACHE_SIZE);
7981     try
7982       TmpData := ImageData;
7983       inc(TmpData, Counter.Y.low * LineSize);           //set line
7984       if (Counter.X.dir < 0) then                       //if x flipped then
7985         inc(TmpData, LineSize - PixelSize);             //set last pixel
7986
7987       repeat
7988         //read CommandByte
7989         CachedRead(Temp, 1);
7990         PixelRepeat  := (Temp and $80) > 0;
7991         PixelsToRead := (Temp and $7F) + 1;
7992         inc(TotalPixelsRead, PixelsToRead);
7993
7994         if PixelRepeat then
7995           CachedRead(buf[0], PixelSize);
7996         while (PixelsToRead > 0) do begin
7997           CheckLine;
7998           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7999           while (PixelCount > 0) do begin
8000             if not PixelRepeat then
8001               CachedRead(buf[0], PixelSize);
8002             PixelToBuffer(@buf[0], TmpData);
8003             inc(LinePixelsRead);
8004             dec(PixelsToRead);
8005             dec(PixelCount);
8006           end;
8007         end;
8008       until (TotalPixelsRead >= TotalPixelsToRead);
8009     finally
8010       FreeMem(Cache);
8011     end;
8012   end;
8013
8014   function IsGrayFormat: Boolean;
8015   begin
8016     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
8017   end;
8018
8019 begin
8020   result := false;
8021
8022   // reading header to test file and set cursor back to begin
8023   StartPosition := aStream.Position;
8024   aStream.Read(Header{%H-}, SizeOf(Header));
8025
8026   // no colormapped files
8027   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
8028     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
8029   begin
8030     try
8031       if Header.ImageID <> 0 then       // skip image ID
8032         aStream.Position := aStream.Position + Header.ImageID;
8033
8034       tgaFormat := tfEmpty;
8035       case Header.Bpp of
8036          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
8037                0: tgaFormat := tfLuminance8ub1;
8038                8: tgaFormat := tfAlpha8ub1;
8039             end;
8040
8041         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
8042                0: tgaFormat := tfLuminance16us1;
8043                8: tgaFormat := tfLuminance8Alpha8ub2;
8044             end else case (Header.ImageDesc and $F) of
8045                0: tgaFormat := tfX1RGB5us1;
8046                1: tgaFormat := tfA1RGB5us1;
8047                4: tgaFormat := tfARGB4us1;
8048             end;
8049
8050         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
8051                0: tgaFormat := tfBGR8ub3;
8052             end;
8053
8054         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
8055                0: tgaFormat := tfDepth32ui1;
8056             end else case (Header.ImageDesc and $F) of
8057                0: tgaFormat := tfX2RGB10ui1;
8058                2: tgaFormat := tfA2RGB10ui1;
8059                8: tgaFormat := tfARGB8ui1;
8060             end;
8061       end;
8062
8063       if (tgaFormat = tfEmpty) then
8064         raise EglBitmap.Create('LoadTga - unsupported format');
8065
8066       FormatDesc := TFormatDescriptor.Get(tgaFormat);
8067       PixelSize  := FormatDesc.GetSize(1, 1);
8068       LineSize   := FormatDesc.GetSize(Header.Width, 1);
8069
8070       GetMem(ImageData, LineSize * Header.Height);
8071       try
8072         //column direction
8073         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
8074           Counter.X.low  := Header.Height-1;;
8075           Counter.X.high := 0;
8076           Counter.X.dir  := -1;
8077         end else begin
8078           Counter.X.low  := 0;
8079           Counter.X.high := Header.Height-1;
8080           Counter.X.dir  := 1;
8081         end;
8082
8083         // Row direction
8084         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
8085           Counter.Y.low  := 0;
8086           Counter.Y.high := Header.Height-1;
8087           Counter.Y.dir  := 1;
8088         end else begin
8089           Counter.Y.low  := Header.Height-1;;
8090           Counter.Y.high := 0;
8091           Counter.Y.dir  := -1;
8092         end;
8093
8094         // Read Image
8095         case Header.ImageType of
8096           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
8097             ReadUncompressed;
8098           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
8099             ReadCompressed;
8100         end;
8101
8102         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
8103         result := true;
8104       except
8105         if Assigned(ImageData) then
8106           FreeMem(ImageData);
8107         raise;
8108       end;
8109     finally
8110       aStream.Position := StartPosition;
8111     end;
8112   end
8113     else aStream.Position := StartPosition;
8114 end;
8115
8116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8117 procedure TglBitmap.SaveTGA(const aStream: TStream);
8118 var
8119   Header: TTGAHeader;
8120   Size: Integer;
8121   FormatDesc: TFormatDescriptor;
8122 begin
8123   if not (ftTGA in FormatGetSupportedFiles(Format)) then
8124     raise EglBitmapUnsupportedFormat.Create(Format);
8125
8126   //prepare header
8127   FormatDesc := TFormatDescriptor.Get(Format);
8128   FillChar(Header{%H-}, SizeOf(Header), 0);
8129   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
8130   Header.Bpp       := FormatDesc.BitsPerPixel;
8131   Header.Width     := Width;
8132   Header.Height    := Height;
8133   Header.ImageDesc := Header.ImageDesc or $20; //flip y
8134   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
8135     Header.ImageType := TGA_UNCOMPRESSED_GRAY
8136   else
8137     Header.ImageType := TGA_UNCOMPRESSED_RGB;
8138   aStream.Write(Header, SizeOf(Header));
8139
8140   // write Data
8141   Size := FormatDesc.GetSize(Dimension);
8142   aStream.Write(Data^, Size);
8143 end;
8144
8145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8146 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8148 const
8149   DDS_MAGIC: Cardinal         = $20534444;
8150
8151   // DDS_header.dwFlags
8152   DDSD_CAPS                   = $00000001;
8153   DDSD_HEIGHT                 = $00000002;
8154   DDSD_WIDTH                  = $00000004;
8155   DDSD_PIXELFORMAT            = $00001000;
8156
8157   // DDS_header.sPixelFormat.dwFlags
8158   DDPF_ALPHAPIXELS            = $00000001;
8159   DDPF_ALPHA                  = $00000002;
8160   DDPF_FOURCC                 = $00000004;
8161   DDPF_RGB                    = $00000040;
8162   DDPF_LUMINANCE              = $00020000;
8163
8164   // DDS_header.sCaps.dwCaps1
8165   DDSCAPS_TEXTURE             = $00001000;
8166
8167   // DDS_header.sCaps.dwCaps2
8168   DDSCAPS2_CUBEMAP            = $00000200;
8169
8170   D3DFMT_DXT1                 = $31545844;
8171   D3DFMT_DXT3                 = $33545844;
8172   D3DFMT_DXT5                 = $35545844;
8173
8174 type
8175   TDDSPixelFormat = packed record
8176     dwSize: Cardinal;
8177     dwFlags: Cardinal;
8178     dwFourCC: Cardinal;
8179     dwRGBBitCount: Cardinal;
8180     dwRBitMask: Cardinal;
8181     dwGBitMask: Cardinal;
8182     dwBBitMask: Cardinal;
8183     dwABitMask: Cardinal;
8184   end;
8185
8186   TDDSCaps = packed record
8187     dwCaps1: Cardinal;
8188     dwCaps2: Cardinal;
8189     dwDDSX: Cardinal;
8190     dwReserved: Cardinal;
8191   end;
8192
8193   TDDSHeader = packed record
8194     dwSize: Cardinal;
8195     dwFlags: Cardinal;
8196     dwHeight: Cardinal;
8197     dwWidth: Cardinal;
8198     dwPitchOrLinearSize: Cardinal;
8199     dwDepth: Cardinal;
8200     dwMipMapCount: Cardinal;
8201     dwReserved: array[0..10] of Cardinal;
8202     PixelFormat: TDDSPixelFormat;
8203     Caps: TDDSCaps;
8204     dwReserved2: Cardinal;
8205   end;
8206
8207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8208 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8209 var
8210   Header: TDDSHeader;
8211   Converter: TbmpBitfieldFormat;
8212
8213   function GetDDSFormat: TglBitmapFormat;
8214   var
8215     fd: TFormatDescriptor;
8216     i: Integer;
8217     Mask: TglBitmapRec4ul;
8218     Range: TglBitmapRec4ui;
8219     match: Boolean;
8220   begin
8221     result := tfEmpty;
8222     with Header.PixelFormat do begin
8223       // Compresses
8224       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8225         case Header.PixelFormat.dwFourCC of
8226           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8227           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8228           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8229         end;
8230       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
8231         // prepare masks
8232         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8233           Mask.r := dwRBitMask;
8234           Mask.g := dwGBitMask;
8235           Mask.b := dwBBitMask;
8236         end else begin
8237           Mask.r := dwRBitMask;
8238           Mask.g := dwRBitMask;
8239           Mask.b := dwRBitMask;
8240         end;
8241         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
8242           Mask.a := dwABitMask
8243         else
8244           Mask.a := 0;;
8245
8246         //find matching format
8247         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
8248         result := fd.Format;
8249         if (result <> tfEmpty) then
8250           exit;
8251
8252         //find format with same Range
8253         for i := 0 to 3 do
8254           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
8255         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8256           fd := TFormatDescriptor.Get(result);
8257           match := true;
8258           for i := 0 to 3 do
8259             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8260               match := false;
8261               break;
8262             end;
8263           if match then
8264             break;
8265         end;
8266
8267         //no format with same range found -> use default
8268         if (result = tfEmpty) then begin
8269           if (dwABitMask > 0) then
8270             result := tfRGBA8ui1
8271           else
8272             result := tfRGB8ub3;
8273         end;
8274
8275         Converter := TbmpBitfieldFormat.Create;
8276         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
8277       end;
8278     end;
8279   end;
8280
8281 var
8282   StreamPos: Int64;
8283   x, y, LineSize, RowSize, Magic: Cardinal;
8284   NewImage, TmpData, RowData, SrcData: System.PByte;
8285   SourceMD, DestMD: Pointer;
8286   Pixel: TglBitmapPixelData;
8287   ddsFormat: TglBitmapFormat;
8288   FormatDesc: TFormatDescriptor;
8289
8290 begin
8291   result    := false;
8292   Converter := nil;
8293   StreamPos := aStream.Position;
8294
8295   // Magic
8296   aStream.Read(Magic{%H-}, sizeof(Magic));
8297   if (Magic <> DDS_MAGIC) then begin
8298     aStream.Position := StreamPos;
8299     exit;
8300   end;
8301
8302   //Header
8303   aStream.Read(Header{%H-}, sizeof(Header));
8304   if (Header.dwSize <> SizeOf(Header)) or
8305      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8306         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8307   begin
8308     aStream.Position := StreamPos;
8309     exit;
8310   end;
8311
8312   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8313     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8314
8315   ddsFormat := GetDDSFormat;
8316   try
8317     if (ddsFormat = tfEmpty) then
8318       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8319
8320     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8321     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8322     GetMem(NewImage, Header.dwHeight * LineSize);
8323     try
8324       TmpData := NewImage;
8325
8326       //Converter needed
8327       if Assigned(Converter) then begin
8328         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8329         GetMem(RowData, RowSize);
8330         SourceMD := Converter.CreateMappingData;
8331         DestMD   := FormatDesc.CreateMappingData;
8332         try
8333           for y := 0 to Header.dwHeight-1 do begin
8334             TmpData := NewImage;
8335             inc(TmpData, y * LineSize);
8336             SrcData := RowData;
8337             aStream.Read(SrcData^, RowSize);
8338             for x := 0 to Header.dwWidth-1 do begin
8339               Converter.Unmap(SrcData, Pixel, SourceMD);
8340               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8341               FormatDesc.Map(Pixel, TmpData, DestMD);
8342             end;
8343           end;
8344         finally
8345           Converter.FreeMappingData(SourceMD);
8346           FormatDesc.FreeMappingData(DestMD);
8347           FreeMem(RowData);
8348         end;
8349       end else
8350
8351       // Compressed
8352       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8353         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8354         for Y := 0 to Header.dwHeight-1 do begin
8355           aStream.Read(TmpData^, RowSize);
8356           Inc(TmpData, LineSize);
8357         end;
8358       end else
8359
8360       // Uncompressed
8361       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8362         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8363         for Y := 0 to Header.dwHeight-1 do begin
8364           aStream.Read(TmpData^, RowSize);
8365           Inc(TmpData, LineSize);
8366         end;
8367       end else
8368         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8369
8370       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8371       result := true;
8372     except
8373       if Assigned(NewImage) then
8374         FreeMem(NewImage);
8375       raise;
8376     end;
8377   finally
8378     FreeAndNil(Converter);
8379   end;
8380 end;
8381
8382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8383 procedure TglBitmap.SaveDDS(const aStream: TStream);
8384 var
8385   Header: TDDSHeader;
8386   FormatDesc: TFormatDescriptor;
8387 begin
8388   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8389     raise EglBitmapUnsupportedFormat.Create(Format);
8390
8391   FormatDesc := TFormatDescriptor.Get(Format);
8392
8393   // Generell
8394   FillChar(Header{%H-}, SizeOf(Header), 0);
8395   Header.dwSize  := SizeOf(Header);
8396   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8397
8398   Header.dwWidth  := Max(1, Width);
8399   Header.dwHeight := Max(1, Height);
8400
8401   // Caps
8402   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8403
8404   // Pixelformat
8405   Header.PixelFormat.dwSize := sizeof(Header);
8406   if (FormatDesc.IsCompressed) then begin
8407     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8408     case Format of
8409       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8410       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8411       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8412     end;
8413   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8414     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8415     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8416     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8417   end else if FormatDesc.IsGrayscale then begin
8418     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8419     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8420     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8421     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8422   end else begin
8423     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8424     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8425     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8426     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8427     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8428     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8429   end;
8430
8431   if (FormatDesc.HasAlpha) then
8432     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8433
8434   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8435   aStream.Write(Header, SizeOf(Header));
8436   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8437 end;
8438
8439 {$IFNDEF OPENGL_ES}
8440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8441 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8443 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8444   const aWidth: Integer; const aHeight: Integer);
8445 var
8446   pTemp: pByte;
8447   Size: Integer;
8448 begin
8449   if (aHeight > 1) then begin
8450     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8451     GetMem(pTemp, Size);
8452     try
8453       Move(aData^, pTemp^, Size);
8454       FreeMem(aData);
8455       aData := nil;
8456     except
8457       FreeMem(pTemp);
8458       raise;
8459     end;
8460   end else
8461     pTemp := aData;
8462   inherited SetDataPointer(pTemp, aFormat, aWidth);
8463 end;
8464
8465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8466 function TglBitmap1D.FlipHorz: Boolean;
8467 var
8468   Col: Integer;
8469   pTempDest, pDest, pSource: PByte;
8470 begin
8471   result := inherited FlipHorz;
8472   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8473     pSource := Data;
8474     GetMem(pDest, fRowSize);
8475     try
8476       pTempDest := pDest;
8477       Inc(pTempDest, fRowSize);
8478       for Col := 0 to Width-1 do begin
8479         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8480         Move(pSource^, pTempDest^, fPixelSize);
8481         Inc(pSource, fPixelSize);
8482       end;
8483       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8484       result := true;
8485     except
8486       if Assigned(pDest) then
8487         FreeMem(pDest);
8488       raise;
8489     end;
8490   end;
8491 end;
8492
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8495 var
8496   FormatDesc: TFormatDescriptor;
8497 begin
8498   // Upload data
8499   FormatDesc := TFormatDescriptor.Get(Format);
8500   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8501     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8502
8503   if FormatDesc.IsCompressed then begin
8504     if not Assigned(glCompressedTexImage1D) then
8505       raise EglBitmap.Create('compressed formats not supported by video adapter');
8506     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8507   end else if aBuildWithGlu then
8508     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8509   else
8510     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8511
8512   // Free Data
8513   if (FreeDataAfterGenTexture) then
8514     FreeData;
8515 end;
8516
8517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8518 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8519 var
8520   BuildWithGlu, TexRec: Boolean;
8521   TexSize: Integer;
8522 begin
8523   if Assigned(Data) then begin
8524     // Check Texture Size
8525     if (aTestTextureSize) then begin
8526       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8527
8528       if (Width > TexSize) then
8529         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8530
8531       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8532                 (Target = GL_TEXTURE_RECTANGLE);
8533       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8534         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8535     end;
8536
8537     CreateId;
8538     SetupParameters(BuildWithGlu);
8539     UploadData(BuildWithGlu);
8540     glAreTexturesResident(1, @fID, @fIsResident);
8541   end;
8542 end;
8543
8544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8545 procedure TglBitmap1D.AfterConstruction;
8546 begin
8547   inherited;
8548   Target := GL_TEXTURE_1D;
8549 end;
8550 {$ENDIF}
8551
8552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8553 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8555 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8556 begin
8557   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8558     result := fLines[aIndex]
8559   else
8560     result := nil;
8561 end;
8562
8563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8564 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8565   const aWidth: Integer; const aHeight: Integer);
8566 var
8567   Idx, LineWidth: Integer;
8568 begin
8569   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8570
8571   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8572     // Assigning Data
8573     if Assigned(Data) then begin
8574       SetLength(fLines, GetHeight);
8575       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8576
8577       for Idx := 0 to GetHeight-1 do begin
8578         fLines[Idx] := Data;
8579         Inc(fLines[Idx], Idx * LineWidth);
8580       end;
8581     end
8582       else SetLength(fLines, 0);
8583   end else begin
8584     SetLength(fLines, 0);
8585   end;
8586 end;
8587
8588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8589 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8590 var
8591   FormatDesc: TFormatDescriptor;
8592 begin
8593   FormatDesc := TFormatDescriptor.Get(Format);
8594   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8595     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8596
8597   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8598
8599   if FormatDesc.IsCompressed then begin
8600     if not Assigned(glCompressedTexImage2D) then
8601       raise EglBitmap.Create('compressed formats not supported by video adapter');
8602     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8603 {$IFNDEF OPENGL_ES}
8604   end else if aBuildWithGlu then begin
8605     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8606       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8607 {$ENDIF}
8608   end else begin
8609     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8610       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8611   end;
8612
8613   // Freigeben
8614   if (FreeDataAfterGenTexture) then
8615     FreeData;
8616 end;
8617
8618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8619 procedure TglBitmap2D.AfterConstruction;
8620 begin
8621   inherited;
8622   Target := GL_TEXTURE_2D;
8623 end;
8624
8625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8626 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8627 var
8628   Temp: pByte;
8629   Size, w, h: Integer;
8630   FormatDesc: TFormatDescriptor;
8631 begin
8632   FormatDesc := TFormatDescriptor.Get(aFormat);
8633   if FormatDesc.IsCompressed then
8634     raise EglBitmapUnsupportedFormat.Create(aFormat);
8635
8636   w    := aRight  - aLeft;
8637   h    := aBottom - aTop;
8638   Size := FormatDesc.GetSize(w, h);
8639   GetMem(Temp, Size);
8640   try
8641     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8642     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8643     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8644     FlipVert;
8645   except
8646     if Assigned(Temp) then
8647       FreeMem(Temp);
8648     raise;
8649   end;
8650 end;
8651
8652 {$IFNDEF OPENGL_ES}
8653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8654 procedure TglBitmap2D.GetDataFromTexture;
8655 var
8656   Temp: PByte;
8657   TempWidth, TempHeight: Integer;
8658   TempIntFormat: GLint;
8659   IntFormat: TglBitmapFormat;
8660   FormatDesc: TFormatDescriptor;
8661 begin
8662   Bind;
8663
8664   // Request Data
8665   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8666   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8667   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8668
8669   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8670   IntFormat  := FormatDesc.Format;
8671
8672   // Getting data from OpenGL
8673   FormatDesc := TFormatDescriptor.Get(IntFormat);
8674   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8675   try
8676     if FormatDesc.IsCompressed then begin
8677       if not Assigned(glGetCompressedTexImage) then
8678         raise EglBitmap.Create('compressed formats not supported by video adapter');
8679       glGetCompressedTexImage(Target, 0, Temp)
8680     end else
8681       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8682     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8683   except
8684     if Assigned(Temp) then
8685       FreeMem(Temp);
8686     raise;
8687   end;
8688 end;
8689 {$ENDIF}
8690
8691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8692 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8693 var
8694   {$IFNDEF OPENGL_ES}
8695   BuildWithGlu, TexRec: Boolean;
8696   {$ENDIF}
8697   PotTex: Boolean;
8698   TexSize: Integer;
8699 begin
8700   if Assigned(Data) then begin
8701     // Check Texture Size
8702     if (aTestTextureSize) then begin
8703       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8704
8705       if ((Height > TexSize) or (Width > TexSize)) then
8706         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8707
8708       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8709 {$IF NOT DEFINED(OPENGL_ES)}
8710       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8711       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8712         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8713 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8714       if not PotTex and not GL_OES_texture_npot then
8715         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8716 {$ELSE}
8717       if not PotTex then
8718         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8719 {$IFEND}
8720     end;
8721
8722     CreateId;
8723     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8724     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8725 {$IFNDEF OPENGL_ES}
8726     glAreTexturesResident(1, @fID, @fIsResident);
8727 {$ENDIF}
8728   end;
8729 end;
8730
8731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8732 function TglBitmap2D.FlipHorz: Boolean;
8733 var
8734   Col, Row: Integer;
8735   TempDestData, DestData, SourceData: PByte;
8736   ImgSize: Integer;
8737 begin
8738   result := inherited FlipHorz;
8739   if Assigned(Data) then begin
8740     SourceData := Data;
8741     ImgSize := Height * fRowSize;
8742     GetMem(DestData, ImgSize);
8743     try
8744       TempDestData := DestData;
8745       Dec(TempDestData, fRowSize + fPixelSize);
8746       for Row := 0 to Height -1 do begin
8747         Inc(TempDestData, fRowSize * 2);
8748         for Col := 0 to Width -1 do begin
8749           Move(SourceData^, TempDestData^, fPixelSize);
8750           Inc(SourceData, fPixelSize);
8751           Dec(TempDestData, fPixelSize);
8752         end;
8753       end;
8754       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8755       result := true;
8756     except
8757       if Assigned(DestData) then
8758         FreeMem(DestData);
8759       raise;
8760     end;
8761   end;
8762 end;
8763
8764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8765 function TglBitmap2D.FlipVert: Boolean;
8766 var
8767   Row: Integer;
8768   TempDestData, DestData, SourceData: PByte;
8769 begin
8770   result := inherited FlipVert;
8771   if Assigned(Data) then begin
8772     SourceData := Data;
8773     GetMem(DestData, Height * fRowSize);
8774     try
8775       TempDestData := DestData;
8776       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8777       for Row := 0 to Height -1 do begin
8778         Move(SourceData^, TempDestData^, fRowSize);
8779         Dec(TempDestData, fRowSize);
8780         Inc(SourceData, fRowSize);
8781       end;
8782       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8783       result := true;
8784     except
8785       if Assigned(DestData) then
8786         FreeMem(DestData);
8787       raise;
8788     end;
8789   end;
8790 end;
8791
8792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8793 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8795 type
8796   TMatrixItem = record
8797     X, Y: Integer;
8798     W: Single;
8799   end;
8800
8801   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8802   TglBitmapToNormalMapRec = Record
8803     Scale: Single;
8804     Heights: array of Single;
8805     MatrixU : array of TMatrixItem;
8806     MatrixV : array of TMatrixItem;
8807   end;
8808
8809 const
8810   ONE_OVER_255 = 1 / 255;
8811
8812   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8813 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8814 var
8815   Val: Single;
8816 begin
8817   with FuncRec do begin
8818     Val :=
8819       Source.Data.r * LUMINANCE_WEIGHT_R +
8820       Source.Data.g * LUMINANCE_WEIGHT_G +
8821       Source.Data.b * LUMINANCE_WEIGHT_B;
8822     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8823   end;
8824 end;
8825
8826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8827 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8828 begin
8829   with FuncRec do
8830     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8831 end;
8832
8833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8834 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8835 type
8836   TVec = Array[0..2] of Single;
8837 var
8838   Idx: Integer;
8839   du, dv: Double;
8840   Len: Single;
8841   Vec: TVec;
8842
8843   function GetHeight(X, Y: Integer): Single;
8844   begin
8845     with FuncRec do begin
8846       X := Max(0, Min(Size.X -1, X));
8847       Y := Max(0, Min(Size.Y -1, Y));
8848       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8849     end;
8850   end;
8851
8852 begin
8853   with FuncRec do begin
8854     with PglBitmapToNormalMapRec(Args)^ do begin
8855       du := 0;
8856       for Idx := Low(MatrixU) to High(MatrixU) do
8857         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8858
8859       dv := 0;
8860       for Idx := Low(MatrixU) to High(MatrixU) do
8861         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8862
8863       Vec[0] := -du * Scale;
8864       Vec[1] := -dv * Scale;
8865       Vec[2] := 1;
8866     end;
8867
8868     // Normalize
8869     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8870     if Len <> 0 then begin
8871       Vec[0] := Vec[0] * Len;
8872       Vec[1] := Vec[1] * Len;
8873       Vec[2] := Vec[2] * Len;
8874     end;
8875
8876     // Farbe zuweisem
8877     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8878     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8879     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8880   end;
8881 end;
8882
8883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8884 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8885 var
8886   Rec: TglBitmapToNormalMapRec;
8887
8888   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8889   begin
8890     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8891       Matrix[Index].X := X;
8892       Matrix[Index].Y := Y;
8893       Matrix[Index].W := W;
8894     end;
8895   end;
8896
8897 begin
8898   if TFormatDescriptor.Get(Format).IsCompressed then
8899     raise EglBitmapUnsupportedFormat.Create(Format);
8900
8901   if aScale > 100 then
8902     Rec.Scale := 100
8903   else if aScale < -100 then
8904     Rec.Scale := -100
8905   else
8906     Rec.Scale := aScale;
8907
8908   SetLength(Rec.Heights, Width * Height);
8909   try
8910     case aFunc of
8911       nm4Samples: begin
8912         SetLength(Rec.MatrixU, 2);
8913         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8914         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8915
8916         SetLength(Rec.MatrixV, 2);
8917         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8918         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8919       end;
8920
8921       nmSobel: begin
8922         SetLength(Rec.MatrixU, 6);
8923         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8924         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8925         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8926         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8927         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8928         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8929
8930         SetLength(Rec.MatrixV, 6);
8931         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8932         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8933         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8934         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8935         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8936         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8937       end;
8938
8939       nm3x3: begin
8940         SetLength(Rec.MatrixU, 6);
8941         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8942         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8943         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8944         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8945         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8946         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8947
8948         SetLength(Rec.MatrixV, 6);
8949         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8950         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8951         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8952         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8953         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8954         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8955       end;
8956
8957       nm5x5: begin
8958         SetLength(Rec.MatrixU, 20);
8959         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8960         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8961         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8962         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8963         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8964         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8965         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8966         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8967         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8968         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8969         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8970         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8971         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8972         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8973         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8974         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8975         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8976         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8977         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8978         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8979
8980         SetLength(Rec.MatrixV, 20);
8981         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8982         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8983         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8984         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8985         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8986         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8987         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8988         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8989         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8990         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8991         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8992         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8993         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8994         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8995         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8996         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8997         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8998         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8999         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
9000         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
9001       end;
9002     end;
9003
9004     // Daten Sammeln
9005     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
9006       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
9007     else
9008       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
9009     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
9010   finally
9011     SetLength(Rec.Heights, 0);
9012   end;
9013 end;
9014
9015 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9017 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9019 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
9020 begin
9021   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
9022 end;
9023
9024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9025 procedure TglBitmapCubeMap.AfterConstruction;
9026 begin
9027   inherited;
9028
9029 {$IFNDEF OPENGL_ES}
9030   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
9031     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9032 {$ELSE}
9033   if not (GL_VERSION_2_0) then
9034     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9035 {$ENDIF}
9036
9037   SetWrap;
9038   Target   := GL_TEXTURE_CUBE_MAP;
9039 {$IFNDEF OPENGL_ES}
9040   fGenMode := GL_REFLECTION_MAP;
9041 {$ENDIF}
9042 end;
9043
9044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9045 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
9046 var
9047   {$IFNDEF OPENGL_ES}
9048   BuildWithGlu: Boolean;
9049   {$ENDIF}
9050   TexSize: Integer;
9051 begin
9052   if (aTestTextureSize) then begin
9053     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
9054
9055     if (Height > TexSize) or (Width > TexSize) then
9056       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
9057
9058 {$IF NOT DEFINED(OPENGL_ES)}
9059     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
9060       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9061 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
9062     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
9063       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9064 {$ELSE}
9065     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
9066       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9067 {$IFEND}
9068   end;
9069
9070   if (ID = 0) then
9071     CreateID;
9072   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
9073   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
9074 end;
9075
9076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9077 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
9078 begin
9079   inherited Bind (aEnableTextureUnit);
9080 {$IFNDEF OPENGL_ES}
9081   if aEnableTexCoordsGen then begin
9082     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
9083     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
9084     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
9085     glEnable(GL_TEXTURE_GEN_S);
9086     glEnable(GL_TEXTURE_GEN_T);
9087     glEnable(GL_TEXTURE_GEN_R);
9088   end;
9089 {$ENDIF}
9090 end;
9091
9092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9093 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
9094 begin
9095   inherited Unbind(aDisableTextureUnit);
9096 {$IFNDEF OPENGL_ES}
9097   if aDisableTexCoordsGen then begin
9098     glDisable(GL_TEXTURE_GEN_S);
9099     glDisable(GL_TEXTURE_GEN_T);
9100     glDisable(GL_TEXTURE_GEN_R);
9101   end;
9102 {$ENDIF}
9103 end;
9104 {$IFEND}
9105
9106 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9108 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9110 type
9111   TVec = Array[0..2] of Single;
9112   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9113
9114   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
9115   TglBitmapNormalMapRec = record
9116     HalfSize : Integer;
9117     Func: TglBitmapNormalMapGetVectorFunc;
9118   end;
9119
9120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9121 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9122 begin
9123   aVec[0] := aHalfSize;
9124   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9125   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
9126 end;
9127
9128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9129 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9130 begin
9131   aVec[0] := - aHalfSize;
9132   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9133   aVec[2] := aPosition.X + 0.5 - aHalfSize;
9134 end;
9135
9136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9137 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9138 begin
9139   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9140   aVec[1] := aHalfSize;
9141   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
9142 end;
9143
9144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9145 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9146 begin
9147   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9148   aVec[1] := - aHalfSize;
9149   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
9150 end;
9151
9152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9153 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9154 begin
9155   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9156   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9157   aVec[2] := aHalfSize;
9158 end;
9159
9160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9161 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9162 begin
9163   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
9164   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9165   aVec[2] := - aHalfSize;
9166 end;
9167
9168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9169 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
9170 var
9171   i: Integer;
9172   Vec: TVec;
9173   Len: Single;
9174 begin
9175   with FuncRec do begin
9176     with PglBitmapNormalMapRec(Args)^ do begin
9177       Func(Vec, Position, HalfSize);
9178
9179       // Normalize
9180       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9181       if Len <> 0 then begin
9182         Vec[0] := Vec[0] * Len;
9183         Vec[1] := Vec[1] * Len;
9184         Vec[2] := Vec[2] * Len;
9185       end;
9186
9187       // Scale Vector and AddVectro
9188       Vec[0] := Vec[0] * 0.5 + 0.5;
9189       Vec[1] := Vec[1] * 0.5 + 0.5;
9190       Vec[2] := Vec[2] * 0.5 + 0.5;
9191     end;
9192
9193     // Set Color
9194     for i := 0 to 2 do
9195       Dest.Data.arr[i] := Round(Vec[i] * 255);
9196   end;
9197 end;
9198
9199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9200 procedure TglBitmapNormalMap.AfterConstruction;
9201 begin
9202   inherited;
9203 {$IFNDEF OPENGL_ES}
9204   fGenMode := GL_NORMAL_MAP;
9205 {$ENDIF}
9206 end;
9207
9208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9209 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9210 var
9211   Rec: TglBitmapNormalMapRec;
9212   SizeRec: TglBitmapPixelPosition;
9213 begin
9214   Rec.HalfSize := aSize div 2;
9215   FreeDataAfterGenTexture := false;
9216
9217   SizeRec.Fields := [ffX, ffY];
9218   SizeRec.X := aSize;
9219   SizeRec.Y := aSize;
9220
9221   // Positive X
9222   Rec.Func := glBitmapNormalMapPosX;
9223   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9224   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9225
9226   // Negative X
9227   Rec.Func := glBitmapNormalMapNegX;
9228   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9229   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9230
9231   // Positive Y
9232   Rec.Func := glBitmapNormalMapPosY;
9233   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9234   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9235
9236   // Negative Y
9237   Rec.Func := glBitmapNormalMapNegY;
9238   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9239   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9240
9241   // Positive Z
9242   Rec.Func := glBitmapNormalMapPosZ;
9243   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9244   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9245
9246   // Negative Z
9247   Rec.Func := glBitmapNormalMapNegZ;
9248   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9249   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9250 end;
9251 {$IFEND}
9252
9253 initialization
9254   glBitmapSetDefaultFormat (tfEmpty);
9255   glBitmapSetDefaultMipmap (mmMipmap);
9256   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9257   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9258 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
9259   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9260 {$IFEND}
9261
9262   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9263   glBitmapSetDefaultDeleteTextureOnFree    (true);
9264
9265   TFormatDescriptor.Init;
9266
9267 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9268   OpenGLInitialized := false;
9269   InitOpenGLCS := TCriticalSection.Create;
9270 {$ENDIF}
9271
9272 finalization
9273   TFormatDescriptor.Finalize;
9274
9275 {$IFDEF GLB_NATIVE_OGL}
9276   if Assigned(GL_LibHandle) then
9277     glbFreeLibrary(GL_LibHandle);
9278
9279 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9280   if Assigned(GLU_LibHandle) then
9281     glbFreeLibrary(GLU_LibHandle);
9282   FreeAndNil(InitOpenGLCS);
9283 {$ENDIF}
9284 {$ENDIF}
9285
9286 end.