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   TglcBitmap1D        = TglBitmap1D;
1324   TglcBitmap2D        = TglBitmap2D;
1325   TglcBitmapCubeMap   = TglBitmapCubeMap;
1326   TglcBitmapNormalMap = TglBitmapNormalMap;
1327
1328 const
1329   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1330
1331 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1332 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1333 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1334 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1335 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1336 procedure glBitmapSetDefaultWrap(
1337   const S: Cardinal = GL_CLAMP_TO_EDGE;
1338   const T: Cardinal = GL_CLAMP_TO_EDGE;
1339   const R: Cardinal = GL_CLAMP_TO_EDGE);
1340
1341 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1342 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1343 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1344 function glBitmapGetDefaultFormat: TglBitmapFormat;
1345 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1346 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1347
1348 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1349 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1350 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1351 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1352 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1353 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1354
1355 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1356
1357 var
1358   glBitmapDefaultDeleteTextureOnFree: Boolean;
1359   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1360   glBitmapDefaultFormat: TglBitmapFormat;
1361   glBitmapDefaultMipmap: TglBitmapMipMap;
1362   glBitmapDefaultFilterMin: Cardinal;
1363   glBitmapDefaultFilterMag: Cardinal;
1364   glBitmapDefaultWrapS: Cardinal;
1365   glBitmapDefaultWrapT: Cardinal;
1366   glBitmapDefaultWrapR: Cardinal;
1367   glDefaultSwizzle: array[0..3] of GLenum;
1368
1369 {$IFDEF GLB_DELPHI}
1370 function CreateGrayPalette: HPALETTE;
1371 {$ENDIF}
1372
1373 implementation
1374
1375 uses
1376   Math, syncobjs, typinfo
1377   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1378
1379 ////////////////////////////////////////////////////////////////////////////////////////////////////
1380 type
1381   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1382   public
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1385
1386     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1387     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1388
1389     function CreateMappingData: Pointer; virtual;
1390     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1391
1392     function IsEmpty: Boolean; virtual;
1393     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1394
1395     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1396
1397     constructor Create; virtual;
1398   public
1399     class procedure Init;
1400     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1401     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1402     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1403     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1404     class procedure Clear;
1405     class procedure Finalize;
1406   end;
1407   TFormatDescriptorClass = class of TFormatDescriptor;
1408
1409   TfdEmpty = class(TFormatDescriptor);
1410
1411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1412   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415   end;
1416
1417   TfdLuminanceUB1 = 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   TfdUniversalUB1 = 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   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* 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   TfdRGBub3 = class(TFormatDescriptor) //3* 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   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
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   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
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   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1453   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1454     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1455     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1456   end;
1457
1458   TfdLuminanceUS1 = 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   TfdUniversalUS1 = 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   TfdDepthUS1 = 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   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* 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   TfdRGBus3 = class(TFormatDescriptor) //3* 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   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
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   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
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   TfdARGBus4 = 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   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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   TfdABGRus4 = 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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1509   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1510     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1511     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1512   end;
1513
1514   TfdDepthUI1 = 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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1520   TfdAlpha4ub1 = class(TfdAlphaUB1)
1521     procedure SetValues; override;
1522   end;
1523
1524   TfdAlpha8ub1 = class(TfdAlphaUB1)
1525     procedure SetValues; override;
1526   end;
1527
1528   TfdAlpha16us1 = class(TfdAlphaUS1)
1529     procedure SetValues; override;
1530   end;
1531
1532   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1533     procedure SetValues; override;
1534   end;
1535
1536   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1537     procedure SetValues; override;
1538   end;
1539
1540   TfdLuminance16us1 = class(TfdLuminanceUS1)
1541     procedure SetValues; override;
1542   end;
1543
1544   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1545     procedure SetValues; override;
1546   end;
1547
1548   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1549     procedure SetValues; override;
1550   end;
1551
1552   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1561     procedure SetValues; override;
1562   end;
1563
1564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1565   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1566     procedure SetValues; override;
1567   end;
1568
1569   TfdRGBX4us1 = class(TfdUniversalUS1)
1570     procedure SetValues; override;
1571   end;
1572
1573   TfdXRGB4us1 = class(TfdUniversalUS1)
1574     procedure SetValues; override;
1575   end;
1576
1577   TfdR5G6B5us1 = class(TfdUniversalUS1)
1578     procedure SetValues; override;
1579   end;
1580
1581   TfdRGB5X1us1 = class(TfdUniversalUS1)
1582     procedure SetValues; override;
1583   end;
1584
1585   TfdX1RGB5us1 = class(TfdUniversalUS1)
1586     procedure SetValues; override;
1587   end;
1588
1589   TfdRGB8ub3 = class(TfdRGBub3)
1590     procedure SetValues; override;
1591   end;
1592
1593   TfdRGBX8ui1 = class(TfdUniversalUI1)
1594     procedure SetValues; override;
1595   end;
1596
1597   TfdXRGB8ui1 = class(TfdUniversalUI1)
1598     procedure SetValues; override;
1599   end;
1600
1601   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1602     procedure SetValues; override;
1603   end;
1604
1605   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1606     procedure SetValues; override;
1607   end;
1608
1609   TfdRGB16us3 = class(TfdRGBus3)
1610     procedure SetValues; override;
1611   end;
1612
1613   TfdRGBA4us1 = class(TfdUniversalUS1)
1614     procedure SetValues; override;
1615   end;
1616
1617   TfdARGB4us1 = class(TfdUniversalUS1)
1618     procedure SetValues; override;
1619   end;
1620
1621   TfdRGB5A1us1 = class(TfdUniversalUS1)
1622     procedure SetValues; override;
1623   end;
1624
1625   TfdA1RGB5us1 = class(TfdUniversalUS1)
1626     procedure SetValues; override;
1627   end;
1628
1629   TfdRGBA8ui1 = class(TfdUniversalUI1)
1630     procedure SetValues; override;
1631   end;
1632
1633   TfdARGB8ui1 = class(TfdUniversalUI1)
1634     procedure SetValues; override;
1635   end;
1636
1637   TfdRGBA8ub4 = class(TfdRGBAub4)
1638     procedure SetValues; override;
1639   end;
1640
1641   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1642     procedure SetValues; override;
1643   end;
1644
1645   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1646     procedure SetValues; override;
1647   end;
1648
1649   TfdRGBA16us4 = class(TfdRGBAus4)
1650     procedure SetValues; override;
1651   end;
1652
1653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1654   TfdBGRX4us1 = class(TfdUniversalUS1)
1655     procedure SetValues; override;
1656   end;
1657
1658   TfdXBGR4us1 = class(TfdUniversalUS1)
1659     procedure SetValues; override;
1660   end;
1661
1662   TfdB5G6R5us1 = class(TfdUniversalUS1)
1663     procedure SetValues; override;
1664   end;
1665
1666   TfdBGR5X1us1 = class(TfdUniversalUS1)
1667     procedure SetValues; override;
1668   end;
1669
1670   TfdX1BGR5us1 = class(TfdUniversalUS1)
1671     procedure SetValues; override;
1672   end;
1673
1674   TfdBGR8ub3 = class(TfdBGRub3)
1675     procedure SetValues; override;
1676   end;
1677
1678   TfdBGRX8ui1 = class(TfdUniversalUI1)
1679     procedure SetValues; override;
1680   end;
1681
1682   TfdXBGR8ui1 = class(TfdUniversalUI1)
1683     procedure SetValues; override;
1684   end;
1685
1686   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1687     procedure SetValues; override;
1688   end;
1689
1690   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1691     procedure SetValues; override;
1692   end;
1693
1694   TfdBGR16us3 = class(TfdBGRus3)
1695     procedure SetValues; override;
1696   end;
1697
1698   TfdBGRA4us1 = class(TfdUniversalUS1)
1699     procedure SetValues; override;
1700   end;
1701
1702   TfdABGR4us1 = class(TfdUniversalUS1)
1703     procedure SetValues; override;
1704   end;
1705
1706   TfdBGR5A1us1 = class(TfdUniversalUS1)
1707     procedure SetValues; override;
1708   end;
1709
1710   TfdA1BGR5us1 = class(TfdUniversalUS1)
1711     procedure SetValues; override;
1712   end;
1713
1714   TfdBGRA8ui1 = class(TfdUniversalUI1)
1715     procedure SetValues; override;
1716   end;
1717
1718   TfdABGR8ui1 = class(TfdUniversalUI1)
1719     procedure SetValues; override;
1720   end;
1721
1722   TfdBGRA8ub4 = class(TfdBGRAub4)
1723     procedure SetValues; override;
1724   end;
1725
1726   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1727     procedure SetValues; override;
1728   end;
1729
1730   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1731     procedure SetValues; override;
1732   end;
1733
1734   TfdBGRA16us4 = class(TfdBGRAus4)
1735     procedure SetValues; override;
1736   end;
1737
1738   TfdDepth16us1 = class(TfdDepthUS1)
1739     procedure SetValues; override;
1740   end;
1741
1742   TfdDepth24ui1 = class(TfdDepthUI1)
1743     procedure SetValues; override;
1744   end;
1745
1746   TfdDepth32ui1 = class(TfdDepthUI1)
1747     procedure SetValues; override;
1748   end;
1749
1750   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1751     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1752     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1753     procedure SetValues; override;
1754   end;
1755
1756   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1757     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1758     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1759     procedure SetValues; override;
1760   end;
1761
1762   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1763     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1764     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1765     procedure SetValues; override;
1766   end;
1767
1768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1769   TbmpBitfieldFormat = class(TFormatDescriptor)
1770   public
1771     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1772     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1773     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1774     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1775   end;
1776
1777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1778   TbmpColorTableEnty = packed record
1779     b, g, r, a: Byte;
1780   end;
1781   TbmpColorTable = array of TbmpColorTableEnty;
1782   TbmpColorTableFormat = class(TFormatDescriptor)
1783   private
1784     fBitsPerPixel: Integer;
1785     fColorTable: TbmpColorTable;
1786   protected
1787     procedure SetValues; override;
1788   public
1789     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1790     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1791
1792     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1793     procedure CalcValues;
1794     procedure CreateColorTable;
1795
1796     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1797     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1798     destructor Destroy; override;
1799   end;
1800
1801 const
1802   LUMINANCE_WEIGHT_R = 0.30;
1803   LUMINANCE_WEIGHT_G = 0.59;
1804   LUMINANCE_WEIGHT_B = 0.11;
1805
1806   ALPHA_WEIGHT_R = 0.30;
1807   ALPHA_WEIGHT_G = 0.59;
1808   ALPHA_WEIGHT_B = 0.11;
1809
1810   DEPTH_WEIGHT_R = 0.333333333;
1811   DEPTH_WEIGHT_G = 0.333333333;
1812   DEPTH_WEIGHT_B = 0.333333333;
1813
1814   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1815     TfdEmpty,
1816
1817     TfdAlpha4ub1,
1818     TfdAlpha8ub1,
1819     TfdAlpha16us1,
1820
1821     TfdLuminance4ub1,
1822     TfdLuminance8ub1,
1823     TfdLuminance16us1,
1824
1825     TfdLuminance4Alpha4ub2,
1826     TfdLuminance6Alpha2ub2,
1827     TfdLuminance8Alpha8ub2,
1828     TfdLuminance12Alpha4us2,
1829     TfdLuminance16Alpha16us2,
1830
1831     TfdR3G3B2ub1,
1832     TfdRGBX4us1,
1833     TfdXRGB4us1,
1834     TfdR5G6B5us1,
1835     TfdRGB5X1us1,
1836     TfdX1RGB5us1,
1837     TfdRGB8ub3,
1838     TfdRGBX8ui1,
1839     TfdXRGB8ui1,
1840     TfdRGB10X2ui1,
1841     TfdX2RGB10ui1,
1842     TfdRGB16us3,
1843
1844     TfdRGBA4us1,
1845     TfdARGB4us1,
1846     TfdRGB5A1us1,
1847     TfdA1RGB5us1,
1848     TfdRGBA8ui1,
1849     TfdARGB8ui1,
1850     TfdRGBA8ub4,
1851     TfdRGB10A2ui1,
1852     TfdA2RGB10ui1,
1853     TfdRGBA16us4,
1854
1855     TfdBGRX4us1,
1856     TfdXBGR4us1,
1857     TfdB5G6R5us1,
1858     TfdBGR5X1us1,
1859     TfdX1BGR5us1,
1860     TfdBGR8ub3,
1861     TfdBGRX8ui1,
1862     TfdXBGR8ui1,
1863     TfdBGR10X2ui1,
1864     TfdX2BGR10ui1,
1865     TfdBGR16us3,
1866
1867     TfdBGRA4us1,
1868     TfdABGR4us1,
1869     TfdBGR5A1us1,
1870     TfdA1BGR5us1,
1871     TfdBGRA8ui1,
1872     TfdABGR8ui1,
1873     TfdBGRA8ub4,
1874     TfdBGR10A2ui1,
1875     TfdA2BGR10ui1,
1876     TfdBGRA16us4,
1877
1878     TfdDepth16us1,
1879     TfdDepth24ui1,
1880     TfdDepth32ui1,
1881
1882     TfdS3tcDtx1RGBA,
1883     TfdS3tcDtx3RGBA,
1884     TfdS3tcDtx5RGBA
1885   );
1886
1887 var
1888   FormatDescriptorCS: TCriticalSection;
1889   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1890
1891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1892 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1893 begin
1894   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1895 end;
1896
1897 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1898 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1899 begin
1900   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1901 end;
1902
1903 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1904 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1905 begin
1906   result.Fields := [];
1907
1908   if X >= 0 then
1909     result.Fields := result.Fields + [ffX];
1910   if Y >= 0 then
1911     result.Fields := result.Fields + [ffY];
1912
1913   result.X := Max(0, X);
1914   result.Y := Max(0, Y);
1915 end;
1916
1917 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1918 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1919 begin
1920   result.r := r;
1921   result.g := g;
1922   result.b := b;
1923   result.a := a;
1924 end;
1925
1926 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1927 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1928 begin
1929   result.r := r;
1930   result.g := g;
1931   result.b := b;
1932   result.a := a;
1933 end;
1934
1935 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1936 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1937 begin
1938   result.r := r;
1939   result.g := g;
1940   result.b := b;
1941   result.a := a;
1942 end;
1943
1944 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1945 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1946 var
1947   i: Integer;
1948 begin
1949   result := false;
1950   for i := 0 to high(r1.arr) do
1951     if (r1.arr[i] <> r2.arr[i]) then
1952       exit;
1953   result := true;
1954 end;
1955
1956 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1957 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1958 var
1959   i: Integer;
1960 begin
1961   result := false;
1962   for i := 0 to high(r1.arr) do
1963     if (r1.arr[i] <> r2.arr[i]) then
1964       exit;
1965   result := true;
1966 end;
1967
1968 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1969 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1970 var
1971   desc: TFormatDescriptor;
1972   p, tmp: PByte;
1973   x, y, i: Integer;
1974   md: Pointer;
1975   px: TglBitmapPixelData;
1976 begin
1977   result := nil;
1978   desc := TFormatDescriptor.Get(aFormat);
1979   if (desc.IsCompressed) or (desc.glFormat = 0) then
1980     exit;
1981
1982   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1983   md := desc.CreateMappingData;
1984   try
1985     tmp := p;
1986     desc.PreparePixel(px);
1987     for y := 0 to 4 do
1988       for x := 0 to 4 do begin
1989         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1990         for i := 0 to 3 do begin
1991           if ((y < 3) and (y = i)) or
1992              ((y = 3) and (i < 3)) or
1993              ((y = 4) and (i = 3))
1994           then
1995             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1996           else if ((y < 4) and (i = 3)) or
1997                   ((y = 4) and (i < 3))
1998           then
1999             px.Data.arr[i] := px.Range.arr[i]
2000           else
2001             px.Data.arr[i] := 0; //px.Range.arr[i];
2002         end;
2003         desc.Map(px, tmp, md);
2004       end;
2005   finally
2006     desc.FreeMappingData(md);
2007   end;
2008
2009   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
2010   result.FreeDataOnDestroy       := true;
2011   result.FreeDataAfterGenTexture := false;
2012   result.SetFilter(GL_NEAREST, GL_NEAREST);
2013 end;
2014
2015 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2016 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
2017 begin
2018   result.r := r;
2019   result.g := g;
2020   result.b := b;
2021   result.a := a;
2022 end;
2023
2024 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2025 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
2026 begin
2027   result := [];
2028
2029   if (aFormat in [
2030         //8bpp
2031         tfAlpha4ub1, tfAlpha8ub1,
2032         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
2033
2034         //16bpp
2035         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2036         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
2037         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
2038
2039         //24bpp
2040         tfBGR8ub3, tfRGB8ub3,
2041
2042         //32bpp
2043         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
2044         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2045   then
2046     result := result + [ ftBMP ];
2047
2048   if (aFormat in [
2049         //8bbp
2050         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2051
2052         //16bbp
2053         tfAlpha16us1, tfLuminance16us1,
2054         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2055         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2056
2057         //24bbp
2058         tfBGR8ub3,
2059
2060         //32bbp
2061         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2062         tfDepth24ui1, tfDepth32ui1])
2063   then
2064     result := result + [ftTGA];
2065
2066   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2067     result := result + [ftDDS];
2068
2069 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2070   if aFormat in [
2071       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2072       tfRGB8ub3, tfRGBA8ui1,
2073       tfBGR8ub3, tfBGRA8ui1] then
2074     result := result + [ftPNG];
2075 {$ENDIF}
2076
2077 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2078   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2079     result := result + [ftJPEG];
2080 {$ENDIF}
2081 end;
2082
2083 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2084 function IsPowerOfTwo(aNumber: Integer): Boolean;
2085 begin
2086   while (aNumber and 1) = 0 do
2087     aNumber := aNumber shr 1;
2088   result := aNumber = 1;
2089 end;
2090
2091 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2092 function GetTopMostBit(aBitSet: QWord): Integer;
2093 begin
2094   result := 0;
2095   while aBitSet > 0 do begin
2096     inc(result);
2097     aBitSet := aBitSet shr 1;
2098   end;
2099 end;
2100
2101 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2102 function CountSetBits(aBitSet: QWord): Integer;
2103 begin
2104   result := 0;
2105   while aBitSet > 0 do begin
2106     if (aBitSet and 1) = 1 then
2107       inc(result);
2108     aBitSet := aBitSet shr 1;
2109   end;
2110 end;
2111
2112 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2113 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2114 begin
2115   result := Trunc(
2116     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2117     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2118     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2119 end;
2120
2121 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2122 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2123 begin
2124   result := Trunc(
2125     DEPTH_WEIGHT_R * aPixel.Data.r +
2126     DEPTH_WEIGHT_G * aPixel.Data.g +
2127     DEPTH_WEIGHT_B * aPixel.Data.b);
2128 end;
2129
2130 {$IFDEF GLB_NATIVE_OGL}
2131 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2132 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2133 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2134 var
2135   GL_LibHandle: Pointer = nil;
2136
2137 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2138 begin
2139   if not Assigned(aLibHandle) then
2140     aLibHandle := GL_LibHandle;
2141
2142 {$IF DEFINED(GLB_WIN)}
2143   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2144   if Assigned(result) then
2145     exit;
2146
2147   if Assigned(wglGetProcAddress) then
2148     result := wglGetProcAddress(aProcName);
2149 {$ELSEIF DEFINED(GLB_LINUX)}
2150   if Assigned(glXGetProcAddress) then begin
2151     result := glXGetProcAddress(aProcName);
2152     if Assigned(result) then
2153       exit;
2154   end;
2155
2156   if Assigned(glXGetProcAddressARB) then begin
2157     result := glXGetProcAddressARB(aProcName);
2158     if Assigned(result) then
2159       exit;
2160   end;
2161
2162   result := dlsym(aLibHandle, aProcName);
2163 {$IFEND}
2164   if not Assigned(result) and aRaiseOnErr then
2165     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2166 end;
2167
2168 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2169 var
2170   GLU_LibHandle: Pointer = nil;
2171   OpenGLInitialized: Boolean;
2172   InitOpenGLCS: TCriticalSection;
2173
2174 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2175 procedure glbInitOpenGL;
2176
2177   ////////////////////////////////////////////////////////////////////////////////
2178   function glbLoadLibrary(const aName: PChar): Pointer;
2179   begin
2180     {$IF DEFINED(GLB_WIN)}
2181     result := {%H-}Pointer(LoadLibrary(aName));
2182     {$ELSEIF DEFINED(GLB_LINUX)}
2183     result := dlopen(Name, RTLD_LAZY);
2184     {$ELSE}
2185     result := nil;
2186     {$IFEND}
2187   end;
2188
2189   ////////////////////////////////////////////////////////////////////////////////
2190   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2191   begin
2192     result := false;
2193     if not Assigned(aLibHandle) then
2194       exit;
2195
2196     {$IF DEFINED(GLB_WIN)}
2197     Result := FreeLibrary({%H-}HINST(aLibHandle));
2198     {$ELSEIF DEFINED(GLB_LINUX)}
2199     Result := dlclose(aLibHandle) = 0;
2200     {$IFEND}
2201   end;
2202
2203 begin
2204   if Assigned(GL_LibHandle) then
2205     glbFreeLibrary(GL_LibHandle);
2206
2207   if Assigned(GLU_LibHandle) then
2208     glbFreeLibrary(GLU_LibHandle);
2209
2210   GL_LibHandle := glbLoadLibrary(libopengl);
2211   if not Assigned(GL_LibHandle) then
2212     raise EglBitmap.Create('unable to load library: ' + libopengl);
2213
2214   GLU_LibHandle := glbLoadLibrary(libglu);
2215   if not Assigned(GLU_LibHandle) then
2216     raise EglBitmap.Create('unable to load library: ' + libglu);
2217
2218 {$IF DEFINED(GLB_WIN)}
2219   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2220 {$ELSEIF DEFINED(GLB_LINUX)}
2221   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2222   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2223 {$IFEND}
2224
2225   glEnable := glbGetProcAddress('glEnable');
2226   glDisable := glbGetProcAddress('glDisable');
2227   glGetString := glbGetProcAddress('glGetString');
2228   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2229   glTexParameteri := glbGetProcAddress('glTexParameteri');
2230   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2231   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2232   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2233   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2234   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2235   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2236   glTexGeni := glbGetProcAddress('glTexGeni');
2237   glGenTextures := glbGetProcAddress('glGenTextures');
2238   glBindTexture := glbGetProcAddress('glBindTexture');
2239   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2240   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2241   glReadPixels := glbGetProcAddress('glReadPixels');
2242   glPixelStorei := glbGetProcAddress('glPixelStorei');
2243   glTexImage1D := glbGetProcAddress('glTexImage1D');
2244   glTexImage2D := glbGetProcAddress('glTexImage2D');
2245   glGetTexImage := glbGetProcAddress('glGetTexImage');
2246
2247   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2248   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2249 end;
2250 {$ENDIF}
2251
2252 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 procedure glbReadOpenGLExtensions;
2254 var
2255   Buffer: AnsiString;
2256   MajorVersion, MinorVersion: Integer;
2257
2258   ///////////////////////////////////////////////////////////////////////////////////////////
2259   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2260   var
2261     Separator: Integer;
2262   begin
2263     aMinor := 0;
2264     aMajor := 0;
2265
2266     Separator := Pos(AnsiString('.'), aBuffer);
2267     if (Separator > 1) and (Separator < Length(aBuffer)) and
2268        (aBuffer[Separator - 1] in ['0'..'9']) and
2269        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2270
2271       Dec(Separator);
2272       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2273         Dec(Separator);
2274
2275       Delete(aBuffer, 1, Separator);
2276       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2277
2278       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2279         Inc(Separator);
2280
2281       Delete(aBuffer, Separator, 255);
2282       Separator := Pos(AnsiString('.'), aBuffer);
2283
2284       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2285       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2286     end;
2287   end;
2288
2289   ///////////////////////////////////////////////////////////////////////////////////////////
2290   function CheckExtension(const Extension: AnsiString): Boolean;
2291   var
2292     ExtPos: Integer;
2293   begin
2294     ExtPos := Pos(Extension, Buffer);
2295     result := ExtPos > 0;
2296     if result then
2297       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2298   end;
2299
2300   ///////////////////////////////////////////////////////////////////////////////////////////
2301   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2302   begin
2303     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2304   end;
2305
2306 begin
2307 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2308   InitOpenGLCS.Enter;
2309   try
2310     if not OpenGLInitialized then begin
2311       glbInitOpenGL;
2312       OpenGLInitialized := true;
2313     end;
2314   finally
2315     InitOpenGLCS.Leave;
2316   end;
2317 {$ENDIF}
2318
2319   // Version
2320   Buffer := glGetString(GL_VERSION);
2321   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2322
2323   GL_VERSION_1_2 := CheckVersion(1, 2);
2324   GL_VERSION_1_3 := CheckVersion(1, 3);
2325   GL_VERSION_1_4 := CheckVersion(1, 4);
2326   GL_VERSION_2_0 := CheckVersion(2, 0);
2327   GL_VERSION_3_3 := CheckVersion(3, 3);
2328
2329   // Extensions
2330   Buffer := glGetString(GL_EXTENSIONS);
2331   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2332   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2333   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2334   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2335   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2336   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2337   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2338   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2339   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2340   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2341   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2342   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2343   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2344   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2345
2346   if GL_VERSION_1_3 then begin
2347     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2348     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2349     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2350   end else begin
2351     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2352     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2353     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2354   end;
2355 end;
2356 {$ENDIF}
2357
2358 {$IFDEF GLB_SDL_IMAGE}
2359 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2361 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2363 begin
2364   result := TStream(context^.unknown.data1).Seek(offset, whence);
2365 end;
2366
2367 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2368 begin
2369   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2370 end;
2371
2372 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2373 begin
2374   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2375 end;
2376
2377 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2378 begin
2379   result := 0;
2380 end;
2381
2382 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2383 begin
2384   result := SDL_AllocRW;
2385
2386   if result = nil then
2387     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2388
2389   result^.seek := glBitmapRWseek;
2390   result^.read := glBitmapRWread;
2391   result^.write := glBitmapRWwrite;
2392   result^.close := glBitmapRWclose;
2393   result^.unknown.data1 := Stream;
2394 end;
2395 {$ENDIF}
2396
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2399 begin
2400   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2405 begin
2406   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2407 end;
2408
2409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2410 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2411 begin
2412   glBitmapDefaultMipmap := aValue;
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2417 begin
2418   glBitmapDefaultFormat := aFormat;
2419 end;
2420
2421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2422 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2423 begin
2424   glBitmapDefaultFilterMin := aMin;
2425   glBitmapDefaultFilterMag := aMag;
2426 end;
2427
2428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2429 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2430 begin
2431   glBitmapDefaultWrapS := S;
2432   glBitmapDefaultWrapT := T;
2433   glBitmapDefaultWrapR := R;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2438 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2439 begin
2440   glDefaultSwizzle[0] := r;
2441   glDefaultSwizzle[1] := g;
2442   glDefaultSwizzle[2] := b;
2443   glDefaultSwizzle[3] := a;
2444 end;
2445 {$IFEND}
2446
2447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2448 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2449 begin
2450   result := glBitmapDefaultDeleteTextureOnFree;
2451 end;
2452
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2455 begin
2456   result := glBitmapDefaultFreeDataAfterGenTextures;
2457 end;
2458
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2461 begin
2462   result := glBitmapDefaultMipmap;
2463 end;
2464
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 function glBitmapGetDefaultFormat: TglBitmapFormat;
2467 begin
2468   result := glBitmapDefaultFormat;
2469 end;
2470
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2473 begin
2474   aMin := glBitmapDefaultFilterMin;
2475   aMag := glBitmapDefaultFilterMag;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2480 begin
2481   S := glBitmapDefaultWrapS;
2482   T := glBitmapDefaultWrapT;
2483   R := glBitmapDefaultWrapR;
2484 end;
2485
2486 {$IFNDEF OPENGL_ES}
2487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2489 begin
2490   r := glDefaultSwizzle[0];
2491   g := glDefaultSwizzle[1];
2492   b := glDefaultSwizzle[2];
2493   a := glDefaultSwizzle[3];
2494 end;
2495 {$ENDIF}
2496
2497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2500 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2501 var
2502   w, h: Integer;
2503 begin
2504   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2505     w := Max(1, aSize.X);
2506     h := Max(1, aSize.Y);
2507     result := GetSize(w, h);
2508   end else
2509     result := 0;
2510 end;
2511
2512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2513 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2514 begin
2515   result := 0;
2516   if (aWidth <= 0) or (aHeight <= 0) then
2517     exit;
2518   result := Ceil(aWidth * aHeight * BytesPerPixel);
2519 end;
2520
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 function TFormatDescriptor.CreateMappingData: Pointer;
2523 begin
2524   result := nil;
2525 end;
2526
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2529 begin
2530   //DUMMY
2531 end;
2532
2533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2534 function TFormatDescriptor.IsEmpty: Boolean;
2535 begin
2536   result := (fFormat = tfEmpty);
2537 end;
2538
2539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2540 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2541 var
2542   i: Integer;
2543   m: TglBitmapRec4ul;
2544 begin
2545   result := false;
2546   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2547     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2548   m := Mask;
2549   for i := 0 to 3 do
2550     if (aMask.arr[i] <> m.arr[i]) then
2551       exit;
2552   result := true;
2553 end;
2554
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2557 begin
2558   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2559   aPixel.Data   := Range;
2560   aPixel.Format := fFormat;
2561   aPixel.Range  := Range;
2562 end;
2563
2564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2565 constructor TFormatDescriptor.Create;
2566 begin
2567   inherited Create;
2568 end;
2569
2570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2573 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2574 begin
2575   aData^ := aPixel.Data.a;
2576   inc(aData);
2577 end;
2578
2579 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2580 begin
2581   aPixel.Data.r := 0;
2582   aPixel.Data.g := 0;
2583   aPixel.Data.b := 0;
2584   aPixel.Data.a := aData^;
2585   inc(aData);
2586 end;
2587
2588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2589 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2590 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2591 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2592 begin
2593   aData^ := LuminanceWeight(aPixel);
2594   inc(aData);
2595 end;
2596
2597 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2598 begin
2599   aPixel.Data.r := aData^;
2600   aPixel.Data.g := aData^;
2601   aPixel.Data.b := aData^;
2602   aPixel.Data.a := 0;
2603   inc(aData);
2604 end;
2605
2606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2607 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2609 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2610 var
2611   i: Integer;
2612 begin
2613   aData^ := 0;
2614   for i := 0 to 3 do
2615     if (Range.arr[i] > 0) then
2616       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2617   inc(aData);
2618 end;
2619
2620 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2621 var
2622   i: Integer;
2623 begin
2624   for i := 0 to 3 do
2625     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2626   inc(aData);
2627 end;
2628
2629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2630 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2632 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2633 begin
2634   inherited Map(aPixel, aData, aMapData);
2635   aData^ := aPixel.Data.a;
2636   inc(aData);
2637 end;
2638
2639 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2640 begin
2641   inherited Unmap(aData, aPixel, aMapData);
2642   aPixel.Data.a := aData^;
2643   inc(aData);
2644 end;
2645
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2650 begin
2651   aData^ := aPixel.Data.r;
2652   inc(aData);
2653   aData^ := aPixel.Data.g;
2654   inc(aData);
2655   aData^ := aPixel.Data.b;
2656   inc(aData);
2657 end;
2658
2659 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2660 begin
2661   aPixel.Data.r := aData^;
2662   inc(aData);
2663   aPixel.Data.g := aData^;
2664   inc(aData);
2665   aPixel.Data.b := aData^;
2666   inc(aData);
2667   aPixel.Data.a := 0;
2668 end;
2669
2670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2671 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2673 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2674 begin
2675   aData^ := aPixel.Data.b;
2676   inc(aData);
2677   aData^ := aPixel.Data.g;
2678   inc(aData);
2679   aData^ := aPixel.Data.r;
2680   inc(aData);
2681 end;
2682
2683 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2684 begin
2685   aPixel.Data.b := aData^;
2686   inc(aData);
2687   aPixel.Data.g := aData^;
2688   inc(aData);
2689   aPixel.Data.r := aData^;
2690   inc(aData);
2691   aPixel.Data.a := 0;
2692 end;
2693
2694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2695 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2698 begin
2699   inherited Map(aPixel, aData, aMapData);
2700   aData^ := aPixel.Data.a;
2701   inc(aData);
2702 end;
2703
2704 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2705 begin
2706   inherited Unmap(aData, aPixel, aMapData);
2707   aPixel.Data.a := aData^;
2708   inc(aData);
2709 end;
2710
2711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2712 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2715 begin
2716   inherited Map(aPixel, aData, aMapData);
2717   aData^ := aPixel.Data.a;
2718   inc(aData);
2719 end;
2720
2721 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2722 begin
2723   inherited Unmap(aData, aPixel, aMapData);
2724   aPixel.Data.a := aData^;
2725   inc(aData);
2726 end;
2727
2728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2729 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2731 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2732 begin
2733   PWord(aData)^ := aPixel.Data.a;
2734   inc(aData, 2);
2735 end;
2736
2737 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2738 begin
2739   aPixel.Data.r := 0;
2740   aPixel.Data.g := 0;
2741   aPixel.Data.b := 0;
2742   aPixel.Data.a := PWord(aData)^;
2743   inc(aData, 2);
2744 end;
2745
2746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2747 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2749 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2750 begin
2751   PWord(aData)^ := LuminanceWeight(aPixel);
2752   inc(aData, 2);
2753 end;
2754
2755 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2756 begin
2757   aPixel.Data.r := PWord(aData)^;
2758   aPixel.Data.g := PWord(aData)^;
2759   aPixel.Data.b := PWord(aData)^;
2760   aPixel.Data.a := 0;
2761   inc(aData, 2);
2762 end;
2763
2764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2765 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2767 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2768 var
2769   i: Integer;
2770 begin
2771   PWord(aData)^ := 0;
2772   for i := 0 to 3 do
2773     if (Range.arr[i] > 0) then
2774       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2775   inc(aData, 2);
2776 end;
2777
2778 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2779 var
2780   i: Integer;
2781 begin
2782   for i := 0 to 3 do
2783     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2784   inc(aData, 2);
2785 end;
2786
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2791 begin
2792   PWord(aData)^ := DepthWeight(aPixel);
2793   inc(aData, 2);
2794 end;
2795
2796 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2797 begin
2798   aPixel.Data.r := PWord(aData)^;
2799   aPixel.Data.g := PWord(aData)^;
2800   aPixel.Data.b := PWord(aData)^;
2801   aPixel.Data.a := PWord(aData)^;;
2802   inc(aData, 2);
2803 end;
2804
2805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2806 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2808 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2809 begin
2810   inherited Map(aPixel, aData, aMapData);
2811   PWord(aData)^ := aPixel.Data.a;
2812   inc(aData, 2);
2813 end;
2814
2815 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2816 begin
2817   inherited Unmap(aData, aPixel, aMapData);
2818   aPixel.Data.a := PWord(aData)^;
2819   inc(aData, 2);
2820 end;
2821
2822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2823 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2826 begin
2827   PWord(aData)^ := aPixel.Data.r;
2828   inc(aData, 2);
2829   PWord(aData)^ := aPixel.Data.g;
2830   inc(aData, 2);
2831   PWord(aData)^ := aPixel.Data.b;
2832   inc(aData, 2);
2833 end;
2834
2835 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2836 begin
2837   aPixel.Data.r := PWord(aData)^;
2838   inc(aData, 2);
2839   aPixel.Data.g := PWord(aData)^;
2840   inc(aData, 2);
2841   aPixel.Data.b := PWord(aData)^;
2842   inc(aData, 2);
2843   aPixel.Data.a := 0;
2844 end;
2845
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2850 begin
2851   PWord(aData)^ := aPixel.Data.b;
2852   inc(aData, 2);
2853   PWord(aData)^ := aPixel.Data.g;
2854   inc(aData, 2);
2855   PWord(aData)^ := aPixel.Data.r;
2856   inc(aData, 2);
2857 end;
2858
2859 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2860 begin
2861   aPixel.Data.b := PWord(aData)^;
2862   inc(aData, 2);
2863   aPixel.Data.g := PWord(aData)^;
2864   inc(aData, 2);
2865   aPixel.Data.r := PWord(aData)^;
2866   inc(aData, 2);
2867   aPixel.Data.a := 0;
2868 end;
2869
2870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2871 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2874 begin
2875   inherited Map(aPixel, aData, aMapData);
2876   PWord(aData)^ := aPixel.Data.a;
2877   inc(aData, 2);
2878 end;
2879
2880 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2881 begin
2882   inherited Unmap(aData, aPixel, aMapData);
2883   aPixel.Data.a := PWord(aData)^;
2884   inc(aData, 2);
2885 end;
2886
2887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2888 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2890 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2891 begin
2892   PWord(aData)^ := aPixel.Data.a;
2893   inc(aData, 2);
2894   inherited Map(aPixel, aData, aMapData);
2895 end;
2896
2897 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2898 begin
2899   aPixel.Data.a := PWord(aData)^;
2900   inc(aData, 2);
2901   inherited Unmap(aData, aPixel, aMapData);
2902 end;
2903
2904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2905 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2907 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2908 begin
2909   inherited Map(aPixel, aData, aMapData);
2910   PWord(aData)^ := aPixel.Data.a;
2911   inc(aData, 2);
2912 end;
2913
2914 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2915 begin
2916   inherited Unmap(aData, aPixel, aMapData);
2917   aPixel.Data.a := PWord(aData)^;
2918   inc(aData, 2);
2919 end;
2920
2921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2922 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2924 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2925 begin
2926   PWord(aData)^ := aPixel.Data.a;
2927   inc(aData, 2);
2928   inherited Map(aPixel, aData, aMapData);
2929 end;
2930
2931 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 begin
2933   aPixel.Data.a := PWord(aData)^;
2934   inc(aData, 2);
2935   inherited Unmap(aData, aPixel, aMapData);
2936 end;
2937
2938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2939 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2941 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2942 var
2943   i: Integer;
2944 begin
2945   PCardinal(aData)^ := 0;
2946   for i := 0 to 3 do
2947     if (Range.arr[i] > 0) then
2948       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2949   inc(aData, 4);
2950 end;
2951
2952 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2953 var
2954   i: Integer;
2955 begin
2956   for i := 0 to 3 do
2957     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2958   inc(aData, 2);
2959 end;
2960
2961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2962 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2964 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2965 begin
2966   PCardinal(aData)^ := DepthWeight(aPixel);
2967   inc(aData, 4);
2968 end;
2969
2970 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2971 begin
2972   aPixel.Data.r := PCardinal(aData)^;
2973   aPixel.Data.g := PCardinal(aData)^;
2974   aPixel.Data.b := PCardinal(aData)^;
2975   aPixel.Data.a := PCardinal(aData)^;
2976   inc(aData, 4);
2977 end;
2978
2979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2982 procedure TfdAlpha4ub1.SetValues;
2983 begin
2984   inherited SetValues;
2985   fBitsPerPixel     := 8;
2986   fFormat           := tfAlpha4ub1;
2987   fWithAlpha        := tfAlpha4ub1;
2988   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2989   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2990 {$IFNDEF OPENGL_ES}
2991   fOpenGLFormat     := tfAlpha4ub1;
2992   fglFormat         := GL_ALPHA;
2993   fglInternalFormat := GL_ALPHA4;
2994   fglDataFormat     := GL_UNSIGNED_BYTE;
2995 {$ELSE}
2996   fOpenGLFormat     := tfAlpha8ub1;
2997 {$ENDIF}
2998 end;
2999
3000 procedure TfdAlpha8ub1.SetValues;
3001 begin
3002   inherited SetValues;
3003   fBitsPerPixel     := 8;
3004   fFormat           := tfAlpha8ub1;
3005   fWithAlpha        := tfAlpha8ub1;
3006   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
3007   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3008   fOpenGLFormat     := tfAlpha8ub1;
3009   fglFormat         := GL_ALPHA;
3010   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
3011   fglDataFormat     := GL_UNSIGNED_BYTE;
3012 end;
3013
3014 procedure TfdAlpha16us1.SetValues;
3015 begin
3016   inherited SetValues;
3017   fBitsPerPixel     := 16;
3018   fFormat           := tfAlpha16us1;
3019   fWithAlpha        := tfAlpha16us1;
3020   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
3021   fShift            := glBitmapRec4ub(0, 0, 0,  0);
3022 {$IFNDEF OPENGL_ES}
3023   fOpenGLFormat     := tfAlpha16us1;
3024   fglFormat         := GL_ALPHA;
3025   fglInternalFormat := GL_ALPHA16;
3026   fglDataFormat     := GL_UNSIGNED_SHORT;
3027 {$ELSE}
3028   fOpenGLFormat     := tfAlpha8ub1;
3029 {$ENDIF}
3030 end;
3031
3032 procedure TfdLuminance4ub1.SetValues;
3033 begin
3034   inherited SetValues;
3035   fBitsPerPixel     := 8;
3036   fFormat           := tfLuminance4ub1;
3037   fWithAlpha        := tfLuminance4Alpha4ub2;
3038   fWithoutAlpha     := tfLuminance4ub1;
3039   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3040   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3041 {$IFNDEF OPENGL_ES}
3042   fOpenGLFormat     := tfLuminance4ub1;
3043   fglFormat         := GL_LUMINANCE;
3044   fglInternalFormat := GL_LUMINANCE4;
3045   fglDataFormat     := GL_UNSIGNED_BYTE;
3046 {$ELSE}
3047   fOpenGLFormat     := tfLuminance8ub1;
3048 {$ENDIF}
3049 end;
3050
3051 procedure TfdLuminance8ub1.SetValues;
3052 begin
3053   inherited SetValues;
3054   fBitsPerPixel     := 8;
3055   fFormat           := tfLuminance8ub1;
3056   fWithAlpha        := tfLuminance8Alpha8ub2;
3057   fWithoutAlpha     := tfLuminance8ub1;
3058   fOpenGLFormat     := tfLuminance8ub1;
3059   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3060   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3061   fglFormat         := GL_LUMINANCE;
3062   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
3063   fglDataFormat     := GL_UNSIGNED_BYTE;
3064 end;
3065
3066 procedure TfdLuminance16us1.SetValues;
3067 begin
3068   inherited SetValues;
3069   fBitsPerPixel     := 16;
3070   fFormat           := tfLuminance16us1;
3071   fWithAlpha        := tfLuminance16Alpha16us2;
3072   fWithoutAlpha     := tfLuminance16us1;
3073   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3074   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3075 {$IFNDEF OPENGL_ES}
3076   fOpenGLFormat     := tfLuminance16us1;
3077   fglFormat         := GL_LUMINANCE;
3078   fglInternalFormat := GL_LUMINANCE16;
3079   fglDataFormat     := GL_UNSIGNED_SHORT;
3080 {$ELSE}
3081   fOpenGLFormat     := tfLuminance8ub1;
3082 {$ENDIF}
3083 end;
3084
3085 procedure TfdLuminance4Alpha4ub2.SetValues;
3086 begin
3087   inherited SetValues;
3088   fBitsPerPixel     := 16;
3089   fFormat           := tfLuminance4Alpha4ub2;
3090   fWithAlpha        := tfLuminance4Alpha4ub2;
3091   fWithoutAlpha     := tfLuminance4ub1;
3092   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3093   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3094 {$IFNDEF OPENGL_ES}
3095   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3096   fglFormat         := GL_LUMINANCE_ALPHA;
3097   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3098   fglDataFormat     := GL_UNSIGNED_BYTE;
3099 {$ELSE}
3100   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3101 {$ENDIF}
3102 end;
3103
3104 procedure TfdLuminance6Alpha2ub2.SetValues;
3105 begin
3106   inherited SetValues;
3107   fBitsPerPixel     := 16;
3108   fFormat           := tfLuminance6Alpha2ub2;
3109   fWithAlpha        := tfLuminance6Alpha2ub2;
3110   fWithoutAlpha     := tfLuminance8ub1;
3111   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3112   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3113 {$IFNDEF OPENGL_ES}
3114   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3115   fglFormat         := GL_LUMINANCE_ALPHA;
3116   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3117   fglDataFormat     := GL_UNSIGNED_BYTE;
3118 {$ELSE}
3119   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3120 {$ENDIF}
3121 end;
3122
3123 procedure TfdLuminance8Alpha8ub2.SetValues;
3124 begin
3125   inherited SetValues;
3126   fBitsPerPixel     := 16;
3127   fFormat           := tfLuminance8Alpha8ub2;
3128   fWithAlpha        := tfLuminance8Alpha8ub2;
3129   fWithoutAlpha     := tfLuminance8ub1;
3130   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3131   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3132   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3133   fglFormat         := GL_LUMINANCE_ALPHA;
3134   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
3135   fglDataFormat     := GL_UNSIGNED_BYTE;
3136 end;
3137
3138 procedure TfdLuminance12Alpha4us2.SetValues;
3139 begin
3140   inherited SetValues;
3141   fBitsPerPixel     := 32;
3142   fFormat           := tfLuminance12Alpha4us2;
3143   fWithAlpha        := tfLuminance12Alpha4us2;
3144   fWithoutAlpha     := tfLuminance16us1;
3145   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3146   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3147 {$IFNDEF OPENGL_ES}
3148   fOpenGLFormat     := tfLuminance12Alpha4us2;
3149   fglFormat         := GL_LUMINANCE_ALPHA;
3150   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3151   fglDataFormat     := GL_UNSIGNED_SHORT;
3152 {$ELSE}
3153   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3154 {$ENDIF}
3155 end;
3156
3157 procedure TfdLuminance16Alpha16us2.SetValues;
3158 begin
3159   inherited SetValues;
3160   fBitsPerPixel     := 32;
3161   fFormat           := tfLuminance16Alpha16us2;
3162   fWithAlpha        := tfLuminance16Alpha16us2;
3163   fWithoutAlpha     := tfLuminance16us1;
3164   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3165   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3166 {$IFNDEF OPENGL_ES}
3167   fOpenGLFormat     := tfLuminance16Alpha16us2;
3168   fglFormat         := GL_LUMINANCE_ALPHA;
3169   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3170   fglDataFormat     := GL_UNSIGNED_SHORT;
3171 {$ELSE}
3172   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3173 {$ENDIF}
3174 end;
3175
3176 procedure TfdR3G3B2ub1.SetValues;
3177 begin
3178   inherited SetValues;
3179   fBitsPerPixel     := 8;
3180   fFormat           := tfR3G3B2ub1;
3181   fWithAlpha        := tfRGBA4us1;
3182   fWithoutAlpha     := tfR3G3B2ub1;
3183   fRGBInverted      := tfEmpty;
3184   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3185   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3186 {$IFNDEF OPENGL_ES}
3187   fOpenGLFormat     := tfR3G3B2ub1;
3188   fglFormat         := GL_RGB;
3189   fglInternalFormat := GL_R3_G3_B2;
3190   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3191 {$ELSE}
3192   fOpenGLFormat     := tfR5G6B5us1;
3193 {$ENDIF}
3194 end;
3195
3196 procedure TfdRGBX4us1.SetValues;
3197 begin
3198   inherited SetValues;
3199   fBitsPerPixel     := 16;
3200   fFormat           := tfRGBX4us1;
3201   fWithAlpha        := tfRGBA4us1;
3202   fWithoutAlpha     := tfRGBX4us1;
3203   fRGBInverted      := tfBGRX4us1;
3204   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3205   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3206 {$IFNDEF OPENGL_ES}
3207   fOpenGLFormat     := tfRGBX4us1;
3208   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3209   fglInternalFormat := GL_RGB4;
3210   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3211 {$ELSE}
3212   fOpenGLFormat     := tfR5G6B5us1;
3213 {$ENDIF}
3214 end;
3215
3216 procedure TfdXRGB4us1.SetValues;
3217 begin
3218   inherited SetValues;
3219   fBitsPerPixel     := 16;
3220   fFormat           := tfXRGB4us1;
3221   fWithAlpha        := tfARGB4us1;
3222   fWithoutAlpha     := tfXRGB4us1;
3223   fRGBInverted      := tfXBGR4us1;
3224   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3225   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3226 {$IFNDEF OPENGL_ES}
3227   fOpenGLFormat     := tfXRGB4us1;
3228   fglFormat         := GL_BGRA;
3229   fglInternalFormat := GL_RGB4;
3230   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3231 {$ELSE}
3232   fOpenGLFormat     := tfR5G6B5us1;
3233 {$ENDIF}
3234 end;
3235
3236 procedure TfdR5G6B5us1.SetValues;
3237 begin
3238   inherited SetValues;
3239   fBitsPerPixel     := 16;
3240   fFormat           := tfR5G6B5us1;
3241   fWithAlpha        := tfRGB5A1us1;
3242   fWithoutAlpha     := tfR5G6B5us1;
3243   fRGBInverted      := tfB5G6R5us1;
3244   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3245   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3246 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3247   fOpenGLFormat     := tfR5G6B5us1;
3248   fglFormat         := GL_RGB;
3249   fglInternalFormat := GL_RGB565;
3250   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3251 {$ELSE}
3252   fOpenGLFormat     := tfRGB8ub3;
3253 {$IFEND}
3254 end;
3255
3256 procedure TfdRGB5X1us1.SetValues;
3257 begin
3258   inherited SetValues;
3259   fBitsPerPixel     := 16;
3260   fFormat           := tfRGB5X1us1;
3261   fWithAlpha        := tfRGB5A1us1;
3262   fWithoutAlpha     := tfRGB5X1us1;
3263   fRGBInverted      := tfBGR5X1us1;
3264   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3265   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3266 {$IFNDEF OPENGL_ES}
3267   fOpenGLFormat     := tfRGB5X1us1;
3268   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3269   fglInternalFormat := GL_RGB5;
3270   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3271 {$ELSE}
3272   fOpenGLFormat     := tfR5G6B5us1;
3273 {$ENDIF}
3274 end;
3275
3276 procedure TfdX1RGB5us1.SetValues;
3277 begin
3278   inherited SetValues;
3279   fBitsPerPixel     := 16;
3280   fFormat           := tfX1RGB5us1;
3281   fWithAlpha        := tfA1RGB5us1;
3282   fWithoutAlpha     := tfX1RGB5us1;
3283   fRGBInverted      := tfX1BGR5us1;
3284   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3285   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3286 {$IFNDEF OPENGL_ES}
3287   fOpenGLFormat     := tfX1RGB5us1;
3288   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3289   fglInternalFormat := GL_RGB5;
3290   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3291 {$ELSE}
3292   fOpenGLFormat     := tfR5G6B5us1;
3293 {$ENDIF}
3294 end;
3295
3296 procedure TfdRGB8ub3.SetValues;
3297 begin
3298   inherited SetValues;
3299   fBitsPerPixel     := 24;
3300   fFormat           := tfRGB8ub3;
3301   fWithAlpha        := tfRGBA8ub4;
3302   fWithoutAlpha     := tfRGB8ub3;
3303   fRGBInverted      := tfBGR8ub3;
3304   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3305   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3306   fOpenGLFormat     := tfRGB8ub3;
3307   fglFormat         := GL_RGB;
3308   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
3309   fglDataFormat     := GL_UNSIGNED_BYTE;
3310 end;
3311
3312 procedure TfdRGBX8ui1.SetValues;
3313 begin
3314   inherited SetValues;
3315   fBitsPerPixel     := 32;
3316   fFormat           := tfRGBX8ui1;
3317   fWithAlpha        := tfRGBA8ui1;
3318   fWithoutAlpha     := tfRGBX8ui1;
3319   fRGBInverted      := tfBGRX8ui1;
3320   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3321   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3322 {$IFNDEF OPENGL_ES}
3323   fOpenGLFormat     := tfRGBX8ui1;
3324   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3325   fglInternalFormat := GL_RGB8;
3326   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3327 {$ELSE}
3328   fOpenGLFormat     := tfRGB8ub3;
3329 {$ENDIF}
3330 end;
3331
3332 procedure TfdXRGB8ui1.SetValues;
3333 begin
3334   inherited SetValues;
3335   fBitsPerPixel     := 32;
3336   fFormat           := tfXRGB8ui1;
3337   fWithAlpha        := tfXRGB8ui1;
3338   fWithoutAlpha     := tfXRGB8ui1;
3339   fOpenGLFormat     := tfXRGB8ui1;
3340   fRGBInverted      := tfXBGR8ui1;
3341   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3342   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3343 {$IFNDEF OPENGL_ES}
3344   fOpenGLFormat     := tfXRGB8ui1;
3345   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3346   fglInternalFormat := GL_RGB8;
3347   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3348 {$ELSE}
3349   fOpenGLFormat     := tfRGB8ub3;
3350 {$ENDIF}
3351 end;
3352
3353 procedure TfdRGB10X2ui1.SetValues;
3354 begin
3355   inherited SetValues;
3356   fBitsPerPixel     := 32;
3357   fFormat           := tfRGB10X2ui1;
3358   fWithAlpha        := tfRGB10A2ui1;
3359   fWithoutAlpha     := tfRGB10X2ui1;
3360   fRGBInverted      := tfBGR10X2ui1;
3361   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3362   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3363 {$IFNDEF OPENGL_ES}
3364   fOpenGLFormat     := tfRGB10X2ui1;
3365   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3366   fglInternalFormat := GL_RGB10;
3367   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3368 {$ELSE}
3369   fOpenGLFormat     := tfRGB16us3;
3370 {$ENDIF}
3371 end;
3372
3373 procedure TfdX2RGB10ui1.SetValues;
3374 begin
3375   inherited SetValues;
3376   fBitsPerPixel     := 32;
3377   fFormat           := tfX2RGB10ui1;
3378   fWithAlpha        := tfA2RGB10ui1;
3379   fWithoutAlpha     := tfX2RGB10ui1;
3380   fRGBInverted      := tfX2BGR10ui1;
3381   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3382   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3383 {$IFNDEF OPENGL_ES}
3384   fOpenGLFormat     := tfX2RGB10ui1;
3385   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3386   fglInternalFormat := GL_RGB10;
3387   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3388 {$ELSE}
3389   fOpenGLFormat     := tfRGB16us3;
3390 {$ENDIF}
3391 end;
3392
3393 procedure TfdRGB16us3.SetValues;
3394 begin
3395   inherited SetValues;
3396   fBitsPerPixel     := 48;
3397   fFormat           := tfRGB16us3;
3398   fWithAlpha        := tfRGBA16us4;
3399   fWithoutAlpha     := tfRGB16us3;
3400   fRGBInverted      := tfBGR16us3;
3401   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3402   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3403 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3404   fOpenGLFormat     := tfRGB16us3;
3405   fglFormat         := GL_RGB;
3406   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3407   fglDataFormat     := GL_UNSIGNED_SHORT;
3408 {$ELSE}
3409   fOpenGLFormat     := tfRGB8ub3;
3410 {$IFEND}
3411 end;
3412
3413 procedure TfdRGBA4us1.SetValues;
3414 begin
3415   inherited SetValues;
3416   fBitsPerPixel     := 16;
3417   fFormat           := tfRGBA4us1;
3418   fWithAlpha        := tfRGBA4us1;
3419   fWithoutAlpha     := tfRGBX4us1;
3420   fOpenGLFormat     := tfRGBA4us1;
3421   fRGBInverted      := tfBGRA4us1;
3422   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3423   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3424   fglFormat         := GL_RGBA;
3425   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3426   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3427 end;
3428
3429 procedure TfdARGB4us1.SetValues;
3430 begin
3431   inherited SetValues;
3432   fBitsPerPixel     := 16;
3433   fFormat           := tfARGB4us1;
3434   fWithAlpha        := tfARGB4us1;
3435   fWithoutAlpha     := tfXRGB4us1;
3436   fRGBInverted      := tfABGR4us1;
3437   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3438   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3439 {$IFNDEF OPENGL_ES}
3440   fOpenGLFormat     := tfARGB4us1;
3441   fglFormat         := GL_BGRA;
3442   fglInternalFormat := GL_RGBA4;
3443   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3444 {$ELSE}
3445   fOpenGLFormat     := tfRGBA4us1;
3446 {$ENDIF}
3447 end;
3448
3449 procedure TfdRGB5A1us1.SetValues;
3450 begin
3451   inherited SetValues;
3452   fBitsPerPixel     := 16;
3453   fFormat           := tfRGB5A1us1;
3454   fWithAlpha        := tfRGB5A1us1;
3455   fWithoutAlpha     := tfRGB5X1us1;
3456   fOpenGLFormat     := tfRGB5A1us1;
3457   fRGBInverted      := tfBGR5A1us1;
3458   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3459   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3460   fglFormat         := GL_RGBA;
3461   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3462   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3463 end;
3464
3465 procedure TfdA1RGB5us1.SetValues;
3466 begin
3467   inherited SetValues;
3468   fBitsPerPixel     := 16;
3469   fFormat           := tfA1RGB5us1;
3470   fWithAlpha        := tfA1RGB5us1;
3471   fWithoutAlpha     := tfX1RGB5us1;
3472   fRGBInverted      := tfA1BGR5us1;
3473   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3474   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3475 {$IFNDEF OPENGL_ES}
3476   fOpenGLFormat     := tfA1RGB5us1;
3477   fglFormat         := GL_BGRA;
3478   fglInternalFormat := GL_RGB5_A1;
3479   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3480 {$ELSE}
3481   fOpenGLFormat     := tfRGB5A1us1;
3482 {$ENDIF}
3483 end;
3484
3485 procedure TfdRGBA8ui1.SetValues;
3486 begin
3487   inherited SetValues;
3488   fBitsPerPixel     := 32;
3489   fFormat           := tfRGBA8ui1;
3490   fWithAlpha        := tfRGBA8ui1;
3491   fWithoutAlpha     := tfRGBX8ui1;
3492   fRGBInverted      := tfBGRA8ui1;
3493   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3494   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3495 {$IFNDEF OPENGL_ES}
3496   fOpenGLFormat     := tfRGBA8ui1;
3497   fglFormat         := GL_RGBA;
3498   fglInternalFormat := GL_RGBA8;
3499   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3500 {$ELSE}
3501   fOpenGLFormat     := tfRGBA8ub4;
3502 {$ENDIF}
3503 end;
3504
3505 procedure TfdARGB8ui1.SetValues;
3506 begin
3507   inherited SetValues;
3508   fBitsPerPixel     := 32;
3509   fFormat           := tfARGB8ui1;
3510   fWithAlpha        := tfARGB8ui1;
3511   fWithoutAlpha     := tfXRGB8ui1;
3512   fRGBInverted      := tfABGR8ui1;
3513   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3514   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3515 {$IFNDEF OPENGL_ES}
3516   fOpenGLFormat     := tfARGB8ui1;
3517   fglFormat         := GL_BGRA;
3518   fglInternalFormat := GL_RGBA8;
3519   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3520 {$ELSE}
3521   fOpenGLFormat     := tfRGBA8ub4;
3522 {$ENDIF}
3523 end;
3524
3525 procedure TfdRGBA8ub4.SetValues;
3526 begin
3527   inherited SetValues;
3528   fBitsPerPixel     := 32;
3529   fFormat           := tfRGBA8ub4;
3530   fWithAlpha        := tfRGBA8ub4;
3531   fWithoutAlpha     := tfRGB8ub3;
3532   fOpenGLFormat     := tfRGBA8ub4;
3533   fRGBInverted      := tfBGRA8ub4;
3534   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3535   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3536   fglFormat         := GL_RGBA;
3537   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3538   fglDataFormat     := GL_UNSIGNED_BYTE;
3539 end;
3540
3541 procedure TfdRGB10A2ui1.SetValues;
3542 begin
3543   inherited SetValues;
3544   fBitsPerPixel     := 32;
3545   fFormat           := tfRGB10A2ui1;
3546   fWithAlpha        := tfRGB10A2ui1;
3547   fWithoutAlpha     := tfRGB10X2ui1;
3548   fRGBInverted      := tfBGR10A2ui1;
3549   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3550   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3551 {$IFNDEF OPENGL_ES}
3552   fOpenGLFormat     := tfRGB10A2ui1;
3553   fglFormat         := GL_RGBA;
3554   fglInternalFormat := GL_RGB10_A2;
3555   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3556 {$ELSE}
3557   fOpenGLFormat     := tfA2RGB10ui1;
3558 {$ENDIF}
3559 end;
3560
3561 procedure TfdA2RGB10ui1.SetValues;
3562 begin
3563   inherited SetValues;
3564   fBitsPerPixel     := 32;
3565   fFormat           := tfA2RGB10ui1;
3566   fWithAlpha        := tfA2RGB10ui1;
3567   fWithoutAlpha     := tfX2RGB10ui1;
3568   fRGBInverted      := tfA2BGR10ui1;
3569   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3570   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3571 {$IF NOT DEFINED(OPENGL_ES)}
3572   fOpenGLFormat     := tfA2RGB10ui1;
3573   fglFormat         := GL_BGRA;
3574   fglInternalFormat := GL_RGB10_A2;
3575   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3576 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3577   fOpenGLFormat     := tfA2RGB10ui1;
3578   fglFormat         := GL_RGBA;
3579   fglInternalFormat := GL_RGB10_A2;
3580   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3581 {$ELSE}
3582   fOpenGLFormat     := tfRGBA8ui1;
3583 {$IFEND}
3584 end;
3585
3586 procedure TfdRGBA16us4.SetValues;
3587 begin
3588   inherited SetValues;
3589   fBitsPerPixel     := 64;
3590   fFormat           := tfRGBA16us4;
3591   fWithAlpha        := tfRGBA16us4;
3592   fWithoutAlpha     := tfRGB16us3;
3593   fRGBInverted      := tfBGRA16us4;
3594   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3595   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3596 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3597   fOpenGLFormat     := tfRGBA16us4;
3598   fglFormat         := GL_RGBA;
3599   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3600   fglDataFormat     := GL_UNSIGNED_SHORT;
3601 {$ELSE}
3602   fOpenGLFormat     := tfRGBA8ub4;
3603 {$IFEND}
3604 end;
3605
3606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3609 procedure TfdBGRX4us1.SetValues;
3610 begin
3611   inherited SetValues;
3612   fBitsPerPixel     := 16;
3613   fFormat           := tfBGRX4us1;
3614   fWithAlpha        := tfBGRA4us1;
3615   fWithoutAlpha     := tfBGRX4us1;
3616   fRGBInverted      := tfRGBX4us1;
3617   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3618   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3619 {$IFNDEF OPENGL_ES}
3620   fOpenGLFormat     := tfBGRX4us1;
3621   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3622   fglInternalFormat := GL_RGB4;
3623   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3624 {$ELSE}
3625   fOpenGLFormat     := tfR5G6B5us1;
3626 {$ENDIF}
3627 end;
3628
3629 procedure TfdXBGR4us1.SetValues;
3630 begin
3631   inherited SetValues;
3632   fBitsPerPixel     := 16;
3633   fFormat           := tfXBGR4us1;
3634   fWithAlpha        := tfABGR4us1;
3635   fWithoutAlpha     := tfXBGR4us1;
3636   fRGBInverted      := tfXRGB4us1;
3637   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3638   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3639 {$IFNDEF OPENGL_ES}
3640   fOpenGLFormat     := tfXBGR4us1;
3641   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3642   fglInternalFormat := GL_RGB4;
3643   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3644 {$ELSE}
3645   fOpenGLFormat     := tfR5G6B5us1;
3646 {$ENDIF}
3647 end;
3648
3649 procedure TfdB5G6R5us1.SetValues;
3650 begin
3651   inherited SetValues;
3652   fBitsPerPixel     := 16;
3653   fFormat           := tfB5G6R5us1;
3654   fWithAlpha        := tfBGR5A1us1;
3655   fWithoutAlpha     := tfB5G6R5us1;
3656   fRGBInverted      := tfR5G6B5us1;
3657   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3658   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3659 {$IFNDEF OPENGL_ES}
3660   fOpenGLFormat     := tfB5G6R5us1;
3661   fglFormat         := GL_RGB;
3662   fglInternalFormat := GL_RGB565;
3663   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3664 {$ELSE}
3665   fOpenGLFormat     := tfR5G6B5us1;
3666 {$ENDIF}
3667 end;
3668
3669 procedure TfdBGR5X1us1.SetValues;
3670 begin
3671   inherited SetValues;
3672   fBitsPerPixel     := 16;
3673   fFormat           := tfBGR5X1us1;
3674   fWithAlpha        := tfBGR5A1us1;
3675   fWithoutAlpha     := tfBGR5X1us1;
3676   fRGBInverted      := tfRGB5X1us1;
3677   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3678   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3679 {$IFNDEF OPENGL_ES}
3680   fOpenGLFormat     := tfBGR5X1us1;
3681   fglFormat         := GL_BGRA;
3682   fglInternalFormat := GL_RGB5;
3683   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3684 {$ELSE}
3685   fOpenGLFormat     := tfR5G6B5us1;
3686 {$ENDIF}
3687 end;
3688
3689 procedure TfdX1BGR5us1.SetValues;
3690 begin
3691   inherited SetValues;
3692   fBitsPerPixel     := 16;
3693   fFormat           := tfX1BGR5us1;
3694   fWithAlpha        := tfA1BGR5us1;
3695   fWithoutAlpha     := tfX1BGR5us1;
3696   fRGBInverted      := tfX1RGB5us1;
3697   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3698   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3699 {$IFNDEF OPENGL_ES}
3700   fOpenGLFormat     := tfX1BGR5us1;
3701   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3702   fglInternalFormat := GL_RGB5;
3703   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3704 {$ELSE}
3705   fOpenGLFormat     := tfR5G6B5us1;
3706 {$ENDIF}
3707 end;
3708
3709 procedure TfdBGR8ub3.SetValues;
3710 begin
3711   inherited SetValues;
3712   fBitsPerPixel     := 24;
3713   fFormat           := tfBGR8ub3;
3714   fWithAlpha        := tfBGRA8ub4;
3715   fWithoutAlpha     := tfBGR8ub3;
3716   fRGBInverted      := tfRGB8ub3;
3717   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3718   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3719 {$IFNDEF OPENGL_ES}
3720   fOpenGLFormat     := tfBGR8ub3;
3721   fglFormat         := GL_BGR;
3722   fglInternalFormat := GL_RGB8;
3723   fglDataFormat     := GL_UNSIGNED_BYTE;
3724 {$ELSE}
3725   fOpenGLFormat     := tfRGB8ub3;
3726 {$ENDIF}
3727 end;
3728
3729 procedure TfdBGRX8ui1.SetValues;
3730 begin
3731   inherited SetValues;
3732   fBitsPerPixel     := 32;
3733   fFormat           := tfBGRX8ui1;
3734   fWithAlpha        := tfBGRA8ui1;
3735   fWithoutAlpha     := tfBGRX8ui1;
3736   fRGBInverted      := tfRGBX8ui1;
3737   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3738   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3739 {$IFNDEF OPENGL_ES}
3740   fOpenGLFormat     := tfBGRX8ui1;
3741   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3742   fglInternalFormat := GL_RGB8;
3743   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3744 {$ELSE}
3745   fOpenGLFormat     := tfRGB8ub3;
3746 {$ENDIF}
3747 end;
3748
3749 procedure TfdXBGR8ui1.SetValues;
3750 begin
3751   inherited SetValues;
3752   fBitsPerPixel     := 32;
3753   fFormat           := tfXBGR8ui1;
3754   fWithAlpha        := tfABGR8ui1;
3755   fWithoutAlpha     := tfXBGR8ui1;
3756   fRGBInverted      := tfXRGB8ui1;
3757   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3758   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3759 {$IFNDEF OPENGL_ES}
3760   fOpenGLFormat     := tfXBGR8ui1;
3761   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3762   fglInternalFormat := GL_RGB8;
3763   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3764 {$ELSE}
3765   fOpenGLFormat     := tfRGB8ub3;
3766 {$ENDIF}
3767 end;
3768
3769 procedure TfdBGR10X2ui1.SetValues;
3770 begin
3771   inherited SetValues;
3772   fBitsPerPixel     := 32;
3773   fFormat           := tfBGR10X2ui1;
3774   fWithAlpha        := tfBGR10A2ui1;
3775   fWithoutAlpha     := tfBGR10X2ui1;
3776   fRGBInverted      := tfRGB10X2ui1;
3777   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3778   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3779 {$IFNDEF OPENGL_ES}
3780   fOpenGLFormat     := tfBGR10X2ui1;
3781   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3782   fglInternalFormat := GL_RGB10;
3783   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3784 {$ELSE}
3785   fOpenGLFormat     := tfRGB16us3;
3786 {$ENDIF}
3787 end;
3788
3789 procedure TfdX2BGR10ui1.SetValues;
3790 begin
3791   inherited SetValues;
3792   fBitsPerPixel     := 32;
3793   fFormat           := tfX2BGR10ui1;
3794   fWithAlpha        := tfA2BGR10ui1;
3795   fWithoutAlpha     := tfX2BGR10ui1;
3796   fRGBInverted      := tfX2RGB10ui1;
3797   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3798   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3799 {$IFNDEF OPENGL_ES}
3800   fOpenGLFormat     := tfX2BGR10ui1;
3801   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3802   fglInternalFormat := GL_RGB10;
3803   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3804 {$ELSE}
3805   fOpenGLFormat     := tfRGB16us3;
3806 {$ENDIF}
3807 end;
3808
3809 procedure TfdBGR16us3.SetValues;
3810 begin
3811   inherited SetValues;
3812   fBitsPerPixel     := 48;
3813   fFormat           := tfBGR16us3;
3814   fWithAlpha        := tfBGRA16us4;
3815   fWithoutAlpha     := tfBGR16us3;
3816   fRGBInverted      := tfRGB16us3;
3817   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3818   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3819 {$IFNDEF OPENGL_ES}
3820   fOpenGLFormat     := tfBGR16us3;
3821   fglFormat         := GL_BGR;
3822   fglInternalFormat := GL_RGB16;
3823   fglDataFormat     := GL_UNSIGNED_SHORT;
3824 {$ELSE}
3825   fOpenGLFormat     := tfRGB16us3;
3826 {$ENDIF}
3827 end;
3828
3829 procedure TfdBGRA4us1.SetValues;
3830 begin
3831   inherited SetValues;
3832   fBitsPerPixel     := 16;
3833   fFormat           := tfBGRA4us1;
3834   fWithAlpha        := tfBGRA4us1;
3835   fWithoutAlpha     := tfBGRX4us1;
3836   fRGBInverted      := tfRGBA4us1;
3837   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3838   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3839 {$IFNDEF OPENGL_ES}
3840   fOpenGLFormat     := tfBGRA4us1;
3841   fglFormat         := GL_BGRA;
3842   fglInternalFormat := GL_RGBA4;
3843   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3844 {$ELSE}
3845   fOpenGLFormat     := tfRGBA4us1;
3846 {$ENDIF}
3847 end;
3848
3849 procedure TfdABGR4us1.SetValues;
3850 begin
3851   inherited SetValues;
3852   fBitsPerPixel     := 16;
3853   fFormat           := tfABGR4us1;
3854   fWithAlpha        := tfABGR4us1;
3855   fWithoutAlpha     := tfXBGR4us1;
3856   fRGBInverted      := tfARGB4us1;
3857   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3858   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3859 {$IFNDEF OPENGL_ES}
3860   fOpenGLFormat     := tfABGR4us1;
3861   fglFormat         := GL_RGBA;
3862   fglInternalFormat := GL_RGBA4;
3863   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3864 {$ELSE}
3865   fOpenGLFormat     := tfRGBA4us1;
3866 {$ENDIF}
3867 end;
3868
3869 procedure TfdBGR5A1us1.SetValues;
3870 begin
3871   inherited SetValues;
3872   fBitsPerPixel     := 16;
3873   fFormat           := tfBGR5A1us1;
3874   fWithAlpha        := tfBGR5A1us1;
3875   fWithoutAlpha     := tfBGR5X1us1;
3876   fRGBInverted      := tfRGB5A1us1;
3877   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3878   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3879 {$IFNDEF OPENGL_ES}
3880   fOpenGLFormat     := tfBGR5A1us1;
3881   fglFormat         := GL_BGRA;
3882   fglInternalFormat := GL_RGB5_A1;
3883   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3884 {$ELSE}
3885   fOpenGLFormat     := tfRGB5A1us1;
3886 {$ENDIF}
3887 end;
3888
3889 procedure TfdA1BGR5us1.SetValues;
3890 begin
3891   inherited SetValues;
3892   fBitsPerPixel     := 16;
3893   fFormat           := tfA1BGR5us1;
3894   fWithAlpha        := tfA1BGR5us1;
3895   fWithoutAlpha     := tfX1BGR5us1;
3896   fRGBInverted      := tfA1RGB5us1;
3897   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3898   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3899 {$IFNDEF OPENGL_ES}
3900   fOpenGLFormat     := tfA1BGR5us1;
3901   fglFormat         := GL_RGBA;
3902   fglInternalFormat := GL_RGB5_A1;
3903   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3904 {$ELSE}
3905   fOpenGLFormat     := tfRGB5A1us1;
3906 {$ENDIF}
3907 end;
3908
3909 procedure TfdBGRA8ui1.SetValues;
3910 begin
3911   inherited SetValues;
3912   fBitsPerPixel     := 32;
3913   fFormat           := tfBGRA8ui1;
3914   fWithAlpha        := tfBGRA8ui1;
3915   fWithoutAlpha     := tfBGRX8ui1;
3916   fRGBInverted      := tfRGBA8ui1;
3917   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3918   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3919 {$IFNDEF OPENGL_ES}
3920   fOpenGLFormat     := tfBGRA8ui1;
3921   fglFormat         := GL_BGRA;
3922   fglInternalFormat := GL_RGBA8;
3923   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3924 {$ELSE}
3925   fOpenGLFormat     := tfRGBA8ub4;
3926 {$ENDIF}
3927 end;
3928
3929 procedure TfdABGR8ui1.SetValues;
3930 begin
3931   inherited SetValues;
3932   fBitsPerPixel     := 32;
3933   fFormat           := tfABGR8ui1;
3934   fWithAlpha        := tfABGR8ui1;
3935   fWithoutAlpha     := tfXBGR8ui1;
3936   fRGBInverted      := tfARGB8ui1;
3937   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3938   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3939 {$IFNDEF OPENGL_ES}
3940   fOpenGLFormat     := tfABGR8ui1;
3941   fglFormat         := GL_RGBA;
3942   fglInternalFormat := GL_RGBA8;
3943   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3944 {$ELSE}
3945   fOpenGLFormat     := tfRGBA8ub4
3946 {$ENDIF}
3947 end;
3948
3949 procedure TfdBGRA8ub4.SetValues;
3950 begin
3951   inherited SetValues;
3952   fBitsPerPixel     := 32;
3953   fFormat           := tfBGRA8ub4;
3954   fWithAlpha        := tfBGRA8ub4;
3955   fWithoutAlpha     := tfBGR8ub3;
3956   fRGBInverted      := tfRGBA8ub4;
3957   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3958   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3959 {$IFNDEF OPENGL_ES}
3960   fOpenGLFormat     := tfBGRA8ub4;
3961   fglFormat         := GL_BGRA;
3962   fglInternalFormat := GL_RGBA8;
3963   fglDataFormat     := GL_UNSIGNED_BYTE;
3964 {$ELSE}
3965   fOpenGLFormat     := tfRGBA8ub4;
3966 {$ENDIF}
3967 end;
3968
3969 procedure TfdBGR10A2ui1.SetValues;
3970 begin
3971   inherited SetValues;
3972   fBitsPerPixel     := 32;
3973   fFormat           := tfBGR10A2ui1;
3974   fWithAlpha        := tfBGR10A2ui1;
3975   fWithoutAlpha     := tfBGR10X2ui1;
3976   fRGBInverted      := tfRGB10A2ui1;
3977   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3978   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3979 {$IFNDEF OPENGL_ES}
3980   fOpenGLFormat     := tfBGR10A2ui1;
3981   fglFormat         := GL_BGRA;
3982   fglInternalFormat := GL_RGB10_A2;
3983   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3984 {$ELSE}
3985   fOpenGLFormat     := tfA2RGB10ui1;
3986 {$ENDIF}
3987 end;
3988
3989 procedure TfdA2BGR10ui1.SetValues;
3990 begin
3991   inherited SetValues;
3992   fBitsPerPixel     := 32;
3993   fFormat           := tfA2BGR10ui1;
3994   fWithAlpha        := tfA2BGR10ui1;
3995   fWithoutAlpha     := tfX2BGR10ui1;
3996   fRGBInverted      := tfA2RGB10ui1;
3997   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3998   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3999 {$IFNDEF OPENGL_ES}
4000   fOpenGLFormat     := tfA2BGR10ui1;
4001   fglFormat         := GL_RGBA;
4002   fglInternalFormat := GL_RGB10_A2;
4003   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
4004 {$ELSE}
4005   fOpenGLFormat     := tfA2RGB10ui1;
4006 {$ENDIF}
4007 end;
4008
4009 procedure TfdBGRA16us4.SetValues;
4010 begin
4011   inherited SetValues;
4012   fBitsPerPixel     := 64;
4013   fFormat           := tfBGRA16us4;
4014   fWithAlpha        := tfBGRA16us4;
4015   fWithoutAlpha     := tfBGR16us3;
4016   fRGBInverted      := tfRGBA16us4;
4017   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4018   fShift            := glBitmapRec4ub(32, 16,  0, 48);
4019 {$IFNDEF OPENGL_ES}
4020   fOpenGLFormat     := tfBGRA16us4;
4021   fglFormat         := GL_BGRA;
4022   fglInternalFormat := GL_RGBA16;
4023   fglDataFormat     := GL_UNSIGNED_SHORT;
4024 {$ELSE}
4025   fOpenGLFormat     := tfRGBA16us4;
4026 {$ENDIF}
4027 end;
4028
4029 procedure TfdDepth16us1.SetValues;
4030 begin
4031   inherited SetValues;
4032   fBitsPerPixel     := 16;
4033   fFormat           := tfDepth16us1;
4034   fWithoutAlpha     := tfDepth16us1;
4035   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4036   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4037 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
4038   fOpenGLFormat     := tfDepth16us1;
4039   fglFormat         := GL_DEPTH_COMPONENT;
4040   fglInternalFormat := GL_DEPTH_COMPONENT16;
4041   fglDataFormat     := GL_UNSIGNED_SHORT;
4042 {$IFEND}
4043 end;
4044
4045 procedure TfdDepth24ui1.SetValues;
4046 begin
4047   inherited SetValues;
4048   fBitsPerPixel     := 32;
4049   fFormat           := tfDepth24ui1;
4050   fWithoutAlpha     := tfDepth24ui1;
4051   fOpenGLFormat     := tfDepth24ui1;
4052   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4053   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4054 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
4055   fOpenGLFormat     := tfDepth24ui1;
4056   fglFormat         := GL_DEPTH_COMPONENT;
4057   fglInternalFormat := GL_DEPTH_COMPONENT24;
4058   fglDataFormat     := GL_UNSIGNED_INT;
4059 {$IFEND}
4060 end;
4061
4062 procedure TfdDepth32ui1.SetValues;
4063 begin
4064   inherited SetValues;
4065   fBitsPerPixel     := 32;
4066   fFormat           := tfDepth32ui1;
4067   fWithoutAlpha     := tfDepth32ui1;
4068   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4069   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4070 {$IF NOT DEFINED(OPENGL_ES)}
4071   fOpenGLFormat     := tfDepth32ui1;
4072   fglFormat         := GL_DEPTH_COMPONENT;
4073   fglInternalFormat := GL_DEPTH_COMPONENT32;
4074   fglDataFormat     := GL_UNSIGNED_INT;
4075 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
4076   fOpenGLFormat     := tfDepth24ui1;
4077 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
4078   fOpenGLFormat     := tfDepth16us1;
4079 {$IFEND}
4080 end;
4081
4082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4083 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4085 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4086 begin
4087   raise EglBitmap.Create('mapping for compressed formats is not supported');
4088 end;
4089
4090 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4091 begin
4092   raise EglBitmap.Create('mapping for compressed formats is not supported');
4093 end;
4094
4095 procedure TfdS3tcDtx1RGBA.SetValues;
4096 begin
4097   inherited SetValues;
4098   fFormat           := tfS3tcDtx1RGBA;
4099   fWithAlpha        := tfS3tcDtx1RGBA;
4100   fUncompressed     := tfRGB5A1us1;
4101   fBitsPerPixel     := 4;
4102   fIsCompressed     := true;
4103 {$IFNDEF OPENGL_ES}
4104   fOpenGLFormat     := tfS3tcDtx1RGBA;
4105   fglFormat         := GL_COMPRESSED_RGBA;
4106   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4107   fglDataFormat     := GL_UNSIGNED_BYTE;
4108 {$ELSE}
4109   fOpenGLFormat     := fUncompressed;
4110 {$ENDIF}
4111 end;
4112
4113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4114 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4117 begin
4118   raise EglBitmap.Create('mapping for compressed formats is not supported');
4119 end;
4120
4121 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4122 begin
4123   raise EglBitmap.Create('mapping for compressed formats is not supported');
4124 end;
4125
4126 procedure TfdS3tcDtx3RGBA.SetValues;
4127 begin
4128   inherited SetValues;
4129   fFormat           := tfS3tcDtx3RGBA;
4130   fWithAlpha        := tfS3tcDtx3RGBA;
4131   fUncompressed     := tfRGBA8ub4;
4132   fBitsPerPixel     := 8;
4133   fIsCompressed     := true;
4134 {$IFNDEF OPENGL_ES}
4135   fOpenGLFormat     := tfS3tcDtx3RGBA;
4136   fglFormat         := GL_COMPRESSED_RGBA;
4137   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4138   fglDataFormat     := GL_UNSIGNED_BYTE;
4139 {$ELSE}
4140   fOpenGLFormat     := fUncompressed;
4141 {$ENDIF}
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4148 begin
4149   raise EglBitmap.Create('mapping for compressed formats is not supported');
4150 end;
4151
4152 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4153 begin
4154   raise EglBitmap.Create('mapping for compressed formats is not supported');
4155 end;
4156
4157 procedure TfdS3tcDtx5RGBA.SetValues;
4158 begin
4159   inherited SetValues;
4160   fFormat           := tfS3tcDtx3RGBA;
4161   fWithAlpha        := tfS3tcDtx3RGBA;
4162   fUncompressed     := tfRGBA8ub4;
4163   fBitsPerPixel     := 8;
4164   fIsCompressed     := true;
4165 {$IFNDEF OPENGL_ES}
4166   fOpenGLFormat     := tfS3tcDtx3RGBA;
4167   fglFormat         := GL_COMPRESSED_RGBA;
4168   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4169   fglDataFormat     := GL_UNSIGNED_BYTE;
4170 {$ELSE}
4171   fOpenGLFormat     := fUncompressed;
4172 {$ENDIF}
4173 end;
4174
4175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4176 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4178 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
4179 begin
4180   result := (fPrecision.r > 0);
4181 end;
4182
4183 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
4184 begin
4185   result := (fPrecision.g > 0);
4186 end;
4187
4188 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
4189 begin
4190   result := (fPrecision.b > 0);
4191 end;
4192
4193 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
4194 begin
4195   result := (fPrecision.a > 0);
4196 end;
4197
4198 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
4199 begin
4200   result := HasRed or HasGreen or HasBlue;
4201 end;
4202
4203 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
4204 begin
4205   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmapFormatDescriptor.SetValues;
4210 begin
4211   fFormat       := tfEmpty;
4212   fWithAlpha    := tfEmpty;
4213   fWithoutAlpha := tfEmpty;
4214   fOpenGLFormat := tfEmpty;
4215   fRGBInverted  := tfEmpty;
4216   fUncompressed := tfEmpty;
4217
4218   fBitsPerPixel := 0;
4219   fIsCompressed := false;
4220
4221   fglFormat         := 0;
4222   fglInternalFormat := 0;
4223   fglDataFormat     := 0;
4224
4225   FillChar(fPrecision, 0, SizeOf(fPrecision));
4226   FillChar(fShift,     0, SizeOf(fShift));
4227 end;
4228
4229 procedure TglBitmapFormatDescriptor.CalcValues;
4230 var
4231   i: Integer;
4232 begin
4233   fBytesPerPixel := fBitsPerPixel / 8;
4234   fChannelCount  := 0;
4235   for i := 0 to 3 do begin
4236     if (fPrecision.arr[i] > 0) then
4237       inc(fChannelCount);
4238     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
4239     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
4240   end;
4241 end;
4242
4243 constructor TglBitmapFormatDescriptor.Create;
4244 begin
4245   inherited Create;
4246   SetValues;
4247   CalcValues;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4252 var
4253   f: TglBitmapFormat;
4254 begin
4255   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4256     result := TFormatDescriptor.Get(f);
4257     if (result.glInternalFormat = aInternalFormat) then
4258       exit;
4259   end;
4260   result := TFormatDescriptor.Get(tfEmpty);
4261 end;
4262
4263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4264 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4266 class procedure TFormatDescriptor.Init;
4267 begin
4268   if not Assigned(FormatDescriptorCS) then
4269     FormatDescriptorCS := TCriticalSection.Create;
4270 end;
4271
4272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4273 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4274 begin
4275   FormatDescriptorCS.Enter;
4276   try
4277     result := FormatDescriptors[aFormat];
4278     if not Assigned(result) then begin
4279       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4280       FormatDescriptors[aFormat] := result;
4281     end;
4282   finally
4283     FormatDescriptorCS.Leave;
4284   end;
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4289 begin
4290   result := Get(Get(aFormat).WithAlpha);
4291 end;
4292
4293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4294 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4295 var
4296   ft: TglBitmapFormat;
4297 begin
4298   // find matching format with OpenGL support
4299   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4300     result := Get(ft);
4301     if (result.MaskMatch(aMask))      and
4302        (result.glFormat <> 0)         and
4303        (result.glInternalFormat <> 0) and
4304        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4305     then
4306       exit;
4307   end;
4308
4309   // find matching format without OpenGL Support
4310   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4311     result := Get(ft);
4312     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4313       exit;
4314   end;
4315
4316   result := TFormatDescriptor.Get(tfEmpty);
4317 end;
4318
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4321 var
4322   ft: TglBitmapFormat;
4323 begin
4324   // find matching format with OpenGL support
4325   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4326     result := Get(ft);
4327     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4328        glBitmapRec4ubCompare(result.Precision, aPrec) and
4329        (result.glFormat <> 0)         and
4330        (result.glInternalFormat <> 0) and
4331        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4332     then
4333       exit;
4334   end;
4335
4336   // find matching format without OpenGL Support
4337   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4338     result := Get(ft);
4339     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4340        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4341        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4342       exit;
4343   end;
4344
4345   result := TFormatDescriptor.Get(tfEmpty);
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 class procedure TFormatDescriptor.Clear;
4350 var
4351   f: TglBitmapFormat;
4352 begin
4353   FormatDescriptorCS.Enter;
4354   try
4355     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4356       FreeAndNil(FormatDescriptors[f]);
4357   finally
4358     FormatDescriptorCS.Leave;
4359   end;
4360 end;
4361
4362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4363 class procedure TFormatDescriptor.Finalize;
4364 begin
4365   Clear;
4366   FreeAndNil(FormatDescriptorCS);
4367 end;
4368
4369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4370 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4372 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4373 var
4374   i: Integer;
4375 begin
4376   for i := 0 to 3 do begin
4377     fShift.arr[i] := 0;
4378     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4379       aMask.arr[i] := aMask.arr[i] shr 1;
4380       inc(fShift.arr[i]);
4381     end;
4382     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4383   end;
4384   CalcValues;
4385 end;
4386
4387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4388 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4389 begin
4390   fBitsPerPixel := aBBP;
4391   fPrecision    := aPrec;
4392   fShift        := aShift;
4393   CalcValues;
4394 end;
4395
4396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4397 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4398 var
4399   data: QWord;
4400 begin
4401   data :=
4402     ((aPixel.Data.r and Range.r) shl Shift.r) or
4403     ((aPixel.Data.g and Range.g) shl Shift.g) or
4404     ((aPixel.Data.b and Range.b) shl Shift.b) or
4405     ((aPixel.Data.a and Range.a) shl Shift.a);
4406   case BitsPerPixel of
4407     8:           aData^  := data;
4408    16:     PWord(aData)^ := data;
4409    32: PCardinal(aData)^ := data;
4410    64:    PQWord(aData)^ := data;
4411   else
4412     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4413   end;
4414   inc(aData, Round(BytesPerPixel));
4415 end;
4416
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4419 var
4420   data: QWord;
4421   i: Integer;
4422 begin
4423   case BitsPerPixel of
4424      8: data :=           aData^;
4425     16: data :=     PWord(aData)^;
4426     32: data := PCardinal(aData)^;
4427     64: data :=    PQWord(aData)^;
4428   else
4429     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4430   end;
4431   for i := 0 to 3 do
4432     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4433   inc(aData, Round(BytesPerPixel));
4434 end;
4435
4436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4437 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4439 procedure TbmpColorTableFormat.SetValues;
4440 begin
4441   inherited SetValues;
4442   fShift := glBitmapRec4ub(8, 8, 8, 0);
4443 end;
4444
4445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4446 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4447 begin
4448   fFormat       := aFormat;
4449   fBitsPerPixel := aBPP;
4450   fPrecision    := aPrec;
4451   fShift        := aShift;
4452   CalcValues;
4453 end;
4454
4455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4456 procedure TbmpColorTableFormat.CalcValues;
4457 begin
4458   inherited CalcValues;
4459 end;
4460
4461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4462 procedure TbmpColorTableFormat.CreateColorTable;
4463 var
4464   i: Integer;
4465 begin
4466   SetLength(fColorTable, 256);
4467   if not HasColor then begin
4468     // alpha
4469     for i := 0 to High(fColorTable) do begin
4470       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4471       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4472       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4473       fColorTable[i].a := 0;
4474     end;
4475   end else begin
4476     // normal
4477     for i := 0 to High(fColorTable) do begin
4478       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4479       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4480       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4481       fColorTable[i].a := 0;
4482     end;
4483   end;
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4488 begin
4489   if (BitsPerPixel <> 8) then
4490     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4491   if not HasColor then
4492     // alpha
4493     aData^ := aPixel.Data.a
4494   else
4495     // normal
4496     aData^ := Round(
4497       ((aPixel.Data.r and Range.r) shl Shift.r) or
4498       ((aPixel.Data.g and Range.g) shl Shift.g) or
4499       ((aPixel.Data.b and Range.b) shl Shift.b));
4500   inc(aData);
4501 end;
4502
4503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4504 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4505 begin
4506   if (BitsPerPixel <> 8) then
4507     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4508   with fColorTable[aData^] do begin
4509     aPixel.Data.r := r;
4510     aPixel.Data.g := g;
4511     aPixel.Data.b := b;
4512     aPixel.Data.a := a;
4513   end;
4514   inc(aData, 1);
4515 end;
4516
4517 destructor TbmpColorTableFormat.Destroy;
4518 begin
4519   SetLength(fColorTable, 0);
4520   inherited Destroy;
4521 end;
4522
4523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4524 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4526 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4527 var
4528   i: Integer;
4529 begin
4530   for i := 0 to 3 do begin
4531     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4532       if (aSourceFD.Range.arr[i] > 0) then
4533         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4534       else
4535         aPixel.Data.arr[i] := 0;
4536     end;
4537   end;
4538 end;
4539
4540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4541 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4542 begin
4543   with aFuncRec do begin
4544     if (Source.Range.r   > 0) then
4545       Dest.Data.r := Source.Data.r;
4546     if (Source.Range.g > 0) then
4547       Dest.Data.g := Source.Data.g;
4548     if (Source.Range.b  > 0) then
4549       Dest.Data.b := Source.Data.b;
4550     if (Source.Range.a > 0) then
4551       Dest.Data.a := Source.Data.a;
4552   end;
4553 end;
4554
4555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4556 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4557 var
4558   i: Integer;
4559 begin
4560   with aFuncRec do begin
4561     for i := 0 to 3 do
4562       if (Source.Range.arr[i] > 0) then
4563         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4564   end;
4565 end;
4566
4567 type
4568   TShiftData = packed record
4569     case Integer of
4570       0: (r, g, b, a: SmallInt);
4571       1: (arr: array[0..3] of SmallInt);
4572   end;
4573   PShiftData = ^TShiftData;
4574
4575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4576 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4577 var
4578   i: Integer;
4579 begin
4580   with aFuncRec do
4581     for i := 0 to 3 do
4582       if (Source.Range.arr[i] > 0) then
4583         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4584 end;
4585
4586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4587 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4588 begin
4589   with aFuncRec do begin
4590     Dest.Data := Source.Data;
4591     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4592       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4593       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4594       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4595     end;
4596     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4597       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4598     end;
4599   end;
4600 end;
4601
4602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4603 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4604 var
4605   i: Integer;
4606 begin
4607   with aFuncRec do begin
4608     for i := 0 to 3 do
4609       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4610   end;
4611 end;
4612
4613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4614 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4615 var
4616   Temp: Single;
4617 begin
4618   with FuncRec do begin
4619     if (FuncRec.Args = nil) then begin //source has no alpha
4620       Temp :=
4621         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4622         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4623         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4624       Dest.Data.a := Round(Dest.Range.a * Temp);
4625     end else
4626       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4627   end;
4628 end;
4629
4630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4631 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4632 type
4633   PglBitmapPixelData = ^TglBitmapPixelData;
4634 begin
4635   with FuncRec do begin
4636     Dest.Data.r := Source.Data.r;
4637     Dest.Data.g := Source.Data.g;
4638     Dest.Data.b := Source.Data.b;
4639
4640     with PglBitmapPixelData(Args)^ do
4641       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4642           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4643           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4644         Dest.Data.a := 0
4645       else
4646         Dest.Data.a := Dest.Range.a;
4647   end;
4648 end;
4649
4650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4651 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4652 begin
4653   with FuncRec do begin
4654     Dest.Data.r := Source.Data.r;
4655     Dest.Data.g := Source.Data.g;
4656     Dest.Data.b := Source.Data.b;
4657     Dest.Data.a := PCardinal(Args)^;
4658   end;
4659 end;
4660
4661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4662 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4663 type
4664   PRGBPix = ^TRGBPix;
4665   TRGBPix = array [0..2] of byte;
4666 var
4667   Temp: Byte;
4668 begin
4669   while aWidth > 0 do begin
4670     Temp := PRGBPix(aData)^[0];
4671     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4672     PRGBPix(aData)^[2] := Temp;
4673
4674     if aHasAlpha then
4675       Inc(aData, 4)
4676     else
4677       Inc(aData, 3);
4678     dec(aWidth);
4679   end;
4680 end;
4681
4682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4683 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4685 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4686 begin
4687   result := TFormatDescriptor.Get(Format);
4688 end;
4689
4690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4691 function TglBitmap.GetWidth: Integer;
4692 begin
4693   if (ffX in fDimension.Fields) then
4694     result := fDimension.X
4695   else
4696     result := -1;
4697 end;
4698
4699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4700 function TglBitmap.GetHeight: Integer;
4701 begin
4702   if (ffY in fDimension.Fields) then
4703     result := fDimension.Y
4704   else
4705     result := -1;
4706 end;
4707
4708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4709 function TglBitmap.GetFileWidth: Integer;
4710 begin
4711   result := Max(1, Width);
4712 end;
4713
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 function TglBitmap.GetFileHeight: Integer;
4716 begin
4717   result := Max(1, Height);
4718 end;
4719
4720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4721 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4722 begin
4723   if fCustomData = aValue then
4724     exit;
4725   fCustomData := aValue;
4726 end;
4727
4728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4729 procedure TglBitmap.SetCustomName(const aValue: String);
4730 begin
4731   if fCustomName = aValue then
4732     exit;
4733   fCustomName := aValue;
4734 end;
4735
4736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4737 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4738 begin
4739   if fCustomNameW = aValue then
4740     exit;
4741   fCustomNameW := aValue;
4742 end;
4743
4744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4745 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4746 begin
4747   if fFreeDataOnDestroy = aValue then
4748     exit;
4749   fFreeDataOnDestroy := aValue;
4750 end;
4751
4752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4753 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4754 begin
4755   if fDeleteTextureOnFree = aValue then
4756     exit;
4757   fDeleteTextureOnFree := aValue;
4758 end;
4759
4760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4761 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4762 begin
4763   if fFormat = aValue then
4764     exit;
4765   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4766     raise EglBitmapUnsupportedFormat.Create(Format);
4767   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4768 end;
4769
4770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4771 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4772 begin
4773   if fFreeDataAfterGenTexture = aValue then
4774     exit;
4775   fFreeDataAfterGenTexture := aValue;
4776 end;
4777
4778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4779 procedure TglBitmap.SetID(const aValue: Cardinal);
4780 begin
4781   if fID = aValue then
4782     exit;
4783   fID := aValue;
4784 end;
4785
4786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4787 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4788 begin
4789   if fMipMap = aValue then
4790     exit;
4791   fMipMap := aValue;
4792 end;
4793
4794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4795 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4796 begin
4797   if fTarget = aValue then
4798     exit;
4799   fTarget := aValue;
4800 end;
4801
4802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4803 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4804 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4805 var
4806   MaxAnisotropic: Integer;
4807 {$IFEND}
4808 begin
4809   fAnisotropic := aValue;
4810   if (ID > 0) then begin
4811 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4812     if GL_EXT_texture_filter_anisotropic then begin
4813       if fAnisotropic > 0 then begin
4814         Bind(false);
4815         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4816         if aValue > MaxAnisotropic then
4817           fAnisotropic := MaxAnisotropic;
4818         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4819       end;
4820     end else begin
4821       fAnisotropic := 0;
4822     end;
4823 {$ELSE}
4824     fAnisotropic := 0;
4825 {$IFEND}
4826   end;
4827 end;
4828
4829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4830 procedure TglBitmap.CreateID;
4831 begin
4832   if (ID <> 0) then
4833     glDeleteTextures(1, @fID);
4834   glGenTextures(1, @fID);
4835   Bind(false);
4836 end;
4837
4838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4839 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
4840 begin
4841   // Set Up Parameters
4842   SetWrap(fWrapS, fWrapT, fWrapR);
4843   SetFilter(fFilterMin, fFilterMag);
4844   SetAnisotropic(fAnisotropic);
4845
4846 {$IFNDEF OPENGL_ES}
4847   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4848   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4849     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4850 {$ENDIF}
4851
4852 {$IFNDEF OPENGL_ES}
4853   // Mip Maps Generation Mode
4854   aBuildWithGlu := false;
4855   if (MipMap = mmMipmap) then begin
4856     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4857       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4858     else
4859       aBuildWithGlu := true;
4860   end else if (MipMap = mmMipmapGlu) then
4861     aBuildWithGlu := true;
4862 {$ELSE}
4863   if (MipMap = mmMipmap) then
4864     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
4865 {$ENDIF}
4866 end;
4867
4868 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4869 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4870   const aWidth: Integer; const aHeight: Integer);
4871 var
4872   s: Single;
4873 begin
4874   if (Data <> aData) then begin
4875     if (Assigned(Data)) then
4876       FreeMem(Data);
4877     fData := aData;
4878   end;
4879
4880   if not Assigned(fData) then begin
4881     fPixelSize := 0;
4882     fRowSize   := 0;
4883   end else begin
4884     FillChar(fDimension, SizeOf(fDimension), 0);
4885     if aWidth <> -1 then begin
4886       fDimension.Fields := fDimension.Fields + [ffX];
4887       fDimension.X := aWidth;
4888     end;
4889
4890     if aHeight <> -1 then begin
4891       fDimension.Fields := fDimension.Fields + [ffY];
4892       fDimension.Y := aHeight;
4893     end;
4894
4895     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4896     fFormat    := aFormat;
4897     fPixelSize := Ceil(s);
4898     fRowSize   := Ceil(s * aWidth);
4899   end;
4900 end;
4901
4902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4903 function TglBitmap.FlipHorz: Boolean;
4904 begin
4905   result := false;
4906 end;
4907
4908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4909 function TglBitmap.FlipVert: Boolean;
4910 begin
4911   result := false;
4912 end;
4913
4914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4915 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4917 procedure TglBitmap.AfterConstruction;
4918 begin
4919   inherited AfterConstruction;
4920
4921   fID         := 0;
4922   fTarget     := 0;
4923 {$IFNDEF OPENGL_ES}
4924   fIsResident := false;
4925 {$ENDIF}
4926
4927   fMipMap                  := glBitmapDefaultMipmap;
4928   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4929   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4930
4931   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4932   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4933 {$IFNDEF OPENGL_ES}
4934   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4935 {$ENDIF}
4936 end;
4937
4938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4939 procedure TglBitmap.BeforeDestruction;
4940 var
4941   NewData: PByte;
4942 begin
4943   if fFreeDataOnDestroy then begin
4944     NewData := nil;
4945     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4946   end;
4947   if (fID > 0) and fDeleteTextureOnFree then
4948     glDeleteTextures(1, @fID);
4949   inherited BeforeDestruction;
4950 end;
4951
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4954 var
4955   TempPos: Integer;
4956 begin
4957   if not Assigned(aResType) then begin
4958     TempPos   := Pos('.', aResource);
4959     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4960     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4961   end;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 procedure TglBitmap.LoadFromFile(const aFilename: String);
4966 var
4967   fs: TFileStream;
4968 begin
4969   if not FileExists(aFilename) then
4970     raise EglBitmap.Create('file does not exist: ' + aFilename);
4971   fFilename := aFilename;
4972   fs := TFileStream.Create(fFilename, fmOpenRead);
4973   try
4974     fs.Position := 0;
4975     LoadFromStream(fs);
4976   finally
4977     fs.Free;
4978   end;
4979 end;
4980
4981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4982 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4983 begin
4984   {$IFDEF GLB_SUPPORT_PNG_READ}
4985   if not LoadPNG(aStream) then
4986   {$ENDIF}
4987   {$IFDEF GLB_SUPPORT_JPEG_READ}
4988   if not LoadJPEG(aStream) then
4989   {$ENDIF}
4990   if not LoadDDS(aStream) then
4991   if not LoadTGA(aStream) then
4992   if not LoadBMP(aStream) then
4993   if not LoadRAW(aStream) then
4994     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4995 end;
4996
4997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4998 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4999   const aFormat: TglBitmapFormat; const aArgs: Pointer);
5000 var
5001   tmpData: PByte;
5002   size: Integer;
5003 begin
5004   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5005   GetMem(tmpData, size);
5006   try
5007     FillChar(tmpData^, size, #$FF);
5008     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5009   except
5010     if Assigned(tmpData) then
5011       FreeMem(tmpData);
5012     raise;
5013   end;
5014   AddFunc(Self, aFunc, false, aFormat, aArgs);
5015 end;
5016
5017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5018 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
5019 var
5020   rs: TResourceStream;
5021 begin
5022   PrepareResType(aResource, aResType);
5023   rs := TResourceStream.Create(aInstance, aResource, aResType);
5024   try
5025     LoadFromStream(rs);
5026   finally
5027     rs.Free;
5028   end;
5029 end;
5030
5031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5032 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5033 var
5034   rs: TResourceStream;
5035 begin
5036   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5037   try
5038     LoadFromStream(rs);
5039   finally
5040     rs.Free;
5041   end;
5042 end;
5043
5044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5045 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
5046 var
5047   fs: TFileStream;
5048 begin
5049   fs := TFileStream.Create(aFileName, fmCreate);
5050   try
5051     fs.Position := 0;
5052     SaveToStream(fs, aFileType);
5053   finally
5054     fs.Free;
5055   end;
5056 end;
5057
5058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5059 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
5060 begin
5061   case aFileType of
5062     {$IFDEF GLB_SUPPORT_PNG_WRITE}
5063     ftPNG:  SavePNG(aStream);
5064     {$ENDIF}
5065     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5066     ftJPEG: SaveJPEG(aStream);
5067     {$ENDIF}
5068     ftDDS:  SaveDDS(aStream);
5069     ftTGA:  SaveTGA(aStream);
5070     ftBMP:  SaveBMP(aStream);
5071     ftRAW:  SaveRAW(aStream);
5072   end;
5073 end;
5074
5075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5076 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
5077 begin
5078   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
5079 end;
5080
5081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5082 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
5083   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
5084 var
5085   DestData, TmpData, SourceData: pByte;
5086   TempHeight, TempWidth: Integer;
5087   SourceFD, DestFD: TFormatDescriptor;
5088   SourceMD, DestMD: Pointer;
5089
5090   FuncRec: TglBitmapFunctionRec;
5091 begin
5092   Assert(Assigned(Data));
5093   Assert(Assigned(aSource));
5094   Assert(Assigned(aSource.Data));
5095
5096   result := false;
5097   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
5098     SourceFD := TFormatDescriptor.Get(aSource.Format);
5099     DestFD   := TFormatDescriptor.Get(aFormat);
5100
5101     if (SourceFD.IsCompressed) then
5102       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
5103     if (DestFD.IsCompressed) then
5104       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
5105
5106     // inkompatible Formats so CreateTemp
5107     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
5108       aCreateTemp := true;
5109
5110     // Values
5111     TempHeight := Max(1, aSource.Height);
5112     TempWidth  := Max(1, aSource.Width);
5113
5114     FuncRec.Sender := Self;
5115     FuncRec.Args   := aArgs;
5116
5117     TmpData := nil;
5118     if aCreateTemp then begin
5119       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5120       DestData := TmpData;
5121     end else
5122       DestData := Data;
5123
5124     try
5125       SourceFD.PreparePixel(FuncRec.Source);
5126       DestFD.PreparePixel  (FuncRec.Dest);
5127
5128       SourceMD := SourceFD.CreateMappingData;
5129       DestMD   := DestFD.CreateMappingData;
5130
5131       FuncRec.Size            := aSource.Dimension;
5132       FuncRec.Position.Fields := FuncRec.Size.Fields;
5133
5134       try
5135         SourceData := aSource.Data;
5136         FuncRec.Position.Y := 0;
5137         while FuncRec.Position.Y < TempHeight do begin
5138           FuncRec.Position.X := 0;
5139           while FuncRec.Position.X < TempWidth do begin
5140             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5141             aFunc(FuncRec);
5142             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5143             inc(FuncRec.Position.X);
5144           end;
5145           inc(FuncRec.Position.Y);
5146         end;
5147
5148         // Updating Image or InternalFormat
5149         if aCreateTemp then
5150           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5151         else if (aFormat <> fFormat) then
5152           Format := aFormat;
5153
5154         result := true;
5155       finally
5156         SourceFD.FreeMappingData(SourceMD);
5157         DestFD.FreeMappingData(DestMD);
5158       end;
5159     except
5160       if aCreateTemp and Assigned(TmpData) then
5161         FreeMem(TmpData);
5162       raise;
5163     end;
5164   end;
5165 end;
5166
5167 {$IFDEF GLB_SDL}
5168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5169 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5170 var
5171   Row, RowSize: Integer;
5172   SourceData, TmpData: PByte;
5173   TempDepth: Integer;
5174   FormatDesc: TFormatDescriptor;
5175
5176   function GetRowPointer(Row: Integer): pByte;
5177   begin
5178     result := aSurface.pixels;
5179     Inc(result, Row * RowSize);
5180   end;
5181
5182 begin
5183   result := false;
5184
5185   FormatDesc := TFormatDescriptor.Get(Format);
5186   if FormatDesc.IsCompressed then
5187     raise EglBitmapUnsupportedFormat.Create(Format);
5188
5189   if Assigned(Data) then begin
5190     case Trunc(FormatDesc.PixelSize) of
5191       1: TempDepth :=  8;
5192       2: TempDepth := 16;
5193       3: TempDepth := 24;
5194       4: TempDepth := 32;
5195     else
5196       raise EglBitmapUnsupportedFormat.Create(Format);
5197     end;
5198
5199     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5200       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5201     SourceData := Data;
5202     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5203
5204     for Row := 0 to FileHeight-1 do begin
5205       TmpData := GetRowPointer(Row);
5206       if Assigned(TmpData) then begin
5207         Move(SourceData^, TmpData^, RowSize);
5208         inc(SourceData, RowSize);
5209       end;
5210     end;
5211     result := true;
5212   end;
5213 end;
5214
5215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5216 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5217 var
5218   pSource, pData, pTempData: PByte;
5219   Row, RowSize, TempWidth, TempHeight: Integer;
5220   IntFormat: TglBitmapFormat;
5221   fd: TFormatDescriptor;
5222   Mask: TglBitmapMask;
5223
5224   function GetRowPointer(Row: Integer): pByte;
5225   begin
5226     result := aSurface^.pixels;
5227     Inc(result, Row * RowSize);
5228   end;
5229
5230 begin
5231   result := false;
5232   if (Assigned(aSurface)) then begin
5233     with aSurface^.format^ do begin
5234       Mask.r := RMask;
5235       Mask.g := GMask;
5236       Mask.b := BMask;
5237       Mask.a := AMask;
5238       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5239       if (IntFormat = tfEmpty) then
5240         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5241     end;
5242
5243     fd := TFormatDescriptor.Get(IntFormat);
5244     TempWidth  := aSurface^.w;
5245     TempHeight := aSurface^.h;
5246     RowSize := fd.GetSize(TempWidth, 1);
5247     GetMem(pData, TempHeight * RowSize);
5248     try
5249       pTempData := pData;
5250       for Row := 0 to TempHeight -1 do begin
5251         pSource := GetRowPointer(Row);
5252         if (Assigned(pSource)) then begin
5253           Move(pSource^, pTempData^, RowSize);
5254           Inc(pTempData, RowSize);
5255         end;
5256       end;
5257       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5258       result := true;
5259     except
5260       if Assigned(pData) then
5261         FreeMem(pData);
5262       raise;
5263     end;
5264   end;
5265 end;
5266
5267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5268 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5269 var
5270   Row, Col, AlphaInterleave: Integer;
5271   pSource, pDest: PByte;
5272
5273   function GetRowPointer(Row: Integer): pByte;
5274   begin
5275     result := aSurface.pixels;
5276     Inc(result, Row * Width);
5277   end;
5278
5279 begin
5280   result := false;
5281   if Assigned(Data) then begin
5282     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5283       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5284
5285       AlphaInterleave := 0;
5286       case Format of
5287         tfLuminance8Alpha8ub2:
5288           AlphaInterleave := 1;
5289         tfBGRA8ub4, tfRGBA8ub4:
5290           AlphaInterleave := 3;
5291       end;
5292
5293       pSource := Data;
5294       for Row := 0 to Height -1 do begin
5295         pDest := GetRowPointer(Row);
5296         if Assigned(pDest) then begin
5297           for Col := 0 to Width -1 do begin
5298             Inc(pSource, AlphaInterleave);
5299             pDest^ := pSource^;
5300             Inc(pDest);
5301             Inc(pSource);
5302           end;
5303         end;
5304       end;
5305       result := true;
5306     end;
5307   end;
5308 end;
5309
5310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5311 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5312 var
5313   bmp: TglBitmap2D;
5314 begin
5315   bmp := TglBitmap2D.Create;
5316   try
5317     bmp.AssignFromSurface(aSurface);
5318     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5319   finally
5320     bmp.Free;
5321   end;
5322 end;
5323 {$ENDIF}
5324
5325 {$IFDEF GLB_DELPHI}
5326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5327 function CreateGrayPalette: HPALETTE;
5328 var
5329   Idx: Integer;
5330   Pal: PLogPalette;
5331 begin
5332   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5333
5334   Pal.palVersion := $300;
5335   Pal.palNumEntries := 256;
5336
5337   for Idx := 0 to Pal.palNumEntries - 1 do begin
5338     Pal.palPalEntry[Idx].peRed   := Idx;
5339     Pal.palPalEntry[Idx].peGreen := Idx;
5340     Pal.palPalEntry[Idx].peBlue  := Idx;
5341     Pal.palPalEntry[Idx].peFlags := 0;
5342   end;
5343   Result := CreatePalette(Pal^);
5344   FreeMem(Pal);
5345 end;
5346
5347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5348 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5349 var
5350   Row: Integer;
5351   pSource, pData: PByte;
5352 begin
5353   result := false;
5354   if Assigned(Data) then begin
5355     if Assigned(aBitmap) then begin
5356       aBitmap.Width  := Width;
5357       aBitmap.Height := Height;
5358
5359       case Format of
5360         tfAlpha8ub1, tfLuminance8ub1: begin
5361           aBitmap.PixelFormat := pf8bit;
5362           aBitmap.Palette     := CreateGrayPalette;
5363         end;
5364         tfRGB5A1us1:
5365           aBitmap.PixelFormat := pf15bit;
5366         tfR5G6B5us1:
5367           aBitmap.PixelFormat := pf16bit;
5368         tfRGB8ub3, tfBGR8ub3:
5369           aBitmap.PixelFormat := pf24bit;
5370         tfRGBA8ub4, tfBGRA8ub4:
5371           aBitmap.PixelFormat := pf32bit;
5372       else
5373         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5374       end;
5375
5376       pSource := Data;
5377       for Row := 0 to FileHeight -1 do begin
5378         pData := aBitmap.Scanline[Row];
5379         Move(pSource^, pData^, fRowSize);
5380         Inc(pSource, fRowSize);
5381         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5382           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5383       end;
5384       result := true;
5385     end;
5386   end;
5387 end;
5388
5389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5390 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5391 var
5392   pSource, pData, pTempData: PByte;
5393   Row, RowSize, TempWidth, TempHeight: Integer;
5394   IntFormat: TglBitmapFormat;
5395 begin
5396   result := false;
5397
5398   if (Assigned(aBitmap)) then begin
5399     case aBitmap.PixelFormat of
5400       pf8bit:
5401         IntFormat := tfLuminance8ub1;
5402       pf15bit:
5403         IntFormat := tfRGB5A1us1;
5404       pf16bit:
5405         IntFormat := tfR5G6B5us1;
5406       pf24bit:
5407         IntFormat := tfBGR8ub3;
5408       pf32bit:
5409         IntFormat := tfBGRA8ub4;
5410     else
5411       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5412     end;
5413
5414     TempWidth  := aBitmap.Width;
5415     TempHeight := aBitmap.Height;
5416     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5417     GetMem(pData, TempHeight * RowSize);
5418     try
5419       pTempData := pData;
5420       for Row := 0 to TempHeight -1 do begin
5421         pSource := aBitmap.Scanline[Row];
5422         if (Assigned(pSource)) then begin
5423           Move(pSource^, pTempData^, RowSize);
5424           Inc(pTempData, RowSize);
5425         end;
5426       end;
5427       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5428       result := true;
5429     except
5430       if Assigned(pData) then
5431         FreeMem(pData);
5432       raise;
5433     end;
5434   end;
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5439 var
5440   Row, Col, AlphaInterleave: Integer;
5441   pSource, pDest: PByte;
5442 begin
5443   result := false;
5444
5445   if Assigned(Data) then begin
5446     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5447       if Assigned(aBitmap) then begin
5448         aBitmap.PixelFormat := pf8bit;
5449         aBitmap.Palette     := CreateGrayPalette;
5450         aBitmap.Width       := Width;
5451         aBitmap.Height      := Height;
5452
5453         case Format of
5454           tfLuminance8Alpha8ub2:
5455             AlphaInterleave := 1;
5456           tfRGBA8ub4, tfBGRA8ub4:
5457             AlphaInterleave := 3;
5458           else
5459             AlphaInterleave := 0;
5460         end;
5461
5462         // Copy Data
5463         pSource := Data;
5464
5465         for Row := 0 to Height -1 do begin
5466           pDest := aBitmap.Scanline[Row];
5467           if Assigned(pDest) then begin
5468             for Col := 0 to Width -1 do begin
5469               Inc(pSource, AlphaInterleave);
5470               pDest^ := pSource^;
5471               Inc(pDest);
5472               Inc(pSource);
5473             end;
5474           end;
5475         end;
5476         result := true;
5477       end;
5478     end;
5479   end;
5480 end;
5481
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5484 var
5485   tex: TglBitmap2D;
5486 begin
5487   tex := TglBitmap2D.Create;
5488   try
5489     tex.AssignFromBitmap(ABitmap);
5490     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5491   finally
5492     tex.Free;
5493   end;
5494 end;
5495 {$ENDIF}
5496
5497 {$IFDEF GLB_LAZARUS}
5498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5499 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5500 var
5501   rid: TRawImageDescription;
5502   FormatDesc: TFormatDescriptor;
5503 begin
5504   if not Assigned(Data) then
5505     raise EglBitmap.Create('no pixel data assigned. load data before save');
5506
5507   result := false;
5508   if not Assigned(aImage) or (Format = tfEmpty) then
5509     exit;
5510   FormatDesc := TFormatDescriptor.Get(Format);
5511   if FormatDesc.IsCompressed then
5512     exit;
5513
5514   FillChar(rid{%H-}, SizeOf(rid), 0);
5515   if FormatDesc.IsGrayscale then
5516     rid.Format := ricfGray
5517   else
5518     rid.Format := ricfRGBA;
5519
5520   rid.Width        := Width;
5521   rid.Height       := Height;
5522   rid.Depth        := FormatDesc.BitsPerPixel;
5523   rid.BitOrder     := riboBitsInOrder;
5524   rid.ByteOrder    := riboLSBFirst;
5525   rid.LineOrder    := riloTopToBottom;
5526   rid.LineEnd      := rileTight;
5527   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5528   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5529   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5530   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5531   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5532   rid.RedShift     := FormatDesc.Shift.r;
5533   rid.GreenShift   := FormatDesc.Shift.g;
5534   rid.BlueShift    := FormatDesc.Shift.b;
5535   rid.AlphaShift   := FormatDesc.Shift.a;
5536
5537   rid.MaskBitsPerPixel  := 0;
5538   rid.PaletteColorCount := 0;
5539
5540   aImage.DataDescription := rid;
5541   aImage.CreateData;
5542
5543   if not Assigned(aImage.PixelData) then
5544     raise EglBitmap.Create('error while creating LazIntfImage');
5545   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5546
5547   result := true;
5548 end;
5549
5550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5551 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5552 var
5553   f: TglBitmapFormat;
5554   FormatDesc: TFormatDescriptor;
5555   ImageData: PByte;
5556   ImageSize: Integer;
5557   CanCopy: Boolean;
5558   Mask: TglBitmapRec4ul;
5559
5560   procedure CopyConvert;
5561   var
5562     bfFormat: TbmpBitfieldFormat;
5563     pSourceLine, pDestLine: PByte;
5564     pSourceMD, pDestMD: Pointer;
5565     Shift, Prec: TglBitmapRec4ub;
5566     x, y: Integer;
5567     pixel: TglBitmapPixelData;
5568   begin
5569     bfFormat  := TbmpBitfieldFormat.Create;
5570     with aImage.DataDescription do begin
5571       Prec.r := RedPrec;
5572       Prec.g := GreenPrec;
5573       Prec.b := BluePrec;
5574       Prec.a := AlphaPrec;
5575       Shift.r := RedShift;
5576       Shift.g := GreenShift;
5577       Shift.b := BlueShift;
5578       Shift.a := AlphaShift;
5579       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5580     end;
5581     pSourceMD := bfFormat.CreateMappingData;
5582     pDestMD   := FormatDesc.CreateMappingData;
5583     try
5584       for y := 0 to aImage.Height-1 do begin
5585         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5586         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5587         for x := 0 to aImage.Width-1 do begin
5588           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5589           FormatDesc.Map(pixel, pDestLine, pDestMD);
5590         end;
5591       end;
5592     finally
5593       FormatDesc.FreeMappingData(pDestMD);
5594       bfFormat.FreeMappingData(pSourceMD);
5595       bfFormat.Free;
5596     end;
5597   end;
5598
5599 begin
5600   result := false;
5601   if not Assigned(aImage) then
5602     exit;
5603
5604   with aImage.DataDescription do begin
5605     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5606     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5607     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5608     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5609   end;
5610   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5611   f          := FormatDesc.Format;
5612   if (f = tfEmpty) then
5613     exit;
5614
5615   CanCopy :=
5616     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5617     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5618
5619   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5620   ImageData := GetMem(ImageSize);
5621   try
5622     if CanCopy then
5623       Move(aImage.PixelData^, ImageData^, ImageSize)
5624     else
5625       CopyConvert;
5626     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5627   except
5628     if Assigned(ImageData) then
5629       FreeMem(ImageData);
5630     raise;
5631   end;
5632
5633   result := true;
5634 end;
5635
5636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5637 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5638 var
5639   rid: TRawImageDescription;
5640   FormatDesc: TFormatDescriptor;
5641   Pixel: TglBitmapPixelData;
5642   x, y: Integer;
5643   srcMD: Pointer;
5644   src, dst: PByte;
5645 begin
5646   result := false;
5647   if not Assigned(aImage) or (Format = tfEmpty) then
5648     exit;
5649   FormatDesc := TFormatDescriptor.Get(Format);
5650   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5651     exit;
5652
5653   FillChar(rid{%H-}, SizeOf(rid), 0);
5654   rid.Format       := ricfGray;
5655   rid.Width        := Width;
5656   rid.Height       := Height;
5657   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5658   rid.BitOrder     := riboBitsInOrder;
5659   rid.ByteOrder    := riboLSBFirst;
5660   rid.LineOrder    := riloTopToBottom;
5661   rid.LineEnd      := rileTight;
5662   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5663   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5664   rid.GreenPrec    := 0;
5665   rid.BluePrec     := 0;
5666   rid.AlphaPrec    := 0;
5667   rid.RedShift     := 0;
5668   rid.GreenShift   := 0;
5669   rid.BlueShift    := 0;
5670   rid.AlphaShift   := 0;
5671
5672   rid.MaskBitsPerPixel  := 0;
5673   rid.PaletteColorCount := 0;
5674
5675   aImage.DataDescription := rid;
5676   aImage.CreateData;
5677
5678   srcMD := FormatDesc.CreateMappingData;
5679   try
5680     FormatDesc.PreparePixel(Pixel);
5681     src := Data;
5682     dst := aImage.PixelData;
5683     for y := 0 to Height-1 do
5684       for x := 0 to Width-1 do begin
5685         FormatDesc.Unmap(src, Pixel, srcMD);
5686         case rid.BitsPerPixel of
5687            8: begin
5688             dst^ := Pixel.Data.a;
5689             inc(dst);
5690           end;
5691           16: begin
5692             PWord(dst)^ := Pixel.Data.a;
5693             inc(dst, 2);
5694           end;
5695           24: begin
5696             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5697             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5698             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5699             inc(dst, 3);
5700           end;
5701           32: begin
5702             PCardinal(dst)^ := Pixel.Data.a;
5703             inc(dst, 4);
5704           end;
5705         else
5706           raise EglBitmapUnsupportedFormat.Create(Format);
5707         end;
5708       end;
5709   finally
5710     FormatDesc.FreeMappingData(srcMD);
5711   end;
5712   result := true;
5713 end;
5714
5715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5716 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5717 var
5718   tex: TglBitmap2D;
5719 begin
5720   tex := TglBitmap2D.Create;
5721   try
5722     tex.AssignFromLazIntfImage(aImage);
5723     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5724   finally
5725     tex.Free;
5726   end;
5727 end;
5728 {$ENDIF}
5729
5730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5731 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5732   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5733 var
5734   rs: TResourceStream;
5735 begin
5736   PrepareResType(aResource, aResType);
5737   rs := TResourceStream.Create(aInstance, aResource, aResType);
5738   try
5739     result := AddAlphaFromStream(rs, aFunc, aArgs);
5740   finally
5741     rs.Free;
5742   end;
5743 end;
5744
5745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5746 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5747   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5748 var
5749   rs: TResourceStream;
5750 begin
5751   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5752   try
5753     result := AddAlphaFromStream(rs, aFunc, aArgs);
5754   finally
5755     rs.Free;
5756   end;
5757 end;
5758
5759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5760 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5761 begin
5762   if TFormatDescriptor.Get(Format).IsCompressed then
5763     raise EglBitmapUnsupportedFormat.Create(Format);
5764   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5765 end;
5766
5767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5768 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5769 var
5770   FS: TFileStream;
5771 begin
5772   FS := TFileStream.Create(aFileName, fmOpenRead);
5773   try
5774     result := AddAlphaFromStream(FS, aFunc, aArgs);
5775   finally
5776     FS.Free;
5777   end;
5778 end;
5779
5780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5781 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5782 var
5783   tex: TglBitmap2D;
5784 begin
5785   tex := TglBitmap2D.Create(aStream);
5786   try
5787     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5788   finally
5789     tex.Free;
5790   end;
5791 end;
5792
5793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5794 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5795 var
5796   DestData, DestData2, SourceData: pByte;
5797   TempHeight, TempWidth: Integer;
5798   SourceFD, DestFD: TFormatDescriptor;
5799   SourceMD, DestMD, DestMD2: Pointer;
5800
5801   FuncRec: TglBitmapFunctionRec;
5802 begin
5803   result := false;
5804
5805   Assert(Assigned(Data));
5806   Assert(Assigned(aBitmap));
5807   Assert(Assigned(aBitmap.Data));
5808
5809   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5810     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5811
5812     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5813     DestFD   := TFormatDescriptor.Get(Format);
5814
5815     if not Assigned(aFunc) then begin
5816       aFunc        := glBitmapAlphaFunc;
5817       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5818     end else
5819       FuncRec.Args := aArgs;
5820
5821     // Values
5822     TempHeight := aBitmap.FileHeight;
5823     TempWidth  := aBitmap.FileWidth;
5824
5825     FuncRec.Sender          := Self;
5826     FuncRec.Size            := Dimension;
5827     FuncRec.Position.Fields := FuncRec.Size.Fields;
5828
5829     DestData   := Data;
5830     DestData2  := Data;
5831     SourceData := aBitmap.Data;
5832
5833     // Mapping
5834     SourceFD.PreparePixel(FuncRec.Source);
5835     DestFD.PreparePixel  (FuncRec.Dest);
5836
5837     SourceMD := SourceFD.CreateMappingData;
5838     DestMD   := DestFD.CreateMappingData;
5839     DestMD2  := DestFD.CreateMappingData;
5840     try
5841       FuncRec.Position.Y := 0;
5842       while FuncRec.Position.Y < TempHeight do begin
5843         FuncRec.Position.X := 0;
5844         while FuncRec.Position.X < TempWidth do begin
5845           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5846           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5847           aFunc(FuncRec);
5848           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5849           inc(FuncRec.Position.X);
5850         end;
5851         inc(FuncRec.Position.Y);
5852       end;
5853     finally
5854       SourceFD.FreeMappingData(SourceMD);
5855       DestFD.FreeMappingData(DestMD);
5856       DestFD.FreeMappingData(DestMD2);
5857     end;
5858   end;
5859 end;
5860
5861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5862 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5863 begin
5864   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5865 end;
5866
5867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5868 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5869 var
5870   PixelData: TglBitmapPixelData;
5871 begin
5872   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5873   result := AddAlphaFromColorKeyFloat(
5874     aRed   / PixelData.Range.r,
5875     aGreen / PixelData.Range.g,
5876     aBlue  / PixelData.Range.b,
5877     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5878 end;
5879
5880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5881 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5882 var
5883   values: array[0..2] of Single;
5884   tmp: Cardinal;
5885   i: Integer;
5886   PixelData: TglBitmapPixelData;
5887 begin
5888   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5889   with PixelData do begin
5890     values[0] := aRed;
5891     values[1] := aGreen;
5892     values[2] := aBlue;
5893
5894     for i := 0 to 2 do begin
5895       tmp          := Trunc(Range.arr[i] * aDeviation);
5896       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5897       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5898     end;
5899     Data.a  := 0;
5900     Range.a := 0;
5901   end;
5902   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5903 end;
5904
5905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5906 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5907 begin
5908   result := AddAlphaFromValueFloat(aAlpha / $FF);
5909 end;
5910
5911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5912 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5913 var
5914   PixelData: TglBitmapPixelData;
5915 begin
5916   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5917   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5918 end;
5919
5920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5921 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5922 var
5923   PixelData: TglBitmapPixelData;
5924 begin
5925   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5926   with PixelData do
5927     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5928   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5929 end;
5930
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 function TglBitmap.RemoveAlpha: Boolean;
5933 var
5934   FormatDesc: TFormatDescriptor;
5935 begin
5936   result := false;
5937   FormatDesc := TFormatDescriptor.Get(Format);
5938   if Assigned(Data) then begin
5939     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5940       raise EglBitmapUnsupportedFormat.Create(Format);
5941     result := ConvertTo(FormatDesc.WithoutAlpha);
5942   end;
5943 end;
5944
5945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5946 function TglBitmap.Clone: TglBitmap;
5947 var
5948   Temp: TglBitmap;
5949   TempPtr: PByte;
5950   Size: Integer;
5951 begin
5952   result := nil;
5953   Temp := (ClassType.Create as TglBitmap);
5954   try
5955     // copy texture data if assigned
5956     if Assigned(Data) then begin
5957       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5958       GetMem(TempPtr, Size);
5959       try
5960         Move(Data^, TempPtr^, Size);
5961         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5962       except
5963         if Assigned(TempPtr) then
5964           FreeMem(TempPtr);
5965         raise;
5966       end;
5967     end else begin
5968       TempPtr := nil;
5969       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5970     end;
5971
5972         // copy properties
5973     Temp.fID                      := ID;
5974     Temp.fTarget                  := Target;
5975     Temp.fFormat                  := Format;
5976     Temp.fMipMap                  := MipMap;
5977     Temp.fAnisotropic             := Anisotropic;
5978     Temp.fBorderColor             := fBorderColor;
5979     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5980     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5981     Temp.fFilterMin               := fFilterMin;
5982     Temp.fFilterMag               := fFilterMag;
5983     Temp.fWrapS                   := fWrapS;
5984     Temp.fWrapT                   := fWrapT;
5985     Temp.fWrapR                   := fWrapR;
5986     Temp.fFilename                := fFilename;
5987     Temp.fCustomName              := fCustomName;
5988     Temp.fCustomNameW             := fCustomNameW;
5989     Temp.fCustomData              := fCustomData;
5990
5991     result := Temp;
5992   except
5993     FreeAndNil(Temp);
5994     raise;
5995   end;
5996 end;
5997
5998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5999 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6000 var
6001   SourceFD, DestFD: TFormatDescriptor;
6002   SourcePD, DestPD: TglBitmapPixelData;
6003   ShiftData: TShiftData;
6004
6005   function DataIsIdentical: Boolean;
6006   begin
6007     result := SourceFD.MaskMatch(DestFD.Mask);
6008   end;
6009
6010   function CanCopyDirect: Boolean;
6011   begin
6012     result :=
6013       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6014       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6015       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6016       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6017   end;
6018
6019   function CanShift: Boolean;
6020   begin
6021     result :=
6022       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6023       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6024       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6025       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6026   end;
6027
6028   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6029   begin
6030     result := 0;
6031     while (aSource > aDest) and (aSource > 0) do begin
6032       inc(result);
6033       aSource := aSource shr 1;
6034     end;
6035   end;
6036
6037 begin
6038   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6039     SourceFD := TFormatDescriptor.Get(Format);
6040     DestFD   := TFormatDescriptor.Get(aFormat);
6041
6042     if DataIsIdentical then begin
6043       result := true;
6044       Format := aFormat;
6045       exit;
6046     end;
6047
6048     SourceFD.PreparePixel(SourcePD);
6049     DestFD.PreparePixel  (DestPD);
6050
6051     if CanCopyDirect then
6052       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
6053     else if CanShift then begin
6054       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6055       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6056       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6057       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6058       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6059     end else
6060       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6061   end else
6062     result := true;
6063 end;
6064
6065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6066 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
6067 begin
6068   if aUseRGB or aUseAlpha then
6069     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
6070       ((Byte(aUseAlpha) and 1) shl 1) or
6071        (Byte(aUseRGB)   and 1)      ));
6072 end;
6073
6074 {$IFNDEF OPENGL_ES}
6075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6076 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
6077 begin
6078   fBorderColor[0] := aRed;
6079   fBorderColor[1] := aGreen;
6080   fBorderColor[2] := aBlue;
6081   fBorderColor[3] := aAlpha;
6082   if (ID > 0) then begin
6083     Bind(false);
6084     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6085   end;
6086 end;
6087 {$ENDIF}
6088
6089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6090 procedure TglBitmap.FreeData;
6091 var
6092   TempPtr: PByte;
6093 begin
6094   TempPtr := nil;
6095   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
6096 end;
6097
6098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6099 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
6100   const aAlpha: Byte);
6101 begin
6102   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
6103 end;
6104
6105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6106 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
6107 var
6108   PixelData: TglBitmapPixelData;
6109 begin
6110   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6111   FillWithColorFloat(
6112     aRed   / PixelData.Range.r,
6113     aGreen / PixelData.Range.g,
6114     aBlue  / PixelData.Range.b,
6115     aAlpha / PixelData.Range.a);
6116 end;
6117
6118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6119 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
6120 var
6121   PixelData: TglBitmapPixelData;
6122 begin
6123   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6124   with PixelData do begin
6125     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6126     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6127     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6128     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6129   end;
6130   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6131 end;
6132
6133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6134 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6135 begin
6136   //check MIN filter
6137   case aMin of
6138     GL_NEAREST:
6139       fFilterMin := GL_NEAREST;
6140     GL_LINEAR:
6141       fFilterMin := GL_LINEAR;
6142     GL_NEAREST_MIPMAP_NEAREST:
6143       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6144     GL_LINEAR_MIPMAP_NEAREST:
6145       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6146     GL_NEAREST_MIPMAP_LINEAR:
6147       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6148     GL_LINEAR_MIPMAP_LINEAR:
6149       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6150     else
6151       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6152   end;
6153
6154   //check MAG filter
6155   case aMag of
6156     GL_NEAREST:
6157       fFilterMag := GL_NEAREST;
6158     GL_LINEAR:
6159       fFilterMag := GL_LINEAR;
6160     else
6161       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6162   end;
6163
6164   //apply filter
6165   if (ID > 0) then begin
6166     Bind(false);
6167     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6168
6169     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
6170       case fFilterMin of
6171         GL_NEAREST, GL_LINEAR:
6172           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6173         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6174           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6175         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6176           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6177       end;
6178     end else
6179       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6180   end;
6181 end;
6182
6183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6184 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6185
6186   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6187   begin
6188     case aValue of
6189 {$IFNDEF OPENGL_ES}
6190       GL_CLAMP:
6191         aTarget := GL_CLAMP;
6192 {$ENDIF}
6193
6194       GL_REPEAT:
6195         aTarget := GL_REPEAT;
6196
6197       GL_CLAMP_TO_EDGE: begin
6198 {$IFNDEF OPENGL_ES}
6199         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
6200           aTarget := GL_CLAMP
6201         else
6202 {$ENDIF}
6203           aTarget := GL_CLAMP_TO_EDGE;
6204       end;
6205
6206 {$IFNDEF OPENGL_ES}
6207       GL_CLAMP_TO_BORDER: begin
6208         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6209           aTarget := GL_CLAMP_TO_BORDER
6210         else
6211           aTarget := GL_CLAMP;
6212       end;
6213 {$ENDIF}
6214
6215 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
6216       GL_MIRRORED_REPEAT: begin
6217   {$IFNDEF OPENGL_ES}
6218         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6219   {$ELSE}
6220         if GL_VERSION_2_0 then
6221   {$ENDIF}
6222           aTarget := GL_MIRRORED_REPEAT
6223         else
6224           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6225       end;
6226 {$IFEND}
6227     else
6228       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6229     end;
6230   end;
6231
6232 begin
6233   CheckAndSetWrap(S, fWrapS);
6234   CheckAndSetWrap(T, fWrapT);
6235   CheckAndSetWrap(R, fWrapR);
6236
6237   if (ID > 0) then begin
6238     Bind(false);
6239     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6240     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6241 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6242     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
6243     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6244 {$IFEND}
6245   end;
6246 end;
6247
6248 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6250 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6251
6252   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6253   begin
6254     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6255        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6256       fSwizzle[aIndex] := aValue
6257     else
6258       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6259   end;
6260
6261 begin
6262 {$IFNDEF OPENGL_ES}
6263   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6264     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6265 {$ELSE}
6266   if not GL_VERSION_3_0 then
6267     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6268 {$ENDIF}
6269   CheckAndSetValue(r, 0);
6270   CheckAndSetValue(g, 1);
6271   CheckAndSetValue(b, 2);
6272   CheckAndSetValue(a, 3);
6273
6274   if (ID > 0) then begin
6275     Bind(false);
6276 {$IFNDEF OPENGL_ES}
6277     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6278 {$ELSE}
6279     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
6280     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
6281     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
6282     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
6283 {$ENDIF}
6284   end;
6285 end;
6286 {$IFEND}
6287
6288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6289 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6290 begin
6291   if aEnableTextureUnit then
6292     glEnable(Target);
6293   if (ID > 0) then
6294     glBindTexture(Target, ID);
6295 end;
6296
6297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6298 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6299 begin
6300   if aDisableTextureUnit then
6301     glDisable(Target);
6302   glBindTexture(Target, 0);
6303 end;
6304
6305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6306 constructor TglBitmap.Create;
6307 begin
6308   if (ClassType = TglBitmap) then
6309     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6310 {$IFDEF GLB_NATIVE_OGL}
6311   glbReadOpenGLExtensions;
6312 {$ENDIF}
6313   inherited Create;
6314   fFormat            := glBitmapGetDefaultFormat;
6315   fFreeDataOnDestroy := true;
6316 end;
6317
6318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6319 constructor TglBitmap.Create(const aFileName: String);
6320 begin
6321   Create;
6322   LoadFromFile(aFileName);
6323 end;
6324
6325 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6326 constructor TglBitmap.Create(const aStream: TStream);
6327 begin
6328   Create;
6329   LoadFromStream(aStream);
6330 end;
6331
6332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6333 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6334 var
6335   ImageSize: Integer;
6336 begin
6337   Create;
6338   if not Assigned(aData) then begin
6339     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6340     GetMem(aData, ImageSize);
6341     try
6342       FillChar(aData^, ImageSize, #$FF);
6343       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6344     except
6345       if Assigned(aData) then
6346         FreeMem(aData);
6347       raise;
6348     end;
6349   end else begin
6350     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6351     fFreeDataOnDestroy := false;
6352   end;
6353 end;
6354
6355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6356 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6357 begin
6358   Create;
6359   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6360 end;
6361
6362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6363 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6364 begin
6365   Create;
6366   LoadFromResource(aInstance, aResource, aResType);
6367 end;
6368
6369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6370 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6371 begin
6372   Create;
6373   LoadFromResourceID(aInstance, aResourceID, aResType);
6374 end;
6375
6376 {$IFDEF GLB_SUPPORT_PNG_READ}
6377 {$IF DEFINED(GLB_LAZ_PNG)}
6378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6379 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6381 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6382 const
6383   MAGIC_LEN = 8;
6384   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6385 var
6386   reader: TLazReaderPNG;
6387   intf: TLazIntfImage;
6388   StreamPos: Int64;
6389   magic: String[MAGIC_LEN];
6390 begin
6391   result := true;
6392   StreamPos := aStream.Position;
6393
6394   SetLength(magic, MAGIC_LEN);
6395   aStream.Read(magic[1], MAGIC_LEN);
6396   aStream.Position := StreamPos;
6397   if (magic <> PNG_MAGIC) then begin
6398     result := false;
6399     exit;
6400   end;
6401
6402   intf   := TLazIntfImage.Create(0, 0);
6403   reader := TLazReaderPNG.Create;
6404   try try
6405     reader.UpdateDescription := true;
6406     reader.ImageRead(aStream, intf);
6407     AssignFromLazIntfImage(intf);
6408   except
6409     result := false;
6410     aStream.Position := StreamPos;
6411     exit;
6412   end;
6413   finally
6414     reader.Free;
6415     intf.Free;
6416   end;
6417 end;
6418
6419 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6421 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6422 var
6423   Surface: PSDL_Surface;
6424   RWops: PSDL_RWops;
6425 begin
6426   result := false;
6427   RWops := glBitmapCreateRWops(aStream);
6428   try
6429     if IMG_isPNG(RWops) > 0 then begin
6430       Surface := IMG_LoadPNG_RW(RWops);
6431       try
6432         AssignFromSurface(Surface);
6433         result := true;
6434       finally
6435         SDL_FreeSurface(Surface);
6436       end;
6437     end;
6438   finally
6439     SDL_FreeRW(RWops);
6440   end;
6441 end;
6442
6443 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6445 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6446 begin
6447   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6448 end;
6449
6450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6451 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6452 var
6453   StreamPos: Int64;
6454   signature: array [0..7] of byte;
6455   png: png_structp;
6456   png_info: png_infop;
6457
6458   TempHeight, TempWidth: Integer;
6459   Format: TglBitmapFormat;
6460
6461   png_data: pByte;
6462   png_rows: array of pByte;
6463   Row, LineSize: Integer;
6464 begin
6465   result := false;
6466
6467   if not init_libPNG then
6468     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6469
6470   try
6471     // signature
6472     StreamPos := aStream.Position;
6473     aStream.Read(signature{%H-}, 8);
6474     aStream.Position := StreamPos;
6475
6476     if png_check_sig(@signature, 8) <> 0 then begin
6477       // png read struct
6478       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6479       if png = nil then
6480         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6481
6482       // png info
6483       png_info := png_create_info_struct(png);
6484       if png_info = nil then begin
6485         png_destroy_read_struct(@png, nil, nil);
6486         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6487       end;
6488
6489       // set read callback
6490       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6491
6492       // read informations
6493       png_read_info(png, png_info);
6494
6495       // size
6496       TempHeight := png_get_image_height(png, png_info);
6497       TempWidth := png_get_image_width(png, png_info);
6498
6499       // format
6500       case png_get_color_type(png, png_info) of
6501         PNG_COLOR_TYPE_GRAY:
6502           Format := tfLuminance8ub1;
6503         PNG_COLOR_TYPE_GRAY_ALPHA:
6504           Format := tfLuminance8Alpha8us1;
6505         PNG_COLOR_TYPE_RGB:
6506           Format := tfRGB8ub3;
6507         PNG_COLOR_TYPE_RGB_ALPHA:
6508           Format := tfRGBA8ub4;
6509         else
6510           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6511       end;
6512
6513       // cut upper 8 bit from 16 bit formats
6514       if png_get_bit_depth(png, png_info) > 8 then
6515         png_set_strip_16(png);
6516
6517       // expand bitdepth smaller than 8
6518       if png_get_bit_depth(png, png_info) < 8 then
6519         png_set_expand(png);
6520
6521       // allocating mem for scanlines
6522       LineSize := png_get_rowbytes(png, png_info);
6523       GetMem(png_data, TempHeight * LineSize);
6524       try
6525         SetLength(png_rows, TempHeight);
6526         for Row := Low(png_rows) to High(png_rows) do begin
6527           png_rows[Row] := png_data;
6528           Inc(png_rows[Row], Row * LineSize);
6529         end;
6530
6531         // read complete image into scanlines
6532         png_read_image(png, @png_rows[0]);
6533
6534         // read end
6535         png_read_end(png, png_info);
6536
6537         // destroy read struct
6538         png_destroy_read_struct(@png, @png_info, nil);
6539
6540         SetLength(png_rows, 0);
6541
6542         // set new data
6543         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6544
6545         result := true;
6546       except
6547         if Assigned(png_data) then
6548           FreeMem(png_data);
6549         raise;
6550       end;
6551     end;
6552   finally
6553     quit_libPNG;
6554   end;
6555 end;
6556
6557 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6559 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6560 var
6561   StreamPos: Int64;
6562   Png: TPNGObject;
6563   Header: String[8];
6564   Row, Col, PixSize, LineSize: Integer;
6565   NewImage, pSource, pDest, pAlpha: pByte;
6566   PngFormat: TglBitmapFormat;
6567   FormatDesc: TFormatDescriptor;
6568
6569 const
6570   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6571
6572 begin
6573   result := false;
6574
6575   StreamPos := aStream.Position;
6576   aStream.Read(Header[0], SizeOf(Header));
6577   aStream.Position := StreamPos;
6578
6579   {Test if the header matches}
6580   if Header = PngHeader then begin
6581     Png := TPNGObject.Create;
6582     try
6583       Png.LoadFromStream(aStream);
6584
6585       case Png.Header.ColorType of
6586         COLOR_GRAYSCALE:
6587           PngFormat := tfLuminance8ub1;
6588         COLOR_GRAYSCALEALPHA:
6589           PngFormat := tfLuminance8Alpha8us1;
6590         COLOR_RGB:
6591           PngFormat := tfBGR8ub3;
6592         COLOR_RGBALPHA:
6593           PngFormat := tfBGRA8ub4;
6594         else
6595           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6596       end;
6597
6598       FormatDesc := TFormatDescriptor.Get(PngFormat);
6599       PixSize    := Round(FormatDesc.PixelSize);
6600       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6601
6602       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6603       try
6604         pDest := NewImage;
6605
6606         case Png.Header.ColorType of
6607           COLOR_RGB, COLOR_GRAYSCALE:
6608             begin
6609               for Row := 0 to Png.Height -1 do begin
6610                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6611                 Inc(pDest, LineSize);
6612               end;
6613             end;
6614           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6615             begin
6616               PixSize := PixSize -1;
6617
6618               for Row := 0 to Png.Height -1 do begin
6619                 pSource := Png.Scanline[Row];
6620                 pAlpha := pByte(Png.AlphaScanline[Row]);
6621
6622                 for Col := 0 to Png.Width -1 do begin
6623                   Move (pSource^, pDest^, PixSize);
6624                   Inc(pSource, PixSize);
6625                   Inc(pDest, PixSize);
6626
6627                   pDest^ := pAlpha^;
6628                   inc(pAlpha);
6629                   Inc(pDest);
6630                 end;
6631               end;
6632             end;
6633           else
6634             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6635         end;
6636
6637         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6638
6639         result := true;
6640       except
6641         if Assigned(NewImage) then
6642           FreeMem(NewImage);
6643         raise;
6644       end;
6645     finally
6646       Png.Free;
6647     end;
6648   end;
6649 end;
6650 {$IFEND}
6651 {$ENDIF}
6652
6653 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6654 {$IFDEF GLB_LIB_PNG}
6655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6656 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6657 begin
6658   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6659 end;
6660 {$ENDIF}
6661
6662 {$IF DEFINED(GLB_LAZ_PNG)}
6663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6664 procedure TglBitmap.SavePNG(const aStream: TStream);
6665 var
6666   png: TPortableNetworkGraphic;
6667   intf: TLazIntfImage;
6668   raw: TRawImage;
6669 begin
6670   png  := TPortableNetworkGraphic.Create;
6671   intf := TLazIntfImage.Create(0, 0);
6672   try
6673     if not AssignToLazIntfImage(intf) then
6674       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6675     intf.GetRawImage(raw);
6676     png.LoadFromRawImage(raw, false);
6677     png.SaveToStream(aStream);
6678   finally
6679     png.Free;
6680     intf.Free;
6681   end;
6682 end;
6683
6684 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6686 procedure TglBitmap.SavePNG(const aStream: TStream);
6687 var
6688   png: png_structp;
6689   png_info: png_infop;
6690   png_rows: array of pByte;
6691   LineSize: Integer;
6692   ColorType: Integer;
6693   Row: Integer;
6694   FormatDesc: TFormatDescriptor;
6695 begin
6696   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6697     raise EglBitmapUnsupportedFormat.Create(Format);
6698
6699   if not init_libPNG then
6700     raise Exception.Create('unable to initialize libPNG.');
6701
6702   try
6703     case Format of
6704       tfAlpha8ub1, tfLuminance8ub1:
6705         ColorType := PNG_COLOR_TYPE_GRAY;
6706       tfLuminance8Alpha8us1:
6707         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6708       tfBGR8ub3, tfRGB8ub3:
6709         ColorType := PNG_COLOR_TYPE_RGB;
6710       tfBGRA8ub4, tfRGBA8ub4:
6711         ColorType := PNG_COLOR_TYPE_RGBA;
6712       else
6713         raise EglBitmapUnsupportedFormat.Create(Format);
6714     end;
6715
6716     FormatDesc := TFormatDescriptor.Get(Format);
6717     LineSize := FormatDesc.GetSize(Width, 1);
6718
6719     // creating array for scanline
6720     SetLength(png_rows, Height);
6721     try
6722       for Row := 0 to Height - 1 do begin
6723         png_rows[Row] := Data;
6724         Inc(png_rows[Row], Row * LineSize)
6725       end;
6726
6727       // write struct
6728       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6729       if png = nil then
6730         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6731
6732       // create png info
6733       png_info := png_create_info_struct(png);
6734       if png_info = nil then begin
6735         png_destroy_write_struct(@png, nil);
6736         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6737       end;
6738
6739       // set read callback
6740       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6741
6742       // set compression
6743       png_set_compression_level(png, 6);
6744
6745       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6746         png_set_bgr(png);
6747
6748       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6749       png_write_info(png, png_info);
6750       png_write_image(png, @png_rows[0]);
6751       png_write_end(png, png_info);
6752       png_destroy_write_struct(@png, @png_info);
6753     finally
6754       SetLength(png_rows, 0);
6755     end;
6756   finally
6757     quit_libPNG;
6758   end;
6759 end;
6760
6761 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6763 procedure TglBitmap.SavePNG(const aStream: TStream);
6764 var
6765   Png: TPNGObject;
6766
6767   pSource, pDest: pByte;
6768   X, Y, PixSize: Integer;
6769   ColorType: Cardinal;
6770   Alpha: Boolean;
6771
6772   pTemp: pByte;
6773   Temp: Byte;
6774 begin
6775   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6776     raise EglBitmapUnsupportedFormat.Create(Format);
6777
6778   case Format of
6779     tfAlpha8ub1, tfLuminance8ub1: begin
6780       ColorType := COLOR_GRAYSCALE;
6781       PixSize   := 1;
6782       Alpha     := false;
6783     end;
6784     tfLuminance8Alpha8us1: begin
6785       ColorType := COLOR_GRAYSCALEALPHA;
6786       PixSize   := 1;
6787       Alpha     := true;
6788     end;
6789     tfBGR8ub3, tfRGB8ub3: begin
6790       ColorType := COLOR_RGB;
6791       PixSize   := 3;
6792       Alpha     := false;
6793     end;
6794     tfBGRA8ub4, tfRGBA8ub4: begin
6795       ColorType := COLOR_RGBALPHA;
6796       PixSize   := 3;
6797       Alpha     := true
6798     end;
6799   else
6800     raise EglBitmapUnsupportedFormat.Create(Format);
6801   end;
6802
6803   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6804   try
6805     // Copy ImageData
6806     pSource := Data;
6807     for Y := 0 to Height -1 do begin
6808       pDest := png.ScanLine[Y];
6809       for X := 0 to Width -1 do begin
6810         Move(pSource^, pDest^, PixSize);
6811         Inc(pDest, PixSize);
6812         Inc(pSource, PixSize);
6813         if Alpha then begin
6814           png.AlphaScanline[Y]^[X] := pSource^;
6815           Inc(pSource);
6816         end;
6817       end;
6818
6819       // convert RGB line to BGR
6820       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6821         pTemp := png.ScanLine[Y];
6822         for X := 0 to Width -1 do begin
6823           Temp := pByteArray(pTemp)^[0];
6824           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6825           pByteArray(pTemp)^[2] := Temp;
6826           Inc(pTemp, 3);
6827         end;
6828       end;
6829     end;
6830
6831     // Save to Stream
6832     Png.CompressionLevel := 6;
6833     Png.SaveToStream(aStream);
6834   finally
6835     FreeAndNil(Png);
6836   end;
6837 end;
6838 {$IFEND}
6839 {$ENDIF}
6840
6841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6842 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6844 {$IFDEF GLB_LIB_JPEG}
6845 type
6846   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6847   glBitmap_libJPEG_source_mgr = record
6848     pub: jpeg_source_mgr;
6849
6850     SrcStream: TStream;
6851     SrcBuffer: array [1..4096] of byte;
6852   end;
6853
6854   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6855   glBitmap_libJPEG_dest_mgr = record
6856     pub: jpeg_destination_mgr;
6857
6858     DestStream: TStream;
6859     DestBuffer: array [1..4096] of byte;
6860   end;
6861
6862 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6863 begin
6864   //DUMMY
6865 end;
6866
6867
6868 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6869 begin
6870   //DUMMY
6871 end;
6872
6873
6874 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6875 begin
6876   //DUMMY
6877 end;
6878
6879 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6880 begin
6881   //DUMMY
6882 end;
6883
6884
6885 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6886 begin
6887   //DUMMY
6888 end;
6889
6890
6891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6892 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6893 var
6894   src: glBitmap_libJPEG_source_mgr_ptr;
6895   bytes: integer;
6896 begin
6897   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6898
6899   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6900         if (bytes <= 0) then begin
6901                 src^.SrcBuffer[1] := $FF;
6902                 src^.SrcBuffer[2] := JPEG_EOI;
6903                 bytes := 2;
6904         end;
6905
6906         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6907         src^.pub.bytes_in_buffer := bytes;
6908
6909   result := true;
6910 end;
6911
6912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6913 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6914 var
6915   src: glBitmap_libJPEG_source_mgr_ptr;
6916 begin
6917   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6918
6919   if num_bytes > 0 then begin
6920     // wanted byte isn't in buffer so set stream position and read buffer
6921     if num_bytes > src^.pub.bytes_in_buffer then begin
6922       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6923       src^.pub.fill_input_buffer(cinfo);
6924     end else begin
6925       // wanted byte is in buffer so only skip
6926                 inc(src^.pub.next_input_byte, num_bytes);
6927                 dec(src^.pub.bytes_in_buffer, num_bytes);
6928     end;
6929   end;
6930 end;
6931
6932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6933 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6934 var
6935   dest: glBitmap_libJPEG_dest_mgr_ptr;
6936 begin
6937   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6938
6939   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6940     // write complete buffer
6941     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6942
6943     // reset buffer
6944     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6945     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6946   end;
6947
6948   result := true;
6949 end;
6950
6951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6952 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6953 var
6954   Idx: Integer;
6955   dest: glBitmap_libJPEG_dest_mgr_ptr;
6956 begin
6957   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6958
6959   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6960     // check for endblock
6961     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6962       // write endblock
6963       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6964
6965       // leave
6966       break;
6967     end else
6968       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6969   end;
6970 end;
6971 {$ENDIF}
6972
6973 {$IFDEF GLB_SUPPORT_JPEG_READ}
6974 {$IF DEFINED(GLB_LAZ_JPEG)}
6975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6976 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6977 const
6978   MAGIC_LEN = 2;
6979   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6980 var
6981   intf: TLazIntfImage;
6982   reader: TFPReaderJPEG;
6983   StreamPos: Int64;
6984   magic: String[MAGIC_LEN];
6985 begin
6986   result := true;
6987   StreamPos := aStream.Position;
6988
6989   SetLength(magic, MAGIC_LEN);
6990   aStream.Read(magic[1], MAGIC_LEN);
6991   aStream.Position := StreamPos;
6992   if (magic <> JPEG_MAGIC) then begin
6993     result := false;
6994     exit;
6995   end;
6996
6997   reader := TFPReaderJPEG.Create;
6998   intf := TLazIntfImage.Create(0, 0);
6999   try try
7000     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
7001     reader.ImageRead(aStream, intf);
7002     AssignFromLazIntfImage(intf);
7003   except
7004     result := false;
7005     aStream.Position := StreamPos;
7006     exit;
7007   end;
7008   finally
7009     reader.Free;
7010     intf.Free;
7011   end;
7012 end;
7013
7014 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
7015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7016 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7017 var
7018   Surface: PSDL_Surface;
7019   RWops: PSDL_RWops;
7020 begin
7021   result := false;
7022
7023   RWops := glBitmapCreateRWops(aStream);
7024   try
7025     if IMG_isJPG(RWops) > 0 then begin
7026       Surface := IMG_LoadJPG_RW(RWops);
7027       try
7028         AssignFromSurface(Surface);
7029         result := true;
7030       finally
7031         SDL_FreeSurface(Surface);
7032       end;
7033     end;
7034   finally
7035     SDL_FreeRW(RWops);
7036   end;
7037 end;
7038
7039 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7041 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7042 var
7043   StreamPos: Int64;
7044   Temp: array[0..1]of Byte;
7045
7046   jpeg: jpeg_decompress_struct;
7047   jpeg_err: jpeg_error_mgr;
7048
7049   IntFormat: TglBitmapFormat;
7050   pImage: pByte;
7051   TempHeight, TempWidth: Integer;
7052
7053   pTemp: pByte;
7054   Row: Integer;
7055
7056   FormatDesc: TFormatDescriptor;
7057 begin
7058   result := false;
7059
7060   if not init_libJPEG then
7061     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
7062
7063   try
7064     // reading first two bytes to test file and set cursor back to begin
7065     StreamPos := aStream.Position;
7066     aStream.Read({%H-}Temp[0], 2);
7067     aStream.Position := StreamPos;
7068
7069     // if Bitmap then read file.
7070     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7071       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
7072       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7073
7074       // error managment
7075       jpeg.err := jpeg_std_error(@jpeg_err);
7076       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7077       jpeg_err.output_message := glBitmap_libJPEG_output_message;
7078
7079       // decompression struct
7080       jpeg_create_decompress(@jpeg);
7081
7082       // allocation space for streaming methods
7083       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
7084
7085       // seeting up custom functions
7086       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
7087         pub.init_source       := glBitmap_libJPEG_init_source;
7088         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
7089         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
7090         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
7091         pub.term_source       := glBitmap_libJPEG_term_source;
7092
7093         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
7094         pub.next_input_byte := nil;   // until buffer loaded
7095
7096         SrcStream := aStream;
7097       end;
7098
7099       // set global decoding state
7100       jpeg.global_state := DSTATE_START;
7101
7102       // read header of jpeg
7103       jpeg_read_header(@jpeg, false);
7104
7105       // setting output parameter
7106       case jpeg.jpeg_color_space of
7107         JCS_GRAYSCALE:
7108           begin
7109             jpeg.out_color_space := JCS_GRAYSCALE;
7110             IntFormat := tfLuminance8ub1;
7111           end;
7112         else
7113           jpeg.out_color_space := JCS_RGB;
7114           IntFormat := tfRGB8ub3;
7115       end;
7116
7117       // reading image
7118       jpeg_start_decompress(@jpeg);
7119
7120       TempHeight := jpeg.output_height;
7121       TempWidth := jpeg.output_width;
7122
7123       FormatDesc := TFormatDescriptor.Get(IntFormat);
7124
7125       // creating new image
7126       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
7127       try
7128         pTemp := pImage;
7129
7130         for Row := 0 to TempHeight -1 do begin
7131           jpeg_read_scanlines(@jpeg, @pTemp, 1);
7132           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
7133         end;
7134
7135         // finish decompression
7136         jpeg_finish_decompress(@jpeg);
7137
7138         // destroy decompression
7139         jpeg_destroy_decompress(@jpeg);
7140
7141         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7142
7143         result := true;
7144       except
7145         if Assigned(pImage) then
7146           FreeMem(pImage);
7147         raise;
7148       end;
7149     end;
7150   finally
7151     quit_libJPEG;
7152   end;
7153 end;
7154
7155 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7157 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7158 var
7159   bmp: TBitmap;
7160   jpg: TJPEGImage;
7161   StreamPos: Int64;
7162   Temp: array[0..1]of Byte;
7163 begin
7164   result := false;
7165
7166   // reading first two bytes to test file and set cursor back to begin
7167   StreamPos := aStream.Position;
7168   aStream.Read(Temp[0], 2);
7169   aStream.Position := StreamPos;
7170
7171   // if Bitmap then read file.
7172   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7173     bmp := TBitmap.Create;
7174     try
7175       jpg := TJPEGImage.Create;
7176       try
7177         jpg.LoadFromStream(aStream);
7178         bmp.Assign(jpg);
7179         result := AssignFromBitmap(bmp);
7180       finally
7181         jpg.Free;
7182       end;
7183     finally
7184       bmp.Free;
7185     end;
7186   end;
7187 end;
7188 {$IFEND}
7189 {$ENDIF}
7190
7191 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7192 {$IF DEFINED(GLB_LAZ_JPEG)}
7193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7194 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7195 var
7196   jpeg: TJPEGImage;
7197   intf: TLazIntfImage;
7198   raw: TRawImage;
7199 begin
7200   jpeg := TJPEGImage.Create;
7201   intf := TLazIntfImage.Create(0, 0);
7202   try
7203     if not AssignToLazIntfImage(intf) then
7204       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7205     intf.GetRawImage(raw);
7206     jpeg.LoadFromRawImage(raw, false);
7207     jpeg.SaveToStream(aStream);
7208   finally
7209     intf.Free;
7210     jpeg.Free;
7211   end;
7212 end;
7213
7214 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7216 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7217 var
7218   jpeg: jpeg_compress_struct;
7219   jpeg_err: jpeg_error_mgr;
7220   Row: Integer;
7221   pTemp, pTemp2: pByte;
7222
7223   procedure CopyRow(pDest, pSource: pByte);
7224   var
7225     X: Integer;
7226   begin
7227     for X := 0 to Width - 1 do begin
7228       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7229       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7230       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7231       Inc(pDest, 3);
7232       Inc(pSource, 3);
7233     end;
7234   end;
7235
7236 begin
7237   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7238     raise EglBitmapUnsupportedFormat.Create(Format);
7239
7240   if not init_libJPEG then
7241     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7242
7243   try
7244     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7245     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7246
7247     // error managment
7248     jpeg.err := jpeg_std_error(@jpeg_err);
7249     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7250     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7251
7252     // compression struct
7253     jpeg_create_compress(@jpeg);
7254
7255     // allocation space for streaming methods
7256     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7257
7258     // seeting up custom functions
7259     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7260       pub.init_destination    := glBitmap_libJPEG_init_destination;
7261       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7262       pub.term_destination    := glBitmap_libJPEG_term_destination;
7263
7264       pub.next_output_byte  := @DestBuffer[1];
7265       pub.free_in_buffer    := Length(DestBuffer);
7266
7267       DestStream := aStream;
7268     end;
7269
7270     // very important state
7271     jpeg.global_state := CSTATE_START;
7272     jpeg.image_width  := Width;
7273     jpeg.image_height := Height;
7274     case Format of
7275       tfAlpha8ub1, tfLuminance8ub1: begin
7276         jpeg.input_components := 1;
7277         jpeg.in_color_space   := JCS_GRAYSCALE;
7278       end;
7279       tfRGB8ub3, tfBGR8ub3: begin
7280         jpeg.input_components := 3;
7281         jpeg.in_color_space   := JCS_RGB;
7282       end;
7283     end;
7284
7285     jpeg_set_defaults(@jpeg);
7286     jpeg_set_quality(@jpeg, 95, true);
7287     jpeg_start_compress(@jpeg, true);
7288     pTemp := Data;
7289
7290     if Format = tfBGR8ub3 then
7291       GetMem(pTemp2, fRowSize)
7292     else
7293       pTemp2 := pTemp;
7294
7295     try
7296       for Row := 0 to jpeg.image_height -1 do begin
7297         // prepare row
7298         if Format = tfBGR8ub3 then
7299           CopyRow(pTemp2, pTemp)
7300         else
7301           pTemp2 := pTemp;
7302
7303         // write row
7304         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7305         inc(pTemp, fRowSize);
7306       end;
7307     finally
7308       // free memory
7309       if Format = tfBGR8ub3 then
7310         FreeMem(pTemp2);
7311     end;
7312     jpeg_finish_compress(@jpeg);
7313     jpeg_destroy_compress(@jpeg);
7314   finally
7315     quit_libJPEG;
7316   end;
7317 end;
7318
7319 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7321 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7322 var
7323   Bmp: TBitmap;
7324   Jpg: TJPEGImage;
7325 begin
7326   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7327     raise EglBitmapUnsupportedFormat.Create(Format);
7328
7329   Bmp := TBitmap.Create;
7330   try
7331     Jpg := TJPEGImage.Create;
7332     try
7333       AssignToBitmap(Bmp);
7334       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7335         Jpg.Grayscale   := true;
7336         Jpg.PixelFormat := jf8Bit;
7337       end;
7338       Jpg.Assign(Bmp);
7339       Jpg.SaveToStream(aStream);
7340     finally
7341       FreeAndNil(Jpg);
7342     end;
7343   finally
7344     FreeAndNil(Bmp);
7345   end;
7346 end;
7347 {$IFEND}
7348 {$ENDIF}
7349
7350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7351 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7353 type
7354   RawHeader = packed record
7355     Magic:        String[5];
7356     Version:      Byte;
7357     Width:        Integer;
7358     Height:       Integer;
7359     DataSize:     Integer;
7360     BitsPerPixel: Integer;
7361     Precision:    TglBitmapRec4ub;
7362     Shift:        TglBitmapRec4ub;
7363   end;
7364
7365 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7366 var
7367   header: RawHeader;
7368   StartPos: Int64;
7369   fd: TFormatDescriptor;
7370   buf: PByte;
7371 begin
7372   result := false;
7373   StartPos := aStream.Position;
7374   aStream.Read(header{%H-}, SizeOf(header));
7375   if (header.Magic <> 'glBMP') then begin
7376     aStream.Position := StartPos;
7377     exit;
7378   end;
7379
7380   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7381   if (fd.Format = tfEmpty) then
7382     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7383
7384   buf := GetMemory(header.DataSize);
7385   aStream.Read(buf^, header.DataSize);
7386   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7387
7388   result := true;
7389 end;
7390
7391 procedure TglBitmap.SaveRAW(const aStream: TStream);
7392 var
7393   header: RawHeader;
7394   fd: TFormatDescriptor;
7395 begin
7396   fd := TFormatDescriptor.Get(Format);
7397   header.Magic        := 'glBMP';
7398   header.Version      := 1;
7399   header.Width        := Width;
7400   header.Height       := Height;
7401   header.DataSize     := fd.GetSize(fDimension);
7402   header.BitsPerPixel := fd.BitsPerPixel;
7403   header.Precision    := fd.Precision;
7404   header.Shift        := fd.Shift;
7405   aStream.Write(header, SizeOf(header));
7406   aStream.Write(Data^,  header.DataSize);
7407 end;
7408
7409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7410 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7412 const
7413   BMP_MAGIC          = $4D42;
7414
7415   BMP_COMP_RGB       = 0;
7416   BMP_COMP_RLE8      = 1;
7417   BMP_COMP_RLE4      = 2;
7418   BMP_COMP_BITFIELDS = 3;
7419
7420 type
7421   TBMPHeader = packed record
7422     bfType: Word;
7423     bfSize: Cardinal;
7424     bfReserved1: Word;
7425     bfReserved2: Word;
7426     bfOffBits: Cardinal;
7427   end;
7428
7429   TBMPInfo = packed record
7430     biSize: Cardinal;
7431     biWidth: Longint;
7432     biHeight: Longint;
7433     biPlanes: Word;
7434     biBitCount: Word;
7435     biCompression: Cardinal;
7436     biSizeImage: Cardinal;
7437     biXPelsPerMeter: Longint;
7438     biYPelsPerMeter: Longint;
7439     biClrUsed: Cardinal;
7440     biClrImportant: Cardinal;
7441   end;
7442
7443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7444 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7445
7446   //////////////////////////////////////////////////////////////////////////////////////////////////
7447   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7448   begin
7449     result := tfEmpty;
7450     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7451     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7452
7453     //Read Compression
7454     case aInfo.biCompression of
7455       BMP_COMP_RLE4,
7456       BMP_COMP_RLE8: begin
7457         raise EglBitmap.Create('RLE compression is not supported');
7458       end;
7459       BMP_COMP_BITFIELDS: begin
7460         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7461           aStream.Read(aMask.r, SizeOf(aMask.r));
7462           aStream.Read(aMask.g, SizeOf(aMask.g));
7463           aStream.Read(aMask.b, SizeOf(aMask.b));
7464           aStream.Read(aMask.a, SizeOf(aMask.a));
7465         end else
7466           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7467       end;
7468     end;
7469
7470     //get suitable format
7471     case aInfo.biBitCount of
7472        8: result := tfLuminance8ub1;
7473       16: result := tfX1RGB5us1;
7474       24: result := tfBGR8ub3;
7475       32: result := tfXRGB8ui1;
7476     end;
7477   end;
7478
7479   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7480   var
7481     i, c: Integer;
7482     ColorTable: TbmpColorTable;
7483   begin
7484     result := nil;
7485     if (aInfo.biBitCount >= 16) then
7486       exit;
7487     aFormat := tfLuminance8ub1;
7488     c := aInfo.biClrUsed;
7489     if (c = 0) then
7490       c := 1 shl aInfo.biBitCount;
7491     SetLength(ColorTable, c);
7492     for i := 0 to c-1 do begin
7493       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7494       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7495         aFormat := tfRGB8ub3;
7496     end;
7497
7498     result := TbmpColorTableFormat.Create;
7499     result.BitsPerPixel := aInfo.biBitCount;
7500     result.ColorTable   := ColorTable;
7501     result.CalcValues;
7502   end;
7503
7504   //////////////////////////////////////////////////////////////////////////////////////////////////
7505   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7506   var
7507     FormatDesc: TFormatDescriptor;
7508   begin
7509     result := nil;
7510     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7511       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7512       if (FormatDesc.Format = tfEmpty) then
7513         exit;
7514       aFormat := FormatDesc.Format;
7515       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7516         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7517       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7518         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7519
7520       result := TbmpBitfieldFormat.Create;
7521       result.SetCustomValues(aInfo.biBitCount, aMask);
7522     end;
7523   end;
7524
7525 var
7526   //simple types
7527   StartPos: Int64;
7528   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7529   PaddingBuff: Cardinal;
7530   LineBuf, ImageData, TmpData: PByte;
7531   SourceMD, DestMD: Pointer;
7532   BmpFormat: TglBitmapFormat;
7533
7534   //records
7535   Mask: TglBitmapRec4ul;
7536   Header: TBMPHeader;
7537   Info: TBMPInfo;
7538
7539   //classes
7540   SpecialFormat: TFormatDescriptor;
7541   FormatDesc: TFormatDescriptor;
7542
7543   //////////////////////////////////////////////////////////////////////////////////////////////////
7544   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7545   var
7546     i: Integer;
7547     Pixel: TglBitmapPixelData;
7548   begin
7549     aStream.Read(aLineBuf^, rbLineSize);
7550     SpecialFormat.PreparePixel(Pixel);
7551     for i := 0 to Info.biWidth-1 do begin
7552       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7553       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7554       FormatDesc.Map(Pixel, aData, DestMD);
7555     end;
7556   end;
7557
7558 begin
7559   result        := false;
7560   BmpFormat     := tfEmpty;
7561   SpecialFormat := nil;
7562   LineBuf       := nil;
7563   SourceMD      := nil;
7564   DestMD        := nil;
7565
7566   // Header
7567   StartPos := aStream.Position;
7568   aStream.Read(Header{%H-}, SizeOf(Header));
7569
7570   if Header.bfType = BMP_MAGIC then begin
7571     try try
7572       BmpFormat        := ReadInfo(Info, Mask);
7573       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7574       if not Assigned(SpecialFormat) then
7575         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7576       aStream.Position := StartPos + Header.bfOffBits;
7577
7578       if (BmpFormat <> tfEmpty) then begin
7579         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7580         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7581         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7582         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7583
7584         //get Memory
7585         DestMD    := FormatDesc.CreateMappingData;
7586         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7587         GetMem(ImageData, ImageSize);
7588         if Assigned(SpecialFormat) then begin
7589           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7590           SourceMD := SpecialFormat.CreateMappingData;
7591         end;
7592
7593         //read Data
7594         try try
7595           FillChar(ImageData^, ImageSize, $FF);
7596           TmpData := ImageData;
7597           if (Info.biHeight > 0) then
7598             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7599           for i := 0 to Abs(Info.biHeight)-1 do begin
7600             if Assigned(SpecialFormat) then
7601               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7602             else
7603               aStream.Read(TmpData^, wbLineSize);   //else only read data
7604             if (Info.biHeight > 0) then
7605               dec(TmpData, wbLineSize)
7606             else
7607               inc(TmpData, wbLineSize);
7608             aStream.Read(PaddingBuff{%H-}, Padding);
7609           end;
7610           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7611           result := true;
7612         finally
7613           if Assigned(LineBuf) then
7614             FreeMem(LineBuf);
7615           if Assigned(SourceMD) then
7616             SpecialFormat.FreeMappingData(SourceMD);
7617           FormatDesc.FreeMappingData(DestMD);
7618         end;
7619         except
7620           if Assigned(ImageData) then
7621             FreeMem(ImageData);
7622           raise;
7623         end;
7624       end else
7625         raise EglBitmap.Create('LoadBMP - No suitable format found');
7626     except
7627       aStream.Position := StartPos;
7628       raise;
7629     end;
7630     finally
7631       FreeAndNil(SpecialFormat);
7632     end;
7633   end
7634     else aStream.Position := StartPos;
7635 end;
7636
7637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7638 procedure TglBitmap.SaveBMP(const aStream: TStream);
7639 var
7640   Header: TBMPHeader;
7641   Info: TBMPInfo;
7642   Converter: TFormatDescriptor;
7643   FormatDesc: TFormatDescriptor;
7644   SourceFD, DestFD: Pointer;
7645   pData, srcData, dstData, ConvertBuffer: pByte;
7646
7647   Pixel: TglBitmapPixelData;
7648   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7649   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7650
7651   PaddingBuff: Cardinal;
7652
7653   function GetLineWidth : Integer;
7654   begin
7655     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7656   end;
7657
7658 begin
7659   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7660     raise EglBitmapUnsupportedFormat.Create(Format);
7661
7662   Converter  := nil;
7663   FormatDesc := TFormatDescriptor.Get(Format);
7664   ImageSize  := FormatDesc.GetSize(Dimension);
7665
7666   FillChar(Header{%H-}, SizeOf(Header), 0);
7667   Header.bfType      := BMP_MAGIC;
7668   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7669   Header.bfReserved1 := 0;
7670   Header.bfReserved2 := 0;
7671   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7672
7673   FillChar(Info{%H-}, SizeOf(Info), 0);
7674   Info.biSize        := SizeOf(Info);
7675   Info.biWidth       := Width;
7676   Info.biHeight      := Height;
7677   Info.biPlanes      := 1;
7678   Info.biCompression := BMP_COMP_RGB;
7679   Info.biSizeImage   := ImageSize;
7680
7681   try
7682     case Format of
7683       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7684       begin
7685         Info.biBitCount  :=  8;
7686         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7687         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7688         Converter := TbmpColorTableFormat.Create;
7689         with (Converter as TbmpColorTableFormat) do begin
7690           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7691           CreateColorTable;
7692         end;
7693       end;
7694
7695       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7696       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7697       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7698       begin
7699         Info.biBitCount    := 16;
7700         Info.biCompression := BMP_COMP_BITFIELDS;
7701       end;
7702
7703       tfBGR8ub3, tfRGB8ub3:
7704       begin
7705         Info.biBitCount := 24;
7706         if (Format = tfRGB8ub3) then
7707           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7708       end;
7709
7710       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7711       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7712       begin
7713         Info.biBitCount    := 32;
7714         Info.biCompression := BMP_COMP_BITFIELDS;
7715       end;
7716     else
7717       raise EglBitmapUnsupportedFormat.Create(Format);
7718     end;
7719     Info.biXPelsPerMeter := 2835;
7720     Info.biYPelsPerMeter := 2835;
7721
7722     // prepare bitmasks
7723     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7724       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7725       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7726
7727       RedMask    := FormatDesc.Mask.r;
7728       GreenMask  := FormatDesc.Mask.g;
7729       BlueMask   := FormatDesc.Mask.b;
7730       AlphaMask  := FormatDesc.Mask.a;
7731     end;
7732
7733     // headers
7734     aStream.Write(Header, SizeOf(Header));
7735     aStream.Write(Info, SizeOf(Info));
7736
7737     // colortable
7738     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7739       with (Converter as TbmpColorTableFormat) do
7740         aStream.Write(ColorTable[0].b,
7741           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7742
7743     // bitmasks
7744     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7745       aStream.Write(RedMask,   SizeOf(Cardinal));
7746       aStream.Write(GreenMask, SizeOf(Cardinal));
7747       aStream.Write(BlueMask,  SizeOf(Cardinal));
7748       aStream.Write(AlphaMask, SizeOf(Cardinal));
7749     end;
7750
7751     // image data
7752     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7753     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7754     Padding     := GetLineWidth - wbLineSize;
7755     PaddingBuff := 0;
7756
7757     pData := Data;
7758     inc(pData, (Height-1) * rbLineSize);
7759
7760     // prepare row buffer. But only for RGB because RGBA supports color masks
7761     // so it's possible to change color within the image.
7762     if Assigned(Converter) then begin
7763       FormatDesc.PreparePixel(Pixel);
7764       GetMem(ConvertBuffer, wbLineSize);
7765       SourceFD := FormatDesc.CreateMappingData;
7766       DestFD   := Converter.CreateMappingData;
7767     end else
7768       ConvertBuffer := nil;
7769
7770     try
7771       for LineIdx := 0 to Height - 1 do begin
7772         // preparing row
7773         if Assigned(Converter) then begin
7774           srcData := pData;
7775           dstData := ConvertBuffer;
7776           for PixelIdx := 0 to Info.biWidth-1 do begin
7777             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7778             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7779             Converter.Map(Pixel, dstData, DestFD);
7780           end;
7781           aStream.Write(ConvertBuffer^, wbLineSize);
7782         end else begin
7783           aStream.Write(pData^, rbLineSize);
7784         end;
7785         dec(pData, rbLineSize);
7786         if (Padding > 0) then
7787           aStream.Write(PaddingBuff, Padding);
7788       end;
7789     finally
7790       // destroy row buffer
7791       if Assigned(ConvertBuffer) then begin
7792         FormatDesc.FreeMappingData(SourceFD);
7793         Converter.FreeMappingData(DestFD);
7794         FreeMem(ConvertBuffer);
7795       end;
7796     end;
7797   finally
7798     if Assigned(Converter) then
7799       Converter.Free;
7800   end;
7801 end;
7802
7803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7804 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7806 type
7807   TTGAHeader = packed record
7808     ImageID: Byte;
7809     ColorMapType: Byte;
7810     ImageType: Byte;
7811     //ColorMapSpec: Array[0..4] of Byte;
7812     ColorMapStart: Word;
7813     ColorMapLength: Word;
7814     ColorMapEntrySize: Byte;
7815     OrigX: Word;
7816     OrigY: Word;
7817     Width: Word;
7818     Height: Word;
7819     Bpp: Byte;
7820     ImageDesc: Byte;
7821   end;
7822
7823 const
7824   TGA_UNCOMPRESSED_RGB  =  2;
7825   TGA_UNCOMPRESSED_GRAY =  3;
7826   TGA_COMPRESSED_RGB    = 10;
7827   TGA_COMPRESSED_GRAY   = 11;
7828
7829   TGA_NONE_COLOR_TABLE  = 0;
7830
7831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7832 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7833 var
7834   Header: TTGAHeader;
7835   ImageData: System.PByte;
7836   StartPosition: Int64;
7837   PixelSize, LineSize: Integer;
7838   tgaFormat: TglBitmapFormat;
7839   FormatDesc: TFormatDescriptor;
7840   Counter: packed record
7841     X, Y: packed record
7842       low, high, dir: Integer;
7843     end;
7844   end;
7845
7846 const
7847   CACHE_SIZE = $4000;
7848
7849   ////////////////////////////////////////////////////////////////////////////////////////
7850   procedure ReadUncompressed;
7851   var
7852     i, j: Integer;
7853     buf, tmp1, tmp2: System.PByte;
7854   begin
7855     buf := nil;
7856     if (Counter.X.dir < 0) then
7857       GetMem(buf, LineSize);
7858     try
7859       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7860         tmp1 := ImageData;
7861         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7862         if (Counter.X.dir < 0) then begin               //flip X
7863           aStream.Read(buf^, LineSize);
7864           tmp2 := buf;
7865           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7866           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7867             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7868               tmp1^ := tmp2^;
7869               inc(tmp1);
7870               inc(tmp2);
7871             end;
7872             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7873           end;
7874         end else
7875           aStream.Read(tmp1^, LineSize);
7876         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7877       end;
7878     finally
7879       if Assigned(buf) then
7880         FreeMem(buf);
7881     end;
7882   end;
7883
7884   ////////////////////////////////////////////////////////////////////////////////////////
7885   procedure ReadCompressed;
7886
7887     /////////////////////////////////////////////////////////////////
7888     var
7889       TmpData: System.PByte;
7890       LinePixelsRead: Integer;
7891     procedure CheckLine;
7892     begin
7893       if (LinePixelsRead >= Header.Width) then begin
7894         LinePixelsRead := 0;
7895         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7896         TmpData := ImageData;
7897         inc(TmpData, Counter.Y.low * LineSize);           //set line
7898         if (Counter.X.dir < 0) then                       //if x flipped then
7899           inc(TmpData, LineSize - PixelSize);             //set last pixel
7900       end;
7901     end;
7902
7903     /////////////////////////////////////////////////////////////////
7904     var
7905       Cache: PByte;
7906       CacheSize, CachePos: Integer;
7907     procedure CachedRead(out Buffer; Count: Integer);
7908     var
7909       BytesRead: Integer;
7910     begin
7911       if (CachePos + Count > CacheSize) then begin
7912         //if buffer overflow save non read bytes
7913         BytesRead := 0;
7914         if (CacheSize - CachePos > 0) then begin
7915           BytesRead := CacheSize - CachePos;
7916           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7917           inc(CachePos, BytesRead);
7918         end;
7919
7920         //load cache from file
7921         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7922         aStream.Read(Cache^, CacheSize);
7923         CachePos := 0;
7924
7925         //read rest of requested bytes
7926         if (Count - BytesRead > 0) then begin
7927           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7928           inc(CachePos, Count - BytesRead);
7929         end;
7930       end else begin
7931         //if no buffer overflow just read the data
7932         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7933         inc(CachePos, Count);
7934       end;
7935     end;
7936
7937     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7938     begin
7939       case PixelSize of
7940         1: begin
7941           aBuffer^ := aData^;
7942           inc(aBuffer, Counter.X.dir);
7943         end;
7944         2: begin
7945           PWord(aBuffer)^ := PWord(aData)^;
7946           inc(aBuffer, 2 * Counter.X.dir);
7947         end;
7948         3: begin
7949           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7950           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7951           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7952           inc(aBuffer, 3 * Counter.X.dir);
7953         end;
7954         4: begin
7955           PCardinal(aBuffer)^ := PCardinal(aData)^;
7956           inc(aBuffer, 4 * Counter.X.dir);
7957         end;
7958       end;
7959     end;
7960
7961   var
7962     TotalPixelsToRead, TotalPixelsRead: Integer;
7963     Temp: Byte;
7964     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7965     PixelRepeat: Boolean;
7966     PixelsToRead, PixelCount: Integer;
7967   begin
7968     CacheSize := 0;
7969     CachePos  := 0;
7970
7971     TotalPixelsToRead := Header.Width * Header.Height;
7972     TotalPixelsRead   := 0;
7973     LinePixelsRead    := 0;
7974
7975     GetMem(Cache, CACHE_SIZE);
7976     try
7977       TmpData := ImageData;
7978       inc(TmpData, Counter.Y.low * LineSize);           //set line
7979       if (Counter.X.dir < 0) then                       //if x flipped then
7980         inc(TmpData, LineSize - PixelSize);             //set last pixel
7981
7982       repeat
7983         //read CommandByte
7984         CachedRead(Temp, 1);
7985         PixelRepeat  := (Temp and $80) > 0;
7986         PixelsToRead := (Temp and $7F) + 1;
7987         inc(TotalPixelsRead, PixelsToRead);
7988
7989         if PixelRepeat then
7990           CachedRead(buf[0], PixelSize);
7991         while (PixelsToRead > 0) do begin
7992           CheckLine;
7993           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7994           while (PixelCount > 0) do begin
7995             if not PixelRepeat then
7996               CachedRead(buf[0], PixelSize);
7997             PixelToBuffer(@buf[0], TmpData);
7998             inc(LinePixelsRead);
7999             dec(PixelsToRead);
8000             dec(PixelCount);
8001           end;
8002         end;
8003       until (TotalPixelsRead >= TotalPixelsToRead);
8004     finally
8005       FreeMem(Cache);
8006     end;
8007   end;
8008
8009   function IsGrayFormat: Boolean;
8010   begin
8011     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
8012   end;
8013
8014 begin
8015   result := false;
8016
8017   // reading header to test file and set cursor back to begin
8018   StartPosition := aStream.Position;
8019   aStream.Read(Header{%H-}, SizeOf(Header));
8020
8021   // no colormapped files
8022   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
8023     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
8024   begin
8025     try
8026       if Header.ImageID <> 0 then       // skip image ID
8027         aStream.Position := aStream.Position + Header.ImageID;
8028
8029       tgaFormat := tfEmpty;
8030       case Header.Bpp of
8031          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
8032                0: tgaFormat := tfLuminance8ub1;
8033                8: tgaFormat := tfAlpha8ub1;
8034             end;
8035
8036         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
8037                0: tgaFormat := tfLuminance16us1;
8038                8: tgaFormat := tfLuminance8Alpha8ub2;
8039             end else case (Header.ImageDesc and $F) of
8040                0: tgaFormat := tfX1RGB5us1;
8041                1: tgaFormat := tfA1RGB5us1;
8042                4: tgaFormat := tfARGB4us1;
8043             end;
8044
8045         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
8046                0: tgaFormat := tfBGR8ub3;
8047             end;
8048
8049         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
8050                0: tgaFormat := tfDepth32ui1;
8051             end else case (Header.ImageDesc and $F) of
8052                0: tgaFormat := tfX2RGB10ui1;
8053                2: tgaFormat := tfA2RGB10ui1;
8054                8: tgaFormat := tfARGB8ui1;
8055             end;
8056       end;
8057
8058       if (tgaFormat = tfEmpty) then
8059         raise EglBitmap.Create('LoadTga - unsupported format');
8060
8061       FormatDesc := TFormatDescriptor.Get(tgaFormat);
8062       PixelSize  := FormatDesc.GetSize(1, 1);
8063       LineSize   := FormatDesc.GetSize(Header.Width, 1);
8064
8065       GetMem(ImageData, LineSize * Header.Height);
8066       try
8067         //column direction
8068         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
8069           Counter.X.low  := Header.Height-1;;
8070           Counter.X.high := 0;
8071           Counter.X.dir  := -1;
8072         end else begin
8073           Counter.X.low  := 0;
8074           Counter.X.high := Header.Height-1;
8075           Counter.X.dir  := 1;
8076         end;
8077
8078         // Row direction
8079         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
8080           Counter.Y.low  := 0;
8081           Counter.Y.high := Header.Height-1;
8082           Counter.Y.dir  := 1;
8083         end else begin
8084           Counter.Y.low  := Header.Height-1;;
8085           Counter.Y.high := 0;
8086           Counter.Y.dir  := -1;
8087         end;
8088
8089         // Read Image
8090         case Header.ImageType of
8091           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
8092             ReadUncompressed;
8093           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
8094             ReadCompressed;
8095         end;
8096
8097         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
8098         result := true;
8099       except
8100         if Assigned(ImageData) then
8101           FreeMem(ImageData);
8102         raise;
8103       end;
8104     finally
8105       aStream.Position := StartPosition;
8106     end;
8107   end
8108     else aStream.Position := StartPosition;
8109 end;
8110
8111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8112 procedure TglBitmap.SaveTGA(const aStream: TStream);
8113 var
8114   Header: TTGAHeader;
8115   Size: Integer;
8116   FormatDesc: TFormatDescriptor;
8117 begin
8118   if not (ftTGA in FormatGetSupportedFiles(Format)) then
8119     raise EglBitmapUnsupportedFormat.Create(Format);
8120
8121   //prepare header
8122   FormatDesc := TFormatDescriptor.Get(Format);
8123   FillChar(Header{%H-}, SizeOf(Header), 0);
8124   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
8125   Header.Bpp       := FormatDesc.BitsPerPixel;
8126   Header.Width     := Width;
8127   Header.Height    := Height;
8128   Header.ImageDesc := Header.ImageDesc or $20; //flip y
8129   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
8130     Header.ImageType := TGA_UNCOMPRESSED_GRAY
8131   else
8132     Header.ImageType := TGA_UNCOMPRESSED_RGB;
8133   aStream.Write(Header, SizeOf(Header));
8134
8135   // write Data
8136   Size := FormatDesc.GetSize(Dimension);
8137   aStream.Write(Data^, Size);
8138 end;
8139
8140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8141 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8143 const
8144   DDS_MAGIC: Cardinal         = $20534444;
8145
8146   // DDS_header.dwFlags
8147   DDSD_CAPS                   = $00000001;
8148   DDSD_HEIGHT                 = $00000002;
8149   DDSD_WIDTH                  = $00000004;
8150   DDSD_PIXELFORMAT            = $00001000;
8151
8152   // DDS_header.sPixelFormat.dwFlags
8153   DDPF_ALPHAPIXELS            = $00000001;
8154   DDPF_ALPHA                  = $00000002;
8155   DDPF_FOURCC                 = $00000004;
8156   DDPF_RGB                    = $00000040;
8157   DDPF_LUMINANCE              = $00020000;
8158
8159   // DDS_header.sCaps.dwCaps1
8160   DDSCAPS_TEXTURE             = $00001000;
8161
8162   // DDS_header.sCaps.dwCaps2
8163   DDSCAPS2_CUBEMAP            = $00000200;
8164
8165   D3DFMT_DXT1                 = $31545844;
8166   D3DFMT_DXT3                 = $33545844;
8167   D3DFMT_DXT5                 = $35545844;
8168
8169 type
8170   TDDSPixelFormat = packed record
8171     dwSize: Cardinal;
8172     dwFlags: Cardinal;
8173     dwFourCC: Cardinal;
8174     dwRGBBitCount: Cardinal;
8175     dwRBitMask: Cardinal;
8176     dwGBitMask: Cardinal;
8177     dwBBitMask: Cardinal;
8178     dwABitMask: Cardinal;
8179   end;
8180
8181   TDDSCaps = packed record
8182     dwCaps1: Cardinal;
8183     dwCaps2: Cardinal;
8184     dwDDSX: Cardinal;
8185     dwReserved: Cardinal;
8186   end;
8187
8188   TDDSHeader = packed record
8189     dwSize: Cardinal;
8190     dwFlags: Cardinal;
8191     dwHeight: Cardinal;
8192     dwWidth: Cardinal;
8193     dwPitchOrLinearSize: Cardinal;
8194     dwDepth: Cardinal;
8195     dwMipMapCount: Cardinal;
8196     dwReserved: array[0..10] of Cardinal;
8197     PixelFormat: TDDSPixelFormat;
8198     Caps: TDDSCaps;
8199     dwReserved2: Cardinal;
8200   end;
8201
8202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8203 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8204 var
8205   Header: TDDSHeader;
8206   Converter: TbmpBitfieldFormat;
8207
8208   function GetDDSFormat: TglBitmapFormat;
8209   var
8210     fd: TFormatDescriptor;
8211     i: Integer;
8212     Mask: TglBitmapRec4ul;
8213     Range: TglBitmapRec4ui;
8214     match: Boolean;
8215   begin
8216     result := tfEmpty;
8217     with Header.PixelFormat do begin
8218       // Compresses
8219       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8220         case Header.PixelFormat.dwFourCC of
8221           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8222           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8223           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8224         end;
8225       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
8226         // prepare masks
8227         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8228           Mask.r := dwRBitMask;
8229           Mask.g := dwGBitMask;
8230           Mask.b := dwBBitMask;
8231         end else begin
8232           Mask.r := dwRBitMask;
8233           Mask.g := dwRBitMask;
8234           Mask.b := dwRBitMask;
8235         end;
8236         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
8237           Mask.a := dwABitMask
8238         else
8239           Mask.a := 0;;
8240
8241         //find matching format
8242         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
8243         result := fd.Format;
8244         if (result <> tfEmpty) then
8245           exit;
8246
8247         //find format with same Range
8248         for i := 0 to 3 do
8249           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
8250         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8251           fd := TFormatDescriptor.Get(result);
8252           match := true;
8253           for i := 0 to 3 do
8254             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8255               match := false;
8256               break;
8257             end;
8258           if match then
8259             break;
8260         end;
8261
8262         //no format with same range found -> use default
8263         if (result = tfEmpty) then begin
8264           if (dwABitMask > 0) then
8265             result := tfRGBA8ui1
8266           else
8267             result := tfRGB8ub3;
8268         end;
8269
8270         Converter := TbmpBitfieldFormat.Create;
8271         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
8272       end;
8273     end;
8274   end;
8275
8276 var
8277   StreamPos: Int64;
8278   x, y, LineSize, RowSize, Magic: Cardinal;
8279   NewImage, TmpData, RowData, SrcData: System.PByte;
8280   SourceMD, DestMD: Pointer;
8281   Pixel: TglBitmapPixelData;
8282   ddsFormat: TglBitmapFormat;
8283   FormatDesc: TFormatDescriptor;
8284
8285 begin
8286   result    := false;
8287   Converter := nil;
8288   StreamPos := aStream.Position;
8289
8290   // Magic
8291   aStream.Read(Magic{%H-}, sizeof(Magic));
8292   if (Magic <> DDS_MAGIC) then begin
8293     aStream.Position := StreamPos;
8294     exit;
8295   end;
8296
8297   //Header
8298   aStream.Read(Header{%H-}, sizeof(Header));
8299   if (Header.dwSize <> SizeOf(Header)) or
8300      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8301         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8302   begin
8303     aStream.Position := StreamPos;
8304     exit;
8305   end;
8306
8307   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8308     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8309
8310   ddsFormat := GetDDSFormat;
8311   try
8312     if (ddsFormat = tfEmpty) then
8313       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8314
8315     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8316     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8317     GetMem(NewImage, Header.dwHeight * LineSize);
8318     try
8319       TmpData := NewImage;
8320
8321       //Converter needed
8322       if Assigned(Converter) then begin
8323         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8324         GetMem(RowData, RowSize);
8325         SourceMD := Converter.CreateMappingData;
8326         DestMD   := FormatDesc.CreateMappingData;
8327         try
8328           for y := 0 to Header.dwHeight-1 do begin
8329             TmpData := NewImage;
8330             inc(TmpData, y * LineSize);
8331             SrcData := RowData;
8332             aStream.Read(SrcData^, RowSize);
8333             for x := 0 to Header.dwWidth-1 do begin
8334               Converter.Unmap(SrcData, Pixel, SourceMD);
8335               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8336               FormatDesc.Map(Pixel, TmpData, DestMD);
8337             end;
8338           end;
8339         finally
8340           Converter.FreeMappingData(SourceMD);
8341           FormatDesc.FreeMappingData(DestMD);
8342           FreeMem(RowData);
8343         end;
8344       end else
8345
8346       // Compressed
8347       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8348         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8349         for Y := 0 to Header.dwHeight-1 do begin
8350           aStream.Read(TmpData^, RowSize);
8351           Inc(TmpData, LineSize);
8352         end;
8353       end else
8354
8355       // Uncompressed
8356       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8357         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8358         for Y := 0 to Header.dwHeight-1 do begin
8359           aStream.Read(TmpData^, RowSize);
8360           Inc(TmpData, LineSize);
8361         end;
8362       end else
8363         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8364
8365       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8366       result := true;
8367     except
8368       if Assigned(NewImage) then
8369         FreeMem(NewImage);
8370       raise;
8371     end;
8372   finally
8373     FreeAndNil(Converter);
8374   end;
8375 end;
8376
8377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8378 procedure TglBitmap.SaveDDS(const aStream: TStream);
8379 var
8380   Header: TDDSHeader;
8381   FormatDesc: TFormatDescriptor;
8382 begin
8383   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8384     raise EglBitmapUnsupportedFormat.Create(Format);
8385
8386   FormatDesc := TFormatDescriptor.Get(Format);
8387
8388   // Generell
8389   FillChar(Header{%H-}, SizeOf(Header), 0);
8390   Header.dwSize  := SizeOf(Header);
8391   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8392
8393   Header.dwWidth  := Max(1, Width);
8394   Header.dwHeight := Max(1, Height);
8395
8396   // Caps
8397   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8398
8399   // Pixelformat
8400   Header.PixelFormat.dwSize := sizeof(Header);
8401   if (FormatDesc.IsCompressed) then begin
8402     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8403     case Format of
8404       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8405       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8406       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8407     end;
8408   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8409     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8410     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8411     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8412   end else if FormatDesc.IsGrayscale then begin
8413     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8414     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8415     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8416     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8417   end else begin
8418     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8419     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8420     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8421     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8422     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8423     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8424   end;
8425
8426   if (FormatDesc.HasAlpha) then
8427     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8428
8429   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8430   aStream.Write(Header, SizeOf(Header));
8431   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8432 end;
8433
8434 {$IFNDEF OPENGL_ES}
8435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8436 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8438 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8439   const aWidth: Integer; const aHeight: Integer);
8440 var
8441   pTemp: pByte;
8442   Size: Integer;
8443 begin
8444   if (aHeight > 1) then begin
8445     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8446     GetMem(pTemp, Size);
8447     try
8448       Move(aData^, pTemp^, Size);
8449       FreeMem(aData);
8450       aData := nil;
8451     except
8452       FreeMem(pTemp);
8453       raise;
8454     end;
8455   end else
8456     pTemp := aData;
8457   inherited SetDataPointer(pTemp, aFormat, aWidth);
8458 end;
8459
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 function TglBitmap1D.FlipHorz: Boolean;
8462 var
8463   Col: Integer;
8464   pTempDest, pDest, pSource: PByte;
8465 begin
8466   result := inherited FlipHorz;
8467   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8468     pSource := Data;
8469     GetMem(pDest, fRowSize);
8470     try
8471       pTempDest := pDest;
8472       Inc(pTempDest, fRowSize);
8473       for Col := 0 to Width-1 do begin
8474         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8475         Move(pSource^, pTempDest^, fPixelSize);
8476         Inc(pSource, fPixelSize);
8477       end;
8478       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8479       result := true;
8480     except
8481       if Assigned(pDest) then
8482         FreeMem(pDest);
8483       raise;
8484     end;
8485   end;
8486 end;
8487
8488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8489 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8490 var
8491   FormatDesc: TFormatDescriptor;
8492 begin
8493   // Upload data
8494   FormatDesc := TFormatDescriptor.Get(Format);
8495   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8496     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8497
8498   if FormatDesc.IsCompressed then begin
8499     if not Assigned(glCompressedTexImage1D) then
8500       raise EglBitmap.Create('compressed formats not supported by video adapter');
8501     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8502   end else if aBuildWithGlu then
8503     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8504   else
8505     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8506
8507   // Free Data
8508   if (FreeDataAfterGenTexture) then
8509     FreeData;
8510 end;
8511
8512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8513 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8514 var
8515   BuildWithGlu, TexRec: Boolean;
8516   TexSize: Integer;
8517 begin
8518   if Assigned(Data) then begin
8519     // Check Texture Size
8520     if (aTestTextureSize) then begin
8521       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8522
8523       if (Width > TexSize) then
8524         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8525
8526       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8527                 (Target = GL_TEXTURE_RECTANGLE);
8528       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8529         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8530     end;
8531
8532     CreateId;
8533     SetupParameters(BuildWithGlu);
8534     UploadData(BuildWithGlu);
8535     glAreTexturesResident(1, @fID, @fIsResident);
8536   end;
8537 end;
8538
8539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8540 procedure TglBitmap1D.AfterConstruction;
8541 begin
8542   inherited;
8543   Target := GL_TEXTURE_1D;
8544 end;
8545 {$ENDIF}
8546
8547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8548 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8550 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8551 begin
8552   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8553     result := fLines[aIndex]
8554   else
8555     result := nil;
8556 end;
8557
8558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8559 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8560   const aWidth: Integer; const aHeight: Integer);
8561 var
8562   Idx, LineWidth: Integer;
8563 begin
8564   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8565
8566   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8567     // Assigning Data
8568     if Assigned(Data) then begin
8569       SetLength(fLines, GetHeight);
8570       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8571
8572       for Idx := 0 to GetHeight-1 do begin
8573         fLines[Idx] := Data;
8574         Inc(fLines[Idx], Idx * LineWidth);
8575       end;
8576     end
8577       else SetLength(fLines, 0);
8578   end else begin
8579     SetLength(fLines, 0);
8580   end;
8581 end;
8582
8583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8584 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8585 var
8586   FormatDesc: TFormatDescriptor;
8587 begin
8588   FormatDesc := TFormatDescriptor.Get(Format);
8589   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8590     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8591
8592   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8593
8594   if FormatDesc.IsCompressed then begin
8595     if not Assigned(glCompressedTexImage2D) then
8596       raise EglBitmap.Create('compressed formats not supported by video adapter');
8597     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8598 {$IFNDEF OPENGL_ES}
8599   end else if aBuildWithGlu then begin
8600     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8601       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8602 {$ENDIF}
8603   end else begin
8604     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8605       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8606   end;
8607
8608   // Freigeben
8609   if (FreeDataAfterGenTexture) then
8610     FreeData;
8611 end;
8612
8613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8614 procedure TglBitmap2D.AfterConstruction;
8615 begin
8616   inherited;
8617   Target := GL_TEXTURE_2D;
8618 end;
8619
8620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8621 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8622 var
8623   Temp: pByte;
8624   Size, w, h: Integer;
8625   FormatDesc: TFormatDescriptor;
8626 begin
8627   FormatDesc := TFormatDescriptor.Get(aFormat);
8628   if FormatDesc.IsCompressed then
8629     raise EglBitmapUnsupportedFormat.Create(aFormat);
8630
8631   w    := aRight  - aLeft;
8632   h    := aBottom - aTop;
8633   Size := FormatDesc.GetSize(w, h);
8634   GetMem(Temp, Size);
8635   try
8636     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8637     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8638     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8639     FlipVert;
8640   except
8641     if Assigned(Temp) then
8642       FreeMem(Temp);
8643     raise;
8644   end;
8645 end;
8646
8647 {$IFNDEF OPENGL_ES}
8648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8649 procedure TglBitmap2D.GetDataFromTexture;
8650 var
8651   Temp: PByte;
8652   TempWidth, TempHeight: Integer;
8653   TempIntFormat: GLint;
8654   IntFormat: TglBitmapFormat;
8655   FormatDesc: TFormatDescriptor;
8656 begin
8657   Bind;
8658
8659   // Request Data
8660   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8661   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8662   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8663
8664   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8665   IntFormat  := FormatDesc.Format;
8666
8667   // Getting data from OpenGL
8668   FormatDesc := TFormatDescriptor.Get(IntFormat);
8669   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8670   try
8671     if FormatDesc.IsCompressed then begin
8672       if not Assigned(glGetCompressedTexImage) then
8673         raise EglBitmap.Create('compressed formats not supported by video adapter');
8674       glGetCompressedTexImage(Target, 0, Temp)
8675     end else
8676       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8677     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8678   except
8679     if Assigned(Temp) then
8680       FreeMem(Temp);
8681     raise;
8682   end;
8683 end;
8684 {$ENDIF}
8685
8686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8687 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8688 var
8689   {$IFNDEF OPENGL_ES}
8690   BuildWithGlu, TexRec: Boolean;
8691   {$ENDIF}
8692   PotTex: Boolean;
8693   TexSize: Integer;
8694 begin
8695   if Assigned(Data) then begin
8696     // Check Texture Size
8697     if (aTestTextureSize) then begin
8698       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8699
8700       if ((Height > TexSize) or (Width > TexSize)) then
8701         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8702
8703       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8704 {$IF NOT DEFINED(OPENGL_ES)}
8705       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8706       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8707         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8708 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8709       if not PotTex and not GL_OES_texture_npot then
8710         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8711 {$ELSE}
8712       if not PotTex then
8713         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8714 {$IFEND}
8715     end;
8716
8717     CreateId;
8718     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8719     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8720 {$IFNDEF OPENGL_ES}
8721     glAreTexturesResident(1, @fID, @fIsResident);
8722 {$ENDIF}
8723   end;
8724 end;
8725
8726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8727 function TglBitmap2D.FlipHorz: Boolean;
8728 var
8729   Col, Row: Integer;
8730   TempDestData, DestData, SourceData: PByte;
8731   ImgSize: Integer;
8732 begin
8733   result := inherited FlipHorz;
8734   if Assigned(Data) then begin
8735     SourceData := Data;
8736     ImgSize := Height * fRowSize;
8737     GetMem(DestData, ImgSize);
8738     try
8739       TempDestData := DestData;
8740       Dec(TempDestData, fRowSize + fPixelSize);
8741       for Row := 0 to Height -1 do begin
8742         Inc(TempDestData, fRowSize * 2);
8743         for Col := 0 to Width -1 do begin
8744           Move(SourceData^, TempDestData^, fPixelSize);
8745           Inc(SourceData, fPixelSize);
8746           Dec(TempDestData, fPixelSize);
8747         end;
8748       end;
8749       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8750       result := true;
8751     except
8752       if Assigned(DestData) then
8753         FreeMem(DestData);
8754       raise;
8755     end;
8756   end;
8757 end;
8758
8759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8760 function TglBitmap2D.FlipVert: Boolean;
8761 var
8762   Row: Integer;
8763   TempDestData, DestData, SourceData: PByte;
8764 begin
8765   result := inherited FlipVert;
8766   if Assigned(Data) then begin
8767     SourceData := Data;
8768     GetMem(DestData, Height * fRowSize);
8769     try
8770       TempDestData := DestData;
8771       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8772       for Row := 0 to Height -1 do begin
8773         Move(SourceData^, TempDestData^, fRowSize);
8774         Dec(TempDestData, fRowSize);
8775         Inc(SourceData, fRowSize);
8776       end;
8777       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8778       result := true;
8779     except
8780       if Assigned(DestData) then
8781         FreeMem(DestData);
8782       raise;
8783     end;
8784   end;
8785 end;
8786
8787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8788 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8790 type
8791   TMatrixItem = record
8792     X, Y: Integer;
8793     W: Single;
8794   end;
8795
8796   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8797   TglBitmapToNormalMapRec = Record
8798     Scale: Single;
8799     Heights: array of Single;
8800     MatrixU : array of TMatrixItem;
8801     MatrixV : array of TMatrixItem;
8802   end;
8803
8804 const
8805   ONE_OVER_255 = 1 / 255;
8806
8807   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8808 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8809 var
8810   Val: Single;
8811 begin
8812   with FuncRec do begin
8813     Val :=
8814       Source.Data.r * LUMINANCE_WEIGHT_R +
8815       Source.Data.g * LUMINANCE_WEIGHT_G +
8816       Source.Data.b * LUMINANCE_WEIGHT_B;
8817     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8818   end;
8819 end;
8820
8821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8822 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8823 begin
8824   with FuncRec do
8825     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8826 end;
8827
8828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8829 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8830 type
8831   TVec = Array[0..2] of Single;
8832 var
8833   Idx: Integer;
8834   du, dv: Double;
8835   Len: Single;
8836   Vec: TVec;
8837
8838   function GetHeight(X, Y: Integer): Single;
8839   begin
8840     with FuncRec do begin
8841       X := Max(0, Min(Size.X -1, X));
8842       Y := Max(0, Min(Size.Y -1, Y));
8843       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8844     end;
8845   end;
8846
8847 begin
8848   with FuncRec do begin
8849     with PglBitmapToNormalMapRec(Args)^ do begin
8850       du := 0;
8851       for Idx := Low(MatrixU) to High(MatrixU) do
8852         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8853
8854       dv := 0;
8855       for Idx := Low(MatrixU) to High(MatrixU) do
8856         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8857
8858       Vec[0] := -du * Scale;
8859       Vec[1] := -dv * Scale;
8860       Vec[2] := 1;
8861     end;
8862
8863     // Normalize
8864     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8865     if Len <> 0 then begin
8866       Vec[0] := Vec[0] * Len;
8867       Vec[1] := Vec[1] * Len;
8868       Vec[2] := Vec[2] * Len;
8869     end;
8870
8871     // Farbe zuweisem
8872     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8873     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8874     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8875   end;
8876 end;
8877
8878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8879 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8880 var
8881   Rec: TglBitmapToNormalMapRec;
8882
8883   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8884   begin
8885     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8886       Matrix[Index].X := X;
8887       Matrix[Index].Y := Y;
8888       Matrix[Index].W := W;
8889     end;
8890   end;
8891
8892 begin
8893   if TFormatDescriptor.Get(Format).IsCompressed then
8894     raise EglBitmapUnsupportedFormat.Create(Format);
8895
8896   if aScale > 100 then
8897     Rec.Scale := 100
8898   else if aScale < -100 then
8899     Rec.Scale := -100
8900   else
8901     Rec.Scale := aScale;
8902
8903   SetLength(Rec.Heights, Width * Height);
8904   try
8905     case aFunc of
8906       nm4Samples: begin
8907         SetLength(Rec.MatrixU, 2);
8908         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8909         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8910
8911         SetLength(Rec.MatrixV, 2);
8912         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8913         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8914       end;
8915
8916       nmSobel: begin
8917         SetLength(Rec.MatrixU, 6);
8918         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8919         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8920         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8921         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8922         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8923         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8924
8925         SetLength(Rec.MatrixV, 6);
8926         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8927         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8928         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8929         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8930         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8931         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8932       end;
8933
8934       nm3x3: begin
8935         SetLength(Rec.MatrixU, 6);
8936         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8937         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8938         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8939         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8940         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8941         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8942
8943         SetLength(Rec.MatrixV, 6);
8944         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8945         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8946         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8947         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8948         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8949         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8950       end;
8951
8952       nm5x5: begin
8953         SetLength(Rec.MatrixU, 20);
8954         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8955         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8956         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8957         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8958         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8959         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8960         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8961         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8962         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8963         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8964         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8965         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8966         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8967         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8968         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8969         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8970         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8971         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8972         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8973         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8974
8975         SetLength(Rec.MatrixV, 20);
8976         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8977         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8978         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8979         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8980         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8981         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8982         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8983         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8984         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8985         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8986         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8987         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8988         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8989         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8990         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8991         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8992         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8993         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8994         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8995         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8996       end;
8997     end;
8998
8999     // Daten Sammeln
9000     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
9001       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
9002     else
9003       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
9004     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
9005   finally
9006     SetLength(Rec.Heights, 0);
9007   end;
9008 end;
9009
9010 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9012 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9014 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
9015 begin
9016   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
9017 end;
9018
9019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9020 procedure TglBitmapCubeMap.AfterConstruction;
9021 begin
9022   inherited;
9023
9024 {$IFNDEF OPENGL_ES}
9025   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
9026     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9027 {$ELSE}
9028   if not (GL_VERSION_2_0) then
9029     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9030 {$ENDIF}
9031
9032   SetWrap;
9033   Target   := GL_TEXTURE_CUBE_MAP;
9034 {$IFNDEF OPENGL_ES}
9035   fGenMode := GL_REFLECTION_MAP;
9036 {$ENDIF}
9037 end;
9038
9039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9040 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
9041 var
9042   {$IFNDEF OPENGL_ES}
9043   BuildWithGlu: Boolean;
9044   {$ENDIF}
9045   TexSize: Integer;
9046 begin
9047   if (aTestTextureSize) then begin
9048     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
9049
9050     if (Height > TexSize) or (Width > TexSize) then
9051       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
9052
9053 {$IF NOT DEFINED(OPENGL_ES)}
9054     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
9055       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9056 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
9057     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
9058       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9059 {$ELSE}
9060     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
9061       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9062 {$IFEND}
9063   end;
9064
9065   if (ID = 0) then
9066     CreateID;
9067   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
9068   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
9069 end;
9070
9071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9072 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
9073 begin
9074   inherited Bind (aEnableTextureUnit);
9075 {$IFNDEF OPENGL_ES}
9076   if aEnableTexCoordsGen then begin
9077     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
9078     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
9079     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
9080     glEnable(GL_TEXTURE_GEN_S);
9081     glEnable(GL_TEXTURE_GEN_T);
9082     glEnable(GL_TEXTURE_GEN_R);
9083   end;
9084 {$ENDIF}
9085 end;
9086
9087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9088 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
9089 begin
9090   inherited Unbind(aDisableTextureUnit);
9091 {$IFNDEF OPENGL_ES}
9092   if aDisableTexCoordsGen then begin
9093     glDisable(GL_TEXTURE_GEN_S);
9094     glDisable(GL_TEXTURE_GEN_T);
9095     glDisable(GL_TEXTURE_GEN_R);
9096   end;
9097 {$ENDIF}
9098 end;
9099 {$IFEND}
9100
9101 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9103 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9105 type
9106   TVec = Array[0..2] of Single;
9107   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9108
9109   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
9110   TglBitmapNormalMapRec = record
9111     HalfSize : Integer;
9112     Func: TglBitmapNormalMapGetVectorFunc;
9113   end;
9114
9115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9116 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9117 begin
9118   aVec[0] := aHalfSize;
9119   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9120   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
9121 end;
9122
9123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9124 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9125 begin
9126   aVec[0] := - aHalfSize;
9127   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9128   aVec[2] := aPosition.X + 0.5 - aHalfSize;
9129 end;
9130
9131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9132 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9133 begin
9134   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9135   aVec[1] := aHalfSize;
9136   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
9137 end;
9138
9139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9140 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9141 begin
9142   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9143   aVec[1] := - aHalfSize;
9144   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
9145 end;
9146
9147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9148 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9149 begin
9150   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9151   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9152   aVec[2] := aHalfSize;
9153 end;
9154
9155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9156 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9157 begin
9158   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
9159   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9160   aVec[2] := - aHalfSize;
9161 end;
9162
9163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9164 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
9165 var
9166   i: Integer;
9167   Vec: TVec;
9168   Len: Single;
9169 begin
9170   with FuncRec do begin
9171     with PglBitmapNormalMapRec(Args)^ do begin
9172       Func(Vec, Position, HalfSize);
9173
9174       // Normalize
9175       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9176       if Len <> 0 then begin
9177         Vec[0] := Vec[0] * Len;
9178         Vec[1] := Vec[1] * Len;
9179         Vec[2] := Vec[2] * Len;
9180       end;
9181
9182       // Scale Vector and AddVectro
9183       Vec[0] := Vec[0] * 0.5 + 0.5;
9184       Vec[1] := Vec[1] * 0.5 + 0.5;
9185       Vec[2] := Vec[2] * 0.5 + 0.5;
9186     end;
9187
9188     // Set Color
9189     for i := 0 to 2 do
9190       Dest.Data.arr[i] := Round(Vec[i] * 255);
9191   end;
9192 end;
9193
9194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9195 procedure TglBitmapNormalMap.AfterConstruction;
9196 begin
9197   inherited;
9198 {$IFNDEF OPENGL_ES}
9199   fGenMode := GL_NORMAL_MAP;
9200 {$ENDIF}
9201 end;
9202
9203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9204 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9205 var
9206   Rec: TglBitmapNormalMapRec;
9207   SizeRec: TglBitmapPixelPosition;
9208 begin
9209   Rec.HalfSize := aSize div 2;
9210   FreeDataAfterGenTexture := false;
9211
9212   SizeRec.Fields := [ffX, ffY];
9213   SizeRec.X := aSize;
9214   SizeRec.Y := aSize;
9215
9216   // Positive X
9217   Rec.Func := glBitmapNormalMapPosX;
9218   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9219   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9220
9221   // Negative X
9222   Rec.Func := glBitmapNormalMapNegX;
9223   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9224   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9225
9226   // Positive Y
9227   Rec.Func := glBitmapNormalMapPosY;
9228   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9229   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9230
9231   // Negative Y
9232   Rec.Func := glBitmapNormalMapNegY;
9233   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9234   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9235
9236   // Positive Z
9237   Rec.Func := glBitmapNormalMapPosZ;
9238   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9239   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9240
9241   // Negative Z
9242   Rec.Func := glBitmapNormalMapNegZ;
9243   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9244   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9245 end;
9246 {$IFEND}
9247
9248 initialization
9249   glBitmapSetDefaultFormat (tfEmpty);
9250   glBitmapSetDefaultMipmap (mmMipmap);
9251   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9252   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9253 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
9254   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9255 {$IFEND}
9256
9257   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9258   glBitmapSetDefaultDeleteTextureOnFree    (true);
9259
9260   TFormatDescriptor.Init;
9261
9262 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9263   OpenGLInitialized := false;
9264   InitOpenGLCS := TCriticalSection.Create;
9265 {$ENDIF}
9266
9267 finalization
9268   TFormatDescriptor.Finalize;
9269
9270 {$IFDEF GLB_NATIVE_OGL}
9271   if Assigned(GL_LibHandle) then
9272     glbFreeLibrary(GL_LibHandle);
9273
9274 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9275   if Assigned(GLU_LibHandle) then
9276     glbFreeLibrary(GLU_LibHandle);
9277   FreeAndNil(InitOpenGLCS);
9278 {$ENDIF}
9279 {$ENDIF}
9280
9281 end.