glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.1
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {.$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {.$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {.$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   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}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   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}
 666   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}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   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;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   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;
 697   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;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776 // the name of formats is composed of the following constituents:
 777 // - multiple chanals:
 778 //    - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved)
 779 //    - width of the chanel in bit       (4, 8, 16, ...)
 780 // - data type                           (e.g. ub, us, ui)
 781 // - number of data types
 782
 783 {$IFNDEF fpc}
 784   QWord   = System.UInt64;
 785   PQWord  = ^QWord;
 786
 787   PtrInt  = Longint;
 788   PtrUInt = DWord;
 789 {$ENDIF}
 790
 791   TglBitmapFormat = (
 792     tfEmpty = 0,                //must be smallest value!
 793
 794     tfAlpha4ub1,                // 1 x unsigned byte
 795     tfAlpha8ub1,                // 1 x unsigned byte
 796     tfAlpha16us1,               // 1 x unsigned short
 797
 798     tfLuminance4ub1,            // 1 x unsigned byte
 799     tfLuminance8ub1,            // 1 x unsigned byte
 800     tfLuminance16us1,           // 1 x unsigned short
 801
 802     tfLuminance4Alpha4ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 803     tfLuminance6Alpha2ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 804     tfLuminance8Alpha8ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 805     tfLuminance12Alpha4us2,     // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 806     tfLuminance16Alpha16us2,    // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 807
 808     tfR3G3B2ub1,                // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 809     tfRGBX4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 810     tfXRGB4us1,                 // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 811     tfR5G6B5us1,                // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 812     tfRGB5X1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 813     tfX1RGB5us1,                // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 814     tfRGB8ub3,                  // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 815     tfRGBX8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 816     tfXRGB8ui1,                 // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 817     tfRGB10X2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 818     tfX2RGB10ui1,               // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 819     tfRGB16us3,                 // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 820
 821     tfRGBA4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 822     tfARGB4us1,                 // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 823     tfRGB5A1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 824     tfA1RGB5us1,                // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 825     tfRGBA8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 826     tfARGB8ui1,                 // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 827     tfRGBA8ub4,                 // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 828     tfRGB10A2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 829     tfA2RGB10ui1,               // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 830     tfRGBA16us4,                // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 831
 832     tfBGRX4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 833     tfXBGR4us1,                 // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 834     tfB5G6R5us1,                // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 835     tfBGR5X1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 836     tfX1BGR5us1,                // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 837     tfBGR8ub3,                  // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 838     tfBGRX8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 839     tfXBGR8ui1,                 // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 840     tfBGR10X2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 841     tfX2BGR10ui1,               // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 842     tfBGR16us3,                 // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 843
 844     tfBGRA4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 845     tfABGR4us1,                 // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 846     tfBGR5A1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 847     tfA1BGR5us1,                // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 848     tfBGRA8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 849     tfABGR8ui1,                 // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 850     tfBGRA8ub4,                 // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 851     tfBGR10A2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 852     tfA2BGR10ui1,               // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 853     tfBGRA16us4,                // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 854
 855     tfDepth16us1,               // 1 x unsigned short (depth)
 856     tfDepth24ui1,               // 1 x unsigned int (depth)
 857     tfDepth32ui1,               // 1 x unsigned int (depth)
 858
 859     tfS3tcDtx1RGBA,
 860     tfS3tcDtx3RGBA,
 861     tfS3tcDtx5RGBA
 862   );
 863
 864   TglBitmapFileType = (
 865      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 866      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 867      ftDDS,
 868      ftTGA,
 869      ftBMP,
 870      ftRAW);
 871    TglBitmapFileTypes = set of TglBitmapFileType;
 872
 873    TglBitmapMipMap = (
 874      mmNone,
 875      mmMipmap,
 876      mmMipmapGlu);
 877
 878    TglBitmapNormalMapFunc = (
 879      nm4Samples,
 880      nmSobel,
 881      nm3x3,
 882      nm5x5);
 883
 884  ////////////////////////////////////////////////////////////////////////////////////////////////////
 885    EglBitmap                  = class(Exception);
 886    EglBitmapNotSupported      = class(Exception);
 887    EglBitmapSizeToLarge       = class(EglBitmap);
 888    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 889    EglBitmapUnsupportedFormat = class(EglBitmap)
 890    public
 891      constructor Create(const aFormat: TglBitmapFormat); overload;
 892      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 893    end;
 894
 895 ////////////////////////////////////////////////////////////////////////////////////////////////////
 896   TglBitmapRec4ui = packed record
 897   case Integer of
 898     0: (r, g, b, a: Cardinal);
 899     1: (arr: array[0..3] of Cardinal);
 900   end;
 901
 902   TglBitmapRec4ub = packed record
 903   case Integer of
 904     0: (r, g, b, a: Byte);
 905     1: (arr: array[0..3] of Byte);
 906   end;
 907
 908   TglBitmapRec4ul = packed record
 909   case Integer of
 910     0: (r, g, b, a: QWord);
 911     1: (arr: array[0..3] of QWord);
 912   end;
 913
 914   TglBitmapFormatDescriptor = class(TObject)
 915   private
 916     // cached properties
 917     fBytesPerPixel: Single;
 918     fChannelCount: Integer;
 919     fMask: TglBitmapRec4ul;
 920     fRange: TglBitmapRec4ui;
 921
 922     function GetHasRed: Boolean;
 923     function GetHasGreen: Boolean;
 924     function GetHasBlue: Boolean;
 925     function GetHasAlpha: Boolean;
 926     function GetHasColor: Boolean;
 927     function GetIsGrayscale: Boolean;
 928   protected
 929     fFormat:        TglBitmapFormat;
 930     fWithAlpha:     TglBitmapFormat;
 931     fWithoutAlpha:  TglBitmapFormat;
 932     fOpenGLFormat:  TglBitmapFormat;
 933     fRGBInverted:   TglBitmapFormat;
 934     fUncompressed:  TglBitmapFormat;
 935
 936     fBitsPerPixel: Integer;
 937     fIsCompressed: Boolean;
 938
 939     fPrecision: TglBitmapRec4ub;
 940     fShift:     TglBitmapRec4ub;
 941
 942     fglFormat:         GLenum;
 943     fglInternalFormat: GLenum;
 944     fglDataFormat:     GLenum;
 945
 946     procedure SetValues; virtual;
 947     procedure CalcValues;
 948   public
 949     property Format:        TglBitmapFormat read fFormat;
 950     property ChannelCount:  Integer         read fChannelCount;
 951     property IsCompressed:  Boolean         read fIsCompressed;
 952     property BitsPerPixel:  Integer         read fBitsPerPixel;
 953     property BytesPerPixel: Single          read fBytesPerPixel;
 954
 955     property Precision: TglBitmapRec4ub read fPrecision;
 956     property Shift:     TglBitmapRec4ub read fShift;
 957     property Range:     TglBitmapRec4ui read fRange;
 958     property Mask:      TglBitmapRec4ul read fMask;
 959
 960     property RGBInverted:  TglBitmapFormat read fRGBInverted;
 961     property WithAlpha:    TglBitmapFormat read fWithAlpha;
 962     property WithoutAlpha: TglBitmapFormat read fWithAlpha;
 963     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
 964     property Uncompressed: TglBitmapFormat read fUncompressed;
 965
 966     property glFormat:         GLenum  read fglFormat;
 967     property glInternalFormat: GLenum  read fglInternalFormat;
 968     property glDataFormat:     GLenum  read fglDataFormat;
 969
 970     property HasRed:       Boolean read GetHasRed;
 971     property HasGreen:     Boolean read GetHasGreen;
 972     property HasBlue:      Boolean read GetHasBlue;
 973     property HasAlpha:     Boolean read GetHasAlpha;
 974     property HasColor:     Boolean read GetHasColor;
 975     property IsGrayscale:  Boolean read GetIsGrayscale;
 976
 977     constructor Create;
 978   public
 979     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 980   end;
 981
 982 ////////////////////////////////////////////////////////////////////////////////////////////////////
 983   TglBitmapPixelData = packed record
 984     Data:   TglBitmapRec4ui;
 985     Range:  TglBitmapRec4ui;
 986     Format: TglBitmapFormat;
 987   end;
 988   PglBitmapPixelData = ^TglBitmapPixelData;
 989
 990   TglBitmapPixelPositionFields = set of (ffX, ffY);
 991   TglBitmapPixelPosition = record
 992     Fields : TglBitmapPixelPositionFields;
 993     X : Word;
 994     Y : Word;
 995   end;
 996
 997 ////////////////////////////////////////////////////////////////////////////////////////////////////
 998   TglBitmap = class;
 999   TglBitmapFunctionRec = record
1000     Sender:   TglBitmap;
1001     Size:     TglBitmapPixelPosition;
1002     Position: TglBitmapPixelPosition;
1003     Source:   TglBitmapPixelData;
1004     Dest:     TglBitmapPixelData;
1005     Args:     Pointer;
1006   end;
1007   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
1008
1009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1010   TglBitmap = class
1011   private
1012     function GetFormatDesc: TglBitmapFormatDescriptor;
1013   protected
1014     fID: GLuint;
1015     fTarget: GLuint;
1016     fAnisotropic: Integer;
1017     fDeleteTextureOnFree: Boolean;
1018     fFreeDataOnDestroy: Boolean;
1019     fFreeDataAfterGenTexture: Boolean;
1020     fData: PByte;
1021     fIsResident: GLboolean;
1022     fBorderColor: array[0..3] of Single;
1023
1024     fDimension: TglBitmapPixelPosition;
1025     fMipMap: TglBitmapMipMap;
1026     fFormat: TglBitmapFormat;
1027
1028     // Mapping
1029     fPixelSize: Integer;
1030     fRowSize: Integer;
1031
1032     // Filtering
1033     fFilterMin: GLenum;
1034     fFilterMag: GLenum;
1035
1036     // TexturWarp
1037     fWrapS: GLenum;
1038     fWrapT: GLenum;
1039     fWrapR: GLenum;
1040
1041     //Swizzle
1042     fSwizzle: array[0..3] of GLenum;
1043
1044     // CustomData
1045     fFilename: String;
1046     fCustomName: String;
1047     fCustomNameW: WideString;
1048     fCustomData: Pointer;
1049
1050     //Getter
1051     function GetWidth:  Integer; virtual;
1052     function GetHeight: Integer; virtual;
1053
1054     function GetFileWidth:  Integer; virtual;
1055     function GetFileHeight: Integer; virtual;
1056
1057     //Setter
1058     procedure SetCustomData(const aValue: Pointer);
1059     procedure SetCustomName(const aValue: String);
1060     procedure SetCustomNameW(const aValue: WideString);
1061     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1062     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1063     procedure SetFormat(const aValue: TglBitmapFormat);
1064     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1065     procedure SetID(const aValue: Cardinal);
1066     procedure SetMipMap(const aValue: TglBitmapMipMap);
1067     procedure SetTarget(const aValue: Cardinal);
1068     procedure SetAnisotropic(const aValue: Integer);
1069
1070     procedure CreateID;
1071     procedure SetupParameters(out aBuildWithGlu: Boolean);
1072     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1073       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1074     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1075
1076     function FlipHorz: Boolean; virtual;
1077     function FlipVert: Boolean; virtual;
1078
1079     property Width:  Integer read GetWidth;
1080     property Height: Integer read GetHeight;
1081
1082     property FileWidth:  Integer read GetFileWidth;
1083     property FileHeight: Integer read GetFileHeight;
1084   public
1085     //Properties
1086     property ID:           Cardinal        read fID          write SetID;
1087     property Target:       Cardinal        read fTarget      write SetTarget;
1088     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1089     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1090     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1091
1092     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1093
1094     property Filename:    String     read fFilename;
1095     property CustomName:  String     read fCustomName  write SetCustomName;
1096     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1097     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1098
1099     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1100     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1101     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1102
1103     property Dimension:  TglBitmapPixelPosition  read fDimension;
1104     property Data:       PByte                   read fData;
1105     property IsResident: GLboolean               read fIsResident;
1106
1107     procedure AfterConstruction; override;
1108     procedure BeforeDestruction; override;
1109
1110     procedure PrepareResType(var aResource: String; var aResType: PChar);
1111
1112     //Load
1113     procedure LoadFromFile(const aFilename: String);
1114     procedure LoadFromStream(const aStream: TStream); virtual;
1115     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1116       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1117     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1118     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1119
1120     //Save
1121     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1122     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1123
1124     //Convert
1125     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1126     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1127       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1128   public
1129     //Alpha & Co
1130     {$IFDEF GLB_SDL}
1131     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1132     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1133     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1134     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1135       const aArgs: Pointer = nil): Boolean;
1136     {$ENDIF}
1137
1138     {$IFDEF GLB_DELPHI}
1139     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1140     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1141     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1142     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1143       const aArgs: Pointer = nil): Boolean;
1144     {$ENDIF}
1145
1146     {$IFDEF GLB_LAZARUS}
1147     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1148     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1149     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1150     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1151       const aArgs: Pointer = nil): Boolean;
1152     {$ENDIF}
1153
1154     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1155       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1156     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1157       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1158
1159     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1160     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1161     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1162     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1163
1164     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1165     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1166     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1167
1168     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1169     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1170     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1171
1172     function RemoveAlpha: Boolean; virtual;
1173   public
1174     //Common
1175     function Clone: TglBitmap;
1176     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1177     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1178     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1179     procedure FreeData;
1180
1181     //ColorFill
1182     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1183     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1184     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1185
1186     //TexParameters
1187     procedure SetFilter(const aMin, aMag: GLenum);
1188     procedure SetWrap(
1189       const S: GLenum = GL_CLAMP_TO_EDGE;
1190       const T: GLenum = GL_CLAMP_TO_EDGE;
1191       const R: GLenum = GL_CLAMP_TO_EDGE);
1192     procedure SetSwizzle(const r, g, b, a: GLenum);
1193
1194     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1195     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1196
1197     //Constructors
1198     constructor Create; overload;
1199     constructor Create(const aFileName: String); overload;
1200     constructor Create(const aStream: TStream); overload;
1201     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1202     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1203     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1204     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1205   private
1206     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1207     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1208
1209     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1210     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1211
1212     function LoadRAW(const aStream: TStream): Boolean;
1213     procedure SaveRAW(const aStream: TStream);
1214
1215     function LoadBMP(const aStream: TStream): Boolean;
1216     procedure SaveBMP(const aStream: TStream);
1217
1218     function LoadTGA(const aStream: TStream): Boolean;
1219     procedure SaveTGA(const aStream: TStream);
1220
1221     function LoadDDS(const aStream: TStream): Boolean;
1222     procedure SaveDDS(const aStream: TStream);
1223   end;
1224
1225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1226   TglBitmap1D = class(TglBitmap)
1227   protected
1228     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1229       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1230     procedure UploadData(const aBuildWithGlu: Boolean);
1231   public
1232     property Width;
1233     procedure AfterConstruction; override;
1234     function FlipHorz: Boolean; override;
1235     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1236   end;
1237
1238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1239   TglBitmap2D = class(TglBitmap)
1240   protected
1241     fLines: array of PByte;
1242     function GetScanline(const aIndex: Integer): Pointer;
1243     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1244       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1245     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1246   public
1247     property Width;
1248     property Height;
1249     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1250
1251     procedure AfterConstruction; override;
1252
1253     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1254     procedure GetDataFromTexture;
1255     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1256
1257     function FlipHorz: Boolean; override;
1258     function FlipVert: Boolean; override;
1259
1260     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1261       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1262   end;
1263
1264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1265   TglBitmapCubeMap = class(TglBitmap2D)
1266   protected
1267     fGenMode: Integer;
1268     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1269   public
1270     procedure AfterConstruction; override;
1271     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1272     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1273     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1274   end;
1275
1276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1277   TglBitmapNormalMap = class(TglBitmapCubeMap)
1278   public
1279     procedure AfterConstruction; override;
1280     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1281   end;
1282
1283 const
1284   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1285
1286 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1287 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1288 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1289 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1290 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1291 procedure glBitmapSetDefaultWrap(
1292   const S: Cardinal = GL_CLAMP_TO_EDGE;
1293   const T: Cardinal = GL_CLAMP_TO_EDGE;
1294   const R: Cardinal = GL_CLAMP_TO_EDGE);
1295
1296 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1297 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1298 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1299 function glBitmapGetDefaultFormat: TglBitmapFormat;
1300 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1301 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1302
1303 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1304 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1305 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1306 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1307 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1308 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1309
1310 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1311
1312 var
1313   glBitmapDefaultDeleteTextureOnFree: Boolean;
1314   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1315   glBitmapDefaultFormat: TglBitmapFormat;
1316   glBitmapDefaultMipmap: TglBitmapMipMap;
1317   glBitmapDefaultFilterMin: Cardinal;
1318   glBitmapDefaultFilterMag: Cardinal;
1319   glBitmapDefaultWrapS: Cardinal;
1320   glBitmapDefaultWrapT: Cardinal;
1321   glBitmapDefaultWrapR: Cardinal;
1322   glDefaultSwizzle: array[0..3] of GLenum;
1323
1324 {$IFDEF GLB_DELPHI}
1325 function CreateGrayPalette: HPALETTE;
1326 {$ENDIF}
1327
1328 implementation
1329
1330 uses
1331   Math, syncobjs, typinfo
1332   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1333
1334 ////////////////////////////////////////////////////////////////////////////////////////////////////
1335 type
1336   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1337   public
1338     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1339     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1340
1341     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1342     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1343
1344     function CreateMappingData: Pointer; virtual;
1345     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1346
1347     function IsEmpty: Boolean; virtual;
1348     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1349
1350     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1351
1352     constructor Create; virtual;
1353   public
1354     class procedure Init;
1355     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1356     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1357     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1358     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1359     class procedure Clear;
1360     class procedure Finalize;
1361   end;
1362   TFormatDescriptorClass = class of TFormatDescriptor;
1363
1364   TfdEmpty = class(TFormatDescriptor);
1365
1366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1367   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370   end;
1371
1372   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1373     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1374     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1375   end;
1376
1377   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1378     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1379     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1380   end;
1381
1382   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385   end;
1386
1387   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390   end;
1391
1392   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395   end;
1396
1397   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400   end;
1401
1402   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1403     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1404     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1405   end;
1406
1407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1408   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1409     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1410     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1411   end;
1412
1413   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1414     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1415     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1416   end;
1417
1418   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421   end;
1422
1423   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1424     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1425     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1426   end;
1427
1428   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431   end;
1432
1433   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1434     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1435     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1436   end;
1437
1438   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441   end;
1442
1443   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446   end;
1447
1448   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1449     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1450     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1451   end;
1452
1453   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1464   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1465     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1466     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1467   end;
1468
1469   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1470     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1471     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1472   end;
1473
1474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1475   TfdAlpha4ub1 = class(TfdAlphaUB1)
1476     procedure SetValues; override;
1477   end;
1478
1479   TfdAlpha8ub1 = class(TfdAlphaUB1)
1480     procedure SetValues; override;
1481   end;
1482
1483   TfdAlpha16us1 = class(TfdAlphaUS1)
1484     procedure SetValues; override;
1485   end;
1486
1487   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1488     procedure SetValues; override;
1489   end;
1490
1491   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1492     procedure SetValues; override;
1493   end;
1494
1495   TfdLuminance16us1 = class(TfdLuminanceUS1)
1496     procedure SetValues; override;
1497   end;
1498
1499   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1500     procedure SetValues; override;
1501   end;
1502
1503   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1504     procedure SetValues; override;
1505   end;
1506
1507   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1508     procedure SetValues; override;
1509   end;
1510
1511   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1512     procedure SetValues; override;
1513   end;
1514
1515   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1516     procedure SetValues; override;
1517   end;
1518
1519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1520   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1521     procedure SetValues; override;
1522   end;
1523
1524   TfdRGBX4us1 = class(TfdUniversalUS1)
1525     procedure SetValues; override;
1526   end;
1527
1528   TfdXRGB4us1 = class(TfdUniversalUS1)
1529     procedure SetValues; override;
1530   end;
1531
1532   TfdR5G6B5us1 = class(TfdUniversalUS1)
1533     procedure SetValues; override;
1534   end;
1535
1536   TfdRGB5X1us1 = class(TfdUniversalUS1)
1537     procedure SetValues; override;
1538   end;
1539
1540   TfdX1RGB5us1 = class(TfdUniversalUS1)
1541     procedure SetValues; override;
1542   end;
1543
1544   TfdRGB8ub3 = class(TfdRGBub3)
1545     procedure SetValues; override;
1546   end;
1547
1548   TfdRGBX8ui1 = class(TfdUniversalUI1)
1549     procedure SetValues; override;
1550   end;
1551
1552   TfdXRGB8ui1 = class(TfdUniversalUI1)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1561     procedure SetValues; override;
1562   end;
1563
1564   TfdRGB16us3 = class(TfdRGBus3)
1565     procedure SetValues; override;
1566   end;
1567
1568   TfdRGBA4us1 = class(TfdUniversalUS1)
1569     procedure SetValues; override;
1570   end;
1571
1572   TfdARGB4us1 = class(TfdUniversalUS1)
1573     procedure SetValues; override;
1574   end;
1575
1576   TfdRGB5A1us1 = class(TfdUniversalUS1)
1577     procedure SetValues; override;
1578   end;
1579
1580   TfdA1RGB5us1 = class(TfdUniversalUS1)
1581     procedure SetValues; override;
1582   end;
1583
1584   TfdRGBA8ui1 = class(TfdUniversalUI1)
1585     procedure SetValues; override;
1586   end;
1587
1588   TfdARGB8ui1 = class(TfdUniversalUI1)
1589     procedure SetValues; override;
1590   end;
1591
1592   TfdRGBA8ub4 = class(TfdRGBAub4)
1593     procedure SetValues; override;
1594   end;
1595
1596   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1597     procedure SetValues; override;
1598   end;
1599
1600   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1601     procedure SetValues; override;
1602   end;
1603
1604   TfdRGBA16us4 = class(TfdRGBAus4)
1605     procedure SetValues; override;
1606   end;
1607
1608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1609   TfdBGRX4us1 = class(TfdUniversalUS1)
1610     procedure SetValues; override;
1611   end;
1612
1613   TfdXBGR4us1 = class(TfdUniversalUS1)
1614     procedure SetValues; override;
1615   end;
1616
1617   TfdB5G6R5us1 = class(TfdUniversalUS1)
1618     procedure SetValues; override;
1619   end;
1620
1621   TfdBGR5X1us1 = class(TfdUniversalUS1)
1622     procedure SetValues; override;
1623   end;
1624
1625   TfdX1BGR5us1 = class(TfdUniversalUS1)
1626     procedure SetValues; override;
1627   end;
1628
1629   TfdBGR8ub3 = class(TfdBGRub3)
1630     procedure SetValues; override;
1631   end;
1632
1633   TfdBGRX8ui1 = class(TfdUniversalUI1)
1634     procedure SetValues; override;
1635   end;
1636
1637   TfdXBGR8ui1 = class(TfdUniversalUI1)
1638     procedure SetValues; override;
1639   end;
1640
1641   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1642     procedure SetValues; override;
1643   end;
1644
1645   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1646     procedure SetValues; override;
1647   end;
1648
1649   TfdBGR16us3 = class(TfdBGRus3)
1650     procedure SetValues; override;
1651   end;
1652
1653   TfdBGRA4us1 = class(TfdUniversalUS1)
1654     procedure SetValues; override;
1655   end;
1656
1657   TfdABGR4us1 = class(TfdUniversalUS1)
1658     procedure SetValues; override;
1659   end;
1660
1661   TfdBGR5A1us1 = class(TfdUniversalUS1)
1662     procedure SetValues; override;
1663   end;
1664
1665   TfdA1BGR5us1 = class(TfdUniversalUS1)
1666     procedure SetValues; override;
1667   end;
1668
1669   TfdBGRA8ui1 = class(TfdUniversalUI1)
1670     procedure SetValues; override;
1671   end;
1672
1673   TfdABGR8ui1 = class(TfdUniversalUI1)
1674     procedure SetValues; override;
1675   end;
1676
1677   TfdBGRA8ub4 = class(TfdBGRAub4)
1678     procedure SetValues; override;
1679   end;
1680
1681   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1682     procedure SetValues; override;
1683   end;
1684
1685   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1686     procedure SetValues; override;
1687   end;
1688
1689   TfdBGRA16us4 = class(TfdBGRAus4)
1690     procedure SetValues; override;
1691   end;
1692
1693   TfdDepth16us1 = class(TfdDepthUS1)
1694     procedure SetValues; override;
1695   end;
1696
1697   TfdDepth24ui1 = class(TfdDepthUI1)
1698     procedure SetValues; override;
1699   end;
1700
1701   TfdDepth32ui1 = class(TfdDepthUI1)
1702     procedure SetValues; override;
1703   end;
1704
1705   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1706     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1707     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1708     procedure SetValues; override;
1709   end;
1710
1711   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1712     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1713     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1714     procedure SetValues; override;
1715   end;
1716
1717   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1718     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1719     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1720     procedure SetValues; override;
1721   end;
1722
1723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1724   TbmpBitfieldFormat = class(TFormatDescriptor)
1725   public
1726     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1727     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1728     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1729     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1730   end;
1731
1732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1733   TbmpColorTableEnty = packed record
1734     b, g, r, a: Byte;
1735   end;
1736   TbmpColorTable = array of TbmpColorTableEnty;
1737   TbmpColorTableFormat = class(TFormatDescriptor)
1738   private
1739     fBitsPerPixel: Integer;
1740     fColorTable: TbmpColorTable;
1741   protected
1742     procedure SetValues; override;
1743   public
1744     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1745     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1746
1747     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1748     procedure CalcValues;
1749     procedure CreateColorTable;
1750
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     destructor Destroy; override;
1754   end;
1755
1756 const
1757   LUMINANCE_WEIGHT_R = 0.30;
1758   LUMINANCE_WEIGHT_G = 0.59;
1759   LUMINANCE_WEIGHT_B = 0.11;
1760
1761   ALPHA_WEIGHT_R = 0.30;
1762   ALPHA_WEIGHT_G = 0.59;
1763   ALPHA_WEIGHT_B = 0.11;
1764
1765   DEPTH_WEIGHT_R = 0.333333333;
1766   DEPTH_WEIGHT_G = 0.333333333;
1767   DEPTH_WEIGHT_B = 0.333333333;
1768
1769   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1770     TfdEmpty,
1771
1772     TfdAlpha4ub1,
1773     TfdAlpha8ub1,
1774     TfdAlpha16us1,
1775
1776     TfdLuminance4ub1,
1777     TfdLuminance8ub1,
1778     TfdLuminance16us1,
1779
1780     TfdLuminance4Alpha4ub2,
1781     TfdLuminance6Alpha2ub2,
1782     TfdLuminance8Alpha8ub2,
1783     TfdLuminance12Alpha4us2,
1784     TfdLuminance16Alpha16us2,
1785
1786     TfdR3G3B2ub1,
1787     TfdRGBX4us1,
1788     TfdXRGB4us1,
1789     TfdR5G6B5us1,
1790     TfdRGB5X1us1,
1791     TfdX1RGB5us1,
1792     TfdRGB8ub3,
1793     TfdRGBX8ui1,
1794     TfdXRGB8ui1,
1795     TfdRGB10X2ui1,
1796     TfdX2RGB10ui1,
1797     TfdRGB16us3,
1798
1799     TfdRGBA4us1,
1800     TfdARGB4us1,
1801     TfdRGB5A1us1,
1802     TfdA1RGB5us1,
1803     TfdRGBA8ui1,
1804     TfdARGB8ui1,
1805     TfdRGBA8ub4,
1806     TfdRGB10A2ui1,
1807     TfdA2RGB10ui1,
1808     TfdRGBA16us4,
1809
1810     TfdBGRX4us1,
1811     TfdXBGR4us1,
1812     TfdB5G6R5us1,
1813     TfdBGR5X1us1,
1814     TfdX1BGR5us1,
1815     TfdBGR8ub3,
1816     TfdBGRX8ui1,
1817     TfdXBGR8ui1,
1818     TfdBGR10X2ui1,
1819     TfdX2BGR10ui1,
1820     TfdBGR16us3,
1821
1822     TfdBGRA4us1,
1823     TfdABGR4us1,
1824     TfdBGR5A1us1,
1825     TfdA1BGR5us1,
1826     TfdBGRA8ui1,
1827     TfdABGR8ui1,
1828     TfdBGRA8ub4,
1829     TfdBGR10A2ui1,
1830     TfdA2BGR10ui1,
1831     TfdBGRA16us4,
1832
1833     TfdDepth16us1,
1834     TfdDepth24ui1,
1835     TfdDepth32ui1,
1836
1837     TfdS3tcDtx1RGBA,
1838     TfdS3tcDtx3RGBA,
1839     TfdS3tcDtx5RGBA
1840   );
1841
1842 var
1843   FormatDescriptorCS: TCriticalSection;
1844   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1845
1846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1847 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1848 begin
1849   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1850 end;
1851
1852 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1853 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1854 begin
1855   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1856 end;
1857
1858 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1859 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1860 begin
1861   result.Fields := [];
1862
1863   if X >= 0 then
1864     result.Fields := result.Fields + [ffX];
1865   if Y >= 0 then
1866     result.Fields := result.Fields + [ffY];
1867
1868   result.X := Max(0, X);
1869   result.Y := Max(0, Y);
1870 end;
1871
1872 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1873 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1874 begin
1875   result.r := r;
1876   result.g := g;
1877   result.b := b;
1878   result.a := a;
1879 end;
1880
1881 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1882 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1883 begin
1884   result.r := r;
1885   result.g := g;
1886   result.b := b;
1887   result.a := a;
1888 end;
1889
1890 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1891 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1892 begin
1893   result.r := r;
1894   result.g := g;
1895   result.b := b;
1896   result.a := a;
1897 end;
1898
1899 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1900 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1901 var
1902   i: Integer;
1903 begin
1904   result := false;
1905   for i := 0 to high(r1.arr) do
1906     if (r1.arr[i] <> r2.arr[i]) then
1907       exit;
1908   result := true;
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1913 var
1914   i: Integer;
1915 begin
1916   result := false;
1917   for i := 0 to high(r1.arr) do
1918     if (r1.arr[i] <> r2.arr[i]) then
1919       exit;
1920   result := true;
1921 end;
1922
1923 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1924 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1925 var
1926   desc: TFormatDescriptor;
1927   p, tmp: PByte;
1928   x, y, i: Integer;
1929   md: Pointer;
1930   px: TglBitmapPixelData;
1931 begin
1932   result := nil;
1933   desc := TFormatDescriptor.Get(aFormat);
1934   if (desc.IsCompressed) or (desc.glFormat = 0) then
1935     exit;
1936
1937   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1938   md := desc.CreateMappingData;
1939   try
1940     tmp := p;
1941     desc.PreparePixel(px);
1942     for y := 0 to 4 do
1943       for x := 0 to 4 do begin
1944         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1945         for i := 0 to 3 do begin
1946           if ((y < 3) and (y = i)) or
1947              ((y = 3) and (i < 3)) or
1948              ((y = 4) and (i = 3))
1949           then
1950             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1951           else if ((y < 4) and (i = 3)) or
1952                   ((y = 4) and (i < 3))
1953           then
1954             px.Data.arr[i] := px.Range.arr[i]
1955           else
1956             px.Data.arr[i] := 0; //px.Range.arr[i];
1957         end;
1958         desc.Map(px, tmp, md);
1959       end;
1960   finally
1961     desc.FreeMappingData(md);
1962   end;
1963
1964   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1965   result.FreeDataOnDestroy       := true;
1966   result.FreeDataAfterGenTexture := false;
1967   result.SetFilter(GL_NEAREST, GL_NEAREST);
1968 end;
1969
1970 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1971 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1972 begin
1973   result.r := r;
1974   result.g := g;
1975   result.b := b;
1976   result.a := a;
1977 end;
1978
1979 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1980 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1981 begin
1982   result := [];
1983
1984   if (aFormat in [
1985         //8bpp
1986         tfAlpha4ub1, tfAlpha8ub1,
1987         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1988
1989         //16bpp
1990         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1991         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1992         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1993
1994         //24bpp
1995         tfBGR8ub3, tfRGB8ub3,
1996
1997         //32bpp
1998         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1999         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2000   then
2001     result := result + [ ftBMP ];
2002
2003   if (aFormat in [
2004         //8bbp
2005         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2006
2007         //16bbp
2008         tfAlpha16us1, tfLuminance16us1,
2009         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2010         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2011
2012         //24bbp
2013         tfBGR8ub3,
2014
2015         //32bbp
2016         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2017         tfDepth24ui1, tfDepth32ui1])
2018   then
2019     result := result + [ftTGA];
2020
2021   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2022     result := result + [ftDDS];
2023
2024 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2025   if aFormat in [
2026       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2027       tfRGB8ub3, tfRGBA8ui1,
2028       tfBGR8ub3, tfBGRA8ui1] then
2029     result := result + [ftPNG];
2030 {$ENDIF}
2031
2032 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2033   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2034     result := result + [ftJPEG];
2035 {$ENDIF}
2036 end;
2037
2038 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2039 function IsPowerOfTwo(aNumber: Integer): Boolean;
2040 begin
2041   while (aNumber and 1) = 0 do
2042     aNumber := aNumber shr 1;
2043   result := aNumber = 1;
2044 end;
2045
2046 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2047 function GetTopMostBit(aBitSet: QWord): Integer;
2048 begin
2049   result := 0;
2050   while aBitSet > 0 do begin
2051     inc(result);
2052     aBitSet := aBitSet shr 1;
2053   end;
2054 end;
2055
2056 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2057 function CountSetBits(aBitSet: QWord): Integer;
2058 begin
2059   result := 0;
2060   while aBitSet > 0 do begin
2061     if (aBitSet and 1) = 1 then
2062       inc(result);
2063     aBitSet := aBitSet shr 1;
2064   end;
2065 end;
2066
2067 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2069 begin
2070   result := Trunc(
2071     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2072     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2073     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2074 end;
2075
2076 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2077 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2078 begin
2079   result := Trunc(
2080     DEPTH_WEIGHT_R * aPixel.Data.r +
2081     DEPTH_WEIGHT_G * aPixel.Data.g +
2082     DEPTH_WEIGHT_B * aPixel.Data.b);
2083 end;
2084
2085 {$IFDEF GLB_NATIVE_OGL}
2086 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 var
2090   GL_LibHandle: Pointer = nil;
2091
2092 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2093 begin
2094   if not Assigned(aLibHandle) then
2095     aLibHandle := GL_LibHandle;
2096
2097 {$IF DEFINED(GLB_WIN)}
2098   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2099   if Assigned(result) then
2100     exit;
2101
2102   if Assigned(wglGetProcAddress) then
2103     result := wglGetProcAddress(aProcName);
2104 {$ELSEIF DEFINED(GLB_LINUX)}
2105   if Assigned(glXGetProcAddress) then begin
2106     result := glXGetProcAddress(aProcName);
2107     if Assigned(result) then
2108       exit;
2109   end;
2110
2111   if Assigned(glXGetProcAddressARB) then begin
2112     result := glXGetProcAddressARB(aProcName);
2113     if Assigned(result) then
2114       exit;
2115   end;
2116
2117   result := dlsym(aLibHandle, aProcName);
2118 {$IFEND}
2119   if not Assigned(result) and aRaiseOnErr then
2120     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2121 end;
2122
2123 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2124 var
2125   GLU_LibHandle: Pointer = nil;
2126   OpenGLInitialized: Boolean;
2127   InitOpenGLCS: TCriticalSection;
2128
2129 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 procedure glbInitOpenGL;
2131
2132   ////////////////////////////////////////////////////////////////////////////////
2133   function glbLoadLibrary(const aName: PChar): Pointer;
2134   begin
2135     {$IF DEFINED(GLB_WIN)}
2136     result := {%H-}Pointer(LoadLibrary(aName));
2137     {$ELSEIF DEFINED(GLB_LINUX)}
2138     result := dlopen(Name, RTLD_LAZY);
2139     {$ELSE}
2140     result := nil;
2141     {$IFEND}
2142   end;
2143
2144   ////////////////////////////////////////////////////////////////////////////////
2145   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2146   begin
2147     result := false;
2148     if not Assigned(aLibHandle) then
2149       exit;
2150
2151     {$IF DEFINED(GLB_WIN)}
2152     Result := FreeLibrary({%H-}HINST(aLibHandle));
2153     {$ELSEIF DEFINED(GLB_LINUX)}
2154     Result := dlclose(aLibHandle) = 0;
2155     {$IFEND}
2156   end;
2157
2158 begin
2159   if Assigned(GL_LibHandle) then
2160     glbFreeLibrary(GL_LibHandle);
2161
2162   if Assigned(GLU_LibHandle) then
2163     glbFreeLibrary(GLU_LibHandle);
2164
2165   GL_LibHandle := glbLoadLibrary(libopengl);
2166   if not Assigned(GL_LibHandle) then
2167     raise EglBitmap.Create('unable to load library: ' + libopengl);
2168
2169   GLU_LibHandle := glbLoadLibrary(libglu);
2170   if not Assigned(GLU_LibHandle) then
2171     raise EglBitmap.Create('unable to load library: ' + libglu);
2172
2173 {$IF DEFINED(GLB_WIN)}
2174   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2175 {$ELSEIF DEFINED(GLB_LINUX)}
2176   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2177   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2178 {$IFEND}
2179
2180   glEnable := glbGetProcAddress('glEnable');
2181   glDisable := glbGetProcAddress('glDisable');
2182   glGetString := glbGetProcAddress('glGetString');
2183   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2184   glTexParameteri := glbGetProcAddress('glTexParameteri');
2185   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2186   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2187   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2188   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2189   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2190   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2191   glTexGeni := glbGetProcAddress('glTexGeni');
2192   glGenTextures := glbGetProcAddress('glGenTextures');
2193   glBindTexture := glbGetProcAddress('glBindTexture');
2194   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2195   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2196   glReadPixels := glbGetProcAddress('glReadPixels');
2197   glPixelStorei := glbGetProcAddress('glPixelStorei');
2198   glTexImage1D := glbGetProcAddress('glTexImage1D');
2199   glTexImage2D := glbGetProcAddress('glTexImage2D');
2200   glGetTexImage := glbGetProcAddress('glGetTexImage');
2201
2202   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2203   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2204 end;
2205 {$ENDIF}
2206
2207 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 procedure glbReadOpenGLExtensions;
2209 var
2210   Buffer: AnsiString;
2211   MajorVersion, MinorVersion: Integer;
2212
2213   ///////////////////////////////////////////////////////////////////////////////////////////
2214   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2215   var
2216     Separator: Integer;
2217   begin
2218     aMinor := 0;
2219     aMajor := 0;
2220
2221     Separator := Pos(AnsiString('.'), aBuffer);
2222     if (Separator > 1) and (Separator < Length(aBuffer)) and
2223        (aBuffer[Separator - 1] in ['0'..'9']) and
2224        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2225
2226       Dec(Separator);
2227       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2228         Dec(Separator);
2229
2230       Delete(aBuffer, 1, Separator);
2231       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2232
2233       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2234         Inc(Separator);
2235
2236       Delete(aBuffer, Separator, 255);
2237       Separator := Pos(AnsiString('.'), aBuffer);
2238
2239       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2240       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2241     end;
2242   end;
2243
2244   ///////////////////////////////////////////////////////////////////////////////////////////
2245   function CheckExtension(const Extension: AnsiString): Boolean;
2246   var
2247     ExtPos: Integer;
2248   begin
2249     ExtPos := Pos(Extension, Buffer);
2250     result := ExtPos > 0;
2251     if result then
2252       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2253   end;
2254
2255   ///////////////////////////////////////////////////////////////////////////////////////////
2256   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2257   begin
2258     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2259   end;
2260
2261 begin
2262 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2263   InitOpenGLCS.Enter;
2264   try
2265     if not OpenGLInitialized then begin
2266       glbInitOpenGL;
2267       OpenGLInitialized := true;
2268     end;
2269   finally
2270     InitOpenGLCS.Leave;
2271   end;
2272 {$ENDIF}
2273
2274   // Version
2275   Buffer := glGetString(GL_VERSION);
2276   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2277
2278   GL_VERSION_1_2 := CheckVersion(1, 2);
2279   GL_VERSION_1_3 := CheckVersion(1, 3);
2280   GL_VERSION_1_4 := CheckVersion(1, 4);
2281   GL_VERSION_2_0 := CheckVersion(2, 0);
2282   GL_VERSION_3_3 := CheckVersion(3, 3);
2283
2284   // Extensions
2285   Buffer := glGetString(GL_EXTENSIONS);
2286   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2287   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2288   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2289   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2290   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2291   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2292   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2293   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2294   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2295   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2296   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2297   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2298   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2299   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2300
2301   if GL_VERSION_1_3 then begin
2302     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2303     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2304     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2305   end else begin
2306     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2307     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2308     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2309   end;
2310 end;
2311 {$ENDIF}
2312
2313 {$IFDEF GLB_SDL_IMAGE}
2314 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2315 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2317 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2318 begin
2319   result := TStream(context^.unknown.data1).Seek(offset, whence);
2320 end;
2321
2322 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2323 begin
2324   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2325 end;
2326
2327 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2328 begin
2329   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2330 end;
2331
2332 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2333 begin
2334   result := 0;
2335 end;
2336
2337 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2338 begin
2339   result := SDL_AllocRW;
2340
2341   if result = nil then
2342     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2343
2344   result^.seek := glBitmapRWseek;
2345   result^.read := glBitmapRWread;
2346   result^.write := glBitmapRWwrite;
2347   result^.close := glBitmapRWclose;
2348   result^.unknown.data1 := Stream;
2349 end;
2350 {$ENDIF}
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2354 begin
2355   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2360 begin
2361   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2366 begin
2367   glBitmapDefaultMipmap := aValue;
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2372 begin
2373   glBitmapDefaultFormat := aFormat;
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2378 begin
2379   glBitmapDefaultFilterMin := aMin;
2380   glBitmapDefaultFilterMag := aMag;
2381 end;
2382
2383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2384 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2385 begin
2386   glBitmapDefaultWrapS := S;
2387   glBitmapDefaultWrapT := T;
2388   glBitmapDefaultWrapR := R;
2389 end;
2390
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2393 begin
2394   glDefaultSwizzle[0] := r;
2395   glDefaultSwizzle[1] := g;
2396   glDefaultSwizzle[2] := b;
2397   glDefaultSwizzle[3] := a;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2402 begin
2403   result := glBitmapDefaultDeleteTextureOnFree;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2408 begin
2409   result := glBitmapDefaultFreeDataAfterGenTextures;
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2414 begin
2415   result := glBitmapDefaultMipmap;
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function glBitmapGetDefaultFormat: TglBitmapFormat;
2420 begin
2421   result := glBitmapDefaultFormat;
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2426 begin
2427   aMin := glBitmapDefaultFilterMin;
2428   aMag := glBitmapDefaultFilterMag;
2429 end;
2430
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2433 begin
2434   S := glBitmapDefaultWrapS;
2435   T := glBitmapDefaultWrapT;
2436   R := glBitmapDefaultWrapR;
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2441 begin
2442   r := glDefaultSwizzle[0];
2443   g := glDefaultSwizzle[1];
2444   b := glDefaultSwizzle[2];
2445   a := glDefaultSwizzle[3];
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2451 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2452 var
2453   w, h: Integer;
2454 begin
2455   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2456     w := Max(1, aSize.X);
2457     h := Max(1, aSize.Y);
2458     result := GetSize(w, h);
2459   end else
2460     result := 0;
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2465 begin
2466   result := 0;
2467   if (aWidth <= 0) or (aHeight <= 0) then
2468     exit;
2469   result := Ceil(aWidth * aHeight * BytesPerPixel);
2470 end;
2471
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 function TFormatDescriptor.CreateMappingData: Pointer;
2474 begin
2475   result := nil;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2480 begin
2481   //DUMMY
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 function TFormatDescriptor.IsEmpty: Boolean;
2486 begin
2487   result := (fFormat = tfEmpty);
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2492 var
2493   i: Integer;
2494   m: TglBitmapRec4ul;
2495 begin
2496   result := false;
2497   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2498     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2499   m := Mask;
2500   for i := 0 to 3 do
2501     if (aMask.arr[i] <> m.arr[i]) then
2502       exit;
2503   result := true;
2504 end;
2505
2506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2507 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2508 begin
2509   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2510   aPixel.Data   := Range;
2511   aPixel.Format := fFormat;
2512   aPixel.Range  := Range;
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 constructor TFormatDescriptor.Create;
2517 begin
2518   inherited Create;
2519 end;
2520
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2525 begin
2526   aData^ := aPixel.Data.a;
2527   inc(aData);
2528 end;
2529
2530 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2531 begin
2532   aPixel.Data.r := 0;
2533   aPixel.Data.g := 0;
2534   aPixel.Data.b := 0;
2535   aPixel.Data.a := aData^;
2536   inc(aData);
2537 end;
2538
2539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2540 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2542 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2543 begin
2544   aData^ := LuminanceWeight(aPixel);
2545   inc(aData);
2546 end;
2547
2548 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2549 begin
2550   aPixel.Data.r := aData^;
2551   aPixel.Data.g := aData^;
2552   aPixel.Data.b := aData^;
2553   aPixel.Data.a := 0;
2554   inc(aData);
2555 end;
2556
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2561 var
2562   i: Integer;
2563 begin
2564   aData^ := 0;
2565   for i := 0 to 3 do
2566     if (Range.arr[i] > 0) then
2567       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2568   inc(aData);
2569 end;
2570
2571 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2572 var
2573   i: Integer;
2574 begin
2575   for i := 0 to 3 do
2576     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2577   inc(aData);
2578 end;
2579
2580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2581 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2584 begin
2585   inherited Map(aPixel, aData, aMapData);
2586   aData^ := aPixel.Data.a;
2587   inc(aData);
2588 end;
2589
2590 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2591 begin
2592   inherited Unmap(aData, aPixel, aMapData);
2593   aPixel.Data.a := aData^;
2594   inc(aData);
2595 end;
2596
2597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2601 begin
2602   aData^ := aPixel.Data.r;
2603   inc(aData);
2604   aData^ := aPixel.Data.g;
2605   inc(aData);
2606   aData^ := aPixel.Data.b;
2607   inc(aData);
2608 end;
2609
2610 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2611 begin
2612   aPixel.Data.r := aData^;
2613   inc(aData);
2614   aPixel.Data.g := aData^;
2615   inc(aData);
2616   aPixel.Data.b := aData^;
2617   inc(aData);
2618   aPixel.Data.a := 0;
2619 end;
2620
2621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2624 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2625 begin
2626   aData^ := aPixel.Data.b;
2627   inc(aData);
2628   aData^ := aPixel.Data.g;
2629   inc(aData);
2630   aData^ := aPixel.Data.r;
2631   inc(aData);
2632 end;
2633
2634 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2635 begin
2636   aPixel.Data.b := aData^;
2637   inc(aData);
2638   aPixel.Data.g := aData^;
2639   inc(aData);
2640   aPixel.Data.r := aData^;
2641   inc(aData);
2642   aPixel.Data.a := 0;
2643 end;
2644
2645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2649 begin
2650   inherited Map(aPixel, aData, aMapData);
2651   aData^ := aPixel.Data.a;
2652   inc(aData);
2653 end;
2654
2655 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2656 begin
2657   inherited Unmap(aData, aPixel, aMapData);
2658   aPixel.Data.a := aData^;
2659   inc(aData);
2660 end;
2661
2662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2663 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2665 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2666 begin
2667   inherited Map(aPixel, aData, aMapData);
2668   aData^ := aPixel.Data.a;
2669   inc(aData);
2670 end;
2671
2672 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2673 begin
2674   inherited Unmap(aData, aPixel, aMapData);
2675   aPixel.Data.a := aData^;
2676   inc(aData);
2677 end;
2678
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2682 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2683 begin
2684   PWord(aData)^ := aPixel.Data.a;
2685   inc(aData, 2);
2686 end;
2687
2688 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2689 begin
2690   aPixel.Data.r := 0;
2691   aPixel.Data.g := 0;
2692   aPixel.Data.b := 0;
2693   aPixel.Data.a := PWord(aData)^;
2694   inc(aData, 2);
2695 end;
2696
2697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2698 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2701 begin
2702   PWord(aData)^ := LuminanceWeight(aPixel);
2703   inc(aData, 2);
2704 end;
2705
2706 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2707 begin
2708   aPixel.Data.r := PWord(aData)^;
2709   aPixel.Data.g := PWord(aData)^;
2710   aPixel.Data.b := PWord(aData)^;
2711   aPixel.Data.a := 0;
2712   inc(aData, 2);
2713 end;
2714
2715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2716 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2719 var
2720   i: Integer;
2721 begin
2722   PWord(aData)^ := 0;
2723   for i := 0 to 3 do
2724     if (Range.arr[i] > 0) then
2725       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2726   inc(aData, 2);
2727 end;
2728
2729 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2730 var
2731   i: Integer;
2732 begin
2733   for i := 0 to 3 do
2734     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2735   inc(aData, 2);
2736 end;
2737
2738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2739 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2742 begin
2743   PWord(aData)^ := DepthWeight(aPixel);
2744   inc(aData, 2);
2745 end;
2746
2747 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2748 begin
2749   aPixel.Data.r := PWord(aData)^;
2750   aPixel.Data.g := PWord(aData)^;
2751   aPixel.Data.b := PWord(aData)^;
2752   aPixel.Data.a := PWord(aData)^;;
2753   inc(aData, 2);
2754 end;
2755
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2760 begin
2761   inherited Map(aPixel, aData, aMapData);
2762   PWord(aData)^ := aPixel.Data.a;
2763   inc(aData, 2);
2764 end;
2765
2766 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2767 begin
2768   inherited Unmap(aData, aPixel, aMapData);
2769   aPixel.Data.a := PWord(aData)^;
2770   inc(aData, 2);
2771 end;
2772
2773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2774 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2776 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2777 begin
2778   PWord(aData)^ := aPixel.Data.r;
2779   inc(aData, 2);
2780   PWord(aData)^ := aPixel.Data.g;
2781   inc(aData, 2);
2782   PWord(aData)^ := aPixel.Data.b;
2783   inc(aData, 2);
2784 end;
2785
2786 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2787 begin
2788   aPixel.Data.r := PWord(aData)^;
2789   inc(aData, 2);
2790   aPixel.Data.g := PWord(aData)^;
2791   inc(aData, 2);
2792   aPixel.Data.b := PWord(aData)^;
2793   inc(aData, 2);
2794   aPixel.Data.a := 0;
2795 end;
2796
2797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2801 begin
2802   PWord(aData)^ := aPixel.Data.b;
2803   inc(aData, 2);
2804   PWord(aData)^ := aPixel.Data.g;
2805   inc(aData, 2);
2806   PWord(aData)^ := aPixel.Data.r;
2807   inc(aData, 2);
2808 end;
2809
2810 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2811 begin
2812   aPixel.Data.b := PWord(aData)^;
2813   inc(aData, 2);
2814   aPixel.Data.g := PWord(aData)^;
2815   inc(aData, 2);
2816   aPixel.Data.r := PWord(aData)^;
2817   inc(aData, 2);
2818   aPixel.Data.a := 0;
2819 end;
2820
2821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2822 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2825 begin
2826   inherited Map(aPixel, aData, aMapData);
2827   PWord(aData)^ := aPixel.Data.a;
2828   inc(aData, 2);
2829 end;
2830
2831 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2832 begin
2833   inherited Unmap(aData, aPixel, aMapData);
2834   aPixel.Data.a := PWord(aData)^;
2835   inc(aData, 2);
2836 end;
2837
2838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2839 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2842 begin
2843   PWord(aData)^ := aPixel.Data.a;
2844   inc(aData, 2);
2845   inherited Map(aPixel, aData, aMapData);
2846 end;
2847
2848 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2849 begin
2850   aPixel.Data.a := PWord(aData)^;
2851   inc(aData, 2);
2852   inherited Unmap(aData, aPixel, aMapData);
2853 end;
2854
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2858 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2859 begin
2860   inherited Map(aPixel, aData, aMapData);
2861   PWord(aData)^ := aPixel.Data.a;
2862   inc(aData, 2);
2863 end;
2864
2865 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2866 begin
2867   inherited Unmap(aData, aPixel, aMapData);
2868   aPixel.Data.a := PWord(aData)^;
2869   inc(aData, 2);
2870 end;
2871
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2876 begin
2877   PWord(aData)^ := aPixel.Data.a;
2878   inc(aData, 2);
2879   inherited Map(aPixel, aData, aMapData);
2880 end;
2881
2882 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2883 begin
2884   aPixel.Data.a := PWord(aData)^;
2885   inc(aData, 2);
2886   inherited Unmap(aData, aPixel, aMapData);
2887 end;
2888
2889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2890 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2892 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2893 var
2894   i: Integer;
2895 begin
2896   PCardinal(aData)^ := 0;
2897   for i := 0 to 3 do
2898     if (Range.arr[i] > 0) then
2899       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2900   inc(aData, 4);
2901 end;
2902
2903 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2904 var
2905   i: Integer;
2906 begin
2907   for i := 0 to 3 do
2908     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2909   inc(aData, 2);
2910 end;
2911
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2916 begin
2917   PCardinal(aData)^ := DepthWeight(aPixel);
2918   inc(aData, 4);
2919 end;
2920
2921 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2922 begin
2923   aPixel.Data.r := PCardinal(aData)^;
2924   aPixel.Data.g := PCardinal(aData)^;
2925   aPixel.Data.b := PCardinal(aData)^;
2926   aPixel.Data.a := PCardinal(aData)^;
2927   inc(aData, 4);
2928 end;
2929
2930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2933 procedure TfdAlpha4ub1.SetValues;
2934 begin
2935   inherited SetValues;
2936   fBitsPerPixel     := 8;
2937   fFormat           := tfAlpha4ub1;
2938   fWithAlpha        := tfAlpha4ub1;
2939   fOpenGLFormat     := tfAlpha4ub1;
2940   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2941   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2942   fglFormat         := GL_ALPHA;
2943   fglInternalFormat := GL_ALPHA4;
2944   fglDataFormat     := GL_UNSIGNED_BYTE;
2945 end;
2946
2947 procedure TfdAlpha8ub1.SetValues;
2948 begin
2949   inherited SetValues;
2950   fBitsPerPixel     := 8;
2951   fFormat           := tfAlpha8ub1;
2952   fWithAlpha        := tfAlpha8ub1;
2953   fOpenGLFormat     := tfAlpha8ub1;
2954   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2955   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2956   fglFormat         := GL_ALPHA;
2957   fglInternalFormat := GL_ALPHA8;
2958   fglDataFormat     := GL_UNSIGNED_BYTE;
2959 end;
2960
2961 procedure TfdAlpha16us1.SetValues;
2962 begin
2963   inherited SetValues;
2964   fBitsPerPixel     := 16;
2965   fFormat           := tfAlpha16us1;
2966   fWithAlpha        := tfAlpha16us1;
2967   fOpenGLFormat     := tfAlpha16us1;
2968   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2969   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2970   fglFormat         := GL_ALPHA;
2971   fglInternalFormat := GL_ALPHA16;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 procedure TfdLuminance4ub1.SetValues;
2976 begin
2977   inherited SetValues;
2978   fBitsPerPixel     := 8;
2979   fFormat           := tfLuminance4ub1;
2980   fWithAlpha        := tfLuminance4Alpha4ub2;
2981   fWithoutAlpha     := tfLuminance4ub1;
2982   fOpenGLFormat     := tfLuminance4ub1;
2983   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2984   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2985   fglFormat         := GL_LUMINANCE;
2986   fglInternalFormat := GL_LUMINANCE4;
2987   fglDataFormat     := GL_UNSIGNED_BYTE;
2988 end;
2989
2990 procedure TfdLuminance8ub1.SetValues;
2991 begin
2992   inherited SetValues;
2993   fBitsPerPixel     := 8;
2994   fFormat           := tfLuminance8ub1;
2995   fWithAlpha        := tfLuminance8Alpha8ub2;
2996   fWithoutAlpha     := tfLuminance8ub1;
2997   fOpenGLFormat     := tfLuminance8ub1;
2998   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2999   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3000   fglFormat         := GL_LUMINANCE;
3001   fglInternalFormat := GL_LUMINANCE8;
3002   fglDataFormat     := GL_UNSIGNED_BYTE;
3003 end;
3004
3005 procedure TfdLuminance16us1.SetValues;
3006 begin
3007   inherited SetValues;
3008   fBitsPerPixel     := 16;
3009   fFormat           := tfLuminance16us1;
3010   fWithAlpha        := tfLuminance16Alpha16us2;
3011   fWithoutAlpha     := tfLuminance16us1;
3012   fOpenGLFormat     := tfLuminance16us1;
3013   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3014   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3015   fglFormat         := GL_LUMINANCE;
3016   fglInternalFormat := GL_LUMINANCE16;
3017   fglDataFormat     := GL_UNSIGNED_SHORT;
3018 end;
3019
3020 procedure TfdLuminance4Alpha4ub2.SetValues;
3021 begin
3022   inherited SetValues;
3023   fBitsPerPixel     := 16;
3024   fFormat           := tfLuminance4Alpha4ub2;
3025   fWithAlpha        := tfLuminance4Alpha4ub2;
3026   fWithoutAlpha     := tfLuminance4ub1;
3027   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3028   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3029   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3030   fglFormat         := GL_LUMINANCE_ALPHA;
3031   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3032   fglDataFormat     := GL_UNSIGNED_BYTE;
3033 end;
3034
3035 procedure TfdLuminance6Alpha2ub2.SetValues;
3036 begin
3037   inherited SetValues;
3038   fBitsPerPixel     := 16;
3039   fFormat           := tfLuminance6Alpha2ub2;
3040   fWithAlpha        := tfLuminance6Alpha2ub2;
3041   fWithoutAlpha     := tfLuminance8ub1;
3042   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3043   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3044   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3045   fglFormat         := GL_LUMINANCE_ALPHA;
3046   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3047   fglDataFormat     := GL_UNSIGNED_BYTE;
3048 end;
3049
3050 procedure TfdLuminance8Alpha8ub2.SetValues;
3051 begin
3052   inherited SetValues;
3053   fBitsPerPixel     := 16;
3054   fFormat           := tfLuminance8Alpha8ub2;
3055   fWithAlpha        := tfLuminance8Alpha8ub2;
3056   fWithoutAlpha     := tfLuminance8ub1;
3057   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3058   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3059   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3060   fglFormat         := GL_LUMINANCE_ALPHA;
3061   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3062   fglDataFormat     := GL_UNSIGNED_BYTE;
3063 end;
3064
3065 procedure TfdLuminance12Alpha4us2.SetValues;
3066 begin
3067   inherited SetValues;
3068   fBitsPerPixel     := 32;
3069   fFormat           := tfLuminance12Alpha4us2;
3070   fWithAlpha        := tfLuminance12Alpha4us2;
3071   fWithoutAlpha     := tfLuminance16us1;
3072   fOpenGLFormat     := tfLuminance12Alpha4us2;
3073   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3074   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3075   fglFormat         := GL_LUMINANCE_ALPHA;
3076   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3077   fglDataFormat     := GL_UNSIGNED_SHORT;
3078 end;
3079
3080 procedure TfdLuminance16Alpha16us2.SetValues;
3081 begin
3082   inherited SetValues;
3083   fBitsPerPixel     := 32;
3084   fFormat           := tfLuminance16Alpha16us2;
3085   fWithAlpha        := tfLuminance16Alpha16us2;
3086   fWithoutAlpha     := tfLuminance16us1;
3087   fOpenGLFormat     := tfLuminance16Alpha16us2;
3088   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3089   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3090   fglFormat         := GL_LUMINANCE_ALPHA;
3091   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3092   fglDataFormat     := GL_UNSIGNED_SHORT;
3093 end;
3094
3095 procedure TfdR3G3B2ub1.SetValues;
3096 begin
3097   inherited SetValues;
3098   fBitsPerPixel     := 8;
3099   fFormat           := tfR3G3B2ub1;
3100   fWithAlpha        := tfRGBA4us1;
3101   fWithoutAlpha     := tfR3G3B2ub1;
3102   fOpenGLFormat     := tfR3G3B2ub1;
3103   fRGBInverted      := tfEmpty;
3104   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3105   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3106   fglFormat         := GL_RGB;
3107   fglInternalFormat := GL_R3_G3_B2;
3108   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3109 end;
3110
3111 procedure TfdRGBX4us1.SetValues;
3112 begin
3113   inherited SetValues;
3114   fBitsPerPixel     := 16;
3115   fFormat           := tfRGBX4us1;
3116   fWithAlpha        := tfRGBA4us1;
3117   fWithoutAlpha     := tfRGBX4us1;
3118   fOpenGLFormat     := tfRGBX4us1;
3119   fRGBInverted      := tfBGRX4us1;
3120   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3121   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3122   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3123   fglInternalFormat := GL_RGB4;
3124   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3125 end;
3126
3127 procedure TfdXRGB4us1.SetValues;
3128 begin
3129   inherited SetValues;
3130   fBitsPerPixel     := 16;
3131   fFormat           := tfXRGB4us1;
3132   fWithAlpha        := tfARGB4us1;
3133   fWithoutAlpha     := tfXRGB4us1;
3134   fOpenGLFormat     := tfXRGB4us1;
3135   fRGBInverted      := tfXBGR4us1;
3136   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3137   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3138   fglFormat         := GL_BGRA;
3139   fglInternalFormat := GL_RGB4;
3140   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3141 end;
3142
3143 procedure TfdR5G6B5us1.SetValues;
3144 begin
3145   inherited SetValues;
3146   fBitsPerPixel     := 16;
3147   fFormat           := tfR5G6B5us1;
3148   fWithAlpha        := tfRGB5A1us1;
3149   fWithoutAlpha     := tfR5G6B5us1;
3150   fOpenGLFormat     := tfR5G6B5us1;
3151   fRGBInverted      := tfB5G6R5us1;
3152   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3153   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3154   fglFormat         := GL_RGB;
3155   fglInternalFormat := GL_RGB565;
3156   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3157 end;
3158
3159 procedure TfdRGB5X1us1.SetValues;
3160 begin
3161   inherited SetValues;
3162   fBitsPerPixel     := 16;
3163   fFormat           := tfRGB5X1us1;
3164   fWithAlpha        := tfRGB5A1us1;
3165   fWithoutAlpha     := tfRGB5X1us1;
3166   fOpenGLFormat     := tfRGB5X1us1;
3167   fRGBInverted      := tfBGR5X1us1;
3168   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3169   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3170   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3171   fglInternalFormat := GL_RGB5;
3172   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3173 end;
3174
3175 procedure TfdX1RGB5us1.SetValues;
3176 begin
3177   inherited SetValues;
3178   fBitsPerPixel     := 16;
3179   fFormat           := tfX1RGB5us1;
3180   fWithAlpha        := tfA1RGB5us1;
3181   fWithoutAlpha     := tfX1RGB5us1;
3182   fOpenGLFormat     := tfX1RGB5us1;
3183   fRGBInverted      := tfX1BGR5us1;
3184   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3185   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3186   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3187   fglInternalFormat := GL_RGB5;
3188   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3189 end;
3190
3191 procedure TfdRGB8ub3.SetValues;
3192 begin
3193   inherited SetValues;
3194   fBitsPerPixel     := 24;
3195   fFormat           := tfRGB8ub3;
3196   fWithAlpha        := tfRGBA8ub4;
3197   fWithoutAlpha     := tfRGB8ub3;
3198   fOpenGLFormat     := tfRGB8ub3;
3199   fRGBInverted      := tfBGR8ub3;
3200   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3201   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3202   fglFormat         := GL_RGB;
3203   fglInternalFormat := GL_RGB8;
3204   fglDataFormat     := GL_UNSIGNED_BYTE;
3205 end;
3206
3207 procedure TfdRGBX8ui1.SetValues;
3208 begin
3209   inherited SetValues;
3210   fBitsPerPixel     := 32;
3211   fFormat           := tfRGBX8ui1;
3212   fWithAlpha        := tfRGBA8ui1;
3213   fWithoutAlpha     := tfRGBX8ui1;
3214   fOpenGLFormat     := tfRGB8ub3;
3215   fRGBInverted      := tfBGRX8ui1;
3216   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3217   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3218   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3219   fglInternalFormat := GL_RGB8;
3220   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3221 end;
3222
3223 procedure TfdXRGB8ui1.SetValues;
3224 begin
3225   inherited SetValues;
3226   fBitsPerPixel     := 32;
3227   fFormat           := tfXRGB8ui1;
3228   fWithAlpha        := tfXRGB8ui1;
3229   fWithoutAlpha     := tfXRGB8ui1;
3230   fOpenGLFormat     := tfRGB8ub3;
3231   fRGBInverted      := tfXBGR8ui1;
3232   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3233   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3234   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3235   fglInternalFormat := GL_RGB8;
3236   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3237 end;
3238
3239 procedure TfdRGB10X2ui1.SetValues;
3240 begin
3241   inherited SetValues;
3242   fBitsPerPixel     := 32;
3243   fFormat           := tfRGB10X2ui1;
3244   fWithAlpha        := tfRGB10A2ui1;
3245   fWithoutAlpha     := tfRGB10X2ui1;
3246   fOpenGLFormat     := tfRGB10X2ui1;
3247   fRGBInverted      := tfBGR10X2ui1;
3248   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3249   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3250   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3251   fglInternalFormat := GL_RGB10;
3252   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3253 end;
3254
3255 procedure TfdX2RGB10ui1.SetValues;
3256 begin
3257   inherited SetValues;
3258   fBitsPerPixel     := 32;
3259   fFormat           := tfX2RGB10ui1;
3260   fWithAlpha        := tfA2RGB10ui1;
3261   fWithoutAlpha     := tfX2RGB10ui1;
3262   fOpenGLFormat     := tfX2RGB10ui1;
3263   fRGBInverted      := tfX2BGR10ui1;
3264   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3265   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3266   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3267   fglInternalFormat := GL_RGB10;
3268   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3269 end;
3270
3271 procedure TfdRGB16us3.SetValues;
3272 begin
3273   inherited SetValues;
3274   fBitsPerPixel     := 48;
3275   fFormat           := tfRGB16us3;
3276   fWithAlpha        := tfRGBA16us4;
3277   fWithoutAlpha     := tfRGB16us3;
3278   fOpenGLFormat     := tfRGB16us3;
3279   fRGBInverted      := tfBGR16us3;
3280   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3281   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3282   fglFormat         := GL_RGB;
3283   fglInternalFormat := GL_RGB16;
3284   fglDataFormat     := GL_UNSIGNED_SHORT;
3285 end;
3286
3287 procedure TfdRGBA4us1.SetValues;
3288 begin
3289   inherited SetValues;
3290   fBitsPerPixel     := 16;
3291   fFormat           := tfRGBA4us1;
3292   fWithAlpha        := tfRGBA4us1;
3293   fWithoutAlpha     := tfRGBX4us1;
3294   fOpenGLFormat     := tfRGBA4us1;
3295   fRGBInverted      := tfBGRA4us1;
3296   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3297   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3298   fglFormat         := GL_RGBA;
3299   fglInternalFormat := GL_RGBA4;
3300   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3301 end;
3302
3303 procedure TfdARGB4us1.SetValues;
3304 begin
3305   inherited SetValues;
3306   fBitsPerPixel     := 16;
3307   fFormat           := tfARGB4us1;
3308   fWithAlpha        := tfARGB4us1;
3309   fWithoutAlpha     := tfXRGB4us1;
3310   fOpenGLFormat     := tfARGB4us1;
3311   fRGBInverted      := tfABGR4us1;
3312   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3313   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3314   fglFormat         := GL_BGRA;
3315   fglInternalFormat := GL_RGBA4;
3316   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3317 end;
3318
3319 procedure TfdRGB5A1us1.SetValues;
3320 begin
3321   inherited SetValues;
3322   fBitsPerPixel     := 16;
3323   fFormat           := tfRGB5A1us1;
3324   fWithAlpha        := tfRGB5A1us1;
3325   fWithoutAlpha     := tfRGB5X1us1;
3326   fOpenGLFormat     := tfRGB5A1us1;
3327   fRGBInverted      := tfBGR5A1us1;
3328   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3329   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3330   fglFormat         := GL_RGBA;
3331   fglInternalFormat := GL_RGB5_A1;
3332   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3333 end;
3334
3335 procedure TfdA1RGB5us1.SetValues;
3336 begin
3337   inherited SetValues;
3338   fBitsPerPixel     := 16;
3339   fFormat           := tfA1RGB5us1;
3340   fWithAlpha        := tfA1RGB5us1;
3341   fWithoutAlpha     := tfX1RGB5us1;
3342   fOpenGLFormat     := tfA1RGB5us1;
3343   fRGBInverted      := tfA1BGR5us1;
3344   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3345   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3346   fglFormat         := GL_BGRA;
3347   fglInternalFormat := GL_RGB5_A1;
3348   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3349 end;
3350
3351 procedure TfdRGBA8ui1.SetValues;
3352 begin
3353   inherited SetValues;
3354   fBitsPerPixel     := 32;
3355   fFormat           := tfRGBA8ui1;
3356   fWithAlpha        := tfRGBA8ui1;
3357   fWithoutAlpha     := tfRGBX8ui1;
3358   fOpenGLFormat     := tfRGBA8ui1;
3359   fRGBInverted      := tfBGRA8ui1;
3360   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3361   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3362   fglFormat         := GL_RGBA;
3363   fglInternalFormat := GL_RGBA8;
3364   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3365 end;
3366
3367 procedure TfdARGB8ui1.SetValues;
3368 begin
3369   inherited SetValues;
3370   fBitsPerPixel     := 32;
3371   fFormat           := tfARGB8ui1;
3372   fWithAlpha        := tfARGB8ui1;
3373   fWithoutAlpha     := tfXRGB8ui1;
3374   fOpenGLFormat     := tfARGB8ui1;
3375   fRGBInverted      := tfABGR8ui1;
3376   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3377   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3378   fglFormat         := GL_BGRA;
3379   fglInternalFormat := GL_RGBA8;
3380   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3381 end;
3382
3383 procedure TfdRGBA8ub4.SetValues;
3384 begin
3385   inherited SetValues;
3386   fBitsPerPixel     := 32;
3387   fFormat           := tfRGBA8ub4;
3388   fWithAlpha        := tfRGBA8ub4;
3389   fWithoutAlpha     := tfRGB8ub3;
3390   fOpenGLFormat     := tfRGBA8ub4;
3391   fRGBInverted      := tfBGRA8ub4;
3392   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3393   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3394   fglFormat         := GL_RGBA;
3395   fglInternalFormat := GL_RGBA8;
3396   fglDataFormat     := GL_UNSIGNED_BYTE;
3397 end;
3398
3399 procedure TfdRGB10A2ui1.SetValues;
3400 begin
3401   inherited SetValues;
3402   fBitsPerPixel     := 32;
3403   fFormat           := tfRGB10A2ui1;
3404   fWithAlpha        := tfRGB10A2ui1;
3405   fWithoutAlpha     := tfRGB10X2ui1;
3406   fOpenGLFormat     := tfRGB10A2ui1;
3407   fRGBInverted      := tfBGR10A2ui1;
3408   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3409   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3410   fglFormat         := GL_RGBA;
3411   fglInternalFormat := GL_RGB10_A2;
3412   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3413 end;
3414
3415 procedure TfdA2RGB10ui1.SetValues;
3416 begin
3417   inherited SetValues;
3418   fBitsPerPixel     := 32;
3419   fFormat           := tfA2RGB10ui1;
3420   fWithAlpha        := tfA2RGB10ui1;
3421   fWithoutAlpha     := tfX2RGB10ui1;
3422   fOpenGLFormat     := tfA2RGB10ui1;
3423   fRGBInverted      := tfA2BGR10ui1;
3424   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3425   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3426   fglFormat         := GL_BGRA;
3427   fglInternalFormat := GL_RGB10_A2;
3428   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3429 end;
3430
3431 procedure TfdRGBA16us4.SetValues;
3432 begin
3433   inherited SetValues;
3434   fBitsPerPixel     := 64;
3435   fFormat           := tfRGBA16us4;
3436   fWithAlpha        := tfRGBA16us4;
3437   fWithoutAlpha     := tfRGB16us3;
3438   fOpenGLFormat     := tfRGBA16us4;
3439   fRGBInverted      := tfBGRA16us4;
3440   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3441   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3442   fglFormat         := GL_RGBA;
3443   fglInternalFormat := GL_RGBA16;
3444   fglDataFormat     := GL_UNSIGNED_SHORT;
3445 end;
3446
3447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3450 procedure TfdBGRX4us1.SetValues;
3451 begin
3452   inherited SetValues;
3453   fBitsPerPixel     := 16;
3454   fFormat           := tfBGRX4us1;
3455   fWithAlpha        := tfBGRA4us1;
3456   fWithoutAlpha     := tfBGRX4us1;
3457   fOpenGLFormat     := tfBGRX4us1;
3458   fRGBInverted      := tfRGBX4us1;
3459   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3460   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3461   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3462   fglInternalFormat := GL_RGB4;
3463   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3464 end;
3465
3466 procedure TfdXBGR4us1.SetValues;
3467 begin
3468   inherited SetValues;
3469   fBitsPerPixel     := 16;
3470   fFormat           := tfXBGR4us1;
3471   fWithAlpha        := tfABGR4us1;
3472   fWithoutAlpha     := tfXBGR4us1;
3473   fOpenGLFormat     := tfXBGR4us1;
3474   fRGBInverted      := tfXRGB4us1;
3475   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3476   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3477   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3478   fglInternalFormat := GL_RGB4;
3479   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3480 end;
3481
3482 procedure TfdB5G6R5us1.SetValues;
3483 begin
3484   inherited SetValues;
3485   fBitsPerPixel     := 16;
3486   fFormat           := tfB5G6R5us1;
3487   fWithAlpha        := tfBGR5A1us1;
3488   fWithoutAlpha     := tfB5G6R5us1;
3489   fOpenGLFormat     := tfB5G6R5us1;
3490   fRGBInverted      := tfR5G6B5us1;
3491   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3492   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3493   fglFormat         := GL_RGB;
3494   fglInternalFormat := GL_RGB565;
3495   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3496 end;
3497
3498 procedure TfdBGR5X1us1.SetValues;
3499 begin
3500   inherited SetValues;
3501   fBitsPerPixel     := 16;
3502   fFormat           := tfBGR5X1us1;
3503   fWithAlpha        := tfBGR5A1us1;
3504   fWithoutAlpha     := tfBGR5X1us1;
3505   fOpenGLFormat     := tfBGR5X1us1;
3506   fRGBInverted      := tfRGB5X1us1;
3507   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3508   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3509   fglFormat         := GL_BGRA;
3510   fglInternalFormat := GL_RGB5;
3511   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3512 end;
3513
3514 procedure TfdX1BGR5us1.SetValues;
3515 begin
3516   inherited SetValues;
3517   fBitsPerPixel     := 16;
3518   fFormat           := tfX1BGR5us1;
3519   fWithAlpha        := tfA1BGR5us1;
3520   fWithoutAlpha     := tfX1BGR5us1;
3521   fOpenGLFormat     := tfX1BGR5us1;
3522   fRGBInverted      := tfX1RGB5us1;
3523   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3524   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3525   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3526   fglInternalFormat := GL_RGB5;
3527   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3528 end;
3529
3530 procedure TfdBGR8ub3.SetValues;
3531 begin
3532   inherited SetValues;
3533   fBitsPerPixel     := 24;
3534   fFormat           := tfBGR8ub3;
3535   fWithAlpha        := tfBGRA8ub4;
3536   fWithoutAlpha     := tfBGR8ub3;
3537   fOpenGLFormat     := tfBGR8ub3;
3538   fRGBInverted      := tfRGB8ub3;
3539   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3540   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3541   fglFormat         := GL_BGR;
3542   fglInternalFormat := GL_RGB8;
3543   fglDataFormat     := GL_UNSIGNED_BYTE;
3544 end;
3545
3546 procedure TfdBGRX8ui1.SetValues;
3547 begin
3548   inherited SetValues;
3549   fBitsPerPixel     := 32;
3550   fFormat           := tfBGRX8ui1;
3551   fWithAlpha        := tfBGRA8ui1;
3552   fWithoutAlpha     := tfBGRX8ui1;
3553   fOpenGLFormat     := tfBGRX8ui1;
3554   fRGBInverted      := tfRGBX8ui1;
3555   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3556   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3557   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3558   fglInternalFormat := GL_RGB8;
3559   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3560 end;
3561
3562 procedure TfdXBGR8ui1.SetValues;
3563 begin
3564   inherited SetValues;
3565   fBitsPerPixel     := 32;
3566   fFormat           := tfXBGR8ui1;
3567   fWithAlpha        := tfABGR8ui1;
3568   fWithoutAlpha     := tfXBGR8ui1;
3569   fOpenGLFormat     := tfXBGR8ui1;
3570   fRGBInverted      := tfXRGB8ui1;
3571   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3572   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3573   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3574   fglInternalFormat := GL_RGB8;
3575   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3576 end;
3577
3578 procedure TfdBGR10X2ui1.SetValues;
3579 begin
3580   inherited SetValues;
3581   fBitsPerPixel     := 32;
3582   fFormat           := tfBGR10X2ui1;
3583   fWithAlpha        := tfBGR10A2ui1;
3584   fWithoutAlpha     := tfBGR10X2ui1;
3585   fOpenGLFormat     := tfBGR10X2ui1;
3586   fRGBInverted      := tfRGB10X2ui1;
3587   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3588   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3589   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3590   fglInternalFormat := GL_RGB10;
3591   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3592 end;
3593
3594 procedure TfdX2BGR10ui1.SetValues;
3595 begin
3596   inherited SetValues;
3597   fBitsPerPixel     := 32;
3598   fFormat           := tfX2BGR10ui1;
3599   fWithAlpha        := tfA2BGR10ui1;
3600   fWithoutAlpha     := tfX2BGR10ui1;
3601   fOpenGLFormat     := tfX2BGR10ui1;
3602   fRGBInverted      := tfX2RGB10ui1;
3603   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3604   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3605   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3606   fglInternalFormat := GL_RGB10;
3607   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3608 end;
3609
3610 procedure TfdBGR16us3.SetValues;
3611 begin
3612   inherited SetValues;
3613   fBitsPerPixel     := 48;
3614   fFormat           := tfBGR16us3;
3615   fWithAlpha        := tfBGRA16us4;
3616   fWithoutAlpha     := tfBGR16us3;
3617   fOpenGLFormat     := tfBGR16us3;
3618   fRGBInverted      := tfRGB16us3;
3619   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3620   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3621   fglFormat         := GL_BGR;
3622   fglInternalFormat := GL_RGB16;
3623   fglDataFormat     := GL_UNSIGNED_SHORT;
3624 end;
3625
3626 procedure TfdBGRA4us1.SetValues;
3627 begin
3628   inherited SetValues;
3629   fBitsPerPixel     := 16;
3630   fFormat           := tfBGRA4us1;
3631   fWithAlpha        := tfBGRA4us1;
3632   fWithoutAlpha     := tfBGRX4us1;
3633   fOpenGLFormat     := tfBGRA4us1;
3634   fRGBInverted      := tfRGBA4us1;
3635   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3636   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3637   fglFormat         := GL_BGRA;
3638   fglInternalFormat := GL_RGBA4;
3639   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3640 end;
3641
3642 procedure TfdABGR4us1.SetValues;
3643 begin
3644   inherited SetValues;
3645   fBitsPerPixel     := 16;
3646   fFormat           := tfABGR4us1;
3647   fWithAlpha        := tfABGR4us1;
3648   fWithoutAlpha     := tfXBGR4us1;
3649   fOpenGLFormat     := tfABGR4us1;
3650   fRGBInverted      := tfARGB4us1;
3651   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3652   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3653   fglFormat         := GL_RGBA;
3654   fglInternalFormat := GL_RGBA4;
3655   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3656 end;
3657
3658 procedure TfdBGR5A1us1.SetValues;
3659 begin
3660   inherited SetValues;
3661   fBitsPerPixel     := 16;
3662   fFormat           := tfBGR5A1us1;
3663   fWithAlpha        := tfBGR5A1us1;
3664   fWithoutAlpha     := tfBGR5X1us1;
3665   fOpenGLFormat     := tfBGR5A1us1;
3666   fRGBInverted      := tfRGB5A1us1;
3667   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3668   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3669   fglFormat         := GL_BGRA;
3670   fglInternalFormat := GL_RGB5_A1;
3671   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3672 end;
3673
3674 procedure TfdA1BGR5us1.SetValues;
3675 begin
3676   inherited SetValues;
3677   fBitsPerPixel     := 16;
3678   fFormat           := tfA1BGR5us1;
3679   fWithAlpha        := tfA1BGR5us1;
3680   fWithoutAlpha     := tfX1BGR5us1;
3681   fOpenGLFormat     := tfA1BGR5us1;
3682   fRGBInverted      := tfA1RGB5us1;
3683   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3684   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3685   fglFormat         := GL_RGBA;
3686   fglInternalFormat := GL_RGB5_A1;
3687   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3688 end;
3689
3690 procedure TfdBGRA8ui1.SetValues;
3691 begin
3692   inherited SetValues;
3693   fBitsPerPixel     := 32;
3694   fFormat           := tfBGRA8ui1;
3695   fWithAlpha        := tfBGRA8ui1;
3696   fWithoutAlpha     := tfBGRX8ui1;
3697   fOpenGLFormat     := tfBGRA8ui1;
3698   fRGBInverted      := tfRGBA8ui1;
3699   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3700   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3701   fglFormat         := GL_BGRA;
3702   fglInternalFormat := GL_RGBA8;
3703   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3704 end;
3705
3706 procedure TfdABGR8ui1.SetValues;
3707 begin
3708   inherited SetValues;
3709   fBitsPerPixel     := 32;
3710   fFormat           := tfABGR8ui1;
3711   fWithAlpha        := tfABGR8ui1;
3712   fWithoutAlpha     := tfXBGR8ui1;
3713   fOpenGLFormat     := tfABGR8ui1;
3714   fRGBInverted      := tfARGB8ui1;
3715   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3716   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3717   fglFormat         := GL_RGBA;
3718   fglInternalFormat := GL_RGBA8;
3719   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3720 end;
3721
3722 procedure TfdBGRA8ub4.SetValues;
3723 begin
3724   inherited SetValues;
3725   fBitsPerPixel     := 32;
3726   fFormat           := tfBGRA8ub4;
3727   fWithAlpha        := tfBGRA8ub4;
3728   fWithoutAlpha     := tfBGR8ub3;
3729   fOpenGLFormat     := tfBGRA8ub4;
3730   fRGBInverted      := tfRGBA8ub4;
3731   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3732   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3733   fglFormat         := GL_BGRA;
3734   fglInternalFormat := GL_RGBA8;
3735   fglDataFormat     := GL_UNSIGNED_BYTE;
3736 end;
3737
3738 procedure TfdBGR10A2ui1.SetValues;
3739 begin
3740   inherited SetValues;
3741   fBitsPerPixel     := 32;
3742   fFormat           := tfBGR10A2ui1;
3743   fWithAlpha        := tfBGR10A2ui1;
3744   fWithoutAlpha     := tfBGR10X2ui1;
3745   fOpenGLFormat     := tfBGR10A2ui1;
3746   fRGBInverted      := tfRGB10A2ui1;
3747   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3748   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3749   fglFormat         := GL_BGRA;
3750   fglInternalFormat := GL_RGB10_A2;
3751   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3752 end;
3753
3754 procedure TfdA2BGR10ui1.SetValues;
3755 begin
3756   inherited SetValues;
3757   fBitsPerPixel     := 32;
3758   fFormat           := tfA2BGR10ui1;
3759   fWithAlpha        := tfA2BGR10ui1;
3760   fWithoutAlpha     := tfX2BGR10ui1;
3761   fOpenGLFormat     := tfA2BGR10ui1;
3762   fRGBInverted      := tfA2RGB10ui1;
3763   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3764   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3765   fglFormat         := GL_RGBA;
3766   fglInternalFormat := GL_RGB10_A2;
3767   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3768 end;
3769
3770 procedure TfdBGRA16us4.SetValues;
3771 begin
3772   inherited SetValues;
3773   fBitsPerPixel     := 64;
3774   fFormat           := tfBGRA16us4;
3775   fWithAlpha        := tfBGRA16us4;
3776   fWithoutAlpha     := tfBGR16us3;
3777   fOpenGLFormat     := tfBGRA16us4;
3778   fRGBInverted      := tfRGBA16us4;
3779   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3780   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3781   fglFormat         := GL_BGRA;
3782   fglInternalFormat := GL_RGBA16;
3783   fglDataFormat     := GL_UNSIGNED_SHORT;
3784 end;
3785
3786 procedure TfdDepth16us1.SetValues;
3787 begin
3788   inherited SetValues;
3789   fBitsPerPixel     := 16;
3790   fFormat           := tfDepth16us1;
3791   fWithoutAlpha     := tfDepth16us1;
3792   fOpenGLFormat     := tfDepth16us1;
3793   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3794   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3795   fglFormat         := GL_DEPTH_COMPONENT;
3796   fglInternalFormat := GL_DEPTH_COMPONENT16;
3797   fglDataFormat     := GL_UNSIGNED_SHORT;
3798 end;
3799
3800 procedure TfdDepth24ui1.SetValues;
3801 begin
3802   inherited SetValues;
3803   fBitsPerPixel     := 32;
3804   fFormat           := tfDepth24ui1;
3805   fWithoutAlpha     := tfDepth24ui1;
3806   fOpenGLFormat     := tfDepth24ui1;
3807   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3808   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3809   fglFormat         := GL_DEPTH_COMPONENT;
3810   fglInternalFormat := GL_DEPTH_COMPONENT24;
3811   fglDataFormat     := GL_UNSIGNED_INT;
3812 end;
3813
3814 procedure TfdDepth32ui1.SetValues;
3815 begin
3816   inherited SetValues;
3817   fBitsPerPixel     := 32;
3818   fFormat           := tfDepth32ui1;
3819   fWithoutAlpha     := tfDepth32ui1;
3820   fOpenGLFormat     := tfDepth32ui1;
3821   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3822   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3823   fglFormat         := GL_DEPTH_COMPONENT;
3824   fglInternalFormat := GL_DEPTH_COMPONENT32;
3825   fglDataFormat     := GL_UNSIGNED_INT;
3826 end;
3827
3828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3829 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3831 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3832 begin
3833   raise EglBitmap.Create('mapping for compressed formats is not supported');
3834 end;
3835
3836 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3837 begin
3838   raise EglBitmap.Create('mapping for compressed formats is not supported');
3839 end;
3840
3841 procedure TfdS3tcDtx1RGBA.SetValues;
3842 begin
3843   inherited SetValues;
3844   fFormat           := tfS3tcDtx1RGBA;
3845   fWithAlpha        := tfS3tcDtx1RGBA;
3846   fOpenGLFormat     := tfS3tcDtx1RGBA;
3847   fUncompressed     := tfRGB5A1us1;
3848   fBitsPerPixel     := 4;
3849   fIsCompressed     := true;
3850   fglFormat         := GL_COMPRESSED_RGBA;
3851   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3852   fglDataFormat     := GL_UNSIGNED_BYTE;
3853 end;
3854
3855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3856 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3858 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3859 begin
3860   raise EglBitmap.Create('mapping for compressed formats is not supported');
3861 end;
3862
3863 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3864 begin
3865   raise EglBitmap.Create('mapping for compressed formats is not supported');
3866 end;
3867
3868 procedure TfdS3tcDtx3RGBA.SetValues;
3869 begin
3870   inherited SetValues;
3871   fFormat           := tfS3tcDtx3RGBA;
3872   fWithAlpha        := tfS3tcDtx3RGBA;
3873   fOpenGLFormat     := tfS3tcDtx3RGBA;
3874   fUncompressed     := tfRGBA8ub4;
3875   fBitsPerPixel     := 8;
3876   fIsCompressed     := true;
3877   fglFormat         := GL_COMPRESSED_RGBA;
3878   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3879   fglDataFormat     := GL_UNSIGNED_BYTE;
3880 end;
3881
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3885 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3886 begin
3887   raise EglBitmap.Create('mapping for compressed formats is not supported');
3888 end;
3889
3890 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3891 begin
3892   raise EglBitmap.Create('mapping for compressed formats is not supported');
3893 end;
3894
3895 procedure TfdS3tcDtx5RGBA.SetValues;
3896 begin
3897   inherited SetValues;
3898   fFormat           := tfS3tcDtx3RGBA;
3899   fWithAlpha        := tfS3tcDtx3RGBA;
3900   fOpenGLFormat     := tfS3tcDtx3RGBA;
3901   fUncompressed     := tfRGBA8ub4;
3902   fBitsPerPixel     := 8;
3903   fIsCompressed     := true;
3904   fglFormat         := GL_COMPRESSED_RGBA;
3905   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3906   fglDataFormat     := GL_UNSIGNED_BYTE;
3907 end;
3908
3909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3910 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3912 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3913 begin
3914   result := (fPrecision.r > 0);
3915 end;
3916
3917 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3918 begin
3919   result := (fPrecision.g > 0);
3920 end;
3921
3922 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3923 begin
3924   result := (fPrecision.b > 0);
3925 end;
3926
3927 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3928 begin
3929   result := (fPrecision.a > 0);
3930 end;
3931
3932 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3933 begin
3934   result := HasRed or HasGreen or HasBlue;
3935 end;
3936
3937 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3938 begin
3939   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3940 end;
3941
3942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3943 procedure TglBitmapFormatDescriptor.SetValues;
3944 begin
3945   fFormat       := tfEmpty;
3946   fWithAlpha    := tfEmpty;
3947   fWithoutAlpha := tfEmpty;
3948   fOpenGLFormat := tfEmpty;
3949   fRGBInverted  := tfEmpty;
3950   fUncompressed := tfEmpty;
3951
3952   fBitsPerPixel := 0;
3953   fIsCompressed := false;
3954
3955   fglFormat         := 0;
3956   fglInternalFormat := 0;
3957   fglDataFormat     := 0;
3958
3959   FillChar(fPrecision, 0, SizeOf(fPrecision));
3960   FillChar(fShift,     0, SizeOf(fShift));
3961 end;
3962
3963 procedure TglBitmapFormatDescriptor.CalcValues;
3964 var
3965   i: Integer;
3966 begin
3967   fBytesPerPixel := fBitsPerPixel / 8;
3968   fChannelCount  := 0;
3969   for i := 0 to 3 do begin
3970     if (fPrecision.arr[i] > 0) then
3971       inc(fChannelCount);
3972     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3973     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3974   end;
3975 end;
3976
3977 constructor TglBitmapFormatDescriptor.Create;
3978 begin
3979   inherited Create;
3980   SetValues;
3981   CalcValues;
3982 end;
3983
3984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3985 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3986 var
3987   f: TglBitmapFormat;
3988 begin
3989   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3990     result := TFormatDescriptor.Get(f);
3991     if (result.glInternalFormat = aInternalFormat) then
3992       exit;
3993   end;
3994   result := TFormatDescriptor.Get(tfEmpty);
3995 end;
3996
3997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3998 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4000 class procedure TFormatDescriptor.Init;
4001 begin
4002   if not Assigned(FormatDescriptorCS) then
4003     FormatDescriptorCS := TCriticalSection.Create;
4004 end;
4005
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4008 begin
4009   FormatDescriptorCS.Enter;
4010   try
4011     result := FormatDescriptors[aFormat];
4012     if not Assigned(result) then begin
4013       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4014       FormatDescriptors[aFormat] := result;
4015     end;
4016   finally
4017     FormatDescriptorCS.Leave;
4018   end;
4019 end;
4020
4021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4023 begin
4024   result := Get(Get(aFormat).WithAlpha);
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4029 var
4030   ft: TglBitmapFormat;
4031 begin
4032   // find matching format with OpenGL support
4033   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4034     result := Get(ft);
4035     if (result.MaskMatch(aMask))      and
4036        (result.glFormat <> 0)         and
4037        (result.glInternalFormat <> 0) and
4038        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4039     then
4040       exit;
4041   end;
4042
4043   // find matching format without OpenGL Support
4044   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4045     result := Get(ft);
4046     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4047       exit;
4048   end;
4049
4050   result := TFormatDescriptor.Get(tfEmpty);
4051 end;
4052
4053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4054 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4055 var
4056   ft: TglBitmapFormat;
4057 begin
4058   // find matching format with OpenGL support
4059   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4060     result := Get(ft);
4061     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4062        glBitmapRec4ubCompare(result.Precision, aPrec) and
4063        (result.glFormat <> 0)         and
4064        (result.glInternalFormat <> 0) and
4065        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4066     then
4067       exit;
4068   end;
4069
4070   // find matching format without OpenGL Support
4071   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4072     result := Get(ft);
4073     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4074        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4075        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4076       exit;
4077   end;
4078
4079   result := TFormatDescriptor.Get(tfEmpty);
4080 end;
4081
4082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4083 class procedure TFormatDescriptor.Clear;
4084 var
4085   f: TglBitmapFormat;
4086 begin
4087   FormatDescriptorCS.Enter;
4088   try
4089     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4090       FreeAndNil(FormatDescriptors[f]);
4091   finally
4092     FormatDescriptorCS.Leave;
4093   end;
4094 end;
4095
4096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4097 class procedure TFormatDescriptor.Finalize;
4098 begin
4099   Clear;
4100   FreeAndNil(FormatDescriptorCS);
4101 end;
4102
4103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4104 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4106 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4107 var
4108   i: Integer;
4109 begin
4110   for i := 0 to 3 do begin
4111     fShift.arr[i] := 0;
4112     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4113       aMask.arr[i] := aMask.arr[i] shr 1;
4114       inc(fShift.arr[i]);
4115     end;
4116     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4117   end;
4118   CalcValues;
4119 end;
4120
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4123 begin
4124   fBitsPerPixel := aBBP;
4125   fPrecision    := aPrec;
4126   fShift        := aShift;
4127   CalcValues;
4128 end;
4129
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4132 var
4133   data: QWord;
4134 begin
4135   data :=
4136     ((aPixel.Data.r and Range.r) shl Shift.r) or
4137     ((aPixel.Data.g and Range.g) shl Shift.g) or
4138     ((aPixel.Data.b and Range.b) shl Shift.b) or
4139     ((aPixel.Data.a and Range.a) shl Shift.a);
4140   case BitsPerPixel of
4141     8:           aData^  := data;
4142    16:     PWord(aData)^ := data;
4143    32: PCardinal(aData)^ := data;
4144    64:    PQWord(aData)^ := data;
4145   else
4146     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4147   end;
4148   inc(aData, Round(BytesPerPixel));
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4153 var
4154   data: QWord;
4155   i: Integer;
4156 begin
4157   case BitsPerPixel of
4158      8: data :=           aData^;
4159     16: data :=     PWord(aData)^;
4160     32: data := PCardinal(aData)^;
4161     64: data :=    PQWord(aData)^;
4162   else
4163     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4164   end;
4165   for i := 0 to 3 do
4166     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4167   inc(aData, Round(BytesPerPixel));
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 procedure TbmpColorTableFormat.SetValues;
4174 begin
4175   inherited SetValues;
4176   fShift := glBitmapRec4ub(8, 8, 8, 0);
4177 end;
4178
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4181 begin
4182   fFormat       := aFormat;
4183   fBitsPerPixel := aBPP;
4184   fPrecision    := aPrec;
4185   fShift        := aShift;
4186   CalcValues;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 procedure TbmpColorTableFormat.CalcValues;
4191 begin
4192   inherited CalcValues;
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 procedure TbmpColorTableFormat.CreateColorTable;
4197 var
4198   i: Integer;
4199 begin
4200   SetLength(fColorTable, 256);
4201   if not HasColor then begin
4202     // alpha
4203     for i := 0 to High(fColorTable) do begin
4204       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4205       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4206       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4207       fColorTable[i].a := 0;
4208     end;
4209   end else begin
4210     // normal
4211     for i := 0 to High(fColorTable) do begin
4212       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4213       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4214       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4215       fColorTable[i].a := 0;
4216     end;
4217   end;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4222 begin
4223   if (BitsPerPixel <> 8) then
4224     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4225   if not HasColor then
4226     // alpha
4227     aData^ := aPixel.Data.a
4228   else
4229     // normal
4230     aData^ := Round(
4231       ((aPixel.Data.r and Range.r) shl Shift.r) or
4232       ((aPixel.Data.g and Range.g) shl Shift.g) or
4233       ((aPixel.Data.b and Range.b) shl Shift.b));
4234   inc(aData);
4235 end;
4236
4237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4238 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4239 begin
4240   if (BitsPerPixel <> 8) then
4241     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4242   with fColorTable[aData^] do begin
4243     aPixel.Data.r := r;
4244     aPixel.Data.g := g;
4245     aPixel.Data.b := b;
4246     aPixel.Data.a := a;
4247   end;
4248   inc(aData, 1);
4249 end;
4250
4251 destructor TbmpColorTableFormat.Destroy;
4252 begin
4253   SetLength(fColorTable, 0);
4254   inherited Destroy;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4261 var
4262   i: Integer;
4263 begin
4264   for i := 0 to 3 do begin
4265     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4266       if (aSourceFD.Range.arr[i] > 0) then
4267         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4268       else
4269         aPixel.Data.arr[i] := 0;
4270     end;
4271   end;
4272 end;
4273
4274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4275 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4276 begin
4277   with aFuncRec do begin
4278     if (Source.Range.r   > 0) then
4279       Dest.Data.r := Source.Data.r;
4280     if (Source.Range.g > 0) then
4281       Dest.Data.g := Source.Data.g;
4282     if (Source.Range.b  > 0) then
4283       Dest.Data.b := Source.Data.b;
4284     if (Source.Range.a > 0) then
4285       Dest.Data.a := Source.Data.a;
4286   end;
4287 end;
4288
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4291 var
4292   i: Integer;
4293 begin
4294   with aFuncRec do begin
4295     for i := 0 to 3 do
4296       if (Source.Range.arr[i] > 0) then
4297         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4298   end;
4299 end;
4300
4301 type
4302   TShiftData = packed record
4303     case Integer of
4304       0: (r, g, b, a: SmallInt);
4305       1: (arr: array[0..3] of SmallInt);
4306   end;
4307   PShiftData = ^TShiftData;
4308
4309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4310 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4311 var
4312   i: Integer;
4313 begin
4314   with aFuncRec do
4315     for i := 0 to 3 do
4316       if (Source.Range.arr[i] > 0) then
4317         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4318 end;
4319
4320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4321 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4322 begin
4323   with aFuncRec do begin
4324     Dest.Data := Source.Data;
4325     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4326       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4327       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4328       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4329     end;
4330     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4331       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4332     end;
4333   end;
4334 end;
4335
4336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4337 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4338 var
4339   i: Integer;
4340 begin
4341   with aFuncRec do begin
4342     for i := 0 to 3 do
4343       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4344   end;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4349 var
4350   Temp: Single;
4351 begin
4352   with FuncRec do begin
4353     if (FuncRec.Args = nil) then begin //source has no alpha
4354       Temp :=
4355         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4356         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4357         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4358       Dest.Data.a := Round(Dest.Range.a * Temp);
4359     end else
4360       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4361   end;
4362 end;
4363
4364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4365 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4366 type
4367   PglBitmapPixelData = ^TglBitmapPixelData;
4368 begin
4369   with FuncRec do begin
4370     Dest.Data.r := Source.Data.r;
4371     Dest.Data.g := Source.Data.g;
4372     Dest.Data.b := Source.Data.b;
4373
4374     with PglBitmapPixelData(Args)^ do
4375       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4376           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4377           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4378         Dest.Data.a := 0
4379       else
4380         Dest.Data.a := Dest.Range.a;
4381   end;
4382 end;
4383
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4386 begin
4387   with FuncRec do begin
4388     Dest.Data.r := Source.Data.r;
4389     Dest.Data.g := Source.Data.g;
4390     Dest.Data.b := Source.Data.b;
4391     Dest.Data.a := PCardinal(Args)^;
4392   end;
4393 end;
4394
4395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4396 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4397 type
4398   PRGBPix = ^TRGBPix;
4399   TRGBPix = array [0..2] of byte;
4400 var
4401   Temp: Byte;
4402 begin
4403   while aWidth > 0 do begin
4404     Temp := PRGBPix(aData)^[0];
4405     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4406     PRGBPix(aData)^[2] := Temp;
4407
4408     if aHasAlpha then
4409       Inc(aData, 4)
4410     else
4411       Inc(aData, 3);
4412     dec(aWidth);
4413   end;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4420 begin
4421   result := TFormatDescriptor.Get(Format);
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 function TglBitmap.GetWidth: Integer;
4426 begin
4427   if (ffX in fDimension.Fields) then
4428     result := fDimension.X
4429   else
4430     result := -1;
4431 end;
4432
4433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4434 function TglBitmap.GetHeight: Integer;
4435 begin
4436   if (ffY in fDimension.Fields) then
4437     result := fDimension.Y
4438   else
4439     result := -1;
4440 end;
4441
4442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4443 function TglBitmap.GetFileWidth: Integer;
4444 begin
4445   result := Max(1, Width);
4446 end;
4447
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 function TglBitmap.GetFileHeight: Integer;
4450 begin
4451   result := Max(1, Height);
4452 end;
4453
4454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4455 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4456 begin
4457   if fCustomData = aValue then
4458     exit;
4459   fCustomData := aValue;
4460 end;
4461
4462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4463 procedure TglBitmap.SetCustomName(const aValue: String);
4464 begin
4465   if fCustomName = aValue then
4466     exit;
4467   fCustomName := aValue;
4468 end;
4469
4470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4471 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4472 begin
4473   if fCustomNameW = aValue then
4474     exit;
4475   fCustomNameW := aValue;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4480 begin
4481   if fFreeDataOnDestroy = aValue then
4482     exit;
4483   fFreeDataOnDestroy := aValue;
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4488 begin
4489   if fDeleteTextureOnFree = aValue then
4490     exit;
4491   fDeleteTextureOnFree := aValue;
4492 end;
4493
4494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4495 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4496 begin
4497   if fFormat = aValue then
4498     exit;
4499   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4500     raise EglBitmapUnsupportedFormat.Create(Format);
4501   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4502 end;
4503
4504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4505 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4506 begin
4507   if fFreeDataAfterGenTexture = aValue then
4508     exit;
4509   fFreeDataAfterGenTexture := aValue;
4510 end;
4511
4512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4513 procedure TglBitmap.SetID(const aValue: Cardinal);
4514 begin
4515   if fID = aValue then
4516     exit;
4517   fID := aValue;
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4522 begin
4523   if fMipMap = aValue then
4524     exit;
4525   fMipMap := aValue;
4526 end;
4527
4528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4529 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4530 begin
4531   if fTarget = aValue then
4532     exit;
4533   fTarget := aValue;
4534 end;
4535
4536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4537 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4538 var
4539   MaxAnisotropic: Integer;
4540 begin
4541   fAnisotropic := aValue;
4542   if (ID > 0) then begin
4543     if GL_EXT_texture_filter_anisotropic then begin
4544       if fAnisotropic > 0 then begin
4545         Bind(false);
4546         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4547         if aValue > MaxAnisotropic then
4548           fAnisotropic := MaxAnisotropic;
4549         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4550       end;
4551     end else begin
4552       fAnisotropic := 0;
4553     end;
4554   end;
4555 end;
4556
4557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4558 procedure TglBitmap.CreateID;
4559 begin
4560   if (ID <> 0) then
4561     glDeleteTextures(1, @fID);
4562   glGenTextures(1, @fID);
4563   Bind(false);
4564 end;
4565
4566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4567 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4568 begin
4569   // Set Up Parameters
4570   SetWrap(fWrapS, fWrapT, fWrapR);
4571   SetFilter(fFilterMin, fFilterMag);
4572   SetAnisotropic(fAnisotropic);
4573   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4574
4575   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4576     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4577
4578   // Mip Maps Generation Mode
4579   aBuildWithGlu := false;
4580   if (MipMap = mmMipmap) then begin
4581     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4582       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4583     else
4584       aBuildWithGlu := true;
4585   end else if (MipMap = mmMipmapGlu) then
4586     aBuildWithGlu := true;
4587 end;
4588
4589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4590 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4591   const aWidth: Integer; const aHeight: Integer);
4592 var
4593   s: Single;
4594 begin
4595   if (Data <> aData) then begin
4596     if (Assigned(Data)) then
4597       FreeMem(Data);
4598     fData := aData;
4599   end;
4600
4601   if not Assigned(fData) then begin
4602     fPixelSize := 0;
4603     fRowSize   := 0;
4604   end else begin
4605     FillChar(fDimension, SizeOf(fDimension), 0);
4606     if aWidth <> -1 then begin
4607       fDimension.Fields := fDimension.Fields + [ffX];
4608       fDimension.X := aWidth;
4609     end;
4610
4611     if aHeight <> -1 then begin
4612       fDimension.Fields := fDimension.Fields + [ffY];
4613       fDimension.Y := aHeight;
4614     end;
4615
4616     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4617     fFormat    := aFormat;
4618     fPixelSize := Ceil(s);
4619     fRowSize   := Ceil(s * aWidth);
4620   end;
4621 end;
4622
4623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4624 function TglBitmap.FlipHorz: Boolean;
4625 begin
4626   result := false;
4627 end;
4628
4629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4630 function TglBitmap.FlipVert: Boolean;
4631 begin
4632   result := false;
4633 end;
4634
4635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4636 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 procedure TglBitmap.AfterConstruction;
4639 begin
4640   inherited AfterConstruction;
4641
4642   fID         := 0;
4643   fTarget     := 0;
4644   fIsResident := false;
4645
4646   fMipMap                  := glBitmapDefaultMipmap;
4647   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4648   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4649
4650   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4651   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4652   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4653 end;
4654
4655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4656 procedure TglBitmap.BeforeDestruction;
4657 var
4658   NewData: PByte;
4659 begin
4660   if fFreeDataOnDestroy then begin
4661     NewData := nil;
4662     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4663   end;
4664   if (fID > 0) and fDeleteTextureOnFree then
4665     glDeleteTextures(1, @fID);
4666   inherited BeforeDestruction;
4667 end;
4668
4669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4670 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4671 var
4672   TempPos: Integer;
4673 begin
4674   if not Assigned(aResType) then begin
4675     TempPos   := Pos('.', aResource);
4676     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4677     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4678   end;
4679 end;
4680
4681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4682 procedure TglBitmap.LoadFromFile(const aFilename: String);
4683 var
4684   fs: TFileStream;
4685 begin
4686   if not FileExists(aFilename) then
4687     raise EglBitmap.Create('file does not exist: ' + aFilename);
4688   fFilename := aFilename;
4689   fs := TFileStream.Create(fFilename, fmOpenRead);
4690   try
4691     fs.Position := 0;
4692     LoadFromStream(fs);
4693   finally
4694     fs.Free;
4695   end;
4696 end;
4697
4698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4699 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4700 begin
4701   {$IFDEF GLB_SUPPORT_PNG_READ}
4702   if not LoadPNG(aStream) then
4703   {$ENDIF}
4704   {$IFDEF GLB_SUPPORT_JPEG_READ}
4705   if not LoadJPEG(aStream) then
4706   {$ENDIF}
4707   if not LoadDDS(aStream) then
4708   if not LoadTGA(aStream) then
4709   if not LoadBMP(aStream) then
4710   if not LoadRAW(aStream) then
4711     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4712 end;
4713
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4716   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4717 var
4718   tmpData: PByte;
4719   size: Integer;
4720 begin
4721   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4722   GetMem(tmpData, size);
4723   try
4724     FillChar(tmpData^, size, #$FF);
4725     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4726   except
4727     if Assigned(tmpData) then
4728       FreeMem(tmpData);
4729     raise;
4730   end;
4731   AddFunc(Self, aFunc, false, aFormat, aArgs);
4732 end;
4733
4734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4735 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4736 var
4737   rs: TResourceStream;
4738 begin
4739   PrepareResType(aResource, aResType);
4740   rs := TResourceStream.Create(aInstance, aResource, aResType);
4741   try
4742     LoadFromStream(rs);
4743   finally
4744     rs.Free;
4745   end;
4746 end;
4747
4748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4749 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4750 var
4751   rs: TResourceStream;
4752 begin
4753   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4754   try
4755     LoadFromStream(rs);
4756   finally
4757     rs.Free;
4758   end;
4759 end;
4760
4761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4762 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4763 var
4764   fs: TFileStream;
4765 begin
4766   fs := TFileStream.Create(aFileName, fmCreate);
4767   try
4768     fs.Position := 0;
4769     SaveToStream(fs, aFileType);
4770   finally
4771     fs.Free;
4772   end;
4773 end;
4774
4775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4776 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4777 begin
4778   case aFileType of
4779     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4780     ftPNG:  SavePNG(aStream);
4781     {$ENDIF}
4782     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4783     ftJPEG: SaveJPEG(aStream);
4784     {$ENDIF}
4785     ftDDS:  SaveDDS(aStream);
4786     ftTGA:  SaveTGA(aStream);
4787     ftBMP:  SaveBMP(aStream);
4788     ftRAW:  SaveRAW(aStream);
4789   end;
4790 end;
4791
4792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4793 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4794 begin
4795   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4796 end;
4797
4798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4799 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4800   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4801 var
4802   DestData, TmpData, SourceData: pByte;
4803   TempHeight, TempWidth: Integer;
4804   SourceFD, DestFD: TFormatDescriptor;
4805   SourceMD, DestMD: Pointer;
4806
4807   FuncRec: TglBitmapFunctionRec;
4808 begin
4809   Assert(Assigned(Data));
4810   Assert(Assigned(aSource));
4811   Assert(Assigned(aSource.Data));
4812
4813   result := false;
4814   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4815     SourceFD := TFormatDescriptor.Get(aSource.Format);
4816     DestFD   := TFormatDescriptor.Get(aFormat);
4817
4818     if (SourceFD.IsCompressed) then
4819       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4820     if (DestFD.IsCompressed) then
4821       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4822
4823     // inkompatible Formats so CreateTemp
4824     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
4825       aCreateTemp := true;
4826
4827     // Values
4828     TempHeight := Max(1, aSource.Height);
4829     TempWidth  := Max(1, aSource.Width);
4830
4831     FuncRec.Sender := Self;
4832     FuncRec.Args   := aArgs;
4833
4834     TmpData := nil;
4835     if aCreateTemp then begin
4836       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4837       DestData := TmpData;
4838     end else
4839       DestData := Data;
4840
4841     try
4842       SourceFD.PreparePixel(FuncRec.Source);
4843       DestFD.PreparePixel  (FuncRec.Dest);
4844
4845       SourceMD := SourceFD.CreateMappingData;
4846       DestMD   := DestFD.CreateMappingData;
4847
4848       FuncRec.Size            := aSource.Dimension;
4849       FuncRec.Position.Fields := FuncRec.Size.Fields;
4850
4851       try
4852         SourceData := aSource.Data;
4853         FuncRec.Position.Y := 0;
4854         while FuncRec.Position.Y < TempHeight do begin
4855           FuncRec.Position.X := 0;
4856           while FuncRec.Position.X < TempWidth do begin
4857             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4858             aFunc(FuncRec);
4859             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4860             inc(FuncRec.Position.X);
4861           end;
4862           inc(FuncRec.Position.Y);
4863         end;
4864
4865         // Updating Image or InternalFormat
4866         if aCreateTemp then
4867           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4868         else if (aFormat <> fFormat) then
4869           Format := aFormat;
4870
4871         result := true;
4872       finally
4873         SourceFD.FreeMappingData(SourceMD);
4874         DestFD.FreeMappingData(DestMD);
4875       end;
4876     except
4877       if aCreateTemp and Assigned(TmpData) then
4878         FreeMem(TmpData);
4879       raise;
4880     end;
4881   end;
4882 end;
4883
4884 {$IFDEF GLB_SDL}
4885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4886 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4887 var
4888   Row, RowSize: Integer;
4889   SourceData, TmpData: PByte;
4890   TempDepth: Integer;
4891   FormatDesc: TFormatDescriptor;
4892
4893   function GetRowPointer(Row: Integer): pByte;
4894   begin
4895     result := aSurface.pixels;
4896     Inc(result, Row * RowSize);
4897   end;
4898
4899 begin
4900   result := false;
4901
4902   FormatDesc := TFormatDescriptor.Get(Format);
4903   if FormatDesc.IsCompressed then
4904     raise EglBitmapUnsupportedFormat.Create(Format);
4905
4906   if Assigned(Data) then begin
4907     case Trunc(FormatDesc.PixelSize) of
4908       1: TempDepth :=  8;
4909       2: TempDepth := 16;
4910       3: TempDepth := 24;
4911       4: TempDepth := 32;
4912     else
4913       raise EglBitmapUnsupportedFormat.Create(Format);
4914     end;
4915
4916     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4917       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4918     SourceData := Data;
4919     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4920
4921     for Row := 0 to FileHeight-1 do begin
4922       TmpData := GetRowPointer(Row);
4923       if Assigned(TmpData) then begin
4924         Move(SourceData^, TmpData^, RowSize);
4925         inc(SourceData, RowSize);
4926       end;
4927     end;
4928     result := true;
4929   end;
4930 end;
4931
4932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4933 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4934 var
4935   pSource, pData, pTempData: PByte;
4936   Row, RowSize, TempWidth, TempHeight: Integer;
4937   IntFormat: TglBitmapFormat;
4938   fd: TFormatDescriptor;
4939   Mask: TglBitmapMask;
4940
4941   function GetRowPointer(Row: Integer): pByte;
4942   begin
4943     result := aSurface^.pixels;
4944     Inc(result, Row * RowSize);
4945   end;
4946
4947 begin
4948   result := false;
4949   if (Assigned(aSurface)) then begin
4950     with aSurface^.format^ do begin
4951       Mask.r := RMask;
4952       Mask.g := GMask;
4953       Mask.b := BMask;
4954       Mask.a := AMask;
4955       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
4956       if (IntFormat = tfEmpty) then
4957         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
4958     end;
4959
4960     fd := TFormatDescriptor.Get(IntFormat);
4961     TempWidth  := aSurface^.w;
4962     TempHeight := aSurface^.h;
4963     RowSize := fd.GetSize(TempWidth, 1);
4964     GetMem(pData, TempHeight * RowSize);
4965     try
4966       pTempData := pData;
4967       for Row := 0 to TempHeight -1 do begin
4968         pSource := GetRowPointer(Row);
4969         if (Assigned(pSource)) then begin
4970           Move(pSource^, pTempData^, RowSize);
4971           Inc(pTempData, RowSize);
4972         end;
4973       end;
4974       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4975       result := true;
4976     except
4977       if Assigned(pData) then
4978         FreeMem(pData);
4979       raise;
4980     end;
4981   end;
4982 end;
4983
4984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4985 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4986 var
4987   Row, Col, AlphaInterleave: Integer;
4988   pSource, pDest: PByte;
4989
4990   function GetRowPointer(Row: Integer): pByte;
4991   begin
4992     result := aSurface.pixels;
4993     Inc(result, Row * Width);
4994   end;
4995
4996 begin
4997   result := false;
4998   if Assigned(Data) then begin
4999     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5000       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5001
5002       AlphaInterleave := 0;
5003       case Format of
5004         tfLuminance8Alpha8ub2:
5005           AlphaInterleave := 1;
5006         tfBGRA8ub4, tfRGBA8ub4:
5007           AlphaInterleave := 3;
5008       end;
5009
5010       pSource := Data;
5011       for Row := 0 to Height -1 do begin
5012         pDest := GetRowPointer(Row);
5013         if Assigned(pDest) then begin
5014           for Col := 0 to Width -1 do begin
5015             Inc(pSource, AlphaInterleave);
5016             pDest^ := pSource^;
5017             Inc(pDest);
5018             Inc(pSource);
5019           end;
5020         end;
5021       end;
5022       result := true;
5023     end;
5024   end;
5025 end;
5026
5027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5028 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5029 var
5030   bmp: TglBitmap2D;
5031 begin
5032   bmp := TglBitmap2D.Create;
5033   try
5034     bmp.AssignFromSurface(aSurface);
5035     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5036   finally
5037     bmp.Free;
5038   end;
5039 end;
5040 {$ENDIF}
5041
5042 {$IFDEF GLB_DELPHI}
5043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5044 function CreateGrayPalette: HPALETTE;
5045 var
5046   Idx: Integer;
5047   Pal: PLogPalette;
5048 begin
5049   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5050
5051   Pal.palVersion := $300;
5052   Pal.palNumEntries := 256;
5053
5054   for Idx := 0 to Pal.palNumEntries - 1 do begin
5055     Pal.palPalEntry[Idx].peRed   := Idx;
5056     Pal.palPalEntry[Idx].peGreen := Idx;
5057     Pal.palPalEntry[Idx].peBlue  := Idx;
5058     Pal.palPalEntry[Idx].peFlags := 0;
5059   end;
5060   Result := CreatePalette(Pal^);
5061   FreeMem(Pal);
5062 end;
5063
5064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5065 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5066 var
5067   Row: Integer;
5068   pSource, pData: PByte;
5069 begin
5070   result := false;
5071   if Assigned(Data) then begin
5072     if Assigned(aBitmap) then begin
5073       aBitmap.Width  := Width;
5074       aBitmap.Height := Height;
5075
5076       case Format of
5077         tfAlpha8ub1, tfLuminance8ub1: begin
5078           aBitmap.PixelFormat := pf8bit;
5079           aBitmap.Palette     := CreateGrayPalette;
5080         end;
5081         tfRGB5A1us1:
5082           aBitmap.PixelFormat := pf15bit;
5083         tfR5G6B5us1:
5084           aBitmap.PixelFormat := pf16bit;
5085         tfRGB8ub3, tfBGR8ub3:
5086           aBitmap.PixelFormat := pf24bit;
5087         tfRGBA8ub4, tfBGRA8ub4:
5088           aBitmap.PixelFormat := pf32bit;
5089       else
5090         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5091       end;
5092
5093       pSource := Data;
5094       for Row := 0 to FileHeight -1 do begin
5095         pData := aBitmap.Scanline[Row];
5096         Move(pSource^, pData^, fRowSize);
5097         Inc(pSource, fRowSize);
5098         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5099           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5100       end;
5101       result := true;
5102     end;
5103   end;
5104 end;
5105
5106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5107 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5108 var
5109   pSource, pData, pTempData: PByte;
5110   Row, RowSize, TempWidth, TempHeight: Integer;
5111   IntFormat: TglBitmapFormat;
5112 begin
5113   result := false;
5114
5115   if (Assigned(aBitmap)) then begin
5116     case aBitmap.PixelFormat of
5117       pf8bit:
5118         IntFormat := tfLuminance8ub1;
5119       pf15bit:
5120         IntFormat := tfRGB5A1us1;
5121       pf16bit:
5122         IntFormat := tfR5G6B5us1;
5123       pf24bit:
5124         IntFormat := tfBGR8ub3;
5125       pf32bit:
5126         IntFormat := tfBGRA8ub4;
5127     else
5128       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5129     end;
5130
5131     TempWidth  := aBitmap.Width;
5132     TempHeight := aBitmap.Height;
5133     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5134     GetMem(pData, TempHeight * RowSize);
5135     try
5136       pTempData := pData;
5137       for Row := 0 to TempHeight -1 do begin
5138         pSource := aBitmap.Scanline[Row];
5139         if (Assigned(pSource)) then begin
5140           Move(pSource^, pTempData^, RowSize);
5141           Inc(pTempData, RowSize);
5142         end;
5143       end;
5144       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5145       result := true;
5146     except
5147       if Assigned(pData) then
5148         FreeMem(pData);
5149       raise;
5150     end;
5151   end;
5152 end;
5153
5154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5155 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5156 var
5157   Row, Col, AlphaInterleave: Integer;
5158   pSource, pDest: PByte;
5159 begin
5160   result := false;
5161
5162   if Assigned(Data) then begin
5163     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5164       if Assigned(aBitmap) then begin
5165         aBitmap.PixelFormat := pf8bit;
5166         aBitmap.Palette     := CreateGrayPalette;
5167         aBitmap.Width       := Width;
5168         aBitmap.Height      := Height;
5169
5170         case Format of
5171           tfLuminance8Alpha8ub2:
5172             AlphaInterleave := 1;
5173           tfRGBA8ub4, tfBGRA8ub4:
5174             AlphaInterleave := 3;
5175           else
5176             AlphaInterleave := 0;
5177         end;
5178
5179         // Copy Data
5180         pSource := Data;
5181
5182         for Row := 0 to Height -1 do begin
5183           pDest := aBitmap.Scanline[Row];
5184           if Assigned(pDest) then begin
5185             for Col := 0 to Width -1 do begin
5186               Inc(pSource, AlphaInterleave);
5187               pDest^ := pSource^;
5188               Inc(pDest);
5189               Inc(pSource);
5190             end;
5191           end;
5192         end;
5193         result := true;
5194       end;
5195     end;
5196   end;
5197 end;
5198
5199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5200 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5201 var
5202   tex: TglBitmap2D;
5203 begin
5204   tex := TglBitmap2D.Create;
5205   try
5206     tex.AssignFromBitmap(ABitmap);
5207     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5208   finally
5209     tex.Free;
5210   end;
5211 end;
5212 {$ENDIF}
5213
5214 {$IFDEF GLB_LAZARUS}
5215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5216 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5217 var
5218   rid: TRawImageDescription;
5219   FormatDesc: TFormatDescriptor;
5220 begin
5221   if not Assigned(Data) then
5222     raise EglBitmap.Create('no pixel data assigned. load data before save');
5223
5224   result := false;
5225   if not Assigned(aImage) or (Format = tfEmpty) then
5226     exit;
5227   FormatDesc := TFormatDescriptor.Get(Format);
5228   if FormatDesc.IsCompressed then
5229     exit;
5230
5231   FillChar(rid{%H-}, SizeOf(rid), 0);
5232   if FormatDesc.IsGrayscale then
5233     rid.Format := ricfGray
5234   else
5235     rid.Format := ricfRGBA;
5236
5237   rid.Width        := Width;
5238   rid.Height       := Height;
5239   rid.Depth        := FormatDesc.BitsPerPixel;
5240   rid.BitOrder     := riboBitsInOrder;
5241   rid.ByteOrder    := riboLSBFirst;
5242   rid.LineOrder    := riloTopToBottom;
5243   rid.LineEnd      := rileTight;
5244   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5245   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5246   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5247   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5248   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5249   rid.RedShift     := FormatDesc.Shift.r;
5250   rid.GreenShift   := FormatDesc.Shift.g;
5251   rid.BlueShift    := FormatDesc.Shift.b;
5252   rid.AlphaShift   := FormatDesc.Shift.a;
5253
5254   rid.MaskBitsPerPixel  := 0;
5255   rid.PaletteColorCount := 0;
5256
5257   aImage.DataDescription := rid;
5258   aImage.CreateData;
5259
5260   if not Assigned(aImage.PixelData) then
5261     raise EglBitmap.Create('error while creating LazIntfImage');
5262   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5263
5264   result := true;
5265 end;
5266
5267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5268 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5269 var
5270   f: TglBitmapFormat;
5271   FormatDesc: TFormatDescriptor;
5272   ImageData: PByte;
5273   ImageSize: Integer;
5274   CanCopy: Boolean;
5275   Mask: TglBitmapRec4ul;
5276
5277   procedure CopyConvert;
5278   var
5279     bfFormat: TbmpBitfieldFormat;
5280     pSourceLine, pDestLine: PByte;
5281     pSourceMD, pDestMD: Pointer;
5282     Shift, Prec: TglBitmapRec4ub;
5283     x, y: Integer;
5284     pixel: TglBitmapPixelData;
5285   begin
5286     bfFormat  := TbmpBitfieldFormat.Create;
5287     with aImage.DataDescription do begin
5288       Prec.r := RedPrec;
5289       Prec.g := GreenPrec;
5290       Prec.b := BluePrec;
5291       Prec.a := AlphaPrec;
5292       Shift.r := RedShift;
5293       Shift.g := GreenShift;
5294       Shift.b := BlueShift;
5295       Shift.a := AlphaShift;
5296       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5297     end;
5298     pSourceMD := bfFormat.CreateMappingData;
5299     pDestMD   := FormatDesc.CreateMappingData;
5300     try
5301       for y := 0 to aImage.Height-1 do begin
5302         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5303         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5304         for x := 0 to aImage.Width-1 do begin
5305           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5306           FormatDesc.Map(pixel, pDestLine, pDestMD);
5307         end;
5308       end;
5309     finally
5310       FormatDesc.FreeMappingData(pDestMD);
5311       bfFormat.FreeMappingData(pSourceMD);
5312       bfFormat.Free;
5313     end;
5314   end;
5315
5316 begin
5317   result := false;
5318   if not Assigned(aImage) then
5319     exit;
5320
5321   with aImage.DataDescription do begin
5322     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5323     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5324     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5325     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5326   end;
5327   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5328   f          := FormatDesc.Format;
5329   if (f = tfEmpty) then
5330     exit;
5331
5332   CanCopy :=
5333     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5334     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5335
5336   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5337   ImageData := GetMem(ImageSize);
5338   try
5339     if CanCopy then
5340       Move(aImage.PixelData^, ImageData^, ImageSize)
5341     else
5342       CopyConvert;
5343     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5344   except
5345     if Assigned(ImageData) then
5346       FreeMem(ImageData);
5347     raise;
5348   end;
5349
5350   result := true;
5351 end;
5352
5353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5354 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5355 var
5356   rid: TRawImageDescription;
5357   FormatDesc: TFormatDescriptor;
5358   Pixel: TglBitmapPixelData;
5359   x, y: Integer;
5360   srcMD: Pointer;
5361   src, dst: PByte;
5362 begin
5363   result := false;
5364   if not Assigned(aImage) or (Format = tfEmpty) then
5365     exit;
5366   FormatDesc := TFormatDescriptor.Get(Format);
5367   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5368     exit;
5369
5370   FillChar(rid{%H-}, SizeOf(rid), 0);
5371   rid.Format       := ricfGray;
5372   rid.Width        := Width;
5373   rid.Height       := Height;
5374   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5375   rid.BitOrder     := riboBitsInOrder;
5376   rid.ByteOrder    := riboLSBFirst;
5377   rid.LineOrder    := riloTopToBottom;
5378   rid.LineEnd      := rileTight;
5379   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5380   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5381   rid.GreenPrec    := 0;
5382   rid.BluePrec     := 0;
5383   rid.AlphaPrec    := 0;
5384   rid.RedShift     := 0;
5385   rid.GreenShift   := 0;
5386   rid.BlueShift    := 0;
5387   rid.AlphaShift   := 0;
5388
5389   rid.MaskBitsPerPixel  := 0;
5390   rid.PaletteColorCount := 0;
5391
5392   aImage.DataDescription := rid;
5393   aImage.CreateData;
5394
5395   srcMD := FormatDesc.CreateMappingData;
5396   try
5397     FormatDesc.PreparePixel(Pixel);
5398     src := Data;
5399     dst := aImage.PixelData;
5400     for y := 0 to Height-1 do
5401       for x := 0 to Width-1 do begin
5402         FormatDesc.Unmap(src, Pixel, srcMD);
5403         case rid.BitsPerPixel of
5404            8: begin
5405             dst^ := Pixel.Data.a;
5406             inc(dst);
5407           end;
5408           16: begin
5409             PWord(dst)^ := Pixel.Data.a;
5410             inc(dst, 2);
5411           end;
5412           24: begin
5413             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5414             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5415             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5416             inc(dst, 3);
5417           end;
5418           32: begin
5419             PCardinal(dst)^ := Pixel.Data.a;
5420             inc(dst, 4);
5421           end;
5422         else
5423           raise EglBitmapUnsupportedFormat.Create(Format);
5424         end;
5425       end;
5426   finally
5427     FormatDesc.FreeMappingData(srcMD);
5428   end;
5429   result := true;
5430 end;
5431
5432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5433 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5434 var
5435   tex: TglBitmap2D;
5436 begin
5437   tex := TglBitmap2D.Create;
5438   try
5439     tex.AssignFromLazIntfImage(aImage);
5440     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5441   finally
5442     tex.Free;
5443   end;
5444 end;
5445 {$ENDIF}
5446
5447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5448 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5449   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5450 var
5451   rs: TResourceStream;
5452 begin
5453   PrepareResType(aResource, aResType);
5454   rs := TResourceStream.Create(aInstance, aResource, aResType);
5455   try
5456     result := AddAlphaFromStream(rs, aFunc, aArgs);
5457   finally
5458     rs.Free;
5459   end;
5460 end;
5461
5462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5463 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5464   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5465 var
5466   rs: TResourceStream;
5467 begin
5468   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5469   try
5470     result := AddAlphaFromStream(rs, aFunc, aArgs);
5471   finally
5472     rs.Free;
5473   end;
5474 end;
5475
5476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5477 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5478 begin
5479   if TFormatDescriptor.Get(Format).IsCompressed then
5480     raise EglBitmapUnsupportedFormat.Create(Format);
5481   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5482 end;
5483
5484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5485 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5486 var
5487   FS: TFileStream;
5488 begin
5489   FS := TFileStream.Create(aFileName, fmOpenRead);
5490   try
5491     result := AddAlphaFromStream(FS, aFunc, aArgs);
5492   finally
5493     FS.Free;
5494   end;
5495 end;
5496
5497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5498 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5499 var
5500   tex: TglBitmap2D;
5501 begin
5502   tex := TglBitmap2D.Create(aStream);
5503   try
5504     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5505   finally
5506     tex.Free;
5507   end;
5508 end;
5509
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5512 var
5513   DestData, DestData2, SourceData: pByte;
5514   TempHeight, TempWidth: Integer;
5515   SourceFD, DestFD: TFormatDescriptor;
5516   SourceMD, DestMD, DestMD2: Pointer;
5517
5518   FuncRec: TglBitmapFunctionRec;
5519 begin
5520   result := false;
5521
5522   Assert(Assigned(Data));
5523   Assert(Assigned(aBitmap));
5524   Assert(Assigned(aBitmap.Data));
5525
5526   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5527     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5528
5529     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5530     DestFD   := TFormatDescriptor.Get(Format);
5531
5532     if not Assigned(aFunc) then begin
5533       aFunc        := glBitmapAlphaFunc;
5534       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5535     end else
5536       FuncRec.Args := aArgs;
5537
5538     // Values
5539     TempHeight := aBitmap.FileHeight;
5540     TempWidth  := aBitmap.FileWidth;
5541
5542     FuncRec.Sender          := Self;
5543     FuncRec.Size            := Dimension;
5544     FuncRec.Position.Fields := FuncRec.Size.Fields;
5545
5546     DestData   := Data;
5547     DestData2  := Data;
5548     SourceData := aBitmap.Data;
5549
5550     // Mapping
5551     SourceFD.PreparePixel(FuncRec.Source);
5552     DestFD.PreparePixel  (FuncRec.Dest);
5553
5554     SourceMD := SourceFD.CreateMappingData;
5555     DestMD   := DestFD.CreateMappingData;
5556     DestMD2  := DestFD.CreateMappingData;
5557     try
5558       FuncRec.Position.Y := 0;
5559       while FuncRec.Position.Y < TempHeight do begin
5560         FuncRec.Position.X := 0;
5561         while FuncRec.Position.X < TempWidth do begin
5562           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5563           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5564           aFunc(FuncRec);
5565           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5566           inc(FuncRec.Position.X);
5567         end;
5568         inc(FuncRec.Position.Y);
5569       end;
5570     finally
5571       SourceFD.FreeMappingData(SourceMD);
5572       DestFD.FreeMappingData(DestMD);
5573       DestFD.FreeMappingData(DestMD2);
5574     end;
5575   end;
5576 end;
5577
5578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5579 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5580 begin
5581   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5582 end;
5583
5584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5585 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5586 var
5587   PixelData: TglBitmapPixelData;
5588 begin
5589   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5590   result := AddAlphaFromColorKeyFloat(
5591     aRed   / PixelData.Range.r,
5592     aGreen / PixelData.Range.g,
5593     aBlue  / PixelData.Range.b,
5594     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5595 end;
5596
5597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5598 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5599 var
5600   values: array[0..2] of Single;
5601   tmp: Cardinal;
5602   i: Integer;
5603   PixelData: TglBitmapPixelData;
5604 begin
5605   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5606   with PixelData do begin
5607     values[0] := aRed;
5608     values[1] := aGreen;
5609     values[2] := aBlue;
5610
5611     for i := 0 to 2 do begin
5612       tmp          := Trunc(Range.arr[i] * aDeviation);
5613       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5614       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5615     end;
5616     Data.a  := 0;
5617     Range.a := 0;
5618   end;
5619   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5620 end;
5621
5622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5623 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5624 begin
5625   result := AddAlphaFromValueFloat(aAlpha / $FF);
5626 end;
5627
5628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5629 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5630 var
5631   PixelData: TglBitmapPixelData;
5632 begin
5633   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5634   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5635 end;
5636
5637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5638 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5639 var
5640   PixelData: TglBitmapPixelData;
5641 begin
5642   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5643   with PixelData do
5644     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5645   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5646 end;
5647
5648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5649 function TglBitmap.RemoveAlpha: Boolean;
5650 var
5651   FormatDesc: TFormatDescriptor;
5652 begin
5653   result := false;
5654   FormatDesc := TFormatDescriptor.Get(Format);
5655   if Assigned(Data) then begin
5656     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5657       raise EglBitmapUnsupportedFormat.Create(Format);
5658     result := ConvertTo(FormatDesc.WithoutAlpha);
5659   end;
5660 end;
5661
5662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5663 function TglBitmap.Clone: TglBitmap;
5664 var
5665   Temp: TglBitmap;
5666   TempPtr: PByte;
5667   Size: Integer;
5668 begin
5669   result := nil;
5670   Temp := (ClassType.Create as TglBitmap);
5671   try
5672     // copy texture data if assigned
5673     if Assigned(Data) then begin
5674       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5675       GetMem(TempPtr, Size);
5676       try
5677         Move(Data^, TempPtr^, Size);
5678         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5679       except
5680         if Assigned(TempPtr) then
5681           FreeMem(TempPtr);
5682         raise;
5683       end;
5684     end else begin
5685       TempPtr := nil;
5686       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5687     end;
5688
5689         // copy properties
5690     Temp.fID                      := ID;
5691     Temp.fTarget                  := Target;
5692     Temp.fFormat                  := Format;
5693     Temp.fMipMap                  := MipMap;
5694     Temp.fAnisotropic             := Anisotropic;
5695     Temp.fBorderColor             := fBorderColor;
5696     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5697     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5698     Temp.fFilterMin               := fFilterMin;
5699     Temp.fFilterMag               := fFilterMag;
5700     Temp.fWrapS                   := fWrapS;
5701     Temp.fWrapT                   := fWrapT;
5702     Temp.fWrapR                   := fWrapR;
5703     Temp.fFilename                := fFilename;
5704     Temp.fCustomName              := fCustomName;
5705     Temp.fCustomNameW             := fCustomNameW;
5706     Temp.fCustomData              := fCustomData;
5707
5708     result := Temp;
5709   except
5710     FreeAndNil(Temp);
5711     raise;
5712   end;
5713 end;
5714
5715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5716 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5717 var
5718   SourceFD, DestFD: TFormatDescriptor;
5719   SourcePD, DestPD: TglBitmapPixelData;
5720   ShiftData: TShiftData;
5721
5722   function DataIsIdentical: Boolean;
5723   begin
5724     result := SourceFD.MaskMatch(DestFD.Mask);
5725   end;
5726
5727   function CanCopyDirect: Boolean;
5728   begin
5729     result :=
5730       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5731       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5732       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5733       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5734   end;
5735
5736   function CanShift: Boolean;
5737   begin
5738     result :=
5739       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5740       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5741       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5742       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5743   end;
5744
5745   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5746   begin
5747     result := 0;
5748     while (aSource > aDest) and (aSource > 0) do begin
5749       inc(result);
5750       aSource := aSource shr 1;
5751     end;
5752   end;
5753
5754 begin
5755   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5756     SourceFD := TFormatDescriptor.Get(Format);
5757     DestFD   := TFormatDescriptor.Get(aFormat);
5758
5759     if DataIsIdentical then begin
5760       result := true;
5761       Format := aFormat;
5762       exit;
5763     end;
5764
5765     SourceFD.PreparePixel(SourcePD);
5766     DestFD.PreparePixel  (DestPD);
5767
5768     if CanCopyDirect then
5769       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5770     else if CanShift then begin
5771       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5772       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5773       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5774       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5775       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5776     end else
5777       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5778   end else
5779     result := true;
5780 end;
5781
5782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5783 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5784 begin
5785   if aUseRGB or aUseAlpha then
5786     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5787       ((Byte(aUseAlpha) and 1) shl 1) or
5788        (Byte(aUseRGB)   and 1)      ));
5789 end;
5790
5791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5792 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5793 begin
5794   fBorderColor[0] := aRed;
5795   fBorderColor[1] := aGreen;
5796   fBorderColor[2] := aBlue;
5797   fBorderColor[3] := aAlpha;
5798   if (ID > 0) then begin
5799     Bind(false);
5800     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5801   end;
5802 end;
5803
5804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5805 procedure TglBitmap.FreeData;
5806 var
5807   TempPtr: PByte;
5808 begin
5809   TempPtr := nil;
5810   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5811 end;
5812
5813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5814 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5815   const aAlpha: Byte);
5816 begin
5817   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5818 end;
5819
5820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5821 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5822 var
5823   PixelData: TglBitmapPixelData;
5824 begin
5825   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5826   FillWithColorFloat(
5827     aRed   / PixelData.Range.r,
5828     aGreen / PixelData.Range.g,
5829     aBlue  / PixelData.Range.b,
5830     aAlpha / PixelData.Range.a);
5831 end;
5832
5833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5834 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5835 var
5836   PixelData: TglBitmapPixelData;
5837 begin
5838   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5839   with PixelData do begin
5840     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5841     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5842     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5843     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5844   end;
5845   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5846 end;
5847
5848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5849 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5850 begin
5851   //check MIN filter
5852   case aMin of
5853     GL_NEAREST:
5854       fFilterMin := GL_NEAREST;
5855     GL_LINEAR:
5856       fFilterMin := GL_LINEAR;
5857     GL_NEAREST_MIPMAP_NEAREST:
5858       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5859     GL_LINEAR_MIPMAP_NEAREST:
5860       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5861     GL_NEAREST_MIPMAP_LINEAR:
5862       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5863     GL_LINEAR_MIPMAP_LINEAR:
5864       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5865     else
5866       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5867   end;
5868
5869   //check MAG filter
5870   case aMag of
5871     GL_NEAREST:
5872       fFilterMag := GL_NEAREST;
5873     GL_LINEAR:
5874       fFilterMag := GL_LINEAR;
5875     else
5876       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5877   end;
5878
5879   //apply filter
5880   if (ID > 0) then begin
5881     Bind(false);
5882     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5883
5884     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5885       case fFilterMin of
5886         GL_NEAREST, GL_LINEAR:
5887           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5888         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5889           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5890         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5891           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5892       end;
5893     end else
5894       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5895   end;
5896 end;
5897
5898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5899 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5900
5901   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5902   begin
5903     case aValue of
5904       GL_CLAMP:
5905         aTarget := GL_CLAMP;
5906
5907       GL_REPEAT:
5908         aTarget := GL_REPEAT;
5909
5910       GL_CLAMP_TO_EDGE: begin
5911         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5912           aTarget := GL_CLAMP_TO_EDGE
5913         else
5914           aTarget := GL_CLAMP;
5915       end;
5916
5917       GL_CLAMP_TO_BORDER: begin
5918         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5919           aTarget := GL_CLAMP_TO_BORDER
5920         else
5921           aTarget := GL_CLAMP;
5922       end;
5923
5924       GL_MIRRORED_REPEAT: begin
5925         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5926           aTarget := GL_MIRRORED_REPEAT
5927         else
5928           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5929       end;
5930     else
5931       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5932     end;
5933   end;
5934
5935 begin
5936   CheckAndSetWrap(S, fWrapS);
5937   CheckAndSetWrap(T, fWrapT);
5938   CheckAndSetWrap(R, fWrapR);
5939
5940   if (ID > 0) then begin
5941     Bind(false);
5942     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5943     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5944     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5945   end;
5946 end;
5947
5948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5949 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5950
5951   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5952   begin
5953     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5954        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5955       fSwizzle[aIndex] := aValue
5956     else
5957       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5958   end;
5959
5960 begin
5961   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5962     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5963   CheckAndSetValue(r, 0);
5964   CheckAndSetValue(g, 1);
5965   CheckAndSetValue(b, 2);
5966   CheckAndSetValue(a, 3);
5967
5968   if (ID > 0) then begin
5969     Bind(false);
5970     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5971   end;
5972 end;
5973
5974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5975 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5976 begin
5977   if aEnableTextureUnit then
5978     glEnable(Target);
5979   if (ID > 0) then
5980     glBindTexture(Target, ID);
5981 end;
5982
5983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5984 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5985 begin
5986   if aDisableTextureUnit then
5987     glDisable(Target);
5988   glBindTexture(Target, 0);
5989 end;
5990
5991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5992 constructor TglBitmap.Create;
5993 begin
5994   if (ClassType = TglBitmap) then
5995     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5996 {$IFDEF GLB_NATIVE_OGL}
5997   glbReadOpenGLExtensions;
5998 {$ENDIF}
5999   inherited Create;
6000   fFormat            := glBitmapGetDefaultFormat;
6001   fFreeDataOnDestroy := true;
6002 end;
6003
6004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6005 constructor TglBitmap.Create(const aFileName: String);
6006 begin
6007   Create;
6008   LoadFromFile(aFileName);
6009 end;
6010
6011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6012 constructor TglBitmap.Create(const aStream: TStream);
6013 begin
6014   Create;
6015   LoadFromStream(aStream);
6016 end;
6017
6018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6019 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6020 var
6021   ImageSize: Integer;
6022 begin
6023   Create;
6024   if not Assigned(aData) then begin
6025     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6026     GetMem(aData, ImageSize);
6027     try
6028       FillChar(aData^, ImageSize, #$FF);
6029       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6030     except
6031       if Assigned(aData) then
6032         FreeMem(aData);
6033       raise;
6034     end;
6035   end else begin
6036     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6037     fFreeDataOnDestroy := false;
6038   end;
6039 end;
6040
6041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6042 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6043 begin
6044   Create;
6045   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6046 end;
6047
6048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6049 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6050 begin
6051   Create;
6052   LoadFromResource(aInstance, aResource, aResType);
6053 end;
6054
6055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6056 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6057 begin
6058   Create;
6059   LoadFromResourceID(aInstance, aResourceID, aResType);
6060 end;
6061
6062 {$IFDEF GLB_SUPPORT_PNG_READ}
6063 {$IF DEFINED(GLB_LAZ_PNG)}
6064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6065 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6067 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6068 const
6069   MAGIC_LEN = 8;
6070   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6071 var
6072   reader: TLazReaderPNG;
6073   intf: TLazIntfImage;
6074   StreamPos: Int64;
6075   magic: String[MAGIC_LEN];
6076 begin
6077   result := true;
6078   StreamPos := aStream.Position;
6079
6080   SetLength(magic, MAGIC_LEN);
6081   aStream.Read(magic[1], MAGIC_LEN);
6082   aStream.Position := StreamPos;
6083   if (magic <> PNG_MAGIC) then begin
6084     result := false;
6085     exit;
6086   end;
6087
6088   intf   := TLazIntfImage.Create(0, 0);
6089   reader := TLazReaderPNG.Create;
6090   try try
6091     reader.UpdateDescription := true;
6092     reader.ImageRead(aStream, intf);
6093     AssignFromLazIntfImage(intf);
6094   except
6095     result := false;
6096     aStream.Position := StreamPos;
6097     exit;
6098   end;
6099   finally
6100     reader.Free;
6101     intf.Free;
6102   end;
6103 end;
6104
6105 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6107 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6108 var
6109   Surface: PSDL_Surface;
6110   RWops: PSDL_RWops;
6111 begin
6112   result := false;
6113   RWops := glBitmapCreateRWops(aStream);
6114   try
6115     if IMG_isPNG(RWops) > 0 then begin
6116       Surface := IMG_LoadPNG_RW(RWops);
6117       try
6118         AssignFromSurface(Surface);
6119         result := true;
6120       finally
6121         SDL_FreeSurface(Surface);
6122       end;
6123     end;
6124   finally
6125     SDL_FreeRW(RWops);
6126   end;
6127 end;
6128
6129 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6131 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6132 begin
6133   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6134 end;
6135
6136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6137 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6138 var
6139   StreamPos: Int64;
6140   signature: array [0..7] of byte;
6141   png: png_structp;
6142   png_info: png_infop;
6143
6144   TempHeight, TempWidth: Integer;
6145   Format: TglBitmapFormat;
6146
6147   png_data: pByte;
6148   png_rows: array of pByte;
6149   Row, LineSize: Integer;
6150 begin
6151   result := false;
6152
6153   if not init_libPNG then
6154     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6155
6156   try
6157     // signature
6158     StreamPos := aStream.Position;
6159     aStream.Read(signature{%H-}, 8);
6160     aStream.Position := StreamPos;
6161
6162     if png_check_sig(@signature, 8) <> 0 then begin
6163       // png read struct
6164       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6165       if png = nil then
6166         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6167
6168       // png info
6169       png_info := png_create_info_struct(png);
6170       if png_info = nil then begin
6171         png_destroy_read_struct(@png, nil, nil);
6172         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6173       end;
6174
6175       // set read callback
6176       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6177
6178       // read informations
6179       png_read_info(png, png_info);
6180
6181       // size
6182       TempHeight := png_get_image_height(png, png_info);
6183       TempWidth := png_get_image_width(png, png_info);
6184
6185       // format
6186       case png_get_color_type(png, png_info) of
6187         PNG_COLOR_TYPE_GRAY:
6188           Format := tfLuminance8ub1;
6189         PNG_COLOR_TYPE_GRAY_ALPHA:
6190           Format := tfLuminance8Alpha8us1;
6191         PNG_COLOR_TYPE_RGB:
6192           Format := tfRGB8ub3;
6193         PNG_COLOR_TYPE_RGB_ALPHA:
6194           Format := tfRGBA8ub4;
6195         else
6196           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6197       end;
6198
6199       // cut upper 8 bit from 16 bit formats
6200       if png_get_bit_depth(png, png_info) > 8 then
6201         png_set_strip_16(png);
6202
6203       // expand bitdepth smaller than 8
6204       if png_get_bit_depth(png, png_info) < 8 then
6205         png_set_expand(png);
6206
6207       // allocating mem for scanlines
6208       LineSize := png_get_rowbytes(png, png_info);
6209       GetMem(png_data, TempHeight * LineSize);
6210       try
6211         SetLength(png_rows, TempHeight);
6212         for Row := Low(png_rows) to High(png_rows) do begin
6213           png_rows[Row] := png_data;
6214           Inc(png_rows[Row], Row * LineSize);
6215         end;
6216
6217         // read complete image into scanlines
6218         png_read_image(png, @png_rows[0]);
6219
6220         // read end
6221         png_read_end(png, png_info);
6222
6223         // destroy read struct
6224         png_destroy_read_struct(@png, @png_info, nil);
6225
6226         SetLength(png_rows, 0);
6227
6228         // set new data
6229         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6230
6231         result := true;
6232       except
6233         if Assigned(png_data) then
6234           FreeMem(png_data);
6235         raise;
6236       end;
6237     end;
6238   finally
6239     quit_libPNG;
6240   end;
6241 end;
6242
6243 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6245 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6246 var
6247   StreamPos: Int64;
6248   Png: TPNGObject;
6249   Header: String[8];
6250   Row, Col, PixSize, LineSize: Integer;
6251   NewImage, pSource, pDest, pAlpha: pByte;
6252   PngFormat: TglBitmapFormat;
6253   FormatDesc: TFormatDescriptor;
6254
6255 const
6256   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6257
6258 begin
6259   result := false;
6260
6261   StreamPos := aStream.Position;
6262   aStream.Read(Header[0], SizeOf(Header));
6263   aStream.Position := StreamPos;
6264
6265   {Test if the header matches}
6266   if Header = PngHeader then begin
6267     Png := TPNGObject.Create;
6268     try
6269       Png.LoadFromStream(aStream);
6270
6271       case Png.Header.ColorType of
6272         COLOR_GRAYSCALE:
6273           PngFormat := tfLuminance8ub1;
6274         COLOR_GRAYSCALEALPHA:
6275           PngFormat := tfLuminance8Alpha8us1;
6276         COLOR_RGB:
6277           PngFormat := tfBGR8ub3;
6278         COLOR_RGBALPHA:
6279           PngFormat := tfBGRA8ub4;
6280         else
6281           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6282       end;
6283
6284       FormatDesc := TFormatDescriptor.Get(PngFormat);
6285       PixSize    := Round(FormatDesc.PixelSize);
6286       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6287
6288       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6289       try
6290         pDest := NewImage;
6291
6292         case Png.Header.ColorType of
6293           COLOR_RGB, COLOR_GRAYSCALE:
6294             begin
6295               for Row := 0 to Png.Height -1 do begin
6296                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6297                 Inc(pDest, LineSize);
6298               end;
6299             end;
6300           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6301             begin
6302               PixSize := PixSize -1;
6303
6304               for Row := 0 to Png.Height -1 do begin
6305                 pSource := Png.Scanline[Row];
6306                 pAlpha := pByte(Png.AlphaScanline[Row]);
6307
6308                 for Col := 0 to Png.Width -1 do begin
6309                   Move (pSource^, pDest^, PixSize);
6310                   Inc(pSource, PixSize);
6311                   Inc(pDest, PixSize);
6312
6313                   pDest^ := pAlpha^;
6314                   inc(pAlpha);
6315                   Inc(pDest);
6316                 end;
6317               end;
6318             end;
6319           else
6320             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6321         end;
6322
6323         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6324
6325         result := true;
6326       except
6327         if Assigned(NewImage) then
6328           FreeMem(NewImage);
6329         raise;
6330       end;
6331     finally
6332       Png.Free;
6333     end;
6334   end;
6335 end;
6336 {$IFEND}
6337 {$ENDIF}
6338
6339 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6340 {$IFDEF GLB_LIB_PNG}
6341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6342 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6343 begin
6344   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6345 end;
6346 {$ENDIF}
6347
6348 {$IF DEFINED(GLB_LAZ_PNG)}
6349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6350 procedure TglBitmap.SavePNG(const aStream: TStream);
6351 var
6352   png: TPortableNetworkGraphic;
6353   intf: TLazIntfImage;
6354   raw: TRawImage;
6355 begin
6356   png  := TPortableNetworkGraphic.Create;
6357   intf := TLazIntfImage.Create(0, 0);
6358   try
6359     if not AssignToLazIntfImage(intf) then
6360       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6361     intf.GetRawImage(raw);
6362     png.LoadFromRawImage(raw, false);
6363     png.SaveToStream(aStream);
6364   finally
6365     png.Free;
6366     intf.Free;
6367   end;
6368 end;
6369
6370 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6372 procedure TglBitmap.SavePNG(const aStream: TStream);
6373 var
6374   png: png_structp;
6375   png_info: png_infop;
6376   png_rows: array of pByte;
6377   LineSize: Integer;
6378   ColorType: Integer;
6379   Row: Integer;
6380   FormatDesc: TFormatDescriptor;
6381 begin
6382   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6383     raise EglBitmapUnsupportedFormat.Create(Format);
6384
6385   if not init_libPNG then
6386     raise Exception.Create('unable to initialize libPNG.');
6387
6388   try
6389     case Format of
6390       tfAlpha8ub1, tfLuminance8ub1:
6391         ColorType := PNG_COLOR_TYPE_GRAY;
6392       tfLuminance8Alpha8us1:
6393         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6394       tfBGR8ub3, tfRGB8ub3:
6395         ColorType := PNG_COLOR_TYPE_RGB;
6396       tfBGRA8ub4, tfRGBA8ub4:
6397         ColorType := PNG_COLOR_TYPE_RGBA;
6398       else
6399         raise EglBitmapUnsupportedFormat.Create(Format);
6400     end;
6401
6402     FormatDesc := TFormatDescriptor.Get(Format);
6403     LineSize := FormatDesc.GetSize(Width, 1);
6404
6405     // creating array for scanline
6406     SetLength(png_rows, Height);
6407     try
6408       for Row := 0 to Height - 1 do begin
6409         png_rows[Row] := Data;
6410         Inc(png_rows[Row], Row * LineSize)
6411       end;
6412
6413       // write struct
6414       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6415       if png = nil then
6416         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6417
6418       // create png info
6419       png_info := png_create_info_struct(png);
6420       if png_info = nil then begin
6421         png_destroy_write_struct(@png, nil);
6422         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6423       end;
6424
6425       // set read callback
6426       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6427
6428       // set compression
6429       png_set_compression_level(png, 6);
6430
6431       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6432         png_set_bgr(png);
6433
6434       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6435       png_write_info(png, png_info);
6436       png_write_image(png, @png_rows[0]);
6437       png_write_end(png, png_info);
6438       png_destroy_write_struct(@png, @png_info);
6439     finally
6440       SetLength(png_rows, 0);
6441     end;
6442   finally
6443     quit_libPNG;
6444   end;
6445 end;
6446
6447 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6449 procedure TglBitmap.SavePNG(const aStream: TStream);
6450 var
6451   Png: TPNGObject;
6452
6453   pSource, pDest: pByte;
6454   X, Y, PixSize: Integer;
6455   ColorType: Cardinal;
6456   Alpha: Boolean;
6457
6458   pTemp: pByte;
6459   Temp: Byte;
6460 begin
6461   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6462     raise EglBitmapUnsupportedFormat.Create(Format);
6463
6464   case Format of
6465     tfAlpha8ub1, tfLuminance8ub1: begin
6466       ColorType := COLOR_GRAYSCALE;
6467       PixSize   := 1;
6468       Alpha     := false;
6469     end;
6470     tfLuminance8Alpha8us1: begin
6471       ColorType := COLOR_GRAYSCALEALPHA;
6472       PixSize   := 1;
6473       Alpha     := true;
6474     end;
6475     tfBGR8ub3, tfRGB8ub3: begin
6476       ColorType := COLOR_RGB;
6477       PixSize   := 3;
6478       Alpha     := false;
6479     end;
6480     tfBGRA8ub4, tfRGBA8ub4: begin
6481       ColorType := COLOR_RGBALPHA;
6482       PixSize   := 3;
6483       Alpha     := true
6484     end;
6485   else
6486     raise EglBitmapUnsupportedFormat.Create(Format);
6487   end;
6488
6489   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6490   try
6491     // Copy ImageData
6492     pSource := Data;
6493     for Y := 0 to Height -1 do begin
6494       pDest := png.ScanLine[Y];
6495       for X := 0 to Width -1 do begin
6496         Move(pSource^, pDest^, PixSize);
6497         Inc(pDest, PixSize);
6498         Inc(pSource, PixSize);
6499         if Alpha then begin
6500           png.AlphaScanline[Y]^[X] := pSource^;
6501           Inc(pSource);
6502         end;
6503       end;
6504
6505       // convert RGB line to BGR
6506       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6507         pTemp := png.ScanLine[Y];
6508         for X := 0 to Width -1 do begin
6509           Temp := pByteArray(pTemp)^[0];
6510           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6511           pByteArray(pTemp)^[2] := Temp;
6512           Inc(pTemp, 3);
6513         end;
6514       end;
6515     end;
6516
6517     // Save to Stream
6518     Png.CompressionLevel := 6;
6519     Png.SaveToStream(aStream);
6520   finally
6521     FreeAndNil(Png);
6522   end;
6523 end;
6524 {$IFEND}
6525 {$ENDIF}
6526
6527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6528 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6530 {$IFDEF GLB_LIB_JPEG}
6531 type
6532   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6533   glBitmap_libJPEG_source_mgr = record
6534     pub: jpeg_source_mgr;
6535
6536     SrcStream: TStream;
6537     SrcBuffer: array [1..4096] of byte;
6538   end;
6539
6540   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6541   glBitmap_libJPEG_dest_mgr = record
6542     pub: jpeg_destination_mgr;
6543
6544     DestStream: TStream;
6545     DestBuffer: array [1..4096] of byte;
6546   end;
6547
6548 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6549 begin
6550   //DUMMY
6551 end;
6552
6553
6554 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6555 begin
6556   //DUMMY
6557 end;
6558
6559
6560 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6561 begin
6562   //DUMMY
6563 end;
6564
6565 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6566 begin
6567   //DUMMY
6568 end;
6569
6570
6571 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6572 begin
6573   //DUMMY
6574 end;
6575
6576
6577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6578 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6579 var
6580   src: glBitmap_libJPEG_source_mgr_ptr;
6581   bytes: integer;
6582 begin
6583   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6584
6585   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6586         if (bytes <= 0) then begin
6587                 src^.SrcBuffer[1] := $FF;
6588                 src^.SrcBuffer[2] := JPEG_EOI;
6589                 bytes := 2;
6590         end;
6591
6592         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6593         src^.pub.bytes_in_buffer := bytes;
6594
6595   result := true;
6596 end;
6597
6598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6599 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6600 var
6601   src: glBitmap_libJPEG_source_mgr_ptr;
6602 begin
6603   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6604
6605   if num_bytes > 0 then begin
6606     // wanted byte isn't in buffer so set stream position and read buffer
6607     if num_bytes > src^.pub.bytes_in_buffer then begin
6608       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6609       src^.pub.fill_input_buffer(cinfo);
6610     end else begin
6611       // wanted byte is in buffer so only skip
6612                 inc(src^.pub.next_input_byte, num_bytes);
6613                 dec(src^.pub.bytes_in_buffer, num_bytes);
6614     end;
6615   end;
6616 end;
6617
6618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6619 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6620 var
6621   dest: glBitmap_libJPEG_dest_mgr_ptr;
6622 begin
6623   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6624
6625   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6626     // write complete buffer
6627     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6628
6629     // reset buffer
6630     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6631     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6632   end;
6633
6634   result := true;
6635 end;
6636
6637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6638 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6639 var
6640   Idx: Integer;
6641   dest: glBitmap_libJPEG_dest_mgr_ptr;
6642 begin
6643   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6644
6645   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6646     // check for endblock
6647     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6648       // write endblock
6649       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6650
6651       // leave
6652       break;
6653     end else
6654       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6655   end;
6656 end;
6657 {$ENDIF}
6658
6659 {$IFDEF GLB_SUPPORT_JPEG_READ}
6660 {$IF DEFINED(GLB_LAZ_JPEG)}
6661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6662 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6663 const
6664   MAGIC_LEN = 2;
6665   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6666 var
6667   intf: TLazIntfImage;
6668   reader: TFPReaderJPEG;
6669   StreamPos: Int64;
6670   magic: String[MAGIC_LEN];
6671 begin
6672   result := true;
6673   StreamPos := aStream.Position;
6674
6675   SetLength(magic, MAGIC_LEN);
6676   aStream.Read(magic[1], MAGIC_LEN);
6677   aStream.Position := StreamPos;
6678   if (magic <> JPEG_MAGIC) then begin
6679     result := false;
6680     exit;
6681   end;
6682
6683   reader := TFPReaderJPEG.Create;
6684   intf := TLazIntfImage.Create(0, 0);
6685   try try
6686     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6687     reader.ImageRead(aStream, intf);
6688     AssignFromLazIntfImage(intf);
6689   except
6690     result := false;
6691     aStream.Position := StreamPos;
6692     exit;
6693   end;
6694   finally
6695     reader.Free;
6696     intf.Free;
6697   end;
6698 end;
6699
6700 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6702 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6703 var
6704   Surface: PSDL_Surface;
6705   RWops: PSDL_RWops;
6706 begin
6707   result := false;
6708
6709   RWops := glBitmapCreateRWops(aStream);
6710   try
6711     if IMG_isJPG(RWops) > 0 then begin
6712       Surface := IMG_LoadJPG_RW(RWops);
6713       try
6714         AssignFromSurface(Surface);
6715         result := true;
6716       finally
6717         SDL_FreeSurface(Surface);
6718       end;
6719     end;
6720   finally
6721     SDL_FreeRW(RWops);
6722   end;
6723 end;
6724
6725 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6727 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6728 var
6729   StreamPos: Int64;
6730   Temp: array[0..1]of Byte;
6731
6732   jpeg: jpeg_decompress_struct;
6733   jpeg_err: jpeg_error_mgr;
6734
6735   IntFormat: TglBitmapFormat;
6736   pImage: pByte;
6737   TempHeight, TempWidth: Integer;
6738
6739   pTemp: pByte;
6740   Row: Integer;
6741
6742   FormatDesc: TFormatDescriptor;
6743 begin
6744   result := false;
6745
6746   if not init_libJPEG then
6747     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6748
6749   try
6750     // reading first two bytes to test file and set cursor back to begin
6751     StreamPos := aStream.Position;
6752     aStream.Read({%H-}Temp[0], 2);
6753     aStream.Position := StreamPos;
6754
6755     // if Bitmap then read file.
6756     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6757       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6758       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6759
6760       // error managment
6761       jpeg.err := jpeg_std_error(@jpeg_err);
6762       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6763       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6764
6765       // decompression struct
6766       jpeg_create_decompress(@jpeg);
6767
6768       // allocation space for streaming methods
6769       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6770
6771       // seeting up custom functions
6772       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6773         pub.init_source       := glBitmap_libJPEG_init_source;
6774         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6775         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6776         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6777         pub.term_source       := glBitmap_libJPEG_term_source;
6778
6779         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6780         pub.next_input_byte := nil;   // until buffer loaded
6781
6782         SrcStream := aStream;
6783       end;
6784
6785       // set global decoding state
6786       jpeg.global_state := DSTATE_START;
6787
6788       // read header of jpeg
6789       jpeg_read_header(@jpeg, false);
6790
6791       // setting output parameter
6792       case jpeg.jpeg_color_space of
6793         JCS_GRAYSCALE:
6794           begin
6795             jpeg.out_color_space := JCS_GRAYSCALE;
6796             IntFormat := tfLuminance8ub1;
6797           end;
6798         else
6799           jpeg.out_color_space := JCS_RGB;
6800           IntFormat := tfRGB8ub3;
6801       end;
6802
6803       // reading image
6804       jpeg_start_decompress(@jpeg);
6805
6806       TempHeight := jpeg.output_height;
6807       TempWidth := jpeg.output_width;
6808
6809       FormatDesc := TFormatDescriptor.Get(IntFormat);
6810
6811       // creating new image
6812       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6813       try
6814         pTemp := pImage;
6815
6816         for Row := 0 to TempHeight -1 do begin
6817           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6818           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6819         end;
6820
6821         // finish decompression
6822         jpeg_finish_decompress(@jpeg);
6823
6824         // destroy decompression
6825         jpeg_destroy_decompress(@jpeg);
6826
6827         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6828
6829         result := true;
6830       except
6831         if Assigned(pImage) then
6832           FreeMem(pImage);
6833         raise;
6834       end;
6835     end;
6836   finally
6837     quit_libJPEG;
6838   end;
6839 end;
6840
6841 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6843 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6844 var
6845   bmp: TBitmap;
6846   jpg: TJPEGImage;
6847   StreamPos: Int64;
6848   Temp: array[0..1]of Byte;
6849 begin
6850   result := false;
6851
6852   // reading first two bytes to test file and set cursor back to begin
6853   StreamPos := aStream.Position;
6854   aStream.Read(Temp[0], 2);
6855   aStream.Position := StreamPos;
6856
6857   // if Bitmap then read file.
6858   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6859     bmp := TBitmap.Create;
6860     try
6861       jpg := TJPEGImage.Create;
6862       try
6863         jpg.LoadFromStream(aStream);
6864         bmp.Assign(jpg);
6865         result := AssignFromBitmap(bmp);
6866       finally
6867         jpg.Free;
6868       end;
6869     finally
6870       bmp.Free;
6871     end;
6872   end;
6873 end;
6874 {$IFEND}
6875 {$ENDIF}
6876
6877 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6878 {$IF DEFINED(GLB_LAZ_JPEG)}
6879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6880 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6881 var
6882   jpeg: TJPEGImage;
6883   intf: TLazIntfImage;
6884   raw: TRawImage;
6885 begin
6886   jpeg := TJPEGImage.Create;
6887   intf := TLazIntfImage.Create(0, 0);
6888   try
6889     if not AssignToLazIntfImage(intf) then
6890       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6891     intf.GetRawImage(raw);
6892     jpeg.LoadFromRawImage(raw, false);
6893     jpeg.SaveToStream(aStream);
6894   finally
6895     intf.Free;
6896     jpeg.Free;
6897   end;
6898 end;
6899
6900 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6902 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6903 var
6904   jpeg: jpeg_compress_struct;
6905   jpeg_err: jpeg_error_mgr;
6906   Row: Integer;
6907   pTemp, pTemp2: pByte;
6908
6909   procedure CopyRow(pDest, pSource: pByte);
6910   var
6911     X: Integer;
6912   begin
6913     for X := 0 to Width - 1 do begin
6914       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6915       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6916       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6917       Inc(pDest, 3);
6918       Inc(pSource, 3);
6919     end;
6920   end;
6921
6922 begin
6923   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6924     raise EglBitmapUnsupportedFormat.Create(Format);
6925
6926   if not init_libJPEG then
6927     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6928
6929   try
6930     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6931     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6932
6933     // error managment
6934     jpeg.err := jpeg_std_error(@jpeg_err);
6935     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6936     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6937
6938     // compression struct
6939     jpeg_create_compress(@jpeg);
6940
6941     // allocation space for streaming methods
6942     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6943
6944     // seeting up custom functions
6945     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6946       pub.init_destination    := glBitmap_libJPEG_init_destination;
6947       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6948       pub.term_destination    := glBitmap_libJPEG_term_destination;
6949
6950       pub.next_output_byte  := @DestBuffer[1];
6951       pub.free_in_buffer    := Length(DestBuffer);
6952
6953       DestStream := aStream;
6954     end;
6955
6956     // very important state
6957     jpeg.global_state := CSTATE_START;
6958     jpeg.image_width  := Width;
6959     jpeg.image_height := Height;
6960     case Format of
6961       tfAlpha8ub1, tfLuminance8ub1: begin
6962         jpeg.input_components := 1;
6963         jpeg.in_color_space   := JCS_GRAYSCALE;
6964       end;
6965       tfRGB8ub3, tfBGR8ub3: begin
6966         jpeg.input_components := 3;
6967         jpeg.in_color_space   := JCS_RGB;
6968       end;
6969     end;
6970
6971     jpeg_set_defaults(@jpeg);
6972     jpeg_set_quality(@jpeg, 95, true);
6973     jpeg_start_compress(@jpeg, true);
6974     pTemp := Data;
6975
6976     if Format = tfBGR8ub3 then
6977       GetMem(pTemp2, fRowSize)
6978     else
6979       pTemp2 := pTemp;
6980
6981     try
6982       for Row := 0 to jpeg.image_height -1 do begin
6983         // prepare row
6984         if Format = tfBGR8ub3 then
6985           CopyRow(pTemp2, pTemp)
6986         else
6987           pTemp2 := pTemp;
6988
6989         // write row
6990         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6991         inc(pTemp, fRowSize);
6992       end;
6993     finally
6994       // free memory
6995       if Format = tfBGR8ub3 then
6996         FreeMem(pTemp2);
6997     end;
6998     jpeg_finish_compress(@jpeg);
6999     jpeg_destroy_compress(@jpeg);
7000   finally
7001     quit_libJPEG;
7002   end;
7003 end;
7004
7005 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7007 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7008 var
7009   Bmp: TBitmap;
7010   Jpg: TJPEGImage;
7011 begin
7012   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7013     raise EglBitmapUnsupportedFormat.Create(Format);
7014
7015   Bmp := TBitmap.Create;
7016   try
7017     Jpg := TJPEGImage.Create;
7018     try
7019       AssignToBitmap(Bmp);
7020       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7021         Jpg.Grayscale   := true;
7022         Jpg.PixelFormat := jf8Bit;
7023       end;
7024       Jpg.Assign(Bmp);
7025       Jpg.SaveToStream(aStream);
7026     finally
7027       FreeAndNil(Jpg);
7028     end;
7029   finally
7030     FreeAndNil(Bmp);
7031   end;
7032 end;
7033 {$IFEND}
7034 {$ENDIF}
7035
7036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7037 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7039 type
7040   RawHeader = packed record
7041     Magic:        String[5];
7042     Version:      Byte;
7043     Width:        Integer;
7044     Height:       Integer;
7045     DataSize:     Integer;
7046     BitsPerPixel: Integer;
7047     Precision:    TglBitmapRec4ub;
7048     Shift:        TglBitmapRec4ub;
7049   end;
7050
7051 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7052 var
7053   header: RawHeader;
7054   StartPos: Int64;
7055   fd: TFormatDescriptor;
7056   buf: PByte;
7057 begin
7058   result := false;
7059   StartPos := aStream.Position;
7060   aStream.Read(header{%H-}, SizeOf(header));
7061   if (header.Magic <> 'glBMP') then begin
7062     aStream.Position := StartPos;
7063     exit;
7064   end;
7065
7066   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7067   if (fd.Format = tfEmpty) then
7068     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7069
7070   buf := GetMemory(header.DataSize);
7071   aStream.Read(buf^, header.DataSize);
7072   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7073
7074   result := true;
7075 end;
7076
7077 procedure TglBitmap.SaveRAW(const aStream: TStream);
7078 var
7079   header: RawHeader;
7080   fd: TFormatDescriptor;
7081 begin
7082   fd := TFormatDescriptor.Get(Format);
7083   header.Magic        := 'glBMP';
7084   header.Version      := 1;
7085   header.Width        := Width;
7086   header.Height       := Height;
7087   header.DataSize     := fd.GetSize(fDimension);
7088   header.BitsPerPixel := fd.BitsPerPixel;
7089   header.Precision    := fd.Precision;
7090   header.Shift        := fd.Shift;
7091   aStream.Write(header, SizeOf(header));
7092   aStream.Write(Data^,  header.DataSize);
7093 end;
7094
7095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7096 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7098 const
7099   BMP_MAGIC          = $4D42;
7100
7101   BMP_COMP_RGB       = 0;
7102   BMP_COMP_RLE8      = 1;
7103   BMP_COMP_RLE4      = 2;
7104   BMP_COMP_BITFIELDS = 3;
7105
7106 type
7107   TBMPHeader = packed record
7108     bfType: Word;
7109     bfSize: Cardinal;
7110     bfReserved1: Word;
7111     bfReserved2: Word;
7112     bfOffBits: Cardinal;
7113   end;
7114
7115   TBMPInfo = packed record
7116     biSize: Cardinal;
7117     biWidth: Longint;
7118     biHeight: Longint;
7119     biPlanes: Word;
7120     biBitCount: Word;
7121     biCompression: Cardinal;
7122     biSizeImage: Cardinal;
7123     biXPelsPerMeter: Longint;
7124     biYPelsPerMeter: Longint;
7125     biClrUsed: Cardinal;
7126     biClrImportant: Cardinal;
7127   end;
7128
7129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7130 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7131
7132   //////////////////////////////////////////////////////////////////////////////////////////////////
7133   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7134   begin
7135     result := tfEmpty;
7136     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7137     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7138
7139     //Read Compression
7140     case aInfo.biCompression of
7141       BMP_COMP_RLE4,
7142       BMP_COMP_RLE8: begin
7143         raise EglBitmap.Create('RLE compression is not supported');
7144       end;
7145       BMP_COMP_BITFIELDS: begin
7146         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7147           aStream.Read(aMask.r, SizeOf(aMask.r));
7148           aStream.Read(aMask.g, SizeOf(aMask.g));
7149           aStream.Read(aMask.b, SizeOf(aMask.b));
7150           aStream.Read(aMask.a, SizeOf(aMask.a));
7151         end else
7152           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7153       end;
7154     end;
7155
7156     //get suitable format
7157     case aInfo.biBitCount of
7158        8: result := tfLuminance8ub1;
7159       16: result := tfX1RGB5us1;
7160       24: result := tfBGR8ub3;
7161       32: result := tfXRGB8ui1;
7162     end;
7163   end;
7164
7165   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7166   var
7167     i, c: Integer;
7168     ColorTable: TbmpColorTable;
7169   begin
7170     result := nil;
7171     if (aInfo.biBitCount >= 16) then
7172       exit;
7173     aFormat := tfLuminance8ub1;
7174     c := aInfo.biClrUsed;
7175     if (c = 0) then
7176       c := 1 shl aInfo.biBitCount;
7177     SetLength(ColorTable, c);
7178     for i := 0 to c-1 do begin
7179       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7180       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7181         aFormat := tfRGB8ub3;
7182     end;
7183
7184     result := TbmpColorTableFormat.Create;
7185     result.BitsPerPixel := aInfo.biBitCount;
7186     result.ColorTable   := ColorTable;
7187     result.CalcValues;
7188   end;
7189
7190   //////////////////////////////////////////////////////////////////////////////////////////////////
7191   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7192   var
7193     FormatDesc: TFormatDescriptor;
7194   begin
7195     result := nil;
7196     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7197       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7198       if (FormatDesc.Format = tfEmpty) then
7199         exit;
7200       aFormat := FormatDesc.Format;
7201       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7202         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7203       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7204         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7205
7206       result := TbmpBitfieldFormat.Create;
7207       result.SetCustomValues(aInfo.biBitCount, aMask);
7208     end;
7209   end;
7210
7211 var
7212   //simple types
7213   StartPos: Int64;
7214   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7215   PaddingBuff: Cardinal;
7216   LineBuf, ImageData, TmpData: PByte;
7217   SourceMD, DestMD: Pointer;
7218   BmpFormat: TglBitmapFormat;
7219
7220   //records
7221   Mask: TglBitmapRec4ul;
7222   Header: TBMPHeader;
7223   Info: TBMPInfo;
7224
7225   //classes
7226   SpecialFormat: TFormatDescriptor;
7227   FormatDesc: TFormatDescriptor;
7228
7229   //////////////////////////////////////////////////////////////////////////////////////////////////
7230   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7231   var
7232     i: Integer;
7233     Pixel: TglBitmapPixelData;
7234   begin
7235     aStream.Read(aLineBuf^, rbLineSize);
7236     SpecialFormat.PreparePixel(Pixel);
7237     for i := 0 to Info.biWidth-1 do begin
7238       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7239       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7240       FormatDesc.Map(Pixel, aData, DestMD);
7241     end;
7242   end;
7243
7244 begin
7245   result        := false;
7246   BmpFormat     := tfEmpty;
7247   SpecialFormat := nil;
7248   LineBuf       := nil;
7249   SourceMD      := nil;
7250   DestMD        := nil;
7251
7252   // Header
7253   StartPos := aStream.Position;
7254   aStream.Read(Header{%H-}, SizeOf(Header));
7255
7256   if Header.bfType = BMP_MAGIC then begin
7257     try try
7258       BmpFormat        := ReadInfo(Info, Mask);
7259       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7260       if not Assigned(SpecialFormat) then
7261         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7262       aStream.Position := StartPos + Header.bfOffBits;
7263
7264       if (BmpFormat <> tfEmpty) then begin
7265         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7266         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7267         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7268         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7269
7270         //get Memory
7271         DestMD    := FormatDesc.CreateMappingData;
7272         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7273         GetMem(ImageData, ImageSize);
7274         if Assigned(SpecialFormat) then begin
7275           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7276           SourceMD := SpecialFormat.CreateMappingData;
7277         end;
7278
7279         //read Data
7280         try try
7281           FillChar(ImageData^, ImageSize, $FF);
7282           TmpData := ImageData;
7283           if (Info.biHeight > 0) then
7284             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7285           for i := 0 to Abs(Info.biHeight)-1 do begin
7286             if Assigned(SpecialFormat) then
7287               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7288             else
7289               aStream.Read(TmpData^, wbLineSize);   //else only read data
7290             if (Info.biHeight > 0) then
7291               dec(TmpData, wbLineSize)
7292             else
7293               inc(TmpData, wbLineSize);
7294             aStream.Read(PaddingBuff{%H-}, Padding);
7295           end;
7296           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7297           result := true;
7298         finally
7299           if Assigned(LineBuf) then
7300             FreeMem(LineBuf);
7301           if Assigned(SourceMD) then
7302             SpecialFormat.FreeMappingData(SourceMD);
7303           FormatDesc.FreeMappingData(DestMD);
7304         end;
7305         except
7306           if Assigned(ImageData) then
7307             FreeMem(ImageData);
7308           raise;
7309         end;
7310       end else
7311         raise EglBitmap.Create('LoadBMP - No suitable format found');
7312     except
7313       aStream.Position := StartPos;
7314       raise;
7315     end;
7316     finally
7317       FreeAndNil(SpecialFormat);
7318     end;
7319   end
7320     else aStream.Position := StartPos;
7321 end;
7322
7323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7324 procedure TglBitmap.SaveBMP(const aStream: TStream);
7325 var
7326   Header: TBMPHeader;
7327   Info: TBMPInfo;
7328   Converter: TFormatDescriptor;
7329   FormatDesc: TFormatDescriptor;
7330   SourceFD, DestFD: Pointer;
7331   pData, srcData, dstData, ConvertBuffer: pByte;
7332
7333   Pixel: TglBitmapPixelData;
7334   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7335   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7336
7337   PaddingBuff: Cardinal;
7338
7339   function GetLineWidth : Integer;
7340   begin
7341     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7342   end;
7343
7344 begin
7345   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7346     raise EglBitmapUnsupportedFormat.Create(Format);
7347
7348   Converter  := nil;
7349   FormatDesc := TFormatDescriptor.Get(Format);
7350   ImageSize  := FormatDesc.GetSize(Dimension);
7351
7352   FillChar(Header{%H-}, SizeOf(Header), 0);
7353   Header.bfType      := BMP_MAGIC;
7354   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7355   Header.bfReserved1 := 0;
7356   Header.bfReserved2 := 0;
7357   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7358
7359   FillChar(Info{%H-}, SizeOf(Info), 0);
7360   Info.biSize        := SizeOf(Info);
7361   Info.biWidth       := Width;
7362   Info.biHeight      := Height;
7363   Info.biPlanes      := 1;
7364   Info.biCompression := BMP_COMP_RGB;
7365   Info.biSizeImage   := ImageSize;
7366
7367   try
7368     case Format of
7369       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7370       begin
7371         Info.biBitCount  :=  8;
7372         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7373         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7374         Converter := TbmpColorTableFormat.Create;
7375         with (Converter as TbmpColorTableFormat) do begin
7376           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7377           CreateColorTable;
7378         end;
7379       end;
7380
7381       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7382       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7383       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7384       begin
7385         Info.biBitCount    := 16;
7386         Info.biCompression := BMP_COMP_BITFIELDS;
7387       end;
7388
7389       tfBGR8ub3, tfRGB8ub3:
7390       begin
7391         Info.biBitCount := 24;
7392         if (Format = tfRGB8ub3) then
7393           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7394       end;
7395
7396       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7397       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7398       begin
7399         Info.biBitCount    := 32;
7400         Info.biCompression := BMP_COMP_BITFIELDS;
7401       end;
7402     else
7403       raise EglBitmapUnsupportedFormat.Create(Format);
7404     end;
7405     Info.biXPelsPerMeter := 2835;
7406     Info.biYPelsPerMeter := 2835;
7407
7408     // prepare bitmasks
7409     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7410       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7411       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7412
7413       RedMask    := FormatDesc.Mask.r;
7414       GreenMask  := FormatDesc.Mask.g;
7415       BlueMask   := FormatDesc.Mask.b;
7416       AlphaMask  := FormatDesc.Mask.a;
7417     end;
7418
7419     // headers
7420     aStream.Write(Header, SizeOf(Header));
7421     aStream.Write(Info, SizeOf(Info));
7422
7423     // colortable
7424     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7425       with (Converter as TbmpColorTableFormat) do
7426         aStream.Write(ColorTable[0].b,
7427           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7428
7429     // bitmasks
7430     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7431       aStream.Write(RedMask,   SizeOf(Cardinal));
7432       aStream.Write(GreenMask, SizeOf(Cardinal));
7433       aStream.Write(BlueMask,  SizeOf(Cardinal));
7434       aStream.Write(AlphaMask, SizeOf(Cardinal));
7435     end;
7436
7437     // image data
7438     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7439     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7440     Padding     := GetLineWidth - wbLineSize;
7441     PaddingBuff := 0;
7442
7443     pData := Data;
7444     inc(pData, (Height-1) * rbLineSize);
7445
7446     // prepare row buffer. But only for RGB because RGBA supports color masks
7447     // so it's possible to change color within the image.
7448     if Assigned(Converter) then begin
7449       FormatDesc.PreparePixel(Pixel);
7450       GetMem(ConvertBuffer, wbLineSize);
7451       SourceFD := FormatDesc.CreateMappingData;
7452       DestFD   := Converter.CreateMappingData;
7453     end else
7454       ConvertBuffer := nil;
7455
7456     try
7457       for LineIdx := 0 to Height - 1 do begin
7458         // preparing row
7459         if Assigned(Converter) then begin
7460           srcData := pData;
7461           dstData := ConvertBuffer;
7462           for PixelIdx := 0 to Info.biWidth-1 do begin
7463             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7464             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7465             Converter.Map(Pixel, dstData, DestFD);
7466           end;
7467           aStream.Write(ConvertBuffer^, wbLineSize);
7468         end else begin
7469           aStream.Write(pData^, rbLineSize);
7470         end;
7471         dec(pData, rbLineSize);
7472         if (Padding > 0) then
7473           aStream.Write(PaddingBuff, Padding);
7474       end;
7475     finally
7476       // destroy row buffer
7477       if Assigned(ConvertBuffer) then begin
7478         FormatDesc.FreeMappingData(SourceFD);
7479         Converter.FreeMappingData(DestFD);
7480         FreeMem(ConvertBuffer);
7481       end;
7482     end;
7483   finally
7484     if Assigned(Converter) then
7485       Converter.Free;
7486   end;
7487 end;
7488
7489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7490 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7492 type
7493   TTGAHeader = packed record
7494     ImageID: Byte;
7495     ColorMapType: Byte;
7496     ImageType: Byte;
7497     //ColorMapSpec: Array[0..4] of Byte;
7498     ColorMapStart: Word;
7499     ColorMapLength: Word;
7500     ColorMapEntrySize: Byte;
7501     OrigX: Word;
7502     OrigY: Word;
7503     Width: Word;
7504     Height: Word;
7505     Bpp: Byte;
7506     ImageDesc: Byte;
7507   end;
7508
7509 const
7510   TGA_UNCOMPRESSED_RGB  =  2;
7511   TGA_UNCOMPRESSED_GRAY =  3;
7512   TGA_COMPRESSED_RGB    = 10;
7513   TGA_COMPRESSED_GRAY   = 11;
7514
7515   TGA_NONE_COLOR_TABLE  = 0;
7516
7517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7518 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7519 var
7520   Header: TTGAHeader;
7521   ImageData: System.PByte;
7522   StartPosition: Int64;
7523   PixelSize, LineSize: Integer;
7524   tgaFormat: TglBitmapFormat;
7525   FormatDesc: TFormatDescriptor;
7526   Counter: packed record
7527     X, Y: packed record
7528       low, high, dir: Integer;
7529     end;
7530   end;
7531
7532 const
7533   CACHE_SIZE = $4000;
7534
7535   ////////////////////////////////////////////////////////////////////////////////////////
7536   procedure ReadUncompressed;
7537   var
7538     i, j: Integer;
7539     buf, tmp1, tmp2: System.PByte;
7540   begin
7541     buf := nil;
7542     if (Counter.X.dir < 0) then
7543       GetMem(buf, LineSize);
7544     try
7545       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7546         tmp1 := ImageData;
7547         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7548         if (Counter.X.dir < 0) then begin               //flip X
7549           aStream.Read(buf^, LineSize);
7550           tmp2 := buf;
7551           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7552           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7553             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7554               tmp1^ := tmp2^;
7555               inc(tmp1);
7556               inc(tmp2);
7557             end;
7558             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7559           end;
7560         end else
7561           aStream.Read(tmp1^, LineSize);
7562         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7563       end;
7564     finally
7565       if Assigned(buf) then
7566         FreeMem(buf);
7567     end;
7568   end;
7569
7570   ////////////////////////////////////////////////////////////////////////////////////////
7571   procedure ReadCompressed;
7572
7573     /////////////////////////////////////////////////////////////////
7574     var
7575       TmpData: System.PByte;
7576       LinePixelsRead: Integer;
7577     procedure CheckLine;
7578     begin
7579       if (LinePixelsRead >= Header.Width) then begin
7580         LinePixelsRead := 0;
7581         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7582         TmpData := ImageData;
7583         inc(TmpData, Counter.Y.low * LineSize);           //set line
7584         if (Counter.X.dir < 0) then                       //if x flipped then
7585           inc(TmpData, LineSize - PixelSize);             //set last pixel
7586       end;
7587     end;
7588
7589     /////////////////////////////////////////////////////////////////
7590     var
7591       Cache: PByte;
7592       CacheSize, CachePos: Integer;
7593     procedure CachedRead(out Buffer; Count: Integer);
7594     var
7595       BytesRead: Integer;
7596     begin
7597       if (CachePos + Count > CacheSize) then begin
7598         //if buffer overflow save non read bytes
7599         BytesRead := 0;
7600         if (CacheSize - CachePos > 0) then begin
7601           BytesRead := CacheSize - CachePos;
7602           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7603           inc(CachePos, BytesRead);
7604         end;
7605
7606         //load cache from file
7607         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7608         aStream.Read(Cache^, CacheSize);
7609         CachePos := 0;
7610
7611         //read rest of requested bytes
7612         if (Count - BytesRead > 0) then begin
7613           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7614           inc(CachePos, Count - BytesRead);
7615         end;
7616       end else begin
7617         //if no buffer overflow just read the data
7618         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7619         inc(CachePos, Count);
7620       end;
7621     end;
7622
7623     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7624     begin
7625       case PixelSize of
7626         1: begin
7627           aBuffer^ := aData^;
7628           inc(aBuffer, Counter.X.dir);
7629         end;
7630         2: begin
7631           PWord(aBuffer)^ := PWord(aData)^;
7632           inc(aBuffer, 2 * Counter.X.dir);
7633         end;
7634         3: begin
7635           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7636           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7637           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7638           inc(aBuffer, 3 * Counter.X.dir);
7639         end;
7640         4: begin
7641           PCardinal(aBuffer)^ := PCardinal(aData)^;
7642           inc(aBuffer, 4 * Counter.X.dir);
7643         end;
7644       end;
7645     end;
7646
7647   var
7648     TotalPixelsToRead, TotalPixelsRead: Integer;
7649     Temp: Byte;
7650     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7651     PixelRepeat: Boolean;
7652     PixelsToRead, PixelCount: Integer;
7653   begin
7654     CacheSize := 0;
7655     CachePos  := 0;
7656
7657     TotalPixelsToRead := Header.Width * Header.Height;
7658     TotalPixelsRead   := 0;
7659     LinePixelsRead    := 0;
7660
7661     GetMem(Cache, CACHE_SIZE);
7662     try
7663       TmpData := ImageData;
7664       inc(TmpData, Counter.Y.low * LineSize);           //set line
7665       if (Counter.X.dir < 0) then                       //if x flipped then
7666         inc(TmpData, LineSize - PixelSize);             //set last pixel
7667
7668       repeat
7669         //read CommandByte
7670         CachedRead(Temp, 1);
7671         PixelRepeat  := (Temp and $80) > 0;
7672         PixelsToRead := (Temp and $7F) + 1;
7673         inc(TotalPixelsRead, PixelsToRead);
7674
7675         if PixelRepeat then
7676           CachedRead(buf[0], PixelSize);
7677         while (PixelsToRead > 0) do begin
7678           CheckLine;
7679           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7680           while (PixelCount > 0) do begin
7681             if not PixelRepeat then
7682               CachedRead(buf[0], PixelSize);
7683             PixelToBuffer(@buf[0], TmpData);
7684             inc(LinePixelsRead);
7685             dec(PixelsToRead);
7686             dec(PixelCount);
7687           end;
7688         end;
7689       until (TotalPixelsRead >= TotalPixelsToRead);
7690     finally
7691       FreeMem(Cache);
7692     end;
7693   end;
7694
7695   function IsGrayFormat: Boolean;
7696   begin
7697     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7698   end;
7699
7700 begin
7701   result := false;
7702
7703   // reading header to test file and set cursor back to begin
7704   StartPosition := aStream.Position;
7705   aStream.Read(Header{%H-}, SizeOf(Header));
7706
7707   // no colormapped files
7708   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7709     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7710   begin
7711     try
7712       if Header.ImageID <> 0 then       // skip image ID
7713         aStream.Position := aStream.Position + Header.ImageID;
7714
7715       tgaFormat := tfEmpty;
7716       case Header.Bpp of
7717          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7718                0: tgaFormat := tfLuminance8ub1;
7719                8: tgaFormat := tfAlpha8ub1;
7720             end;
7721
7722         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7723                0: tgaFormat := tfLuminance16us1;
7724                8: tgaFormat := tfLuminance8Alpha8ub2;
7725             end else case (Header.ImageDesc and $F) of
7726                0: tgaFormat := tfX1RGB5us1;
7727                1: tgaFormat := tfA1RGB5us1;
7728                4: tgaFormat := tfARGB4us1;
7729             end;
7730
7731         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7732                0: tgaFormat := tfBGR8ub3;
7733             end;
7734
7735         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7736                0: tgaFormat := tfDepth32ui1;
7737             end else case (Header.ImageDesc and $F) of
7738                0: tgaFormat := tfX2RGB10ui1;
7739                2: tgaFormat := tfA2RGB10ui1;
7740                8: tgaFormat := tfARGB8ui1;
7741             end;
7742       end;
7743
7744       if (tgaFormat = tfEmpty) then
7745         raise EglBitmap.Create('LoadTga - unsupported format');
7746
7747       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7748       PixelSize  := FormatDesc.GetSize(1, 1);
7749       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7750
7751       GetMem(ImageData, LineSize * Header.Height);
7752       try
7753         //column direction
7754         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7755           Counter.X.low  := Header.Height-1;;
7756           Counter.X.high := 0;
7757           Counter.X.dir  := -1;
7758         end else begin
7759           Counter.X.low  := 0;
7760           Counter.X.high := Header.Height-1;
7761           Counter.X.dir  := 1;
7762         end;
7763
7764         // Row direction
7765         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7766           Counter.Y.low  := 0;
7767           Counter.Y.high := Header.Height-1;
7768           Counter.Y.dir  := 1;
7769         end else begin
7770           Counter.Y.low  := Header.Height-1;;
7771           Counter.Y.high := 0;
7772           Counter.Y.dir  := -1;
7773         end;
7774
7775         // Read Image
7776         case Header.ImageType of
7777           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7778             ReadUncompressed;
7779           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7780             ReadCompressed;
7781         end;
7782
7783         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7784         result := true;
7785       except
7786         if Assigned(ImageData) then
7787           FreeMem(ImageData);
7788         raise;
7789       end;
7790     finally
7791       aStream.Position := StartPosition;
7792     end;
7793   end
7794     else aStream.Position := StartPosition;
7795 end;
7796
7797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7798 procedure TglBitmap.SaveTGA(const aStream: TStream);
7799 var
7800   Header: TTGAHeader;
7801   Size: Integer;
7802   FormatDesc: TFormatDescriptor;
7803 begin
7804   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7805     raise EglBitmapUnsupportedFormat.Create(Format);
7806
7807   //prepare header
7808   FormatDesc := TFormatDescriptor.Get(Format);
7809   FillChar(Header{%H-}, SizeOf(Header), 0);
7810   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
7811   Header.Bpp       := FormatDesc.BitsPerPixel;
7812   Header.Width     := Width;
7813   Header.Height    := Height;
7814   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7815   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
7816     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7817   else
7818     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7819   aStream.Write(Header, SizeOf(Header));
7820
7821   // write Data
7822   Size := FormatDesc.GetSize(Dimension);
7823   aStream.Write(Data^, Size);
7824 end;
7825
7826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7827 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7829 const
7830   DDS_MAGIC: Cardinal         = $20534444;
7831
7832   // DDS_header.dwFlags
7833   DDSD_CAPS                   = $00000001;
7834   DDSD_HEIGHT                 = $00000002;
7835   DDSD_WIDTH                  = $00000004;
7836   DDSD_PIXELFORMAT            = $00001000;
7837
7838   // DDS_header.sPixelFormat.dwFlags
7839   DDPF_ALPHAPIXELS            = $00000001;
7840   DDPF_ALPHA                  = $00000002;
7841   DDPF_FOURCC                 = $00000004;
7842   DDPF_RGB                    = $00000040;
7843   DDPF_LUMINANCE              = $00020000;
7844
7845   // DDS_header.sCaps.dwCaps1
7846   DDSCAPS_TEXTURE             = $00001000;
7847
7848   // DDS_header.sCaps.dwCaps2
7849   DDSCAPS2_CUBEMAP            = $00000200;
7850
7851   D3DFMT_DXT1                 = $31545844;
7852   D3DFMT_DXT3                 = $33545844;
7853   D3DFMT_DXT5                 = $35545844;
7854
7855 type
7856   TDDSPixelFormat = packed record
7857     dwSize: Cardinal;
7858     dwFlags: Cardinal;
7859     dwFourCC: Cardinal;
7860     dwRGBBitCount: Cardinal;
7861     dwRBitMask: Cardinal;
7862     dwGBitMask: Cardinal;
7863     dwBBitMask: Cardinal;
7864     dwABitMask: Cardinal;
7865   end;
7866
7867   TDDSCaps = packed record
7868     dwCaps1: Cardinal;
7869     dwCaps2: Cardinal;
7870     dwDDSX: Cardinal;
7871     dwReserved: Cardinal;
7872   end;
7873
7874   TDDSHeader = packed record
7875     dwSize: Cardinal;
7876     dwFlags: Cardinal;
7877     dwHeight: Cardinal;
7878     dwWidth: Cardinal;
7879     dwPitchOrLinearSize: Cardinal;
7880     dwDepth: Cardinal;
7881     dwMipMapCount: Cardinal;
7882     dwReserved: array[0..10] of Cardinal;
7883     PixelFormat: TDDSPixelFormat;
7884     Caps: TDDSCaps;
7885     dwReserved2: Cardinal;
7886   end;
7887
7888 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7889 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7890 var
7891   Header: TDDSHeader;
7892   Converter: TbmpBitfieldFormat;
7893
7894   function GetDDSFormat: TglBitmapFormat;
7895   var
7896     fd: TFormatDescriptor;
7897     i: Integer;
7898     Mask: TglBitmapRec4ul;
7899     Range: TglBitmapRec4ui;
7900     match: Boolean;
7901   begin
7902     result := tfEmpty;
7903     with Header.PixelFormat do begin
7904       // Compresses
7905       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7906         case Header.PixelFormat.dwFourCC of
7907           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7908           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7909           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7910         end;
7911       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
7912         // prepare masks
7913         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
7914           Mask.r := dwRBitMask;
7915           Mask.g := dwGBitMask;
7916           Mask.b := dwBBitMask;
7917         end else begin
7918           Mask.r := dwRBitMask;
7919           Mask.g := dwRBitMask;
7920           Mask.b := dwRBitMask;
7921         end;
7922         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
7923           Mask.a := dwABitMask
7924         else
7925           Mask.a := 0;;
7926
7927         //find matching format
7928         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
7929         result := fd.Format;
7930         if (result <> tfEmpty) then
7931           exit;
7932
7933         //find format with same Range
7934         for i := 0 to 3 do
7935           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
7936         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7937           fd := TFormatDescriptor.Get(result);
7938           match := true;
7939           for i := 0 to 3 do
7940             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7941               match := false;
7942               break;
7943             end;
7944           if match then
7945             break;
7946         end;
7947
7948         //no format with same range found -> use default
7949         if (result = tfEmpty) then begin
7950           if (dwABitMask > 0) then
7951             result := tfRGBA8ui1
7952           else
7953             result := tfRGB8ub3;
7954         end;
7955
7956         Converter := TbmpBitfieldFormat.Create;
7957         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
7958       end;
7959     end;
7960   end;
7961
7962 var
7963   StreamPos: Int64;
7964   x, y, LineSize, RowSize, Magic: Cardinal;
7965   NewImage, TmpData, RowData, SrcData: System.PByte;
7966   SourceMD, DestMD: Pointer;
7967   Pixel: TglBitmapPixelData;
7968   ddsFormat: TglBitmapFormat;
7969   FormatDesc: TFormatDescriptor;
7970
7971 begin
7972   result    := false;
7973   Converter := nil;
7974   StreamPos := aStream.Position;
7975
7976   // Magic
7977   aStream.Read(Magic{%H-}, sizeof(Magic));
7978   if (Magic <> DDS_MAGIC) then begin
7979     aStream.Position := StreamPos;
7980     exit;
7981   end;
7982
7983   //Header
7984   aStream.Read(Header{%H-}, sizeof(Header));
7985   if (Header.dwSize <> SizeOf(Header)) or
7986      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7987         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7988   begin
7989     aStream.Position := StreamPos;
7990     exit;
7991   end;
7992
7993   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7994     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7995
7996   ddsFormat := GetDDSFormat;
7997   try
7998     if (ddsFormat = tfEmpty) then
7999       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8000
8001     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8002     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8003     GetMem(NewImage, Header.dwHeight * LineSize);
8004     try
8005       TmpData := NewImage;
8006
8007       //Converter needed
8008       if Assigned(Converter) then begin
8009         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8010         GetMem(RowData, RowSize);
8011         SourceMD := Converter.CreateMappingData;
8012         DestMD   := FormatDesc.CreateMappingData;
8013         try
8014           for y := 0 to Header.dwHeight-1 do begin
8015             TmpData := NewImage;
8016             inc(TmpData, y * LineSize);
8017             SrcData := RowData;
8018             aStream.Read(SrcData^, RowSize);
8019             for x := 0 to Header.dwWidth-1 do begin
8020               Converter.Unmap(SrcData, Pixel, SourceMD);
8021               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8022               FormatDesc.Map(Pixel, TmpData, DestMD);
8023             end;
8024           end;
8025         finally
8026           Converter.FreeMappingData(SourceMD);
8027           FormatDesc.FreeMappingData(DestMD);
8028           FreeMem(RowData);
8029         end;
8030       end else
8031
8032       // Compressed
8033       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8034         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8035         for Y := 0 to Header.dwHeight-1 do begin
8036           aStream.Read(TmpData^, RowSize);
8037           Inc(TmpData, LineSize);
8038         end;
8039       end else
8040
8041       // Uncompressed
8042       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8043         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8044         for Y := 0 to Header.dwHeight-1 do begin
8045           aStream.Read(TmpData^, RowSize);
8046           Inc(TmpData, LineSize);
8047         end;
8048       end else
8049         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8050
8051       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8052       result := true;
8053     except
8054       if Assigned(NewImage) then
8055         FreeMem(NewImage);
8056       raise;
8057     end;
8058   finally
8059     FreeAndNil(Converter);
8060   end;
8061 end;
8062
8063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8064 procedure TglBitmap.SaveDDS(const aStream: TStream);
8065 var
8066   Header: TDDSHeader;
8067   FormatDesc: TFormatDescriptor;
8068 begin
8069   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8070     raise EglBitmapUnsupportedFormat.Create(Format);
8071
8072   FormatDesc := TFormatDescriptor.Get(Format);
8073
8074   // Generell
8075   FillChar(Header{%H-}, SizeOf(Header), 0);
8076   Header.dwSize  := SizeOf(Header);
8077   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8078
8079   Header.dwWidth  := Max(1, Width);
8080   Header.dwHeight := Max(1, Height);
8081
8082   // Caps
8083   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8084
8085   // Pixelformat
8086   Header.PixelFormat.dwSize := sizeof(Header);
8087   if (FormatDesc.IsCompressed) then begin
8088     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8089     case Format of
8090       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8091       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8092       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8093     end;
8094   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8095     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8096     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8097     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8098   end else if FormatDesc.IsGrayscale then begin
8099     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8100     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8101     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8102     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8103   end else begin
8104     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8105     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8106     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8107     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8108     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8109     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8110   end;
8111
8112   if (FormatDesc.HasAlpha) then
8113     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8114
8115   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8116   aStream.Write(Header, SizeOf(Header));
8117   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8118 end;
8119
8120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8121 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8123 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8124   const aWidth: Integer; const aHeight: Integer);
8125 var
8126   pTemp: pByte;
8127   Size: Integer;
8128 begin
8129   if (aHeight > 1) then begin
8130     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8131     GetMem(pTemp, Size);
8132     try
8133       Move(aData^, pTemp^, Size);
8134       FreeMem(aData);
8135       aData := nil;
8136     except
8137       FreeMem(pTemp);
8138       raise;
8139     end;
8140   end else
8141     pTemp := aData;
8142   inherited SetDataPointer(pTemp, aFormat, aWidth);
8143 end;
8144
8145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8146 function TglBitmap1D.FlipHorz: Boolean;
8147 var
8148   Col: Integer;
8149   pTempDest, pDest, pSource: PByte;
8150 begin
8151   result := inherited FlipHorz;
8152   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8153     pSource := Data;
8154     GetMem(pDest, fRowSize);
8155     try
8156       pTempDest := pDest;
8157       Inc(pTempDest, fRowSize);
8158       for Col := 0 to Width-1 do begin
8159         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8160         Move(pSource^, pTempDest^, fPixelSize);
8161         Inc(pSource, fPixelSize);
8162       end;
8163       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8164       result := true;
8165     except
8166       if Assigned(pDest) then
8167         FreeMem(pDest);
8168       raise;
8169     end;
8170   end;
8171 end;
8172
8173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8174 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8175 var
8176   FormatDesc: TFormatDescriptor;
8177 begin
8178   // Upload data
8179   FormatDesc := TFormatDescriptor.Get(Format);
8180   if FormatDesc.IsCompressed then begin
8181     if not Assigned(glCompressedTexImage1D) then
8182       raise EglBitmap.Create('compressed formats not supported by video adapter');
8183     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8184   end else if aBuildWithGlu then
8185     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8186   else
8187     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8188
8189   // Free Data
8190   if (FreeDataAfterGenTexture) then
8191     FreeData;
8192 end;
8193
8194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8195 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8196 var
8197   BuildWithGlu, TexRec: Boolean;
8198   TexSize: Integer;
8199 begin
8200   if Assigned(Data) then begin
8201     // Check Texture Size
8202     if (aTestTextureSize) then begin
8203       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8204
8205       if (Width > TexSize) then
8206         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8207
8208       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8209                 (Target = GL_TEXTURE_RECTANGLE);
8210       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8211         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8212     end;
8213
8214     CreateId;
8215     SetupParameters(BuildWithGlu);
8216     UploadData(BuildWithGlu);
8217     glAreTexturesResident(1, @fID, @fIsResident);
8218   end;
8219 end;
8220
8221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8222 procedure TglBitmap1D.AfterConstruction;
8223 begin
8224   inherited;
8225   Target := GL_TEXTURE_1D;
8226 end;
8227
8228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8229 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8231 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8232 begin
8233   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8234     result := fLines[aIndex]
8235   else
8236     result := nil;
8237 end;
8238
8239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8240 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8241   const aWidth: Integer; const aHeight: Integer);
8242 var
8243   Idx, LineWidth: Integer;
8244 begin
8245   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8246
8247   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8248     // Assigning Data
8249     if Assigned(Data) then begin
8250       SetLength(fLines, GetHeight);
8251       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8252
8253       for Idx := 0 to GetHeight-1 do begin
8254         fLines[Idx] := Data;
8255         Inc(fLines[Idx], Idx * LineWidth);
8256       end;
8257     end
8258       else SetLength(fLines, 0);
8259   end else begin
8260     SetLength(fLines, 0);
8261   end;
8262 end;
8263
8264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8265 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8266 var
8267   FormatDesc: TFormatDescriptor;
8268 begin
8269   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8270
8271   FormatDesc := TFormatDescriptor.Get(Format);
8272   if FormatDesc.IsCompressed then begin
8273     if not Assigned(glCompressedTexImage2D) then
8274       raise EglBitmap.Create('compressed formats not supported by video adapter');
8275     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8276   end else if aBuildWithGlu then begin
8277     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8278       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8279   end else begin
8280     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8281       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8282   end;
8283
8284   // Freigeben
8285   if (FreeDataAfterGenTexture) then
8286     FreeData;
8287 end;
8288
8289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8290 procedure TglBitmap2D.AfterConstruction;
8291 begin
8292   inherited;
8293   Target := GL_TEXTURE_2D;
8294 end;
8295
8296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8297 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8298 var
8299   Temp: pByte;
8300   Size, w, h: Integer;
8301   FormatDesc: TFormatDescriptor;
8302 begin
8303   FormatDesc := TFormatDescriptor.Get(aFormat);
8304   if FormatDesc.IsCompressed then
8305     raise EglBitmapUnsupportedFormat.Create(aFormat);
8306
8307   w    := aRight  - aLeft;
8308   h    := aBottom - aTop;
8309   Size := FormatDesc.GetSize(w, h);
8310   GetMem(Temp, Size);
8311   try
8312     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8313     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8314     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8315     FlipVert;
8316   except
8317     if Assigned(Temp) then
8318       FreeMem(Temp);
8319     raise;
8320   end;
8321 end;
8322
8323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8324 procedure TglBitmap2D.GetDataFromTexture;
8325 var
8326   Temp: PByte;
8327   TempWidth, TempHeight: Integer;
8328   TempIntFormat: GLint;
8329   IntFormat: TglBitmapFormat;
8330   FormatDesc: TFormatDescriptor;
8331 begin
8332   Bind;
8333
8334   // Request Data
8335   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8336   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8337   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8338
8339   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8340   IntFormat  := FormatDesc.Format;
8341
8342   // Getting data from OpenGL
8343   FormatDesc := TFormatDescriptor.Get(IntFormat);
8344   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8345   try
8346     if FormatDesc.IsCompressed then begin
8347       if not Assigned(glGetCompressedTexImage) then
8348         raise EglBitmap.Create('compressed formats not supported by video adapter');
8349       glGetCompressedTexImage(Target, 0, Temp)
8350     end else
8351       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8352     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8353   except
8354     if Assigned(Temp) then
8355       FreeMem(Temp);
8356     raise;
8357   end;
8358 end;
8359
8360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8361 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8362 var
8363   BuildWithGlu, PotTex, TexRec: Boolean;
8364   TexSize: Integer;
8365 begin
8366   if Assigned(Data) then begin
8367     // Check Texture Size
8368     if (aTestTextureSize) then begin
8369       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8370
8371       if ((Height > TexSize) or (Width > TexSize)) then
8372         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8373
8374       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8375       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8376       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8377         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8378     end;
8379
8380     CreateId;
8381     SetupParameters(BuildWithGlu);
8382     UploadData(Target, BuildWithGlu);
8383     glAreTexturesResident(1, @fID, @fIsResident);
8384   end;
8385 end;
8386
8387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8388 function TglBitmap2D.FlipHorz: Boolean;
8389 var
8390   Col, Row: Integer;
8391   TempDestData, DestData, SourceData: PByte;
8392   ImgSize: Integer;
8393 begin
8394   result := inherited FlipHorz;
8395   if Assigned(Data) then begin
8396     SourceData := Data;
8397     ImgSize := Height * fRowSize;
8398     GetMem(DestData, ImgSize);
8399     try
8400       TempDestData := DestData;
8401       Dec(TempDestData, fRowSize + fPixelSize);
8402       for Row := 0 to Height -1 do begin
8403         Inc(TempDestData, fRowSize * 2);
8404         for Col := 0 to Width -1 do begin
8405           Move(SourceData^, TempDestData^, fPixelSize);
8406           Inc(SourceData, fPixelSize);
8407           Dec(TempDestData, fPixelSize);
8408         end;
8409       end;
8410       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8411       result := true;
8412     except
8413       if Assigned(DestData) then
8414         FreeMem(DestData);
8415       raise;
8416     end;
8417   end;
8418 end;
8419
8420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8421 function TglBitmap2D.FlipVert: Boolean;
8422 var
8423   Row: Integer;
8424   TempDestData, DestData, SourceData: PByte;
8425 begin
8426   result := inherited FlipVert;
8427   if Assigned(Data) then begin
8428     SourceData := Data;
8429     GetMem(DestData, Height * fRowSize);
8430     try
8431       TempDestData := DestData;
8432       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8433       for Row := 0 to Height -1 do begin
8434         Move(SourceData^, TempDestData^, fRowSize);
8435         Dec(TempDestData, fRowSize);
8436         Inc(SourceData, fRowSize);
8437       end;
8438       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8439       result := true;
8440     except
8441       if Assigned(DestData) then
8442         FreeMem(DestData);
8443       raise;
8444     end;
8445   end;
8446 end;
8447
8448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8449 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 type
8452   TMatrixItem = record
8453     X, Y: Integer;
8454     W: Single;
8455   end;
8456
8457   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8458   TglBitmapToNormalMapRec = Record
8459     Scale: Single;
8460     Heights: array of Single;
8461     MatrixU : array of TMatrixItem;
8462     MatrixV : array of TMatrixItem;
8463   end;
8464
8465 const
8466   ONE_OVER_255 = 1 / 255;
8467
8468   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8469 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8470 var
8471   Val: Single;
8472 begin
8473   with FuncRec do begin
8474     Val :=
8475       Source.Data.r * LUMINANCE_WEIGHT_R +
8476       Source.Data.g * LUMINANCE_WEIGHT_G +
8477       Source.Data.b * LUMINANCE_WEIGHT_B;
8478     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8479   end;
8480 end;
8481
8482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8483 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8484 begin
8485   with FuncRec do
8486     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8487 end;
8488
8489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8490 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8491 type
8492   TVec = Array[0..2] of Single;
8493 var
8494   Idx: Integer;
8495   du, dv: Double;
8496   Len: Single;
8497   Vec: TVec;
8498
8499   function GetHeight(X, Y: Integer): Single;
8500   begin
8501     with FuncRec do begin
8502       X := Max(0, Min(Size.X -1, X));
8503       Y := Max(0, Min(Size.Y -1, Y));
8504       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8505     end;
8506   end;
8507
8508 begin
8509   with FuncRec do begin
8510     with PglBitmapToNormalMapRec(Args)^ do begin
8511       du := 0;
8512       for Idx := Low(MatrixU) to High(MatrixU) do
8513         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8514
8515       dv := 0;
8516       for Idx := Low(MatrixU) to High(MatrixU) do
8517         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8518
8519       Vec[0] := -du * Scale;
8520       Vec[1] := -dv * Scale;
8521       Vec[2] := 1;
8522     end;
8523
8524     // Normalize
8525     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8526     if Len <> 0 then begin
8527       Vec[0] := Vec[0] * Len;
8528       Vec[1] := Vec[1] * Len;
8529       Vec[2] := Vec[2] * Len;
8530     end;
8531
8532     // Farbe zuweisem
8533     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8534     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8535     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8536   end;
8537 end;
8538
8539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8540 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8541 var
8542   Rec: TglBitmapToNormalMapRec;
8543
8544   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8545   begin
8546     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8547       Matrix[Index].X := X;
8548       Matrix[Index].Y := Y;
8549       Matrix[Index].W := W;
8550     end;
8551   end;
8552
8553 begin
8554   if TFormatDescriptor.Get(Format).IsCompressed then
8555     raise EglBitmapUnsupportedFormat.Create(Format);
8556
8557   if aScale > 100 then
8558     Rec.Scale := 100
8559   else if aScale < -100 then
8560     Rec.Scale := -100
8561   else
8562     Rec.Scale := aScale;
8563
8564   SetLength(Rec.Heights, Width * Height);
8565   try
8566     case aFunc of
8567       nm4Samples: begin
8568         SetLength(Rec.MatrixU, 2);
8569         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8570         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8571
8572         SetLength(Rec.MatrixV, 2);
8573         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8574         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8575       end;
8576
8577       nmSobel: begin
8578         SetLength(Rec.MatrixU, 6);
8579         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8580         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8581         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8582         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8583         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8584         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8585
8586         SetLength(Rec.MatrixV, 6);
8587         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8588         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8589         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8590         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8591         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8592         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8593       end;
8594
8595       nm3x3: begin
8596         SetLength(Rec.MatrixU, 6);
8597         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8598         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8599         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8600         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8601         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8602         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8603
8604         SetLength(Rec.MatrixV, 6);
8605         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8606         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8607         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8608         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8609         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8610         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8611       end;
8612
8613       nm5x5: begin
8614         SetLength(Rec.MatrixU, 20);
8615         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8616         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8617         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8618         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8619         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8620         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8621         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8622         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8623         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8624         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8625         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8626         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8627         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8628         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8629         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8630         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8631         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8632         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8633         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8634         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8635
8636         SetLength(Rec.MatrixV, 20);
8637         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8638         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8639         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8640         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8641         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8642         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8643         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8644         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8645         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8646         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8647         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8648         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8649         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8650         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8651         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8652         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8653         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8654         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8655         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8656         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8657       end;
8658     end;
8659
8660     // Daten Sammeln
8661     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8662       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8663     else
8664       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8665     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8666   finally
8667     SetLength(Rec.Heights, 0);
8668   end;
8669 end;
8670
8671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8672 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8674 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8675 begin
8676   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8677 end;
8678
8679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8680 procedure TglBitmapCubeMap.AfterConstruction;
8681 begin
8682   inherited;
8683
8684   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8685     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8686
8687   SetWrap;
8688   Target   := GL_TEXTURE_CUBE_MAP;
8689   fGenMode := GL_REFLECTION_MAP;
8690 end;
8691
8692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8693 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8694 var
8695   BuildWithGlu: Boolean;
8696   TexSize: Integer;
8697 begin
8698   if (aTestTextureSize) then begin
8699     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8700
8701     if (Height > TexSize) or (Width > TexSize) then
8702       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8703
8704     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8705       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8706   end;
8707
8708   if (ID = 0) then
8709     CreateID;
8710   SetupParameters(BuildWithGlu);
8711   UploadData(aCubeTarget, BuildWithGlu);
8712 end;
8713
8714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8715 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8716 begin
8717   inherited Bind (aEnableTextureUnit);
8718   if aEnableTexCoordsGen then begin
8719     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8720     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8721     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8722     glEnable(GL_TEXTURE_GEN_S);
8723     glEnable(GL_TEXTURE_GEN_T);
8724     glEnable(GL_TEXTURE_GEN_R);
8725   end;
8726 end;
8727
8728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8729 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8730 begin
8731   inherited Unbind(aDisableTextureUnit);
8732   if aDisableTexCoordsGen then begin
8733     glDisable(GL_TEXTURE_GEN_S);
8734     glDisable(GL_TEXTURE_GEN_T);
8735     glDisable(GL_TEXTURE_GEN_R);
8736   end;
8737 end;
8738
8739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8740 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8742 type
8743   TVec = Array[0..2] of Single;
8744   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8745
8746   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8747   TglBitmapNormalMapRec = record
8748     HalfSize : Integer;
8749     Func: TglBitmapNormalMapGetVectorFunc;
8750   end;
8751
8752   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8753 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8754 begin
8755   aVec[0] := aHalfSize;
8756   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8757   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8758 end;
8759
8760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8761 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8762 begin
8763   aVec[0] := - aHalfSize;
8764   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8765   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8766 end;
8767
8768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8769 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8770 begin
8771   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8772   aVec[1] := aHalfSize;
8773   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8774 end;
8775
8776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8777 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8778 begin
8779   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8780   aVec[1] := - aHalfSize;
8781   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8782 end;
8783
8784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8785 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8786 begin
8787   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8788   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8789   aVec[2] := aHalfSize;
8790 end;
8791
8792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8793 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8794 begin
8795   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8796   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8797   aVec[2] := - aHalfSize;
8798 end;
8799
8800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8801 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8802 var
8803   i: Integer;
8804   Vec: TVec;
8805   Len: Single;
8806 begin
8807   with FuncRec do begin
8808     with PglBitmapNormalMapRec(Args)^ do begin
8809       Func(Vec, Position, HalfSize);
8810
8811       // Normalize
8812       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8813       if Len <> 0 then begin
8814         Vec[0] := Vec[0] * Len;
8815         Vec[1] := Vec[1] * Len;
8816         Vec[2] := Vec[2] * Len;
8817       end;
8818
8819       // Scale Vector and AddVectro
8820       Vec[0] := Vec[0] * 0.5 + 0.5;
8821       Vec[1] := Vec[1] * 0.5 + 0.5;
8822       Vec[2] := Vec[2] * 0.5 + 0.5;
8823     end;
8824
8825     // Set Color
8826     for i := 0 to 2 do
8827       Dest.Data.arr[i] := Round(Vec[i] * 255);
8828   end;
8829 end;
8830
8831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8832 procedure TglBitmapNormalMap.AfterConstruction;
8833 begin
8834   inherited;
8835   fGenMode := GL_NORMAL_MAP;
8836 end;
8837
8838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8839 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8840 var
8841   Rec: TglBitmapNormalMapRec;
8842   SizeRec: TglBitmapPixelPosition;
8843 begin
8844   Rec.HalfSize := aSize div 2;
8845   FreeDataAfterGenTexture := false;
8846
8847   SizeRec.Fields := [ffX, ffY];
8848   SizeRec.X := aSize;
8849   SizeRec.Y := aSize;
8850
8851   // Positive X
8852   Rec.Func := glBitmapNormalMapPosX;
8853   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8854   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8855
8856   // Negative X
8857   Rec.Func := glBitmapNormalMapNegX;
8858   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8859   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8860
8861   // Positive Y
8862   Rec.Func := glBitmapNormalMapPosY;
8863   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8864   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8865
8866   // Negative Y
8867   Rec.Func := glBitmapNormalMapNegY;
8868   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8869   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8870
8871   // Positive Z
8872   Rec.Func := glBitmapNormalMapPosZ;
8873   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8874   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8875
8876   // Negative Z
8877   Rec.Func := glBitmapNormalMapNegZ;
8878   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8879   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8880 end;
8881
8882
8883 initialization
8884   glBitmapSetDefaultFormat (tfEmpty);
8885   glBitmapSetDefaultMipmap (mmMipmap);
8886   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8887   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8888   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8889
8890   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8891   glBitmapSetDefaultDeleteTextureOnFree    (true);
8892
8893   TFormatDescriptor.Init;
8894
8895 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8896   OpenGLInitialized := false;
8897   InitOpenGLCS := TCriticalSection.Create;
8898 {$ENDIF}
8899
8900 finalization
8901   TFormatDescriptor.Finalize;
8902
8903 {$IFDEF GLB_NATIVE_OGL}
8904   if Assigned(GL_LibHandle) then
8905     glbFreeLibrary(GL_LibHandle);
8906
8907 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8908   if Assigned(GLU_LibHandle) then
8909     glbFreeLibrary(GLU_LibHandle);
8910   FreeAndNil(InitOpenGLCS);
8911 {$ENDIF}
8912 {$ENDIF}
8913
8914 end.