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
 784   TglBitmapFormat = (
 785     tfEmpty = 0,                //must be smallest value!
 786
 787     tfAlpha4ub1,                // 1 x unsigned byte
 788     tfAlpha8ub1,                // 1 x unsigned byte
 789     tfAlpha16us1,               // 1 x unsigned short
 790
 791     tfLuminance4ub1,            // 1 x unsigned byte
 792     tfLuminance8ub1,            // 1 x unsigned byte
 793     tfLuminance16us1,           // 1 x unsigned short
 794
 795     tfLuminance4Alpha4ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 796     tfLuminance6Alpha2ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 797     tfLuminance8Alpha8ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 798     tfLuminance12Alpha4us2,     // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 799     tfLuminance16Alpha16us2,    // 1 x unsigned short (lum), 1 x unsigned short (alpha)
 800
 801     tfR3G3B2ub1,                // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 802     tfRGBX4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 803     tfXRGB4us1,                 // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 804     tfR5G6B5us1,                // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 805     tfRGB5X1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 806     tfX1RGB5us1,                // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 807     tfRGB8ub3,                  // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 808     tfRGBX8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 809     tfXRGB8ui1,                 // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 810     tfRGB10X2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 811     tfX2RGB10ui1,               // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 812     tfRGB16us3,                 // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 813
 814     tfRGBA4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 815     tfARGB4us1,                 // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 816     tfRGB5A1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 817     tfA1RGB5us1,                // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 818     tfRGBA8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 819     tfARGB8ui1,                 // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 820     tfRGBA8ub4,                 // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 821     tfRGB10A2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 822     tfA2RGB10ui1,               // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 823     tfRGBA16us4,                // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 824
 825     tfBGRX4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 826     tfXBGR4us1,                 // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 827     tfB5G6R5us1,                // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 828     tfBGR5X1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 829     tfX1BGR5us1,                // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 830     tfBGR8ub3,                  // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 831     tfBGRX8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 832     tfXBGR8ui1,                 // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 833     tfBGR10X2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 834     tfX2BGR10ui1,               // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 835     tfBGR16us3,                 // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 836
 837     tfBGRA4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 838     tfABGR4us1,                 // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 839     tfBGR5A1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 840     tfA1BGR5us1,                // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 841     tfBGRA8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 842     tfABGR8ui1,                 // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 843     tfBGRA8ub4,                 // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 844     tfBGR10A2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 845     tfA2BGR10ui1,               // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 846     tfBGRA16us4,                // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 847
 848     tfDepth16us1,               // 1 x unsigned short (depth)
 849     tfDepth24ui1,               // 1 x unsigned int (depth)
 850     tfDepth32ui1,               // 1 x unsigned int (depth)
 851
 852     tfS3tcDtx1RGBA,
 853     tfS3tcDtx3RGBA,
 854     tfS3tcDtx5RGBA
 855   );
 856
 857   TglBitmapFileType = (
 858      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 859      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 860      ftDDS,
 861      ftTGA,
 862      ftBMP,
 863      ftRAW);
 864    TglBitmapFileTypes = set of TglBitmapFileType;
 865
 866    TglBitmapMipMap = (
 867      mmNone,
 868      mmMipmap,
 869      mmMipmapGlu);
 870
 871    TglBitmapNormalMapFunc = (
 872      nm4Samples,
 873      nmSobel,
 874      nm3x3,
 875      nm5x5);
 876
 877  ////////////////////////////////////////////////////////////////////////////////////////////////////
 878    EglBitmap                  = class(Exception);
 879    EglBitmapNotSupported      = class(Exception);
 880    EglBitmapSizeToLarge       = class(EglBitmap);
 881    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 882    EglBitmapUnsupportedFormat = class(EglBitmap)
 883    public
 884      constructor Create(const aFormat: TglBitmapFormat); overload;
 885      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 886    end;
 887
 888 ////////////////////////////////////////////////////////////////////////////////////////////////////
 889   TglBitmapRec4ui = packed record
 890   case Integer of
 891     0: (r, g, b, a: Cardinal);
 892     1: (arr: array[0..3] of Cardinal);
 893   end;
 894
 895   TglBitmapRec4ub = packed record
 896   case Integer of
 897     0: (r, g, b, a: Byte);
 898     1: (arr: array[0..3] of Byte);
 899   end;
 900
 901   TglBitmapRec4ul = packed record
 902   case Integer of
 903     0: (r, g, b, a: QWord);
 904     1: (arr: array[0..3] of QWord);
 905   end;
 906
 907   TglBitmapFormatDescriptor = class(TObject)
 908   strict private
 909     // cached properties
 910     fBytesPerPixel: Single;
 911     fChannelCount: Integer;
 912     fMask: TglBitmapRec4ul;
 913     fRange: TglBitmapRec4ui;
 914
 915     function GetHasRed: Boolean;
 916     function GetHasGreen: Boolean;
 917     function GetHasBlue: Boolean;
 918     function GetHasAlpha: Boolean;
 919     function GetHasColor: Boolean;
 920     function GetIsGrayscale: Boolean;
 921   protected
 922     fFormat:        TglBitmapFormat;
 923     fWithAlpha:     TglBitmapFormat;
 924     fWithoutAlpha:  TglBitmapFormat;
 925     fOpenGLFormat:  TglBitmapFormat;
 926     fRGBInverted:   TglBitmapFormat;
 927     fUncompressed:  TglBitmapFormat;
 928
 929     fBitsPerPixel: Integer;
 930     fIsCompressed: Boolean;
 931
 932     fPrecision: TglBitmapRec4ub;
 933     fShift:     TglBitmapRec4ub;
 934
 935     fglFormat:         GLenum;
 936     fglInternalFormat: GLenum;
 937     fglDataFormat:     GLenum;
 938
 939     procedure SetValues; virtual;
 940     procedure CalcValues;
 941   public
 942     property Format:        TglBitmapFormat read fFormat;
 943     property ChannelCount:  Integer         read fChannelCount;
 944     property IsCompressed:  Boolean         read fIsCompressed;
 945     property BitsPerPixel:  Integer         read fBitsPerPixel;
 946     property BytesPerPixel: Single          read fBytesPerPixel;
 947
 948     property Precision: TglBitmapRec4ub read fPrecision;
 949     property Shift:     TglBitmapRec4ub read fShift;
 950     property Range:     TglBitmapRec4ui read fRange;
 951     property Mask:      TglBitmapRec4ul read fMask;
 952
 953     property RGBInverted:  TglBitmapFormat read fRGBInverted;
 954     property WithAlpha:    TglBitmapFormat read fWithAlpha;
 955     property WithoutAlpha: TglBitmapFormat read fWithAlpha;
 956     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
 957     property Uncompressed: TglBitmapFormat read fUncompressed;
 958
 959     property glFormat:         GLenum  read fglFormat;
 960     property glInternalFormat: GLenum  read fglInternalFormat;
 961     property glDataFormat:     GLenum  read fglDataFormat;
 962
 963     property HasRed:       Boolean read GetHasRed;
 964     property HasGreen:     Boolean read GetHasGreen;
 965     property HasBlue:      Boolean read GetHasBlue;
 966     property HasAlpha:     Boolean read GetHasAlpha;
 967     property HasColor:     Boolean read GetHasColor;
 968     property IsGrayscale:  Boolean read GetIsGrayscale;
 969
 970     constructor Create;
 971   public
 972     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 973   end;
 974
 975 ////////////////////////////////////////////////////////////////////////////////////////////////////
 976   TglBitmapPixelData = packed record
 977     Data:   TglBitmapRec4ui;
 978     Range:  TglBitmapRec4ui;
 979     Format: TglBitmapFormat;
 980   end;
 981   PglBitmapPixelData = ^TglBitmapPixelData;
 982
 983   TglBitmapPixelPositionFields = set of (ffX, ffY);
 984   TglBitmapPixelPosition = record
 985     Fields : TglBitmapPixelPositionFields;
 986     X : Word;
 987     Y : Word;
 988   end;
 989
 990 ////////////////////////////////////////////////////////////////////////////////////////////////////
 991   TglBitmap = class;
 992   TglBitmapFunctionRec = record
 993     Sender:   TglBitmap;
 994     Size:     TglBitmapPixelPosition;
 995     Position: TglBitmapPixelPosition;
 996     Source:   TglBitmapPixelData;
 997     Dest:     TglBitmapPixelData;
 998     Args:     Pointer;
 999   end;
1000   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
1001
1002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1003   TglBitmap = class
1004   private
1005     function GetFormatDesc: TglBitmapFormatDescriptor;
1006   protected
1007     fID: GLuint;
1008     fTarget: GLuint;
1009     fAnisotropic: Integer;
1010     fDeleteTextureOnFree: Boolean;
1011     fFreeDataOnDestroy: Boolean;
1012     fFreeDataAfterGenTexture: Boolean;
1013     fData: PByte;
1014     fIsResident: GLboolean;
1015     fBorderColor: array[0..3] of Single;
1016
1017     fDimension: TglBitmapPixelPosition;
1018     fMipMap: TglBitmapMipMap;
1019     fFormat: TglBitmapFormat;
1020
1021     // Mapping
1022     fPixelSize: Integer;
1023     fRowSize: Integer;
1024
1025     // Filtering
1026     fFilterMin: GLenum;
1027     fFilterMag: GLenum;
1028
1029     // TexturWarp
1030     fWrapS: GLenum;
1031     fWrapT: GLenum;
1032     fWrapR: GLenum;
1033
1034     //Swizzle
1035     fSwizzle: array[0..3] of GLenum;
1036
1037     // CustomData
1038     fFilename: String;
1039     fCustomName: String;
1040     fCustomNameW: WideString;
1041     fCustomData: Pointer;
1042
1043     //Getter
1044     function GetWidth:  Integer; virtual;
1045     function GetHeight: Integer; virtual;
1046
1047     function GetFileWidth:  Integer; virtual;
1048     function GetFileHeight: Integer; virtual;
1049
1050     //Setter
1051     procedure SetCustomData(const aValue: Pointer);
1052     procedure SetCustomName(const aValue: String);
1053     procedure SetCustomNameW(const aValue: WideString);
1054     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1055     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1056     procedure SetFormat(const aValue: TglBitmapFormat);
1057     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1058     procedure SetID(const aValue: Cardinal);
1059     procedure SetMipMap(const aValue: TglBitmapMipMap);
1060     procedure SetTarget(const aValue: Cardinal);
1061     procedure SetAnisotropic(const aValue: Integer);
1062
1063     procedure CreateID;
1064     procedure SetupParameters(out aBuildWithGlu: Boolean);
1065     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1066       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1067     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1068
1069     function FlipHorz: Boolean; virtual;
1070     function FlipVert: Boolean; virtual;
1071
1072     property Width:  Integer read GetWidth;
1073     property Height: Integer read GetHeight;
1074
1075     property FileWidth:  Integer read GetFileWidth;
1076     property FileHeight: Integer read GetFileHeight;
1077   public
1078     //Properties
1079     property ID:           Cardinal        read fID          write SetID;
1080     property Target:       Cardinal        read fTarget      write SetTarget;
1081     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1082     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1083     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1084
1085     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1086
1087     property Filename:    String     read fFilename;
1088     property CustomName:  String     read fCustomName  write SetCustomName;
1089     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1090     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1091
1092     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1093     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1094     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1095
1096     property Dimension:  TglBitmapPixelPosition  read fDimension;
1097     property Data:       PByte                   read fData;
1098     property IsResident: GLboolean               read fIsResident;
1099
1100     procedure AfterConstruction; override;
1101     procedure BeforeDestruction; override;
1102
1103     procedure PrepareResType(var aResource: String; var aResType: PChar);
1104
1105     //Load
1106     procedure LoadFromFile(const aFilename: String);
1107     procedure LoadFromStream(const aStream: TStream); virtual;
1108     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1109       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1110     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1111     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1112
1113     //Save
1114     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1115     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1116
1117     //Convert
1118     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1119     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1120       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1121   public
1122     //Alpha & Co
1123     {$IFDEF GLB_SDL}
1124     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1125     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1126     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1127     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1128       const aArgs: Pointer = nil): Boolean;
1129     {$ENDIF}
1130
1131     {$IFDEF GLB_DELPHI}
1132     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1133     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1134     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1135     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1136       const aArgs: Pointer = nil): Boolean;
1137     {$ENDIF}
1138
1139     {$IFDEF GLB_LAZARUS}
1140     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1141     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1142     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1143     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1144       const aArgs: Pointer = nil): Boolean;
1145     {$ENDIF}
1146
1147     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1148       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1149     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1150       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1151
1152     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1153     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1154     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1155     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1156
1157     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1158     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1159     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1160
1161     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1162     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1163     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1164
1165     function RemoveAlpha: Boolean; virtual;
1166   public
1167     //Common
1168     function Clone: TglBitmap;
1169     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1170     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1171     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1172     procedure FreeData;
1173
1174     //ColorFill
1175     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1176     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1177     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1178
1179     //TexParameters
1180     procedure SetFilter(const aMin, aMag: GLenum);
1181     procedure SetWrap(
1182       const S: GLenum = GL_CLAMP_TO_EDGE;
1183       const T: GLenum = GL_CLAMP_TO_EDGE;
1184       const R: GLenum = GL_CLAMP_TO_EDGE);
1185     procedure SetSwizzle(const r, g, b, a: GLenum);
1186
1187     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1188     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1189
1190     //Constructors
1191     constructor Create; overload;
1192     constructor Create(const aFileName: String); overload;
1193     constructor Create(const aStream: TStream); overload;
1194     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1195     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1196     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1197     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1198   private
1199     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1200     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1201
1202     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1203     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1204
1205     function LoadRAW(const aStream: TStream): Boolean;
1206     procedure SaveRAW(const aStream: TStream);
1207
1208     function LoadBMP(const aStream: TStream): Boolean;
1209     procedure SaveBMP(const aStream: TStream);
1210
1211     function LoadTGA(const aStream: TStream): Boolean;
1212     procedure SaveTGA(const aStream: TStream);
1213
1214     function LoadDDS(const aStream: TStream): Boolean;
1215     procedure SaveDDS(const aStream: TStream);
1216   end;
1217
1218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1219   TglBitmap1D = class(TglBitmap)
1220   protected
1221     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1222       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1223     procedure UploadData(const aBuildWithGlu: Boolean);
1224   public
1225     property Width;
1226     procedure AfterConstruction; override;
1227     function FlipHorz: Boolean; override;
1228     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1229   end;
1230
1231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1232   TglBitmap2D = class(TglBitmap)
1233   protected
1234     fLines: array of PByte;
1235     function GetScanline(const aIndex: Integer): Pointer;
1236     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1237       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1238     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1239   public
1240     property Width;
1241     property Height;
1242     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1243
1244     procedure AfterConstruction; override;
1245
1246     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1247     procedure GetDataFromTexture;
1248     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1249
1250     function FlipHorz: Boolean; override;
1251     function FlipVert: Boolean; override;
1252
1253     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1254       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1255   end;
1256
1257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1258   TglBitmapCubeMap = class(TglBitmap2D)
1259   protected
1260     fGenMode: Integer;
1261     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1262   public
1263     procedure AfterConstruction; override;
1264     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1265     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1266     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1267   end;
1268
1269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1270   TglBitmapNormalMap = class(TglBitmapCubeMap)
1271   public
1272     procedure AfterConstruction; override;
1273     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1274   end;
1275
1276 const
1277   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1278
1279 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1280 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1281 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1282 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1283 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1284 procedure glBitmapSetDefaultWrap(
1285   const S: Cardinal = GL_CLAMP_TO_EDGE;
1286   const T: Cardinal = GL_CLAMP_TO_EDGE;
1287   const R: Cardinal = GL_CLAMP_TO_EDGE);
1288
1289 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1290 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1291 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1292 function glBitmapGetDefaultFormat: TglBitmapFormat;
1293 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1294 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1295
1296 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1297 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1298 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1299 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1300 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1301 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1302
1303 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1304
1305 var
1306   glBitmapDefaultDeleteTextureOnFree: Boolean;
1307   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1308   glBitmapDefaultFormat: TglBitmapFormat;
1309   glBitmapDefaultMipmap: TglBitmapMipMap;
1310   glBitmapDefaultFilterMin: Cardinal;
1311   glBitmapDefaultFilterMag: Cardinal;
1312   glBitmapDefaultWrapS: Cardinal;
1313   glBitmapDefaultWrapT: Cardinal;
1314   glBitmapDefaultWrapR: Cardinal;
1315   glDefaultSwizzle: array[0..3] of GLenum;
1316
1317 {$IFDEF GLB_DELPHI}
1318 function CreateGrayPalette: HPALETTE;
1319 {$ENDIF}
1320
1321 implementation
1322
1323 uses
1324   Math, syncobjs, typinfo
1325   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1326
1327 type
1328 {$IFNDEF fpc}
1329   QWord   = System.UInt64;
1330   PQWord  = ^QWord;
1331
1332   PtrInt  = Longint;
1333   PtrUInt = DWord;
1334 {$ENDIF}
1335
1336 ////////////////////////////////////////////////////////////////////////////////////////////////////
1337   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1338   public
1339     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1340     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1341
1342     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1343     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1344
1345     function CreateMappingData: Pointer; virtual;
1346     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1347
1348     function IsEmpty: Boolean; virtual;
1349     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1350
1351     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1352
1353     constructor Create; virtual;
1354   public
1355     class procedure Init;
1356     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1357     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1358     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1359     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1360     class procedure Clear;
1361     class procedure Finalize;
1362   end;
1363   TFormatDescriptorClass = class of TFormatDescriptor;
1364
1365   TfdEmpty = class(TFormatDescriptor);
1366
1367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1368   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1369     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1370     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1371   end;
1372
1373   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376   end;
1377
1378   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1379     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1380     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1381   end;
1382
1383   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1384     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1385     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1386   end;
1387
1388   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1389     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1390     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1391   end;
1392
1393   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1394     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1395     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1396   end;
1397
1398   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1399     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1400     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1401   end;
1402
1403   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1404     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1405     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1406   end;
1407
1408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1409   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1410     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1411     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1412   end;
1413
1414   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1415     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1416     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1417   end;
1418
1419   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1420     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1421     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1422   end;
1423
1424   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1425     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1426     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1427   end;
1428
1429   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1430     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1431     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1432   end;
1433
1434   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1435     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1436     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1437   end;
1438
1439   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1440     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1441     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1442   end;
1443
1444   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1445     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1446     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1447   end;
1448
1449   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1450     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1451     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1452   end;
1453
1454   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1455     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1456     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1457   end;
1458
1459   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1460     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1461     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1462   end;
1463
1464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1465   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1466     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1467     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1468   end;
1469
1470   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1471     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1472     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1473   end;
1474
1475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1476   TfdAlpha4ub1 = class(TfdAlphaUB1)
1477     procedure SetValues; override;
1478   end;
1479
1480   TfdAlpha8ub1 = class(TfdAlphaUB1)
1481     procedure SetValues; override;
1482   end;
1483
1484   TfdAlpha16us1 = class(TfdAlphaUS1)
1485     procedure SetValues; override;
1486   end;
1487
1488   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1489     procedure SetValues; override;
1490   end;
1491
1492   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1493     procedure SetValues; override;
1494   end;
1495
1496   TfdLuminance16us1 = class(TfdLuminanceUS1)
1497     procedure SetValues; override;
1498   end;
1499
1500   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1501     procedure SetValues; override;
1502   end;
1503
1504   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1505     procedure SetValues; override;
1506   end;
1507
1508   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1509     procedure SetValues; override;
1510   end;
1511
1512   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1513     procedure SetValues; override;
1514   end;
1515
1516   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1517     procedure SetValues; override;
1518   end;
1519
1520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1521   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1522     procedure SetValues; override;
1523   end;
1524
1525   TfdRGBX4us1 = class(TfdUniversalUS1)
1526     procedure SetValues; override;
1527   end;
1528
1529   TfdXRGB4us1 = class(TfdUniversalUS1)
1530     procedure SetValues; override;
1531   end;
1532
1533   TfdR5G6B5us1 = class(TfdUniversalUS1)
1534     procedure SetValues; override;
1535   end;
1536
1537   TfdRGB5X1us1 = class(TfdUniversalUS1)
1538     procedure SetValues; override;
1539   end;
1540
1541   TfdX1RGB5us1 = class(TfdUniversalUS1)
1542     procedure SetValues; override;
1543   end;
1544
1545   TfdRGB8ub3 = class(TfdRGBub3)
1546     procedure SetValues; override;
1547   end;
1548
1549   TfdRGBX8ui1 = class(TfdUniversalUI1)
1550     procedure SetValues; override;
1551   end;
1552
1553   TfdXRGB8ui1 = class(TfdUniversalUI1)
1554     procedure SetValues; override;
1555   end;
1556
1557   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1558     procedure SetValues; override;
1559   end;
1560
1561   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1562     procedure SetValues; override;
1563   end;
1564
1565   TfdRGB16us3 = class(TfdRGBus3)
1566     procedure SetValues; override;
1567   end;
1568
1569   TfdRGBA4us1 = class(TfdUniversalUS1)
1570     procedure SetValues; override;
1571   end;
1572
1573   TfdARGB4us1 = class(TfdUniversalUS1)
1574     procedure SetValues; override;
1575   end;
1576
1577   TfdRGB5A1us1 = class(TfdUniversalUS1)
1578     procedure SetValues; override;
1579   end;
1580
1581   TfdA1RGB5us1 = class(TfdUniversalUS1)
1582     procedure SetValues; override;
1583   end;
1584
1585   TfdRGBA8ui1 = class(TfdUniversalUI1)
1586     procedure SetValues; override;
1587   end;
1588
1589   TfdARGB8ui1 = class(TfdUniversalUI1)
1590     procedure SetValues; override;
1591   end;
1592
1593   TfdRGBA8ub4 = class(TfdRGBAub4)
1594     procedure SetValues; override;
1595   end;
1596
1597   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1598     procedure SetValues; override;
1599   end;
1600
1601   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1602     procedure SetValues; override;
1603   end;
1604
1605   TfdRGBA16us4 = class(TfdRGBAus4)
1606     procedure SetValues; override;
1607   end;
1608
1609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1610   TfdBGRX4us1 = class(TfdUniversalUS1)
1611     procedure SetValues; override;
1612   end;
1613
1614   TfdXBGR4us1 = class(TfdUniversalUS1)
1615     procedure SetValues; override;
1616   end;
1617
1618   TfdB5G6R5us1 = class(TfdUniversalUS1)
1619     procedure SetValues; override;
1620   end;
1621
1622   TfdBGR5X1us1 = class(TfdUniversalUS1)
1623     procedure SetValues; override;
1624   end;
1625
1626   TfdX1BGR5us1 = class(TfdUniversalUS1)
1627     procedure SetValues; override;
1628   end;
1629
1630   TfdBGR8ub3 = class(TfdBGRub3)
1631     procedure SetValues; override;
1632   end;
1633
1634   TfdBGRX8ui1 = class(TfdUniversalUI1)
1635     procedure SetValues; override;
1636   end;
1637
1638   TfdXBGR8ui1 = class(TfdUniversalUI1)
1639     procedure SetValues; override;
1640   end;
1641
1642   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1643     procedure SetValues; override;
1644   end;
1645
1646   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1647     procedure SetValues; override;
1648   end;
1649
1650   TfdBGR16us3 = class(TfdBGRus3)
1651     procedure SetValues; override;
1652   end;
1653
1654   TfdBGRA4us1 = class(TfdUniversalUS1)
1655     procedure SetValues; override;
1656   end;
1657
1658   TfdABGR4us1 = class(TfdUniversalUS1)
1659     procedure SetValues; override;
1660   end;
1661
1662   TfdBGR5A1us1 = class(TfdUniversalUS1)
1663     procedure SetValues; override;
1664   end;
1665
1666   TfdA1BGR5us1 = class(TfdUniversalUS1)
1667     procedure SetValues; override;
1668   end;
1669
1670   TfdBGRA8ui1 = class(TfdUniversalUI1)
1671     procedure SetValues; override;
1672   end;
1673
1674   TfdABGR8ui1 = class(TfdUniversalUI1)
1675     procedure SetValues; override;
1676   end;
1677
1678   TfdBGRA8ub4 = class(TfdBGRAub4)
1679     procedure SetValues; override;
1680   end;
1681
1682   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1683     procedure SetValues; override;
1684   end;
1685
1686   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1687     procedure SetValues; override;
1688   end;
1689
1690   TfdBGRA16us4 = class(TfdBGRAus4)
1691     procedure SetValues; override;
1692   end;
1693
1694   TfdDepth16us1 = class(TfdDepthUS1)
1695     procedure SetValues; override;
1696   end;
1697
1698   TfdDepth24ui1 = class(TfdDepthUI1)
1699     procedure SetValues; override;
1700   end;
1701
1702   TfdDepth32ui1 = class(TfdDepthUI1)
1703     procedure SetValues; override;
1704   end;
1705
1706   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1707     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1708     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1709     procedure SetValues; override;
1710   end;
1711
1712   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1713     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1714     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1715     procedure SetValues; override;
1716   end;
1717
1718   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1719     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1720     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1721     procedure SetValues; override;
1722   end;
1723
1724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1725   TbmpBitfieldFormat = class(TFormatDescriptor)
1726   public
1727     procedure SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1728     procedure SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1729     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1730     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1731   end;
1732
1733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1734   TbmpColorTableEnty = packed record
1735     b, g, r, a: Byte;
1736   end;
1737   TbmpColorTable = array of TbmpColorTableEnty;
1738   TbmpColorTableFormat = class(TFormatDescriptor)
1739   private
1740     fBitsPerPixel: Integer;
1741     fColorTable: TbmpColorTable;
1742   protected
1743     procedure SetValues; override; overload;
1744   public
1745     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1746     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1747
1748     procedure SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1749     procedure CalcValues;
1750     procedure CreateColorTable;
1751
1752     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1753     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1754     destructor Destroy; override;
1755   end;
1756
1757 const
1758   LUMINANCE_WEIGHT_R = 0.30;
1759   LUMINANCE_WEIGHT_G = 0.59;
1760   LUMINANCE_WEIGHT_B = 0.11;
1761
1762   ALPHA_WEIGHT_R = 0.30;
1763   ALPHA_WEIGHT_G = 0.59;
1764   ALPHA_WEIGHT_B = 0.11;
1765
1766   DEPTH_WEIGHT_R = 0.333333333;
1767   DEPTH_WEIGHT_G = 0.333333333;
1768   DEPTH_WEIGHT_B = 0.333333333;
1769
1770   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1771     TfdEmpty,
1772
1773     TfdAlpha4ub1,
1774     TfdAlpha8ub1,
1775     TfdAlpha16us1,
1776
1777     TfdLuminance4ub1,
1778     TfdLuminance8ub1,
1779     TfdLuminance16us1,
1780
1781     TfdLuminance4Alpha4ub2,
1782     TfdLuminance6Alpha2ub2,
1783     TfdLuminance8Alpha8ub2,
1784     TfdLuminance12Alpha4us2,
1785     TfdLuminance16Alpha16us2,
1786
1787     TfdR3G3B2ub1,
1788     TfdRGBX4us1,
1789     TfdXRGB4us1,
1790     TfdR5G6B5us1,
1791     TfdRGB5X1us1,
1792     TfdX1RGB5us1,
1793     TfdRGB8ub3,
1794     TfdRGBX8ui1,
1795     TfdXRGB8ui1,
1796     TfdRGB10X2ui1,
1797     TfdX2RGB10ui1,
1798     TfdRGB16us3,
1799
1800     TfdRGBA4us1,
1801     TfdARGB4us1,
1802     TfdRGB5A1us1,
1803     TfdA1RGB5us1,
1804     TfdRGBA8ui1,
1805     TfdARGB8ui1,
1806     TfdRGBA8ub4,
1807     TfdRGB10A2ui1,
1808     TfdA2RGB10ui1,
1809     TfdRGBA16us4,
1810
1811     TfdBGRX4us1,
1812     TfdXBGR4us1,
1813     TfdB5G6R5us1,
1814     TfdBGR5X1us1,
1815     TfdX1BGR5us1,
1816     TfdBGR8ub3,
1817     TfdBGRX8ui1,
1818     TfdXBGR8ui1,
1819     TfdBGR10X2ui1,
1820     TfdX2BGR10ui1,
1821     TfdBGR16us3,
1822
1823     TfdBGRA4us1,
1824     TfdABGR4us1,
1825     TfdBGR5A1us1,
1826     TfdA1BGR5us1,
1827     TfdBGRA8ui1,
1828     TfdABGR8ui1,
1829     TfdBGRA8ub4,
1830     TfdBGR10A2ui1,
1831     TfdA2BGR10ui1,
1832     TfdBGRA16us4,
1833
1834     TfdDepth16us1,
1835     TfdDepth24ui1,
1836     TfdDepth32ui1,
1837
1838     TfdS3tcDtx1RGBA,
1839     TfdS3tcDtx3RGBA,
1840     TfdS3tcDtx5RGBA
1841   );
1842
1843 var
1844   FormatDescriptorCS: TCriticalSection;
1845   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1846
1847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1848 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1849 begin
1850   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1851 end;
1852
1853 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1854 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1855 begin
1856   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1857 end;
1858
1859 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1860 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1861 begin
1862   result.Fields := [];
1863
1864   if X >= 0 then
1865     result.Fields := result.Fields + [ffX];
1866   if Y >= 0 then
1867     result.Fields := result.Fields + [ffY];
1868
1869   result.X := Max(0, X);
1870   result.Y := Max(0, Y);
1871 end;
1872
1873 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1874 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1875 begin
1876   result.r := r;
1877   result.g := g;
1878   result.b := b;
1879   result.a := a;
1880 end;
1881
1882 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1883 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1884 begin
1885   result.r := r;
1886   result.g := g;
1887   result.b := b;
1888   result.a := a;
1889 end;
1890
1891 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1892 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1893 begin
1894   result.r := r;
1895   result.g := g;
1896   result.b := b;
1897   result.a := a;
1898 end;
1899
1900 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1901 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1902 var
1903   i: Integer;
1904 begin
1905   result := false;
1906   for i := 0 to high(r1.arr) do
1907     if (r1.arr[i] <> r2.arr[i]) then
1908       exit;
1909   result := true;
1910 end;
1911
1912 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1913 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1914 var
1915   i: Integer;
1916 begin
1917   result := false;
1918   for i := 0 to high(r1.arr) do
1919     if (r1.arr[i] <> r2.arr[i]) then
1920       exit;
1921   result := true;
1922 end;
1923
1924 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1925 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1926 var
1927   desc: TFormatDescriptor;
1928   p, tmp: PByte;
1929   x, y, i: Integer;
1930   md: Pointer;
1931   px: TglBitmapPixelData;
1932 begin
1933   result := nil;
1934   desc := TFormatDescriptor.Get(aFormat);
1935   if (desc.IsCompressed) or (desc.glFormat = 0) then
1936     exit;
1937
1938   p := GetMem(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1939   md := desc.CreateMappingData;
1940   try
1941     tmp := p;
1942     desc.PreparePixel(px);
1943     for y := 0 to 4 do
1944       for x := 0 to 4 do begin
1945         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1946         for i := 0 to 3 do begin
1947           if ((y < 3) and (y = i)) or
1948              ((y = 3) and (i < 3)) or
1949              ((y = 4) and (i = 3))
1950           then
1951             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1952           else if ((y < 4) and (i = 3)) or
1953                   ((y = 4) and (i < 3))
1954           then
1955             px.Data.arr[i] := px.Range.arr[i]
1956           else
1957             px.Data.arr[i] := 0; //px.Range.arr[i];
1958         end;
1959         desc.Map(px, tmp, md);
1960       end;
1961   finally
1962     desc.FreeMappingData(md);
1963   end;
1964
1965   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1966   result.FreeDataOnDestroy       := true;
1967   result.FreeDataAfterGenTexture := false;
1968   result.SetFilter(GL_NEAREST, GL_NEAREST);
1969 end;
1970
1971 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1972 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1973 begin
1974   result.r := r;
1975   result.g := g;
1976   result.b := b;
1977   result.a := a;
1978 end;
1979
1980 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1981 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1982 begin
1983   result := [];
1984
1985   if (aFormat in [
1986         //8bpp
1987         tfAlpha4ub1, tfAlpha8ub1,
1988         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1989
1990         //16bpp
1991         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1992         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1993         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1994
1995         //24bpp
1996         tfBGR8ub3, tfRGB8ub3,
1997
1998         //32bpp
1999         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
2000         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2001   then
2002     result := result + [ ftBMP ];
2003
2004   if (aFormat in [
2005         //8bbp
2006         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2007
2008         //16bbp
2009         tfAlpha16us1, tfLuminance16us1,
2010         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2011         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2012
2013         //24bbp
2014         tfBGR8ub3,
2015
2016         //32bbp
2017         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2018         tfDepth24ui1, tfDepth32ui1])
2019   then
2020     result := result + [ftTGA];
2021
2022   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2023     result := result + [ftDDS];
2024
2025 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2026   if aFormat in [
2027       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2028       tfRGB8ub3, tfRGBA8ui1,
2029       tfBGR8ub3, tfBGRA8ui1] then
2030     result := result + [ftPNG];
2031 {$ENDIF}
2032
2033 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2034   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2035     result := result + [ftJPEG];
2036 {$ENDIF}
2037 end;
2038
2039 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2040 function IsPowerOfTwo(aNumber: Integer): Boolean;
2041 begin
2042   while (aNumber and 1) = 0 do
2043     aNumber := aNumber shr 1;
2044   result := aNumber = 1;
2045 end;
2046
2047 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2048 function GetTopMostBit(aBitSet: QWord): Integer;
2049 begin
2050   result := 0;
2051   while aBitSet > 0 do begin
2052     inc(result);
2053     aBitSet := aBitSet shr 1;
2054   end;
2055 end;
2056
2057 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2058 function CountSetBits(aBitSet: QWord): Integer;
2059 begin
2060   result := 0;
2061   while aBitSet > 0 do begin
2062     if (aBitSet and 1) = 1 then
2063       inc(result);
2064     aBitSet := aBitSet shr 1;
2065   end;
2066 end;
2067
2068 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2070 begin
2071   result := Trunc(
2072     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2073     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2074     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2075 end;
2076
2077 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2078 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2079 begin
2080   result := Trunc(
2081     DEPTH_WEIGHT_R * aPixel.Data.r +
2082     DEPTH_WEIGHT_G * aPixel.Data.g +
2083     DEPTH_WEIGHT_B * aPixel.Data.b);
2084 end;
2085
2086 {$IFDEF GLB_NATIVE_OGL}
2087 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2090 var
2091   GL_LibHandle: Pointer = nil;
2092
2093 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2094 begin
2095   if not Assigned(aLibHandle) then
2096     aLibHandle := GL_LibHandle;
2097
2098 {$IF DEFINED(GLB_WIN)}
2099   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2100   if Assigned(result) then
2101     exit;
2102
2103   if Assigned(wglGetProcAddress) then
2104     result := wglGetProcAddress(aProcName);
2105 {$ELSEIF DEFINED(GLB_LINUX)}
2106   if Assigned(glXGetProcAddress) then begin
2107     result := glXGetProcAddress(aProcName);
2108     if Assigned(result) then
2109       exit;
2110   end;
2111
2112   if Assigned(glXGetProcAddressARB) then begin
2113     result := glXGetProcAddressARB(aProcName);
2114     if Assigned(result) then
2115       exit;
2116   end;
2117
2118   result := dlsym(aLibHandle, aProcName);
2119 {$IFEND}
2120   if not Assigned(result) and aRaiseOnErr then
2121     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2122 end;
2123
2124 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2125 var
2126   GLU_LibHandle: Pointer = nil;
2127   OpenGLInitialized: Boolean;
2128   InitOpenGLCS: TCriticalSection;
2129
2130 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2131 procedure glbInitOpenGL;
2132
2133   ////////////////////////////////////////////////////////////////////////////////
2134   function glbLoadLibrary(const aName: PChar): Pointer;
2135   begin
2136     {$IF DEFINED(GLB_WIN)}
2137     result := {%H-}Pointer(LoadLibrary(aName));
2138     {$ELSEIF DEFINED(GLB_LINUX)}
2139     result := dlopen(Name, RTLD_LAZY);
2140     {$ELSE}
2141     result := nil;
2142     {$IFEND}
2143   end;
2144
2145   ////////////////////////////////////////////////////////////////////////////////
2146   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2147   begin
2148     result := false;
2149     if not Assigned(aLibHandle) then
2150       exit;
2151
2152     {$IF DEFINED(GLB_WIN)}
2153     Result := FreeLibrary({%H-}HINST(aLibHandle));
2154     {$ELSEIF DEFINED(GLB_LINUX)}
2155     Result := dlclose(aLibHandle) = 0;
2156     {$IFEND}
2157   end;
2158
2159 begin
2160   if Assigned(GL_LibHandle) then
2161     glbFreeLibrary(GL_LibHandle);
2162
2163   if Assigned(GLU_LibHandle) then
2164     glbFreeLibrary(GLU_LibHandle);
2165
2166   GL_LibHandle := glbLoadLibrary(libopengl);
2167   if not Assigned(GL_LibHandle) then
2168     raise EglBitmap.Create('unable to load library: ' + libopengl);
2169
2170   GLU_LibHandle := glbLoadLibrary(libglu);
2171   if not Assigned(GLU_LibHandle) then
2172     raise EglBitmap.Create('unable to load library: ' + libglu);
2173
2174 {$IF DEFINED(GLB_WIN)}
2175   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2176 {$ELSEIF DEFINED(GLB_LINUX)}
2177   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2178   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2179 {$IFEND}
2180
2181   glEnable := glbGetProcAddress('glEnable');
2182   glDisable := glbGetProcAddress('glDisable');
2183   glGetString := glbGetProcAddress('glGetString');
2184   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2185   glTexParameteri := glbGetProcAddress('glTexParameteri');
2186   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2187   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2188   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2189   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2190   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2191   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2192   glTexGeni := glbGetProcAddress('glTexGeni');
2193   glGenTextures := glbGetProcAddress('glGenTextures');
2194   glBindTexture := glbGetProcAddress('glBindTexture');
2195   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2196   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2197   glReadPixels := glbGetProcAddress('glReadPixels');
2198   glPixelStorei := glbGetProcAddress('glPixelStorei');
2199   glTexImage1D := glbGetProcAddress('glTexImage1D');
2200   glTexImage2D := glbGetProcAddress('glTexImage2D');
2201   glGetTexImage := glbGetProcAddress('glGetTexImage');
2202
2203   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2204   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2205 end;
2206 {$ENDIF}
2207
2208 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2209 procedure glbReadOpenGLExtensions;
2210 var
2211   Buffer: AnsiString;
2212   MajorVersion, MinorVersion: Integer;
2213
2214   ///////////////////////////////////////////////////////////////////////////////////////////
2215   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2216   var
2217     Separator: Integer;
2218   begin
2219     aMinor := 0;
2220     aMajor := 0;
2221
2222     Separator := Pos(AnsiString('.'), aBuffer);
2223     if (Separator > 1) and (Separator < Length(aBuffer)) and
2224        (aBuffer[Separator - 1] in ['0'..'9']) and
2225        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2226
2227       Dec(Separator);
2228       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2229         Dec(Separator);
2230
2231       Delete(aBuffer, 1, Separator);
2232       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2233
2234       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2235         Inc(Separator);
2236
2237       Delete(aBuffer, Separator, 255);
2238       Separator := Pos(AnsiString('.'), aBuffer);
2239
2240       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2241       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2242     end;
2243   end;
2244
2245   ///////////////////////////////////////////////////////////////////////////////////////////
2246   function CheckExtension(const Extension: AnsiString): Boolean;
2247   var
2248     ExtPos: Integer;
2249   begin
2250     ExtPos := Pos(Extension, Buffer);
2251     result := ExtPos > 0;
2252     if result then
2253       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2254   end;
2255
2256   ///////////////////////////////////////////////////////////////////////////////////////////
2257   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2258   begin
2259     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2260   end;
2261
2262 begin
2263 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2264   InitOpenGLCS.Enter;
2265   try
2266     if not OpenGLInitialized then begin
2267       glbInitOpenGL;
2268       OpenGLInitialized := true;
2269     end;
2270   finally
2271     InitOpenGLCS.Leave;
2272   end;
2273 {$ENDIF}
2274
2275   // Version
2276   Buffer := glGetString(GL_VERSION);
2277   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2278
2279   GL_VERSION_1_2 := CheckVersion(1, 2);
2280   GL_VERSION_1_3 := CheckVersion(1, 3);
2281   GL_VERSION_1_4 := CheckVersion(1, 4);
2282   GL_VERSION_2_0 := CheckVersion(2, 0);
2283   GL_VERSION_3_3 := CheckVersion(3, 3);
2284
2285   // Extensions
2286   Buffer := glGetString(GL_EXTENSIONS);
2287   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2288   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2289   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2290   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2291   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2292   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2293   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2294   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2295   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2296   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2297   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2298   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2299   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2300   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2301
2302   if GL_VERSION_1_3 then begin
2303     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2304     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2305     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2306   end else begin
2307     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2308     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2309     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2310   end;
2311 end;
2312 {$ENDIF}
2313
2314 {$IFDEF GLB_SDL_IMAGE}
2315 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2317 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2319 begin
2320   result := TStream(context^.unknown.data1).Seek(offset, whence);
2321 end;
2322
2323 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2324 begin
2325   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2326 end;
2327
2328 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2329 begin
2330   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2331 end;
2332
2333 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2334 begin
2335   result := 0;
2336 end;
2337
2338 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2339 begin
2340   result := SDL_AllocRW;
2341
2342   if result = nil then
2343     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2344
2345   result^.seek := glBitmapRWseek;
2346   result^.read := glBitmapRWread;
2347   result^.write := glBitmapRWwrite;
2348   result^.close := glBitmapRWclose;
2349   result^.unknown.data1 := Stream;
2350 end;
2351 {$ENDIF}
2352
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2355 begin
2356   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2361 begin
2362   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2363 end;
2364
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2367 begin
2368   glBitmapDefaultMipmap := aValue;
2369 end;
2370
2371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2373 begin
2374   glBitmapDefaultFormat := aFormat;
2375 end;
2376
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2379 begin
2380   glBitmapDefaultFilterMin := aMin;
2381   glBitmapDefaultFilterMag := aMag;
2382 end;
2383
2384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2385 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2386 begin
2387   glBitmapDefaultWrapS := S;
2388   glBitmapDefaultWrapT := T;
2389   glBitmapDefaultWrapR := R;
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2394 begin
2395   glDefaultSwizzle[0] := r;
2396   glDefaultSwizzle[1] := g;
2397   glDefaultSwizzle[2] := b;
2398   glDefaultSwizzle[3] := a;
2399 end;
2400
2401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2403 begin
2404   result := glBitmapDefaultDeleteTextureOnFree;
2405 end;
2406
2407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2408 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2409 begin
2410   result := glBitmapDefaultFreeDataAfterGenTextures;
2411 end;
2412
2413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2414 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2415 begin
2416   result := glBitmapDefaultMipmap;
2417 end;
2418
2419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2420 function glBitmapGetDefaultFormat: TglBitmapFormat;
2421 begin
2422   result := glBitmapDefaultFormat;
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2427 begin
2428   aMin := glBitmapDefaultFilterMin;
2429   aMag := glBitmapDefaultFilterMag;
2430 end;
2431
2432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2433 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2434 begin
2435   S := glBitmapDefaultWrapS;
2436   T := glBitmapDefaultWrapT;
2437   R := glBitmapDefaultWrapR;
2438 end;
2439
2440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2441 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2442 begin
2443   r := glDefaultSwizzle[0];
2444   g := glDefaultSwizzle[1];
2445   b := glDefaultSwizzle[2];
2446   a := glDefaultSwizzle[3];
2447 end;
2448
2449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2450 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2452 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2453 var
2454   w, h: Integer;
2455 begin
2456   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2457     w := Max(1, aSize.X);
2458     h := Max(1, aSize.Y);
2459     result := GetSize(w, h);
2460   end else
2461     result := 0;
2462 end;
2463
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2466 begin
2467   result := 0;
2468   if (aWidth <= 0) or (aHeight <= 0) then
2469     exit;
2470   result := Ceil(aWidth * aHeight * BytesPerPixel);
2471 end;
2472
2473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2474 function TFormatDescriptor.CreateMappingData: Pointer;
2475 begin
2476   result := nil;
2477 end;
2478
2479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2480 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2481 begin
2482   //DUMMY
2483 end;
2484
2485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 function TFormatDescriptor.IsEmpty: Boolean;
2487 begin
2488   result := (fFormat = tfEmpty);
2489 end;
2490
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2493 var
2494   i: Integer;
2495   m: TglBitmapRec4ul;
2496 begin
2497   result := false;
2498   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2499     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2500   m := Mask;
2501   for i := 0 to 3 do
2502     if (aMask.arr[i] <> m.arr[i]) then
2503       exit;
2504   result := true;
2505 end;
2506
2507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2508 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2509 begin
2510   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2511   aPixel.Data   := Range;
2512   aPixel.Format := fFormat;
2513   aPixel.Range  := Range;
2514 end;
2515
2516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 constructor TFormatDescriptor.Create;
2518 begin
2519   inherited Create;
2520 end;
2521
2522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2523 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2525 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2526 begin
2527   aData^ := aPixel.Data.a;
2528   inc(aData);
2529 end;
2530
2531 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2532 begin
2533   aPixel.Data.r := 0;
2534   aPixel.Data.g := 0;
2535   aPixel.Data.b := 0;
2536   aPixel.Data.a := aData^;
2537   inc(aData);
2538 end;
2539
2540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2541 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2544 begin
2545   aData^ := LuminanceWeight(aPixel);
2546   inc(aData);
2547 end;
2548
2549 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2550 begin
2551   aPixel.Data.r := aData^;
2552   aPixel.Data.g := aData^;
2553   aPixel.Data.b := aData^;
2554   aPixel.Data.a := 0;
2555   inc(aData);
2556 end;
2557
2558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2561 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2562 var
2563   i: Integer;
2564 begin
2565   aData^ := 0;
2566   for i := 0 to 3 do
2567     if (Range.arr[i] > 0) then
2568       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2569   inc(aData);
2570 end;
2571
2572 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2573 var
2574   i: Integer;
2575 begin
2576   for i := 0 to 3 do
2577     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2578   inc(aData);
2579 end;
2580
2581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2582 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2585 begin
2586   inherited Map(aPixel, aData, aMapData);
2587   aData^ := aPixel.Data.a;
2588   inc(aData);
2589 end;
2590
2591 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2592 begin
2593   inherited Unmap(aData, aPixel, aMapData);
2594   aPixel.Data.a := aData^;
2595   inc(aData);
2596 end;
2597
2598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2601 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2602 begin
2603   aData^ := aPixel.Data.r;
2604   inc(aData);
2605   aData^ := aPixel.Data.g;
2606   inc(aData);
2607   aData^ := aPixel.Data.b;
2608   inc(aData);
2609 end;
2610
2611 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2612 begin
2613   aPixel.Data.r := aData^;
2614   inc(aData);
2615   aPixel.Data.g := aData^;
2616   inc(aData);
2617   aPixel.Data.b := aData^;
2618   inc(aData);
2619   aPixel.Data.a := 0;
2620 end;
2621
2622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2625 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2626 begin
2627   aData^ := aPixel.Data.b;
2628   inc(aData);
2629   aData^ := aPixel.Data.g;
2630   inc(aData);
2631   aData^ := aPixel.Data.r;
2632   inc(aData);
2633 end;
2634
2635 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2636 begin
2637   aPixel.Data.b := aData^;
2638   inc(aData);
2639   aPixel.Data.g := aData^;
2640   inc(aData);
2641   aPixel.Data.r := aData^;
2642   inc(aData);
2643   aPixel.Data.a := 0;
2644 end;
2645
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2650 begin
2651   inherited Map(aPixel, aData, aMapData);
2652   aData^ := aPixel.Data.a;
2653   inc(aData);
2654 end;
2655
2656 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2657 begin
2658   inherited Unmap(aData, aPixel, aMapData);
2659   aPixel.Data.a := aData^;
2660   inc(aData);
2661 end;
2662
2663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2664 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2666 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2667 begin
2668   inherited Map(aPixel, aData, aMapData);
2669   aData^ := aPixel.Data.a;
2670   inc(aData);
2671 end;
2672
2673 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2674 begin
2675   inherited Unmap(aData, aPixel, aMapData);
2676   aPixel.Data.a := aData^;
2677   inc(aData);
2678 end;
2679
2680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2683 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2684 begin
2685   PWord(aData)^ := aPixel.Data.a;
2686   inc(aData, 2);
2687 end;
2688
2689 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2690 begin
2691   aPixel.Data.r := 0;
2692   aPixel.Data.g := 0;
2693   aPixel.Data.b := 0;
2694   aPixel.Data.a := PWord(aData)^;
2695   inc(aData, 2);
2696 end;
2697
2698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2701 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2702 begin
2703   PWord(aData)^ := LuminanceWeight(aPixel);
2704   inc(aData, 2);
2705 end;
2706
2707 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2708 begin
2709   aPixel.Data.r := PWord(aData)^;
2710   aPixel.Data.g := PWord(aData)^;
2711   aPixel.Data.b := PWord(aData)^;
2712   aPixel.Data.a := 0;
2713   inc(aData, 2);
2714 end;
2715
2716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2717 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2719 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2720 var
2721   i: Integer;
2722 begin
2723   PWord(aData)^ := 0;
2724   for i := 0 to 3 do
2725     if (Range.arr[i] > 0) then
2726       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2727   inc(aData, 2);
2728 end;
2729
2730 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2731 var
2732   i: Integer;
2733 begin
2734   for i := 0 to 3 do
2735     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2736   inc(aData, 2);
2737 end;
2738
2739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2743 begin
2744   PWord(aData)^ := DepthWeight(aPixel);
2745   inc(aData, 2);
2746 end;
2747
2748 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2749 begin
2750   aPixel.Data.r := PWord(aData)^;
2751   aPixel.Data.g := PWord(aData)^;
2752   aPixel.Data.b := PWord(aData)^;
2753   aPixel.Data.a := PWord(aData)^;;
2754   inc(aData, 2);
2755 end;
2756
2757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2761 begin
2762   inherited Map(aPixel, aData, aMapData);
2763   PWord(aData)^ := aPixel.Data.a;
2764   inc(aData, 2);
2765 end;
2766
2767 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2768 begin
2769   inherited Unmap(aData, aPixel, aMapData);
2770   aPixel.Data.a := PWord(aData)^;
2771   inc(aData, 2);
2772 end;
2773
2774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2777 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2778 begin
2779   PWord(aData)^ := aPixel.Data.r;
2780   inc(aData, 2);
2781   PWord(aData)^ := aPixel.Data.g;
2782   inc(aData, 2);
2783   PWord(aData)^ := aPixel.Data.b;
2784   inc(aData, 2);
2785 end;
2786
2787 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2788 begin
2789   aPixel.Data.r := PWord(aData)^;
2790   inc(aData, 2);
2791   aPixel.Data.g := PWord(aData)^;
2792   inc(aData, 2);
2793   aPixel.Data.b := PWord(aData)^;
2794   inc(aData, 2);
2795   aPixel.Data.a := 0;
2796 end;
2797
2798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2801 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2802 begin
2803   PWord(aData)^ := aPixel.Data.b;
2804   inc(aData, 2);
2805   PWord(aData)^ := aPixel.Data.g;
2806   inc(aData, 2);
2807   PWord(aData)^ := aPixel.Data.r;
2808   inc(aData, 2);
2809 end;
2810
2811 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2812 begin
2813   aPixel.Data.b := PWord(aData)^;
2814   inc(aData, 2);
2815   aPixel.Data.g := PWord(aData)^;
2816   inc(aData, 2);
2817   aPixel.Data.r := PWord(aData)^;
2818   inc(aData, 2);
2819   aPixel.Data.a := 0;
2820 end;
2821
2822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2823 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2826 begin
2827   inherited Map(aPixel, aData, aMapData);
2828   PWord(aData)^ := aPixel.Data.a;
2829   inc(aData, 2);
2830 end;
2831
2832 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2833 begin
2834   inherited Unmap(aData, aPixel, aMapData);
2835   aPixel.Data.a := PWord(aData)^;
2836   inc(aData, 2);
2837 end;
2838
2839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2840 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2843 begin
2844   PWord(aData)^ := aPixel.Data.a;
2845   inc(aData, 2);
2846   inherited Map(aPixel, aData, aMapData);
2847 end;
2848
2849 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2850 begin
2851   aPixel.Data.a := PWord(aData)^;
2852   inc(aData, 2);
2853   inherited Unmap(aData, aPixel, aMapData);
2854 end;
2855
2856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2857 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2859 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2860 begin
2861   inherited Map(aPixel, aData, aMapData);
2862   PWord(aData)^ := aPixel.Data.a;
2863   inc(aData, 2);
2864 end;
2865
2866 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2867 begin
2868   inherited Unmap(aData, aPixel, aMapData);
2869   aPixel.Data.a := PWord(aData)^;
2870   inc(aData, 2);
2871 end;
2872
2873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2876 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2877 begin
2878   PWord(aData)^ := aPixel.Data.a;
2879   inc(aData, 2);
2880   inherited Map(aPixel, aData, aMapData);
2881 end;
2882
2883 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2884 begin
2885   aPixel.Data.a := PWord(aData)^;
2886   inc(aData, 2);
2887   inherited Unmap(aData, aPixel, aMapData);
2888 end;
2889
2890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2891 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2892 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2893 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2894 var
2895   i: Integer;
2896 begin
2897   PCardinal(aData)^ := 0;
2898   for i := 0 to 3 do
2899     if (Range.arr[i] > 0) then
2900       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2901   inc(aData, 4);
2902 end;
2903
2904 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2905 var
2906   i: Integer;
2907 begin
2908   for i := 0 to 3 do
2909     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2910   inc(aData, 2);
2911 end;
2912
2913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2916 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2917 begin
2918   PCardinal(aData)^ := DepthWeight(aPixel);
2919   inc(aData, 4);
2920 end;
2921
2922 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2923 begin
2924   aPixel.Data.r := PCardinal(aData)^;
2925   aPixel.Data.g := PCardinal(aData)^;
2926   aPixel.Data.b := PCardinal(aData)^;
2927   aPixel.Data.a := PCardinal(aData)^;
2928   inc(aData, 4);
2929 end;
2930
2931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2934 procedure TfdAlpha4ub1.SetValues;
2935 begin
2936   inherited SetValues;
2937   fBitsPerPixel     := 8;
2938   fFormat           := tfAlpha4ub1;
2939   fWithAlpha        := tfAlpha4ub1;
2940   fOpenGLFormat     := tfAlpha4ub1;
2941   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2942   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2943   fglFormat         := GL_ALPHA;
2944   fglInternalFormat := GL_ALPHA4;
2945   fglDataFormat     := GL_UNSIGNED_BYTE;
2946 end;
2947
2948 procedure TfdAlpha8ub1.SetValues;
2949 begin
2950   inherited SetValues;
2951   fBitsPerPixel     := 8;
2952   fFormat           := tfAlpha8ub1;
2953   fWithAlpha        := tfAlpha8ub1;
2954   fOpenGLFormat     := tfAlpha8ub1;
2955   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2956   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2957   fglFormat         := GL_ALPHA;
2958   fglInternalFormat := GL_ALPHA8;
2959   fglDataFormat     := GL_UNSIGNED_BYTE;
2960 end;
2961
2962 procedure TfdAlpha16us1.SetValues;
2963 begin
2964   inherited SetValues;
2965   fBitsPerPixel     := 16;
2966   fFormat           := tfAlpha16us1;
2967   fWithAlpha        := tfAlpha16us1;
2968   fOpenGLFormat     := tfAlpha16us1;
2969   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2970   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2971   fglFormat         := GL_ALPHA;
2972   fglInternalFormat := GL_ALPHA16;
2973   fglDataFormat     := GL_UNSIGNED_SHORT;
2974 end;
2975
2976 procedure TfdLuminance4ub1.SetValues;
2977 begin
2978   inherited SetValues;
2979   fBitsPerPixel     := 8;
2980   fFormat           := tfLuminance4ub1;
2981   fWithAlpha        := tfLuminance4Alpha4ub2;
2982   fWithoutAlpha     := tfLuminance4ub1;
2983   fOpenGLFormat     := tfLuminance4ub1;
2984   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2985   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2986   fglFormat         := GL_LUMINANCE;
2987   fglInternalFormat := GL_LUMINANCE4;
2988   fglDataFormat     := GL_UNSIGNED_BYTE;
2989 end;
2990
2991 procedure TfdLuminance8ub1.SetValues;
2992 begin
2993   inherited SetValues;
2994   fBitsPerPixel     := 8;
2995   fFormat           := tfLuminance8ub1;
2996   fWithAlpha        := tfLuminance8Alpha8ub2;
2997   fWithoutAlpha     := tfLuminance8ub1;
2998   fOpenGLFormat     := tfLuminance8ub1;
2999   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3000   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3001   fglFormat         := GL_LUMINANCE;
3002   fglInternalFormat := GL_LUMINANCE8;
3003   fglDataFormat     := GL_UNSIGNED_BYTE;
3004 end;
3005
3006 procedure TfdLuminance16us1.SetValues;
3007 begin
3008   inherited SetValues;
3009   fBitsPerPixel     := 16;
3010   fFormat           := tfLuminance16us1;
3011   fWithAlpha        := tfLuminance16Alpha16us2;
3012   fWithoutAlpha     := tfLuminance16us1;
3013   fOpenGLFormat     := tfLuminance16us1;
3014   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3015   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3016   fglFormat         := GL_LUMINANCE;
3017   fglInternalFormat := GL_LUMINANCE16;
3018   fglDataFormat     := GL_UNSIGNED_SHORT;
3019 end;
3020
3021 procedure TfdLuminance4Alpha4ub2.SetValues;
3022 begin
3023   inherited SetValues;
3024   fBitsPerPixel     := 16;
3025   fFormat           := tfLuminance4Alpha4ub2;
3026   fWithAlpha        := tfLuminance4Alpha4ub2;
3027   fWithoutAlpha     := tfLuminance4ub1;
3028   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3029   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3030   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3031   fglFormat         := GL_LUMINANCE_ALPHA;
3032   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3033   fglDataFormat     := GL_UNSIGNED_BYTE;
3034 end;
3035
3036 procedure TfdLuminance6Alpha2ub2.SetValues;
3037 begin
3038   inherited SetValues;
3039   fBitsPerPixel     := 16;
3040   fFormat           := tfLuminance6Alpha2ub2;
3041   fWithAlpha        := tfLuminance6Alpha2ub2;
3042   fWithoutAlpha     := tfLuminance8ub1;
3043   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3044   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3045   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3046   fglFormat         := GL_LUMINANCE_ALPHA;
3047   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3048   fglDataFormat     := GL_UNSIGNED_BYTE;
3049 end;
3050
3051 procedure TfdLuminance8Alpha8ub2.SetValues;
3052 begin
3053   inherited SetValues;
3054   fBitsPerPixel     := 16;
3055   fFormat           := tfLuminance8Alpha8ub2;
3056   fWithAlpha        := tfLuminance8Alpha8ub2;
3057   fWithoutAlpha     := tfLuminance8ub1;
3058   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3059   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3060   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3061   fglFormat         := GL_LUMINANCE_ALPHA;
3062   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3063   fglDataFormat     := GL_UNSIGNED_BYTE;
3064 end;
3065
3066 procedure TfdLuminance12Alpha4us2.SetValues;
3067 begin
3068   inherited SetValues;
3069   fBitsPerPixel     := 32;
3070   fFormat           := tfLuminance12Alpha4us2;
3071   fWithAlpha        := tfLuminance12Alpha4us2;
3072   fWithoutAlpha     := tfLuminance16us1;
3073   fOpenGLFormat     := tfLuminance12Alpha4us2;
3074   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3075   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3076   fglFormat         := GL_LUMINANCE_ALPHA;
3077   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3078   fglDataFormat     := GL_UNSIGNED_SHORT;
3079 end;
3080
3081 procedure TfdLuminance16Alpha16us2.SetValues;
3082 begin
3083   inherited SetValues;
3084   fBitsPerPixel     := 32;
3085   fFormat           := tfLuminance16Alpha16us2;
3086   fWithAlpha        := tfLuminance16Alpha16us2;
3087   fWithoutAlpha     := tfLuminance16us1;
3088   fOpenGLFormat     := tfLuminance16Alpha16us2;
3089   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3090   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3091   fglFormat         := GL_LUMINANCE_ALPHA;
3092   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3093   fglDataFormat     := GL_UNSIGNED_SHORT;
3094 end;
3095
3096 procedure TfdR3G3B2ub1.SetValues;
3097 begin
3098   inherited SetValues;
3099   fBitsPerPixel     := 8;
3100   fFormat           := tfR3G3B2ub1;
3101   fWithAlpha        := tfRGBA4us1;
3102   fWithoutAlpha     := tfR3G3B2ub1;
3103   fOpenGLFormat     := tfR3G3B2ub1;
3104   fRGBInverted      := tfEmpty;
3105   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3106   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3107   fglFormat         := GL_RGB;
3108   fglInternalFormat := GL_R3_G3_B2;
3109   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3110 end;
3111
3112 procedure TfdRGBX4us1.SetValues;
3113 begin
3114   inherited SetValues;
3115   fBitsPerPixel     := 16;
3116   fFormat           := tfRGBX4us1;
3117   fWithAlpha        := tfRGBA4us1;
3118   fWithoutAlpha     := tfRGBX4us1;
3119   fOpenGLFormat     := tfRGBX4us1;
3120   fRGBInverted      := tfBGRX4us1;
3121   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3122   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3123   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3124   fglInternalFormat := GL_RGB4;
3125   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3126 end;
3127
3128 procedure TfdXRGB4us1.SetValues;
3129 begin
3130   inherited SetValues;
3131   fBitsPerPixel     := 16;
3132   fFormat           := tfXRGB4us1;
3133   fWithAlpha        := tfARGB4us1;
3134   fWithoutAlpha     := tfXRGB4us1;
3135   fOpenGLFormat     := tfXRGB4us1;
3136   fRGBInverted      := tfXBGR4us1;
3137   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3138   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3139   fglFormat         := GL_BGRA;
3140   fglInternalFormat := GL_RGB4;
3141   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3142 end;
3143
3144 procedure TfdR5G6B5us1.SetValues;
3145 begin
3146   inherited SetValues;
3147   fBitsPerPixel     := 16;
3148   fFormat           := tfR5G6B5us1;
3149   fWithAlpha        := tfRGB5A1us1;
3150   fWithoutAlpha     := tfR5G6B5us1;
3151   fOpenGLFormat     := tfR5G6B5us1;
3152   fRGBInverted      := tfB5G6R5us1;
3153   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3154   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3155   fglFormat         := GL_RGB;
3156   fglInternalFormat := GL_RGB565;
3157   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3158 end;
3159
3160 procedure TfdRGB5X1us1.SetValues;
3161 begin
3162   inherited SetValues;
3163   fBitsPerPixel     := 16;
3164   fFormat           := tfRGB5X1us1;
3165   fWithAlpha        := tfRGB5A1us1;
3166   fWithoutAlpha     := tfRGB5X1us1;
3167   fOpenGLFormat     := tfRGB5X1us1;
3168   fRGBInverted      := tfBGR5X1us1;
3169   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3170   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3171   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3172   fglInternalFormat := GL_RGB5;
3173   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3174 end;
3175
3176 procedure TfdX1RGB5us1.SetValues;
3177 begin
3178   inherited SetValues;
3179   fBitsPerPixel     := 16;
3180   fFormat           := tfX1RGB5us1;
3181   fWithAlpha        := tfA1RGB5us1;
3182   fWithoutAlpha     := tfX1RGB5us1;
3183   fOpenGLFormat     := tfX1RGB5us1;
3184   fRGBInverted      := tfX1BGR5us1;
3185   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3186   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3187   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3188   fglInternalFormat := GL_RGB5;
3189   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3190 end;
3191
3192 procedure TfdRGB8ub3.SetValues;
3193 begin
3194   inherited SetValues;
3195   fBitsPerPixel     := 24;
3196   fFormat           := tfRGB8ub3;
3197   fWithAlpha        := tfRGBA8ub4;
3198   fWithoutAlpha     := tfRGB8ub3;
3199   fOpenGLFormat     := tfRGB8ub3;
3200   fRGBInverted      := tfBGR8ub3;
3201   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3202   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3203   fglFormat         := GL_RGB;
3204   fglInternalFormat := GL_RGB8;
3205   fglDataFormat     := GL_UNSIGNED_BYTE;
3206 end;
3207
3208 procedure TfdRGBX8ui1.SetValues;
3209 begin
3210   inherited SetValues;
3211   fBitsPerPixel     := 32;
3212   fFormat           := tfRGBX8ui1;
3213   fWithAlpha        := tfRGBA8ui1;
3214   fWithoutAlpha     := tfRGBX8ui1;
3215   fOpenGLFormat     := tfRGB8ub3;
3216   fRGBInverted      := tfBGRX8ui1;
3217   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3218   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3219   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3220   fglInternalFormat := GL_RGB8;
3221   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3222 end;
3223
3224 procedure TfdXRGB8ui1.SetValues;
3225 begin
3226   inherited SetValues;
3227   fBitsPerPixel     := 32;
3228   fFormat           := tfXRGB8ui1;
3229   fWithAlpha        := tfXRGB8ui1;
3230   fWithoutAlpha     := tfXRGB8ui1;
3231   fOpenGLFormat     := tfRGB8ub3;
3232   fRGBInverted      := tfXBGR8ui1;
3233   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3234   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3235   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3236   fglInternalFormat := GL_RGB8;
3237   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3238 end;
3239
3240 procedure TfdRGB10X2ui1.SetValues;
3241 begin
3242   inherited SetValues;
3243   fBitsPerPixel     := 32;
3244   fFormat           := tfRGB10X2ui1;
3245   fWithAlpha        := tfRGB10A2ui1;
3246   fWithoutAlpha     := tfRGB10X2ui1;
3247   fOpenGLFormat     := tfRGB10X2ui1;
3248   fRGBInverted      := tfBGR10X2ui1;
3249   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3250   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3251   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3252   fglInternalFormat := GL_RGB10;
3253   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3254 end;
3255
3256 procedure TfdX2RGB10ui1.SetValues;
3257 begin
3258   inherited SetValues;
3259   fBitsPerPixel     := 32;
3260   fFormat           := tfX2RGB10ui1;
3261   fWithAlpha        := tfA2RGB10ui1;
3262   fWithoutAlpha     := tfX2RGB10ui1;
3263   fOpenGLFormat     := tfX2RGB10ui1;
3264   fRGBInverted      := tfX2BGR10ui1;
3265   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3266   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3267   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3268   fglInternalFormat := GL_RGB10;
3269   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3270 end;
3271
3272 procedure TfdRGB16us3.SetValues;
3273 begin
3274   inherited SetValues;
3275   fBitsPerPixel     := 48;
3276   fFormat           := tfRGB16us3;
3277   fWithAlpha        := tfRGBA16us4;
3278   fWithoutAlpha     := tfRGB16us3;
3279   fOpenGLFormat     := tfRGB16us3;
3280   fRGBInverted      := tfBGR16us3;
3281   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3282   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3283   fglFormat         := GL_RGB;
3284   fglInternalFormat := GL_RGB16;
3285   fglDataFormat     := GL_UNSIGNED_SHORT;
3286 end;
3287
3288 procedure TfdRGBA4us1.SetValues;
3289 begin
3290   inherited SetValues;
3291   fBitsPerPixel     := 16;
3292   fFormat           := tfRGBA4us1;
3293   fWithAlpha        := tfRGBA4us1;
3294   fWithoutAlpha     := tfRGBX4us1;
3295   fOpenGLFormat     := tfRGBA4us1;
3296   fRGBInverted      := tfBGRA4us1;
3297   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3298   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3299   fglFormat         := GL_RGBA;
3300   fglInternalFormat := GL_RGBA4;
3301   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3302 end;
3303
3304 procedure TfdARGB4us1.SetValues;
3305 begin
3306   inherited SetValues;
3307   fBitsPerPixel     := 16;
3308   fFormat           := tfARGB4us1;
3309   fWithAlpha        := tfARGB4us1;
3310   fWithoutAlpha     := tfXRGB4us1;
3311   fOpenGLFormat     := tfARGB4us1;
3312   fRGBInverted      := tfABGR4us1;
3313   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3314   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3315   fglFormat         := GL_BGRA;
3316   fglInternalFormat := GL_RGBA4;
3317   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3318 end;
3319
3320 procedure TfdRGB5A1us1.SetValues;
3321 begin
3322   inherited SetValues;
3323   fBitsPerPixel     := 16;
3324   fFormat           := tfRGB5A1us1;
3325   fWithAlpha        := tfRGB5A1us1;
3326   fWithoutAlpha     := tfRGB5X1us1;
3327   fOpenGLFormat     := tfRGB5A1us1;
3328   fRGBInverted      := tfBGR5A1us1;
3329   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3330   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3331   fglFormat         := GL_RGBA;
3332   fglInternalFormat := GL_RGB5_A1;
3333   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3334 end;
3335
3336 procedure TfdA1RGB5us1.SetValues;
3337 begin
3338   inherited SetValues;
3339   fBitsPerPixel     := 16;
3340   fFormat           := tfA1RGB5us1;
3341   fWithAlpha        := tfA1RGB5us1;
3342   fWithoutAlpha     := tfX1RGB5us1;
3343   fOpenGLFormat     := tfA1RGB5us1;
3344   fRGBInverted      := tfA1BGR5us1;
3345   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3346   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3347   fglFormat         := GL_BGRA;
3348   fglInternalFormat := GL_RGB5_A1;
3349   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3350 end;
3351
3352 procedure TfdRGBA8ui1.SetValues;
3353 begin
3354   inherited SetValues;
3355   fBitsPerPixel     := 32;
3356   fFormat           := tfRGBA8ui1;
3357   fWithAlpha        := tfRGBA8ui1;
3358   fWithoutAlpha     := tfRGBX8ui1;
3359   fOpenGLFormat     := tfRGBA8ui1;
3360   fRGBInverted      := tfBGRA8ui1;
3361   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3362   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3363   fglFormat         := GL_RGBA;
3364   fglInternalFormat := GL_RGBA8;
3365   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3366 end;
3367
3368 procedure TfdARGB8ui1.SetValues;
3369 begin
3370   inherited SetValues;
3371   fBitsPerPixel     := 32;
3372   fFormat           := tfARGB8ui1;
3373   fWithAlpha        := tfARGB8ui1;
3374   fWithoutAlpha     := tfXRGB8ui1;
3375   fOpenGLFormat     := tfARGB8ui1;
3376   fRGBInverted      := tfABGR8ui1;
3377   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3378   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3379   fglFormat         := GL_BGRA;
3380   fglInternalFormat := GL_RGBA8;
3381   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3382 end;
3383
3384 procedure TfdRGBA8ub4.SetValues;
3385 begin
3386   inherited SetValues;
3387   fBitsPerPixel     := 32;
3388   fFormat           := tfRGBA8ub4;
3389   fWithAlpha        := tfRGBA8ub4;
3390   fWithoutAlpha     := tfRGB8ub3;
3391   fOpenGLFormat     := tfRGBA8ub4;
3392   fRGBInverted      := tfBGRA8ub4;
3393   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3394   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3395   fglFormat         := GL_RGBA;
3396   fglInternalFormat := GL_RGBA8;
3397   fglDataFormat     := GL_UNSIGNED_BYTE;
3398 end;
3399
3400 procedure TfdRGB10A2ui1.SetValues;
3401 begin
3402   inherited SetValues;
3403   fBitsPerPixel     := 32;
3404   fFormat           := tfRGB10A2ui1;
3405   fWithAlpha        := tfRGB10A2ui1;
3406   fWithoutAlpha     := tfRGB10X2ui1;
3407   fOpenGLFormat     := tfRGB10A2ui1;
3408   fRGBInverted      := tfBGR10A2ui1;
3409   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3410   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3411   fglFormat         := GL_RGBA;
3412   fglInternalFormat := GL_RGB10_A2;
3413   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3414 end;
3415
3416 procedure TfdA2RGB10ui1.SetValues;
3417 begin
3418   inherited SetValues;
3419   fBitsPerPixel     := 32;
3420   fFormat           := tfA2RGB10ui1;
3421   fWithAlpha        := tfA2RGB10ui1;
3422   fWithoutAlpha     := tfX2RGB10ui1;
3423   fOpenGLFormat     := tfA2RGB10ui1;
3424   fRGBInverted      := tfA2BGR10ui1;
3425   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3426   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3427   fglFormat         := GL_BGRA;
3428   fglInternalFormat := GL_RGB10_A2;
3429   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3430 end;
3431
3432 procedure TfdRGBA16us4.SetValues;
3433 begin
3434   inherited SetValues;
3435   fBitsPerPixel     := 64;
3436   fFormat           := tfRGBA16us4;
3437   fWithAlpha        := tfRGBA16us4;
3438   fWithoutAlpha     := tfRGB16us3;
3439   fOpenGLFormat     := tfRGBA16us4;
3440   fRGBInverted      := tfBGRA16us4;
3441   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3442   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3443   fglFormat         := GL_RGBA;
3444   fglInternalFormat := GL_RGBA16;
3445   fglDataFormat     := GL_UNSIGNED_SHORT;
3446 end;
3447
3448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3451 procedure TfdBGRX4us1.SetValues;
3452 begin
3453   inherited SetValues;
3454   fBitsPerPixel     := 16;
3455   fFormat           := tfBGRX4us1;
3456   fWithAlpha        := tfBGRA4us1;
3457   fWithoutAlpha     := tfBGRX4us1;
3458   fOpenGLFormat     := tfBGRX4us1;
3459   fRGBInverted      := tfRGBX4us1;
3460   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3461   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3462   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3463   fglInternalFormat := GL_RGB4;
3464   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3465 end;
3466
3467 procedure TfdXBGR4us1.SetValues;
3468 begin
3469   inherited SetValues;
3470   fBitsPerPixel     := 16;
3471   fFormat           := tfXBGR4us1;
3472   fWithAlpha        := tfABGR4us1;
3473   fWithoutAlpha     := tfXBGR4us1;
3474   fOpenGLFormat     := tfXBGR4us1;
3475   fRGBInverted      := tfXRGB4us1;
3476   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3477   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3478   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3479   fglInternalFormat := GL_RGB4;
3480   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3481 end;
3482
3483 procedure TfdB5G6R5us1.SetValues;
3484 begin
3485   inherited SetValues;
3486   fBitsPerPixel     := 16;
3487   fFormat           := tfB5G6R5us1;
3488   fWithAlpha        := tfBGR5A1us1;
3489   fWithoutAlpha     := tfB5G6R5us1;
3490   fOpenGLFormat     := tfB5G6R5us1;
3491   fRGBInverted      := tfR5G6B5us1;
3492   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3493   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3494   fglFormat         := GL_RGB;
3495   fglInternalFormat := GL_RGB565;
3496   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3497 end;
3498
3499 procedure TfdBGR5X1us1.SetValues;
3500 begin
3501   inherited SetValues;
3502   fBitsPerPixel     := 16;
3503   fFormat           := tfBGR5X1us1;
3504   fWithAlpha        := tfBGR5A1us1;
3505   fWithoutAlpha     := tfBGR5X1us1;
3506   fOpenGLFormat     := tfBGR5X1us1;
3507   fRGBInverted      := tfRGB5X1us1;
3508   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3509   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3510   fglFormat         := GL_BGRA;
3511   fglInternalFormat := GL_RGB5;
3512   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3513 end;
3514
3515 procedure TfdX1BGR5us1.SetValues;
3516 begin
3517   inherited SetValues;
3518   fBitsPerPixel     := 16;
3519   fFormat           := tfX1BGR5us1;
3520   fWithAlpha        := tfA1BGR5us1;
3521   fWithoutAlpha     := tfX1BGR5us1;
3522   fOpenGLFormat     := tfX1BGR5us1;
3523   fRGBInverted      := tfX1RGB5us1;
3524   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3525   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3526   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3527   fglInternalFormat := GL_RGB5;
3528   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3529 end;
3530
3531 procedure TfdBGR8ub3.SetValues;
3532 begin
3533   inherited SetValues;
3534   fBitsPerPixel     := 24;
3535   fFormat           := tfBGR8ub3;
3536   fWithAlpha        := tfBGRA8ub4;
3537   fWithoutAlpha     := tfBGR8ub3;
3538   fOpenGLFormat     := tfBGR8ub3;
3539   fRGBInverted      := tfRGB8ub3;
3540   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3541   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3542   fglFormat         := GL_BGR;
3543   fglInternalFormat := GL_RGB8;
3544   fglDataFormat     := GL_UNSIGNED_BYTE;
3545 end;
3546
3547 procedure TfdBGRX8ui1.SetValues;
3548 begin
3549   inherited SetValues;
3550   fBitsPerPixel     := 32;
3551   fFormat           := tfBGRX8ui1;
3552   fWithAlpha        := tfBGRA8ui1;
3553   fWithoutAlpha     := tfBGRX8ui1;
3554   fOpenGLFormat     := tfBGRX8ui1;
3555   fRGBInverted      := tfRGBX8ui1;
3556   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3557   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3558   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3559   fglInternalFormat := GL_RGB8;
3560   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3561 end;
3562
3563 procedure TfdXBGR8ui1.SetValues;
3564 begin
3565   inherited SetValues;
3566   fBitsPerPixel     := 32;
3567   fFormat           := tfXBGR8ui1;
3568   fWithAlpha        := tfABGR8ui1;
3569   fWithoutAlpha     := tfXBGR8ui1;
3570   fOpenGLFormat     := tfXBGR8ui1;
3571   fRGBInverted      := tfXRGB8ui1;
3572   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3573   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3574   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3575   fglInternalFormat := GL_RGB8;
3576   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3577 end;
3578
3579 procedure TfdBGR10X2ui1.SetValues;
3580 begin
3581   inherited SetValues;
3582   fBitsPerPixel     := 32;
3583   fFormat           := tfBGR10X2ui1;
3584   fWithAlpha        := tfBGR10A2ui1;
3585   fWithoutAlpha     := tfBGR10X2ui1;
3586   fOpenGLFormat     := tfBGR10X2ui1;
3587   fRGBInverted      := tfRGB10X2ui1;
3588   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3589   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3590   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3591   fglInternalFormat := GL_RGB10;
3592   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3593 end;
3594
3595 procedure TfdX2BGR10ui1.SetValues;
3596 begin
3597   inherited SetValues;
3598   fBitsPerPixel     := 32;
3599   fFormat           := tfX2BGR10ui1;
3600   fWithAlpha        := tfA2BGR10ui1;
3601   fWithoutAlpha     := tfX2BGR10ui1;
3602   fOpenGLFormat     := tfX2BGR10ui1;
3603   fRGBInverted      := tfX2RGB10ui1;
3604   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3605   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3606   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3607   fglInternalFormat := GL_RGB10;
3608   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3609 end;
3610
3611 procedure TfdBGR16us3.SetValues;
3612 begin
3613   inherited SetValues;
3614   fBitsPerPixel     := 48;
3615   fFormat           := tfBGR16us3;
3616   fWithAlpha        := tfBGRA16us4;
3617   fWithoutAlpha     := tfBGR16us3;
3618   fOpenGLFormat     := tfBGR16us3;
3619   fRGBInverted      := tfRGB16us3;
3620   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3621   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3622   fglFormat         := GL_BGR;
3623   fglInternalFormat := GL_RGB16;
3624   fglDataFormat     := GL_UNSIGNED_SHORT;
3625 end;
3626
3627 procedure TfdBGRA4us1.SetValues;
3628 begin
3629   inherited SetValues;
3630   fBitsPerPixel     := 16;
3631   fFormat           := tfBGRA4us1;
3632   fWithAlpha        := tfBGRA4us1;
3633   fWithoutAlpha     := tfBGRX4us1;
3634   fOpenGLFormat     := tfBGRA4us1;
3635   fRGBInverted      := tfRGBA4us1;
3636   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3637   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3638   fglFormat         := GL_BGRA;
3639   fglInternalFormat := GL_RGBA4;
3640   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3641 end;
3642
3643 procedure TfdABGR4us1.SetValues;
3644 begin
3645   inherited SetValues;
3646   fBitsPerPixel     := 16;
3647   fFormat           := tfABGR4us1;
3648   fWithAlpha        := tfABGR4us1;
3649   fWithoutAlpha     := tfXBGR4us1;
3650   fOpenGLFormat     := tfABGR4us1;
3651   fRGBInverted      := tfARGB4us1;
3652   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3653   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3654   fglFormat         := GL_RGBA;
3655   fglInternalFormat := GL_RGBA4;
3656   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3657 end;
3658
3659 procedure TfdBGR5A1us1.SetValues;
3660 begin
3661   inherited SetValues;
3662   fBitsPerPixel     := 16;
3663   fFormat           := tfBGR5A1us1;
3664   fWithAlpha        := tfBGR5A1us1;
3665   fWithoutAlpha     := tfBGR5X1us1;
3666   fOpenGLFormat     := tfBGR5A1us1;
3667   fRGBInverted      := tfRGB5A1us1;
3668   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3669   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3670   fglFormat         := GL_BGRA;
3671   fglInternalFormat := GL_RGB5_A1;
3672   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3673 end;
3674
3675 procedure TfdA1BGR5us1.SetValues;
3676 begin
3677   inherited SetValues;
3678   fBitsPerPixel     := 16;
3679   fFormat           := tfA1BGR5us1;
3680   fWithAlpha        := tfA1BGR5us1;
3681   fWithoutAlpha     := tfX1BGR5us1;
3682   fOpenGLFormat     := tfA1BGR5us1;
3683   fRGBInverted      := tfA1RGB5us1;
3684   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3685   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3686   fglFormat         := GL_RGBA;
3687   fglInternalFormat := GL_RGB5_A1;
3688   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3689 end;
3690
3691 procedure TfdBGRA8ui1.SetValues;
3692 begin
3693   inherited SetValues;
3694   fBitsPerPixel     := 32;
3695   fFormat           := tfBGRA8ui1;
3696   fWithAlpha        := tfBGRA8ui1;
3697   fWithoutAlpha     := tfBGRX8ui1;
3698   fOpenGLFormat     := tfBGRA8ui1;
3699   fRGBInverted      := tfRGBA8ui1;
3700   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3701   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3702   fglFormat         := GL_BGRA;
3703   fglInternalFormat := GL_RGBA8;
3704   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3705 end;
3706
3707 procedure TfdABGR8ui1.SetValues;
3708 begin
3709   inherited SetValues;
3710   fBitsPerPixel     := 32;
3711   fFormat           := tfABGR8ui1;
3712   fWithAlpha        := tfABGR8ui1;
3713   fWithoutAlpha     := tfXBGR8ui1;
3714   fOpenGLFormat     := tfABGR8ui1;
3715   fRGBInverted      := tfARGB8ui1;
3716   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3717   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3718   fglFormat         := GL_RGBA;
3719   fglInternalFormat := GL_RGBA8;
3720   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3721 end;
3722
3723 procedure TfdBGRA8ub4.SetValues;
3724 begin
3725   inherited SetValues;
3726   fBitsPerPixel     := 32;
3727   fFormat           := tfBGRA8ub4;
3728   fWithAlpha        := tfBGRA8ub4;
3729   fWithoutAlpha     := tfBGR8ub3;
3730   fOpenGLFormat     := tfBGRA8ub4;
3731   fRGBInverted      := tfRGBA8ub4;
3732   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3733   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3734   fglFormat         := GL_BGRA;
3735   fglInternalFormat := GL_RGBA8;
3736   fglDataFormat     := GL_UNSIGNED_BYTE;
3737 end;
3738
3739 procedure TfdBGR10A2ui1.SetValues;
3740 begin
3741   inherited SetValues;
3742   fBitsPerPixel     := 32;
3743   fFormat           := tfBGR10A2ui1;
3744   fWithAlpha        := tfBGR10A2ui1;
3745   fWithoutAlpha     := tfBGR10X2ui1;
3746   fOpenGLFormat     := tfBGR10A2ui1;
3747   fRGBInverted      := tfRGB10A2ui1;
3748   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3749   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3750   fglFormat         := GL_BGRA;
3751   fglInternalFormat := GL_RGB10_A2;
3752   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3753 end;
3754
3755 procedure TfdA2BGR10ui1.SetValues;
3756 begin
3757   inherited SetValues;
3758   fBitsPerPixel     := 32;
3759   fFormat           := tfA2BGR10ui1;
3760   fWithAlpha        := tfA2BGR10ui1;
3761   fWithoutAlpha     := tfX2BGR10ui1;
3762   fOpenGLFormat     := tfA2BGR10ui1;
3763   fRGBInverted      := tfA2RGB10ui1;
3764   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3765   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3766   fglFormat         := GL_RGBA;
3767   fglInternalFormat := GL_RGB10_A2;
3768   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3769 end;
3770
3771 procedure TfdBGRA16us4.SetValues;
3772 begin
3773   inherited SetValues;
3774   fBitsPerPixel     := 64;
3775   fFormat           := tfBGRA16us4;
3776   fWithAlpha        := tfBGRA16us4;
3777   fWithoutAlpha     := tfBGR16us3;
3778   fOpenGLFormat     := tfBGRA16us4;
3779   fRGBInverted      := tfRGBA16us4;
3780   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3781   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3782   fglFormat         := GL_BGRA;
3783   fglInternalFormat := GL_RGBA16;
3784   fglDataFormat     := GL_UNSIGNED_SHORT;
3785 end;
3786
3787 procedure TfdDepth16us1.SetValues;
3788 begin
3789   inherited SetValues;
3790   fBitsPerPixel     := 16;
3791   fFormat           := tfDepth16us1;
3792   fWithoutAlpha     := tfDepth16us1;
3793   fOpenGLFormat     := tfDepth16us1;
3794   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3795   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3796   fglFormat         := GL_DEPTH_COMPONENT;
3797   fglInternalFormat := GL_DEPTH_COMPONENT16;
3798   fglDataFormat     := GL_UNSIGNED_SHORT;
3799 end;
3800
3801 procedure TfdDepth24ui1.SetValues;
3802 begin
3803   inherited SetValues;
3804   fBitsPerPixel     := 32;
3805   fFormat           := tfDepth24ui1;
3806   fWithoutAlpha     := tfDepth24ui1;
3807   fOpenGLFormat     := tfDepth24ui1;
3808   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3809   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3810   fglFormat         := GL_DEPTH_COMPONENT;
3811   fglInternalFormat := GL_DEPTH_COMPONENT24;
3812   fglDataFormat     := GL_UNSIGNED_INT;
3813 end;
3814
3815 procedure TfdDepth32ui1.SetValues;
3816 begin
3817   inherited SetValues;
3818   fBitsPerPixel     := 32;
3819   fFormat           := tfDepth32ui1;
3820   fWithoutAlpha     := tfDepth32ui1;
3821   fOpenGLFormat     := tfDepth32ui1;
3822   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3823   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3824   fglFormat         := GL_DEPTH_COMPONENT;
3825   fglInternalFormat := GL_DEPTH_COMPONENT32;
3826   fglDataFormat     := GL_UNSIGNED_INT;
3827 end;
3828
3829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3830 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3832 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3833 begin
3834   raise EglBitmap.Create('mapping for compressed formats is not supported');
3835 end;
3836
3837 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3838 begin
3839   raise EglBitmap.Create('mapping for compressed formats is not supported');
3840 end;
3841
3842 procedure TfdS3tcDtx1RGBA.SetValues;
3843 begin
3844   inherited SetValues;
3845   fFormat           := tfS3tcDtx1RGBA;
3846   fWithAlpha        := tfS3tcDtx1RGBA;
3847   fOpenGLFormat     := tfS3tcDtx1RGBA;
3848   fUncompressed     := tfRGB5A1us1;
3849   fBitsPerPixel     := 4;
3850   fIsCompressed     := true;
3851   fglFormat         := GL_COMPRESSED_RGBA;
3852   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3853   fglDataFormat     := GL_UNSIGNED_BYTE;
3854 end;
3855
3856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3857 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3859 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3860 begin
3861   raise EglBitmap.Create('mapping for compressed formats is not supported');
3862 end;
3863
3864 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3865 begin
3866   raise EglBitmap.Create('mapping for compressed formats is not supported');
3867 end;
3868
3869 procedure TfdS3tcDtx3RGBA.SetValues;
3870 begin
3871   inherited SetValues;
3872   fFormat           := tfS3tcDtx3RGBA;
3873   fWithAlpha        := tfS3tcDtx3RGBA;
3874   fOpenGLFormat     := tfS3tcDtx3RGBA;
3875   fUncompressed     := tfRGBA8ub4;
3876   fBitsPerPixel     := 8;
3877   fIsCompressed     := true;
3878   fglFormat         := GL_COMPRESSED_RGBA;
3879   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3880   fglDataFormat     := GL_UNSIGNED_BYTE;
3881 end;
3882
3883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3886 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3887 begin
3888   raise EglBitmap.Create('mapping for compressed formats is not supported');
3889 end;
3890
3891 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3892 begin
3893   raise EglBitmap.Create('mapping for compressed formats is not supported');
3894 end;
3895
3896 procedure TfdS3tcDtx5RGBA.SetValues;
3897 begin
3898   inherited SetValues;
3899   fFormat           := tfS3tcDtx3RGBA;
3900   fWithAlpha        := tfS3tcDtx3RGBA;
3901   fOpenGLFormat     := tfS3tcDtx3RGBA;
3902   fUncompressed     := tfRGBA8ub4;
3903   fBitsPerPixel     := 8;
3904   fIsCompressed     := true;
3905   fglFormat         := GL_COMPRESSED_RGBA;
3906   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3907   fglDataFormat     := GL_UNSIGNED_BYTE;
3908 end;
3909
3910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3914 begin
3915   result := (fPrecision.r > 0);
3916 end;
3917
3918 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3919 begin
3920   result := (fPrecision.g > 0);
3921 end;
3922
3923 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3924 begin
3925   result := (fPrecision.b > 0);
3926 end;
3927
3928 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3929 begin
3930   result := (fPrecision.a > 0);
3931 end;
3932
3933 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3934 begin
3935   result := HasRed or HasGreen or HasBlue;
3936 end;
3937
3938 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3939 begin
3940   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3941 end;
3942
3943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3944 procedure TglBitmapFormatDescriptor.SetValues;
3945 begin
3946   fFormat       := tfEmpty;
3947   fWithAlpha    := tfEmpty;
3948   fWithoutAlpha := tfEmpty;
3949   fOpenGLFormat := tfEmpty;
3950   fRGBInverted  := tfEmpty;
3951   fUncompressed := tfEmpty;
3952
3953   fBitsPerPixel := 0;
3954   fIsCompressed := false;
3955
3956   fglFormat         := 0;
3957   fglInternalFormat := 0;
3958   fglDataFormat     := 0;
3959
3960   FillChar(fPrecision, 0, SizeOf(fPrecision));
3961   FillChar(fShift,     0, SizeOf(fShift));
3962 end;
3963
3964 procedure TglBitmapFormatDescriptor.CalcValues;
3965 var
3966   i: Integer;
3967 begin
3968   fBytesPerPixel := fBitsPerPixel / 8;
3969   fChannelCount  := 0;
3970   for i := 0 to 3 do begin
3971     if (fPrecision.arr[i] > 0) then
3972       inc(fChannelCount);
3973     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3974     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3975   end;
3976 end;
3977
3978 constructor TglBitmapFormatDescriptor.Create;
3979 begin
3980   inherited Create;
3981   SetValues;
3982   CalcValues;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3987 var
3988   f: TglBitmapFormat;
3989 begin
3990   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3991     result := TFormatDescriptor.Get(f);
3992     if (result.glInternalFormat = aInternalFormat) then
3993       exit;
3994   end;
3995   result := TFormatDescriptor.Get(tfEmpty);
3996 end;
3997
3998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3999 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4001 class procedure TFormatDescriptor.Init;
4002 begin
4003   if not Assigned(FormatDescriptorCS) then
4004     FormatDescriptorCS := TCriticalSection.Create;
4005 end;
4006
4007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4008 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4009 begin
4010   FormatDescriptorCS.Enter;
4011   try
4012     result := FormatDescriptors[aFormat];
4013     if not Assigned(result) then begin
4014       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4015       FormatDescriptors[aFormat] := result;
4016     end;
4017   finally
4018     FormatDescriptorCS.Leave;
4019   end;
4020 end;
4021
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4024 begin
4025   result := Get(Get(aFormat).WithAlpha);
4026 end;
4027
4028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4029 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4030 var
4031   ft: TglBitmapFormat;
4032 begin
4033   // find matching format with OpenGL support
4034   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4035     result := Get(ft);
4036     if (result.MaskMatch(aMask))      and
4037        (result.glFormat <> 0)         and
4038        (result.glInternalFormat <> 0) and
4039        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4040     then
4041       exit;
4042   end;
4043
4044   // find matching format without OpenGL Support
4045   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4046     result := Get(ft);
4047     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4048       exit;
4049   end;
4050
4051   result := TFormatDescriptor.Get(tfEmpty);
4052 end;
4053
4054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4055 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4056 var
4057   ft: TglBitmapFormat;
4058 begin
4059   // find matching format with OpenGL support
4060   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4061     result := Get(ft);
4062     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4063        glBitmapRec4ubCompare(result.Precision, aPrec) and
4064        (result.glFormat <> 0)         and
4065        (result.glInternalFormat <> 0) and
4066        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4067     then
4068       exit;
4069   end;
4070
4071   // find matching format without OpenGL Support
4072   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4073     result := Get(ft);
4074     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4075        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4076        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4077       exit;
4078   end;
4079
4080   result := TFormatDescriptor.Get(tfEmpty);
4081 end;
4082
4083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4084 class procedure TFormatDescriptor.Clear;
4085 var
4086   f: TglBitmapFormat;
4087 begin
4088   FormatDescriptorCS.Enter;
4089   try
4090     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4091       FreeAndNil(FormatDescriptors[f]);
4092   finally
4093     FormatDescriptorCS.Leave;
4094   end;
4095 end;
4096
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 class procedure TFormatDescriptor.Finalize;
4099 begin
4100   Clear;
4101   FreeAndNil(FormatDescriptorCS);
4102 end;
4103
4104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4105 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4107 procedure TbmpBitfieldFormat.SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4108 var
4109   i: Integer;
4110 begin
4111   for i := 0 to 3 do begin
4112     fShift.arr[i] := 0;
4113     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4114       aMask.arr[i] := aMask.arr[i] shr 1;
4115       inc(fShift.arr[i]);
4116     end;
4117     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4118   end;
4119   CalcValues;
4120 end;
4121
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 procedure TbmpBitfieldFormat.SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4124 begin
4125   fBitsPerPixel := aBBP;
4126   fPrecision    := aPrec;
4127   fShift        := aShift;
4128   CalcValues;
4129 end;
4130
4131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4132 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4133 var
4134   data: QWord;
4135 begin
4136   data :=
4137     ((aPixel.Data.r and Range.r) shl Shift.r) or
4138     ((aPixel.Data.g and Range.g) shl Shift.g) or
4139     ((aPixel.Data.b and Range.b) shl Shift.b) or
4140     ((aPixel.Data.a and Range.a) shl Shift.a);
4141   case BitsPerPixel of
4142     8:           aData^  := data;
4143    16:     PWord(aData)^ := data;
4144    32: PCardinal(aData)^ := data;
4145    64:    PQWord(aData)^ := data;
4146   else
4147     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4148   end;
4149   inc(aData, Round(BytesPerPixel));
4150 end;
4151
4152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4153 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4154 var
4155   data: QWord;
4156   i: Integer;
4157 begin
4158   case BitsPerPixel of
4159      8: data :=           aData^;
4160     16: data :=     PWord(aData)^;
4161     32: data := PCardinal(aData)^;
4162     64: data :=    PQWord(aData)^;
4163   else
4164     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4165   end;
4166   for i := 0 to 3 do
4167     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4168   inc(aData, Round(BytesPerPixel));
4169 end;
4170
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 procedure TbmpColorTableFormat.SetValues;
4175 begin
4176   inherited SetValues;
4177   fShift := glBitmapRec4ub(8, 8, 8, 0);
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure TbmpColorTableFormat.SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4182 begin
4183   fFormat       := aFormat;
4184   fBitsPerPixel := aBPP;
4185   fPrecision    := aPrec;
4186   fShift        := aShift;
4187   CalcValues;
4188 end;
4189
4190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4191 procedure TbmpColorTableFormat.CalcValues;
4192 begin
4193   inherited CalcValues;
4194 end;
4195
4196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4197 procedure TbmpColorTableFormat.CreateColorTable;
4198 var
4199   i: Integer;
4200 begin
4201   SetLength(fColorTable, 256);
4202   if not HasColor then begin
4203     // alpha
4204     for i := 0 to High(fColorTable) do begin
4205       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4206       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4207       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4208       fColorTable[i].a := 0;
4209     end;
4210   end else begin
4211     // normal
4212     for i := 0 to High(fColorTable) do begin
4213       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4214       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4215       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4216       fColorTable[i].a := 0;
4217     end;
4218   end;
4219 end;
4220
4221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4222 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4223 begin
4224   if (BitsPerPixel <> 8) then
4225     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4226   if not HasColor then
4227     // alpha
4228     aData^ := aPixel.Data.a
4229   else
4230     // normal
4231     aData^ := Round(
4232       ((aPixel.Data.r and Range.r) shl Shift.r) or
4233       ((aPixel.Data.g and Range.g) shl Shift.g) or
4234       ((aPixel.Data.b and Range.b) shl Shift.b));
4235   inc(aData);
4236 end;
4237
4238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4239 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4240 begin
4241   if (BitsPerPixel <> 8) then
4242     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4243   with fColorTable[aData^] do begin
4244     aPixel.Data.r := r;
4245     aPixel.Data.g := g;
4246     aPixel.Data.b := b;
4247     aPixel.Data.a := a;
4248   end;
4249   inc(aData, 1);
4250 end;
4251
4252 destructor TbmpColorTableFormat.Destroy;
4253 begin
4254   SetLength(fColorTable, 0);
4255   inherited Destroy;
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4262 var
4263   i: Integer;
4264 begin
4265   for i := 0 to 3 do begin
4266     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4267       if (aSourceFD.Range.arr[i] > 0) then
4268         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4269       else
4270         aPixel.Data.arr[i] := 0;
4271     end;
4272   end;
4273 end;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4277 begin
4278   with aFuncRec do begin
4279     if (Source.Range.r   > 0) then
4280       Dest.Data.r := Source.Data.r;
4281     if (Source.Range.g > 0) then
4282       Dest.Data.g := Source.Data.g;
4283     if (Source.Range.b  > 0) then
4284       Dest.Data.b := Source.Data.b;
4285     if (Source.Range.a > 0) then
4286       Dest.Data.a := Source.Data.a;
4287   end;
4288 end;
4289
4290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4291 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4292 var
4293   i: Integer;
4294 begin
4295   with aFuncRec do begin
4296     for i := 0 to 3 do
4297       if (Source.Range.arr[i] > 0) then
4298         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4299   end;
4300 end;
4301
4302 type
4303   TShiftData = packed record
4304     case Integer of
4305       0: (r, g, b, a: SmallInt);
4306       1: (arr: array[0..3] of SmallInt);
4307   end;
4308   PShiftData = ^TShiftData;
4309
4310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4311 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4312 var
4313   i: Integer;
4314 begin
4315   with aFuncRec do
4316     for i := 0 to 3 do
4317       if (Source.Range.arr[i] > 0) then
4318         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4319 end;
4320
4321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4322 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4323 begin
4324   with aFuncRec do begin
4325     Dest.Data := Source.Data;
4326     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4327       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4328       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4329       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4330     end;
4331     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4332       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4333     end;
4334   end;
4335 end;
4336
4337 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4338 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4339 var
4340   i: Integer;
4341 begin
4342   with aFuncRec do begin
4343     for i := 0 to 3 do
4344       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4345   end;
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4350 var
4351   Temp: Single;
4352 begin
4353   with FuncRec do begin
4354     if (FuncRec.Args = nil) then begin //source has no alpha
4355       Temp :=
4356         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4357         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4358         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4359       Dest.Data.a := Round(Dest.Range.a * Temp);
4360     end else
4361       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4362   end;
4363 end;
4364
4365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4366 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4367 type
4368   PglBitmapPixelData = ^TglBitmapPixelData;
4369 begin
4370   with FuncRec do begin
4371     Dest.Data.r := Source.Data.r;
4372     Dest.Data.g := Source.Data.g;
4373     Dest.Data.b := Source.Data.b;
4374
4375     with PglBitmapPixelData(Args)^ do
4376       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4377           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4378           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4379         Dest.Data.a := 0
4380       else
4381         Dest.Data.a := Dest.Range.a;
4382   end;
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4387 begin
4388   with FuncRec do begin
4389     Dest.Data.r := Source.Data.r;
4390     Dest.Data.g := Source.Data.g;
4391     Dest.Data.b := Source.Data.b;
4392     Dest.Data.a := PCardinal(Args)^;
4393   end;
4394 end;
4395
4396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4397 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4398 type
4399   PRGBPix = ^TRGBPix;
4400   TRGBPix = array [0..2] of byte;
4401 var
4402   Temp: Byte;
4403 begin
4404   while aWidth > 0 do begin
4405     Temp := PRGBPix(aData)^[0];
4406     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4407     PRGBPix(aData)^[2] := Temp;
4408
4409     if aHasAlpha then
4410       Inc(aData, 4)
4411     else
4412       Inc(aData, 3);
4413     dec(aWidth);
4414   end;
4415 end;
4416
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4420 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4421 begin
4422   result := TFormatDescriptor.Get(Format);
4423 end;
4424
4425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4426 function TglBitmap.GetWidth: Integer;
4427 begin
4428   if (ffX in fDimension.Fields) then
4429     result := fDimension.X
4430   else
4431     result := -1;
4432 end;
4433
4434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4435 function TglBitmap.GetHeight: Integer;
4436 begin
4437   if (ffY in fDimension.Fields) then
4438     result := fDimension.Y
4439   else
4440     result := -1;
4441 end;
4442
4443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4444 function TglBitmap.GetFileWidth: Integer;
4445 begin
4446   result := Max(1, Width);
4447 end;
4448
4449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4450 function TglBitmap.GetFileHeight: Integer;
4451 begin
4452   result := Max(1, Height);
4453 end;
4454
4455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4456 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4457 begin
4458   if fCustomData = aValue then
4459     exit;
4460   fCustomData := aValue;
4461 end;
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 procedure TglBitmap.SetCustomName(const aValue: String);
4465 begin
4466   if fCustomName = aValue then
4467     exit;
4468   fCustomName := aValue;
4469 end;
4470
4471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4472 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4473 begin
4474   if fCustomNameW = aValue then
4475     exit;
4476   fCustomNameW := aValue;
4477 end;
4478
4479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4480 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4481 begin
4482   if fFreeDataOnDestroy = aValue then
4483     exit;
4484   fFreeDataOnDestroy := aValue;
4485 end;
4486
4487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4488 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4489 begin
4490   if fDeleteTextureOnFree = aValue then
4491     exit;
4492   fDeleteTextureOnFree := aValue;
4493 end;
4494
4495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4496 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4497 begin
4498   if fFormat = aValue then
4499     exit;
4500   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4501     raise EglBitmapUnsupportedFormat.Create(Format);
4502   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4503 end;
4504
4505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4506 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4507 begin
4508   if fFreeDataAfterGenTexture = aValue then
4509     exit;
4510   fFreeDataAfterGenTexture := aValue;
4511 end;
4512
4513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4514 procedure TglBitmap.SetID(const aValue: Cardinal);
4515 begin
4516   if fID = aValue then
4517     exit;
4518   fID := aValue;
4519 end;
4520
4521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4522 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4523 begin
4524   if fMipMap = aValue then
4525     exit;
4526   fMipMap := aValue;
4527 end;
4528
4529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4530 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4531 begin
4532   if fTarget = aValue then
4533     exit;
4534   fTarget := aValue;
4535 end;
4536
4537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4538 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4539 var
4540   MaxAnisotropic: Integer;
4541 begin
4542   fAnisotropic := aValue;
4543   if (ID > 0) then begin
4544     if GL_EXT_texture_filter_anisotropic then begin
4545       if fAnisotropic > 0 then begin
4546         Bind(false);
4547         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4548         if aValue > MaxAnisotropic then
4549           fAnisotropic := MaxAnisotropic;
4550         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4551       end;
4552     end else begin
4553       fAnisotropic := 0;
4554     end;
4555   end;
4556 end;
4557
4558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4559 procedure TglBitmap.CreateID;
4560 begin
4561   if (ID <> 0) then
4562     glDeleteTextures(1, @fID);
4563   glGenTextures(1, @fID);
4564   Bind(false);
4565 end;
4566
4567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4568 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4569 begin
4570   // Set Up Parameters
4571   SetWrap(fWrapS, fWrapT, fWrapR);
4572   SetFilter(fFilterMin, fFilterMag);
4573   SetAnisotropic(fAnisotropic);
4574   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4575
4576   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4577     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4578
4579   // Mip Maps Generation Mode
4580   aBuildWithGlu := false;
4581   if (MipMap = mmMipmap) then begin
4582     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4583       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4584     else
4585       aBuildWithGlu := true;
4586   end else if (MipMap = mmMipmapGlu) then
4587     aBuildWithGlu := true;
4588 end;
4589
4590 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4591 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4592   const aWidth: Integer; const aHeight: Integer);
4593 var
4594   s: Single;
4595 begin
4596   if (Data <> aData) then begin
4597     if (Assigned(Data)) then
4598       FreeMem(Data);
4599     fData := aData;
4600   end;
4601
4602   if not Assigned(fData) then begin
4603     fPixelSize := 0;
4604     fRowSize   := 0;
4605   end else begin
4606     FillChar(fDimension, SizeOf(fDimension), 0);
4607     if aWidth <> -1 then begin
4608       fDimension.Fields := fDimension.Fields + [ffX];
4609       fDimension.X := aWidth;
4610     end;
4611
4612     if aHeight <> -1 then begin
4613       fDimension.Fields := fDimension.Fields + [ffY];
4614       fDimension.Y := aHeight;
4615     end;
4616
4617     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4618     fFormat    := aFormat;
4619     fPixelSize := Ceil(s);
4620     fRowSize   := Ceil(s * aWidth);
4621   end;
4622 end;
4623
4624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4625 function TglBitmap.FlipHorz: Boolean;
4626 begin
4627   result := false;
4628 end;
4629
4630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4631 function TglBitmap.FlipVert: Boolean;
4632 begin
4633   result := false;
4634 end;
4635
4636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4637 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4639 procedure TglBitmap.AfterConstruction;
4640 begin
4641   inherited AfterConstruction;
4642
4643   fID         := 0;
4644   fTarget     := 0;
4645   fIsResident := false;
4646
4647   fMipMap                  := glBitmapDefaultMipmap;
4648   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4649   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4650
4651   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4652   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4653   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4654 end;
4655
4656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4657 procedure TglBitmap.BeforeDestruction;
4658 var
4659   NewData: PByte;
4660 begin
4661   if fFreeDataOnDestroy then begin
4662     NewData := nil;
4663     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4664   end;
4665   if (fID > 0) and fDeleteTextureOnFree then
4666     glDeleteTextures(1, @fID);
4667   inherited BeforeDestruction;
4668 end;
4669
4670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4671 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4672 var
4673   TempPos: Integer;
4674 begin
4675   if not Assigned(aResType) then begin
4676     TempPos   := Pos('.', aResource);
4677     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4678     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4679   end;
4680 end;
4681
4682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4683 procedure TglBitmap.LoadFromFile(const aFilename: String);
4684 var
4685   fs: TFileStream;
4686 begin
4687   if not FileExists(aFilename) then
4688     raise EglBitmap.Create('file does not exist: ' + aFilename);
4689   fFilename := aFilename;
4690   fs := TFileStream.Create(fFilename, fmOpenRead);
4691   try
4692     fs.Position := 0;
4693     LoadFromStream(fs);
4694   finally
4695     fs.Free;
4696   end;
4697 end;
4698
4699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4700 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4701 begin
4702   {$IFDEF GLB_SUPPORT_PNG_READ}
4703   if not LoadPNG(aStream) then
4704   {$ENDIF}
4705   {$IFDEF GLB_SUPPORT_JPEG_READ}
4706   if not LoadJPEG(aStream) then
4707   {$ENDIF}
4708   if not LoadDDS(aStream) then
4709   if not LoadTGA(aStream) then
4710   if not LoadBMP(aStream) then
4711   if not LoadRAW(aStream) then
4712     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4713 end;
4714
4715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4716 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4717   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4718 var
4719   tmpData: PByte;
4720   size: Integer;
4721 begin
4722   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4723   GetMem(tmpData, size);
4724   try
4725     FillChar(tmpData^, size, #$FF);
4726     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4727   except
4728     if Assigned(tmpData) then
4729       FreeMem(tmpData);
4730     raise;
4731   end;
4732   AddFunc(Self, aFunc, false, aFormat, aArgs);
4733 end;
4734
4735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4736 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4737 var
4738   rs: TResourceStream;
4739 begin
4740   PrepareResType(aResource, aResType);
4741   rs := TResourceStream.Create(aInstance, aResource, aResType);
4742   try
4743     LoadFromStream(rs);
4744   finally
4745     rs.Free;
4746   end;
4747 end;
4748
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4751 var
4752   rs: TResourceStream;
4753 begin
4754   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4755   try
4756     LoadFromStream(rs);
4757   finally
4758     rs.Free;
4759   end;
4760 end;
4761
4762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4763 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4764 var
4765   fs: TFileStream;
4766 begin
4767   fs := TFileStream.Create(aFileName, fmCreate);
4768   try
4769     fs.Position := 0;
4770     SaveToStream(fs, aFileType);
4771   finally
4772     fs.Free;
4773   end;
4774 end;
4775
4776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4777 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4778 begin
4779   case aFileType of
4780     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4781     ftPNG:  SavePNG(aStream);
4782     {$ENDIF}
4783     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4784     ftJPEG: SaveJPEG(aStream);
4785     {$ENDIF}
4786     ftDDS:  SaveDDS(aStream);
4787     ftTGA:  SaveTGA(aStream);
4788     ftBMP:  SaveBMP(aStream);
4789     ftRAW:  SaveRAW(aStream);
4790   end;
4791 end;
4792
4793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4794 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4795 begin
4796   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4797 end;
4798
4799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4800 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4801   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4802 var
4803   DestData, TmpData, SourceData: pByte;
4804   TempHeight, TempWidth: Integer;
4805   SourceFD, DestFD: TFormatDescriptor;
4806   SourceMD, DestMD: Pointer;
4807
4808   FuncRec: TglBitmapFunctionRec;
4809 begin
4810   Assert(Assigned(Data));
4811   Assert(Assigned(aSource));
4812   Assert(Assigned(aSource.Data));
4813
4814   result := false;
4815   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4816     SourceFD := TFormatDescriptor.Get(aSource.Format);
4817     DestFD   := TFormatDescriptor.Get(aFormat);
4818
4819     if (SourceFD.IsCompressed) then
4820       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4821     if (DestFD.IsCompressed) then
4822       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4823
4824     // inkompatible Formats so CreateTemp
4825     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
4826       aCreateTemp := true;
4827
4828     // Values
4829     TempHeight := Max(1, aSource.Height);
4830     TempWidth  := Max(1, aSource.Width);
4831
4832     FuncRec.Sender := Self;
4833     FuncRec.Args   := aArgs;
4834
4835     TmpData := nil;
4836     if aCreateTemp then begin
4837       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4838       DestData := TmpData;
4839     end else
4840       DestData := Data;
4841
4842     try
4843       SourceFD.PreparePixel(FuncRec.Source);
4844       DestFD.PreparePixel  (FuncRec.Dest);
4845
4846       SourceMD := SourceFD.CreateMappingData;
4847       DestMD   := DestFD.CreateMappingData;
4848
4849       FuncRec.Size            := aSource.Dimension;
4850       FuncRec.Position.Fields := FuncRec.Size.Fields;
4851
4852       try
4853         SourceData := aSource.Data;
4854         FuncRec.Position.Y := 0;
4855         while FuncRec.Position.Y < TempHeight do begin
4856           FuncRec.Position.X := 0;
4857           while FuncRec.Position.X < TempWidth do begin
4858             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4859             aFunc(FuncRec);
4860             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4861             inc(FuncRec.Position.X);
4862           end;
4863           inc(FuncRec.Position.Y);
4864         end;
4865
4866         // Updating Image or InternalFormat
4867         if aCreateTemp then
4868           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4869         else if (aFormat <> fFormat) then
4870           Format := aFormat;
4871
4872         result := true;
4873       finally
4874         SourceFD.FreeMappingData(SourceMD);
4875         DestFD.FreeMappingData(DestMD);
4876       end;
4877     except
4878       if aCreateTemp and Assigned(TmpData) then
4879         FreeMem(TmpData);
4880       raise;
4881     end;
4882   end;
4883 end;
4884
4885 {$IFDEF GLB_SDL}
4886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4887 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4888 var
4889   Row, RowSize: Integer;
4890   SourceData, TmpData: PByte;
4891   TempDepth: Integer;
4892   FormatDesc: TFormatDescriptor;
4893
4894   function GetRowPointer(Row: Integer): pByte;
4895   begin
4896     result := aSurface.pixels;
4897     Inc(result, Row * RowSize);
4898   end;
4899
4900 begin
4901   result := false;
4902
4903   FormatDesc := TFormatDescriptor.Get(Format);
4904   if FormatDesc.IsCompressed then
4905     raise EglBitmapUnsupportedFormat.Create(Format);
4906
4907   if Assigned(Data) then begin
4908     case Trunc(FormatDesc.PixelSize) of
4909       1: TempDepth :=  8;
4910       2: TempDepth := 16;
4911       3: TempDepth := 24;
4912       4: TempDepth := 32;
4913     else
4914       raise EglBitmapUnsupportedFormat.Create(Format);
4915     end;
4916
4917     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4918       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4919     SourceData := Data;
4920     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4921
4922     for Row := 0 to FileHeight-1 do begin
4923       TmpData := GetRowPointer(Row);
4924       if Assigned(TmpData) then begin
4925         Move(SourceData^, TmpData^, RowSize);
4926         inc(SourceData, RowSize);
4927       end;
4928     end;
4929     result := true;
4930   end;
4931 end;
4932
4933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4934 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4935 var
4936   pSource, pData, pTempData: PByte;
4937   Row, RowSize, TempWidth, TempHeight: Integer;
4938   IntFormat: TglBitmapFormat;
4939   fd: TFormatDescriptor;
4940   Mask: TglBitmapMask;
4941
4942   function GetRowPointer(Row: Integer): pByte;
4943   begin
4944     result := aSurface^.pixels;
4945     Inc(result, Row * RowSize);
4946   end;
4947
4948 begin
4949   result := false;
4950   if (Assigned(aSurface)) then begin
4951     with aSurface^.format^ do begin
4952       Mask.r := RMask;
4953       Mask.g := GMask;
4954       Mask.b := BMask;
4955       Mask.a := AMask;
4956       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
4957       if (IntFormat = tfEmpty) then
4958         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
4959     end;
4960
4961     fd := TFormatDescriptor.Get(IntFormat);
4962     TempWidth  := aSurface^.w;
4963     TempHeight := aSurface^.h;
4964     RowSize := fd.GetSize(TempWidth, 1);
4965     GetMem(pData, TempHeight * RowSize);
4966     try
4967       pTempData := pData;
4968       for Row := 0 to TempHeight -1 do begin
4969         pSource := GetRowPointer(Row);
4970         if (Assigned(pSource)) then begin
4971           Move(pSource^, pTempData^, RowSize);
4972           Inc(pTempData, RowSize);
4973         end;
4974       end;
4975       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4976       result := true;
4977     except
4978       if Assigned(pData) then
4979         FreeMem(pData);
4980       raise;
4981     end;
4982   end;
4983 end;
4984
4985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4986 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4987 var
4988   Row, Col, AlphaInterleave: Integer;
4989   pSource, pDest: PByte;
4990
4991   function GetRowPointer(Row: Integer): pByte;
4992   begin
4993     result := aSurface.pixels;
4994     Inc(result, Row * Width);
4995   end;
4996
4997 begin
4998   result := false;
4999   if Assigned(Data) then begin
5000     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5001       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5002
5003       AlphaInterleave := 0;
5004       case Format of
5005         tfLuminance8Alpha8ub2:
5006           AlphaInterleave := 1;
5007         tfBGRA8ub4, tfRGBA8ub4:
5008           AlphaInterleave := 3;
5009       end;
5010
5011       pSource := Data;
5012       for Row := 0 to Height -1 do begin
5013         pDest := GetRowPointer(Row);
5014         if Assigned(pDest) then begin
5015           for Col := 0 to Width -1 do begin
5016             Inc(pSource, AlphaInterleave);
5017             pDest^ := pSource^;
5018             Inc(pDest);
5019             Inc(pSource);
5020           end;
5021         end;
5022       end;
5023       result := true;
5024     end;
5025   end;
5026 end;
5027
5028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5029 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5030 var
5031   bmp: TglBitmap2D;
5032 begin
5033   bmp := TglBitmap2D.Create;
5034   try
5035     bmp.AssignFromSurface(aSurface);
5036     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5037   finally
5038     bmp.Free;
5039   end;
5040 end;
5041 {$ENDIF}
5042
5043 {$IFDEF GLB_DELPHI}
5044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5045 function CreateGrayPalette: HPALETTE;
5046 var
5047   Idx: Integer;
5048   Pal: PLogPalette;
5049 begin
5050   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5051
5052   Pal.palVersion := $300;
5053   Pal.palNumEntries := 256;
5054
5055   for Idx := 0 to Pal.palNumEntries - 1 do begin
5056     Pal.palPalEntry[Idx].peRed   := Idx;
5057     Pal.palPalEntry[Idx].peGreen := Idx;
5058     Pal.palPalEntry[Idx].peBlue  := Idx;
5059     Pal.palPalEntry[Idx].peFlags := 0;
5060   end;
5061   Result := CreatePalette(Pal^);
5062   FreeMem(Pal);
5063 end;
5064
5065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5066 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5067 var
5068   Row: Integer;
5069   pSource, pData: PByte;
5070 begin
5071   result := false;
5072   if Assigned(Data) then begin
5073     if Assigned(aBitmap) then begin
5074       aBitmap.Width  := Width;
5075       aBitmap.Height := Height;
5076
5077       case Format of
5078         tfAlpha8ub1, tfLuminance8ub1: begin
5079           aBitmap.PixelFormat := pf8bit;
5080           aBitmap.Palette     := CreateGrayPalette;
5081         end;
5082         tfRGB5A1us1:
5083           aBitmap.PixelFormat := pf15bit;
5084         tfR5G6B5us1:
5085           aBitmap.PixelFormat := pf16bit;
5086         tfRGB8ub3, tfBGR8ub3:
5087           aBitmap.PixelFormat := pf24bit;
5088         tfRGBA8ub4, tfBGRA8ub4:
5089           aBitmap.PixelFormat := pf32bit;
5090       else
5091         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5092       end;
5093
5094       pSource := Data;
5095       for Row := 0 to FileHeight -1 do begin
5096         pData := aBitmap.Scanline[Row];
5097         Move(pSource^, pData^, fRowSize);
5098         Inc(pSource, fRowSize);
5099         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5100           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5101       end;
5102       result := true;
5103     end;
5104   end;
5105 end;
5106
5107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5108 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5109 var
5110   pSource, pData, pTempData: PByte;
5111   Row, RowSize, TempWidth, TempHeight: Integer;
5112   IntFormat: TglBitmapFormat;
5113 begin
5114   result := false;
5115
5116   if (Assigned(aBitmap)) then begin
5117     case aBitmap.PixelFormat of
5118       pf8bit:
5119         IntFormat := tfLuminance8ub1;
5120       pf15bit:
5121         IntFormat := tfRGB5A1us1;
5122       pf16bit:
5123         IntFormat := tfR5G6B5us1;
5124       pf24bit:
5125         IntFormat := tfBGR8ub3;
5126       pf32bit:
5127         IntFormat := tfBGRA8ub4;
5128     else
5129       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5130     end;
5131
5132     TempWidth  := aBitmap.Width;
5133     TempHeight := aBitmap.Height;
5134     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5135     GetMem(pData, TempHeight * RowSize);
5136     try
5137       pTempData := pData;
5138       for Row := 0 to TempHeight -1 do begin
5139         pSource := aBitmap.Scanline[Row];
5140         if (Assigned(pSource)) then begin
5141           Move(pSource^, pTempData^, RowSize);
5142           Inc(pTempData, RowSize);
5143         end;
5144       end;
5145       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5146       result := true;
5147     except
5148       if Assigned(pData) then
5149         FreeMem(pData);
5150       raise;
5151     end;
5152   end;
5153 end;
5154
5155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5156 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5157 var
5158   Row, Col, AlphaInterleave: Integer;
5159   pSource, pDest: PByte;
5160 begin
5161   result := false;
5162
5163   if Assigned(Data) then begin
5164     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5165       if Assigned(aBitmap) then begin
5166         aBitmap.PixelFormat := pf8bit;
5167         aBitmap.Palette     := CreateGrayPalette;
5168         aBitmap.Width       := Width;
5169         aBitmap.Height      := Height;
5170
5171         case Format of
5172           tfLuminance8Alpha8ub2:
5173             AlphaInterleave := 1;
5174           tfRGBA8ub4, tfBGRA8ub4:
5175             AlphaInterleave := 3;
5176           else
5177             AlphaInterleave := 0;
5178         end;
5179
5180         // Copy Data
5181         pSource := Data;
5182
5183         for Row := 0 to Height -1 do begin
5184           pDest := aBitmap.Scanline[Row];
5185           if Assigned(pDest) then begin
5186             for Col := 0 to Width -1 do begin
5187               Inc(pSource, AlphaInterleave);
5188               pDest^ := pSource^;
5189               Inc(pDest);
5190               Inc(pSource);
5191             end;
5192           end;
5193         end;
5194         result := true;
5195       end;
5196     end;
5197   end;
5198 end;
5199
5200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5201 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5202 var
5203   tex: TglBitmap2D;
5204 begin
5205   tex := TglBitmap2D.Create;
5206   try
5207     tex.AssignFromBitmap(ABitmap);
5208     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5209   finally
5210     tex.Free;
5211   end;
5212 end;
5213 {$ENDIF}
5214
5215 {$IFDEF GLB_LAZARUS}
5216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5217 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5218 var
5219   rid: TRawImageDescription;
5220   FormatDesc: TFormatDescriptor;
5221 begin
5222   if not Assigned(Data) then
5223     raise EglBitmap.Create('no pixel data assigned. load data before save');
5224
5225   result := false;
5226   if not Assigned(aImage) or (Format = tfEmpty) then
5227     exit;
5228   FormatDesc := TFormatDescriptor.Get(Format);
5229   if FormatDesc.IsCompressed then
5230     exit;
5231
5232   FillChar(rid{%H-}, SizeOf(rid), 0);
5233   if FormatDesc.IsGrayscale then
5234     rid.Format := ricfGray
5235   else
5236     rid.Format := ricfRGBA;
5237
5238   rid.Width        := Width;
5239   rid.Height       := Height;
5240   rid.Depth        := FormatDesc.BitsPerPixel;
5241   rid.BitOrder     := riboBitsInOrder;
5242   rid.ByteOrder    := riboLSBFirst;
5243   rid.LineOrder    := riloTopToBottom;
5244   rid.LineEnd      := rileTight;
5245   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5246   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5247   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5248   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5249   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5250   rid.RedShift     := FormatDesc.Shift.r;
5251   rid.GreenShift   := FormatDesc.Shift.g;
5252   rid.BlueShift    := FormatDesc.Shift.b;
5253   rid.AlphaShift   := FormatDesc.Shift.a;
5254
5255   rid.MaskBitsPerPixel  := 0;
5256   rid.PaletteColorCount := 0;
5257
5258   aImage.DataDescription := rid;
5259   aImage.CreateData;
5260
5261   if not Assigned(aImage.PixelData) then
5262     raise EglBitmap.Create('error while creating LazIntfImage');
5263   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5264
5265   result := true;
5266 end;
5267
5268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5269 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5270 var
5271   f: TglBitmapFormat;
5272   FormatDesc: TFormatDescriptor;
5273   ImageData: PByte;
5274   ImageSize: Integer;
5275   CanCopy: Boolean;
5276   Mask: TglBitmapRec4ul;
5277
5278   procedure CopyConvert;
5279   var
5280     bfFormat: TbmpBitfieldFormat;
5281     pSourceLine, pDestLine: PByte;
5282     pSourceMD, pDestMD: Pointer;
5283     Shift, Prec: TglBitmapRec4ub;
5284     x, y: Integer;
5285     pixel: TglBitmapPixelData;
5286   begin
5287     bfFormat  := TbmpBitfieldFormat.Create;
5288     with aImage.DataDescription do begin
5289       Prec.r := RedPrec;
5290       Prec.g := GreenPrec;
5291       Prec.b := BluePrec;
5292       Prec.a := AlphaPrec;
5293       Shift.r := RedShift;
5294       Shift.g := GreenShift;
5295       Shift.b := BlueShift;
5296       Shift.a := AlphaShift;
5297       bfFormat.SetValues(BitsPerPixel, Prec, Shift);
5298     end;
5299     pSourceMD := bfFormat.CreateMappingData;
5300     pDestMD   := FormatDesc.CreateMappingData;
5301     try
5302       for y := 0 to aImage.Height-1 do begin
5303         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5304         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5305         for x := 0 to aImage.Width-1 do begin
5306           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5307           FormatDesc.Map(pixel, pDestLine, pDestMD);
5308         end;
5309       end;
5310     finally
5311       FormatDesc.FreeMappingData(pDestMD);
5312       bfFormat.FreeMappingData(pSourceMD);
5313       bfFormat.Free;
5314     end;
5315   end;
5316
5317 begin
5318   result := false;
5319   if not Assigned(aImage) then
5320     exit;
5321
5322   with aImage.DataDescription do begin
5323     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5324     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5325     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5326     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5327   end;
5328   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5329   f          := FormatDesc.Format;
5330   if (f = tfEmpty) then
5331     exit;
5332
5333   CanCopy :=
5334     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5335     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5336
5337   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5338   ImageData := GetMem(ImageSize);
5339   try
5340     if CanCopy then
5341       Move(aImage.PixelData^, ImageData^, ImageSize)
5342     else
5343       CopyConvert;
5344     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5345   except
5346     if Assigned(ImageData) then
5347       FreeMem(ImageData);
5348     raise;
5349   end;
5350
5351   result := true;
5352 end;
5353
5354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5355 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5356 var
5357   rid: TRawImageDescription;
5358   FormatDesc: TFormatDescriptor;
5359   Pixel: TglBitmapPixelData;
5360   x, y: Integer;
5361   srcMD: Pointer;
5362   src, dst: PByte;
5363 begin
5364   result := false;
5365   if not Assigned(aImage) or (Format = tfEmpty) then
5366     exit;
5367   FormatDesc := TFormatDescriptor.Get(Format);
5368   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5369     exit;
5370
5371   FillChar(rid{%H-}, SizeOf(rid), 0);
5372   rid.Format       := ricfGray;
5373   rid.Width        := Width;
5374   rid.Height       := Height;
5375   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5376   rid.BitOrder     := riboBitsInOrder;
5377   rid.ByteOrder    := riboLSBFirst;
5378   rid.LineOrder    := riloTopToBottom;
5379   rid.LineEnd      := rileTight;
5380   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5381   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5382   rid.GreenPrec    := 0;
5383   rid.BluePrec     := 0;
5384   rid.AlphaPrec    := 0;
5385   rid.RedShift     := 0;
5386   rid.GreenShift   := 0;
5387   rid.BlueShift    := 0;
5388   rid.AlphaShift   := 0;
5389
5390   rid.MaskBitsPerPixel  := 0;
5391   rid.PaletteColorCount := 0;
5392
5393   aImage.DataDescription := rid;
5394   aImage.CreateData;
5395
5396   srcMD := FormatDesc.CreateMappingData;
5397   try
5398     FormatDesc.PreparePixel(Pixel);
5399     src := Data;
5400     dst := aImage.PixelData;
5401     for y := 0 to Height-1 do
5402       for x := 0 to Width-1 do begin
5403         FormatDesc.Unmap(src, Pixel, srcMD);
5404         case rid.BitsPerPixel of
5405            8: begin
5406             dst^ := Pixel.Data.a;
5407             inc(dst);
5408           end;
5409           16: begin
5410             PWord(dst)^ := Pixel.Data.a;
5411             inc(dst, 2);
5412           end;
5413           24: begin
5414             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5415             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5416             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5417             inc(dst, 3);
5418           end;
5419           32: begin
5420             PCardinal(dst)^ := Pixel.Data.a;
5421             inc(dst, 4);
5422           end;
5423         else
5424           raise EglBitmapUnsupportedFormat.Create(Format);
5425         end;
5426       end;
5427   finally
5428     FormatDesc.FreeMappingData(srcMD);
5429   end;
5430   result := true;
5431 end;
5432
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5435 var
5436   tex: TglBitmap2D;
5437 begin
5438   tex := TglBitmap2D.Create;
5439   try
5440     tex.AssignFromLazIntfImage(aImage);
5441     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5442   finally
5443     tex.Free;
5444   end;
5445 end;
5446 {$ENDIF}
5447
5448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5449 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5450   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5451 var
5452   rs: TResourceStream;
5453 begin
5454   PrepareResType(aResource, aResType);
5455   rs := TResourceStream.Create(aInstance, aResource, aResType);
5456   try
5457     result := AddAlphaFromStream(rs, aFunc, aArgs);
5458   finally
5459     rs.Free;
5460   end;
5461 end;
5462
5463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5464 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5465   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5466 var
5467   rs: TResourceStream;
5468 begin
5469   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5470   try
5471     result := AddAlphaFromStream(rs, aFunc, aArgs);
5472   finally
5473     rs.Free;
5474   end;
5475 end;
5476
5477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5478 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5479 begin
5480   if TFormatDescriptor.Get(Format).IsCompressed then
5481     raise EglBitmapUnsupportedFormat.Create(Format);
5482   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5483 end;
5484
5485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5486 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5487 var
5488   FS: TFileStream;
5489 begin
5490   FS := TFileStream.Create(aFileName, fmOpenRead);
5491   try
5492     result := AddAlphaFromStream(FS, aFunc, aArgs);
5493   finally
5494     FS.Free;
5495   end;
5496 end;
5497
5498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5499 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5500 var
5501   tex: TglBitmap2D;
5502 begin
5503   tex := TglBitmap2D.Create(aStream);
5504   try
5505     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5506   finally
5507     tex.Free;
5508   end;
5509 end;
5510
5511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5512 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5513 var
5514   DestData, DestData2, SourceData: pByte;
5515   TempHeight, TempWidth: Integer;
5516   SourceFD, DestFD: TFormatDescriptor;
5517   SourceMD, DestMD, DestMD2: Pointer;
5518
5519   FuncRec: TglBitmapFunctionRec;
5520 begin
5521   result := false;
5522
5523   Assert(Assigned(Data));
5524   Assert(Assigned(aBitmap));
5525   Assert(Assigned(aBitmap.Data));
5526
5527   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5528     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5529
5530     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5531     DestFD   := TFormatDescriptor.Get(Format);
5532
5533     if not Assigned(aFunc) then begin
5534       aFunc        := glBitmapAlphaFunc;
5535       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5536     end else
5537       FuncRec.Args := aArgs;
5538
5539     // Values
5540     TempHeight := aBitmap.FileHeight;
5541     TempWidth  := aBitmap.FileWidth;
5542
5543     FuncRec.Sender          := Self;
5544     FuncRec.Size            := Dimension;
5545     FuncRec.Position.Fields := FuncRec.Size.Fields;
5546
5547     DestData   := Data;
5548     DestData2  := Data;
5549     SourceData := aBitmap.Data;
5550
5551     // Mapping
5552     SourceFD.PreparePixel(FuncRec.Source);
5553     DestFD.PreparePixel  (FuncRec.Dest);
5554
5555     SourceMD := SourceFD.CreateMappingData;
5556     DestMD   := DestFD.CreateMappingData;
5557     DestMD2  := DestFD.CreateMappingData;
5558     try
5559       FuncRec.Position.Y := 0;
5560       while FuncRec.Position.Y < TempHeight do begin
5561         FuncRec.Position.X := 0;
5562         while FuncRec.Position.X < TempWidth do begin
5563           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5564           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5565           aFunc(FuncRec);
5566           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5567           inc(FuncRec.Position.X);
5568         end;
5569         inc(FuncRec.Position.Y);
5570       end;
5571     finally
5572       SourceFD.FreeMappingData(SourceMD);
5573       DestFD.FreeMappingData(DestMD);
5574       DestFD.FreeMappingData(DestMD2);
5575     end;
5576   end;
5577 end;
5578
5579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5580 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5581 begin
5582   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5583 end;
5584
5585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5586 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5587 var
5588   PixelData: TglBitmapPixelData;
5589 begin
5590   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5591   result := AddAlphaFromColorKeyFloat(
5592     aRed   / PixelData.Range.r,
5593     aGreen / PixelData.Range.g,
5594     aBlue  / PixelData.Range.b,
5595     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5596 end;
5597
5598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5599 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5600 var
5601   values: array[0..2] of Single;
5602   tmp: Cardinal;
5603   i: Integer;
5604   PixelData: TglBitmapPixelData;
5605 begin
5606   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5607   with PixelData do begin
5608     values[0] := aRed;
5609     values[1] := aGreen;
5610     values[2] := aBlue;
5611
5612     for i := 0 to 2 do begin
5613       tmp          := Trunc(Range.arr[i] * aDeviation);
5614       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5615       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5616     end;
5617     Data.a  := 0;
5618     Range.a := 0;
5619   end;
5620   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5621 end;
5622
5623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5624 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5625 begin
5626   result := AddAlphaFromValueFloat(aAlpha / $FF);
5627 end;
5628
5629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5630 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5631 var
5632   PixelData: TglBitmapPixelData;
5633 begin
5634   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5635   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5636 end;
5637
5638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5639 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5640 var
5641   PixelData: TglBitmapPixelData;
5642 begin
5643   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5644   with PixelData do
5645     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5646   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5647 end;
5648
5649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5650 function TglBitmap.RemoveAlpha: Boolean;
5651 var
5652   FormatDesc: TFormatDescriptor;
5653 begin
5654   result := false;
5655   FormatDesc := TFormatDescriptor.Get(Format);
5656   if Assigned(Data) then begin
5657     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5658       raise EglBitmapUnsupportedFormat.Create(Format);
5659     result := ConvertTo(FormatDesc.WithoutAlpha);
5660   end;
5661 end;
5662
5663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5664 function TglBitmap.Clone: TglBitmap;
5665 var
5666   Temp: TglBitmap;
5667   TempPtr: PByte;
5668   Size: Integer;
5669 begin
5670   result := nil;
5671   Temp := (ClassType.Create as TglBitmap);
5672   try
5673     // copy texture data if assigned
5674     if Assigned(Data) then begin
5675       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5676       GetMem(TempPtr, Size);
5677       try
5678         Move(Data^, TempPtr^, Size);
5679         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5680       except
5681         if Assigned(TempPtr) then
5682           FreeMem(TempPtr);
5683         raise;
5684       end;
5685     end else begin
5686       TempPtr := nil;
5687       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5688     end;
5689
5690         // copy properties
5691     Temp.fID                      := ID;
5692     Temp.fTarget                  := Target;
5693     Temp.fFormat                  := Format;
5694     Temp.fMipMap                  := MipMap;
5695     Temp.fAnisotropic             := Anisotropic;
5696     Temp.fBorderColor             := fBorderColor;
5697     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5698     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5699     Temp.fFilterMin               := fFilterMin;
5700     Temp.fFilterMag               := fFilterMag;
5701     Temp.fWrapS                   := fWrapS;
5702     Temp.fWrapT                   := fWrapT;
5703     Temp.fWrapR                   := fWrapR;
5704     Temp.fFilename                := fFilename;
5705     Temp.fCustomName              := fCustomName;
5706     Temp.fCustomNameW             := fCustomNameW;
5707     Temp.fCustomData              := fCustomData;
5708
5709     result := Temp;
5710   except
5711     FreeAndNil(Temp);
5712     raise;
5713   end;
5714 end;
5715
5716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5717 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5718 var
5719   SourceFD, DestFD: TFormatDescriptor;
5720   SourcePD, DestPD: TglBitmapPixelData;
5721   ShiftData: TShiftData;
5722
5723   function DataIsIdentical: Boolean;
5724   begin
5725     result := SourceFD.MaskMatch(DestFD.Mask);
5726   end;
5727
5728   function CanCopyDirect: Boolean;
5729   begin
5730     result :=
5731       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5732       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5733       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5734       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5735   end;
5736
5737   function CanShift: Boolean;
5738   begin
5739     result :=
5740       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5741       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5742       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5743       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5744   end;
5745
5746   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5747   begin
5748     result := 0;
5749     while (aSource > aDest) and (aSource > 0) do begin
5750       inc(result);
5751       aSource := aSource shr 1;
5752     end;
5753   end;
5754
5755 begin
5756   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5757     SourceFD := TFormatDescriptor.Get(Format);
5758     DestFD   := TFormatDescriptor.Get(aFormat);
5759
5760     if DataIsIdentical then begin
5761       result := true;
5762       Format := aFormat;
5763       exit;
5764     end;
5765
5766     SourceFD.PreparePixel(SourcePD);
5767     DestFD.PreparePixel  (DestPD);
5768
5769     if CanCopyDirect then
5770       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5771     else if CanShift then begin
5772       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5773       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5774       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5775       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5776       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5777     end else
5778       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5779   end else
5780     result := true;
5781 end;
5782
5783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5784 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5785 begin
5786   if aUseRGB or aUseAlpha then
5787     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5788       ((Byte(aUseAlpha) and 1) shl 1) or
5789        (Byte(aUseRGB)   and 1)      ));
5790 end;
5791
5792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5793 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5794 begin
5795   fBorderColor[0] := aRed;
5796   fBorderColor[1] := aGreen;
5797   fBorderColor[2] := aBlue;
5798   fBorderColor[3] := aAlpha;
5799   if (ID > 0) then begin
5800     Bind(false);
5801     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5802   end;
5803 end;
5804
5805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5806 procedure TglBitmap.FreeData;
5807 var
5808   TempPtr: PByte;
5809 begin
5810   TempPtr := nil;
5811   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5812 end;
5813
5814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5815 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5816   const aAlpha: Byte);
5817 begin
5818   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5819 end;
5820
5821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5822 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5823 var
5824   PixelData: TglBitmapPixelData;
5825 begin
5826   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5827   FillWithColorFloat(
5828     aRed   / PixelData.Range.r,
5829     aGreen / PixelData.Range.g,
5830     aBlue  / PixelData.Range.b,
5831     aAlpha / PixelData.Range.a);
5832 end;
5833
5834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5835 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5836 var
5837   PixelData: TglBitmapPixelData;
5838 begin
5839   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5840   with PixelData do begin
5841     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5842     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5843     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5844     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5845   end;
5846   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5847 end;
5848
5849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5850 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5851 begin
5852   //check MIN filter
5853   case aMin of
5854     GL_NEAREST:
5855       fFilterMin := GL_NEAREST;
5856     GL_LINEAR:
5857       fFilterMin := GL_LINEAR;
5858     GL_NEAREST_MIPMAP_NEAREST:
5859       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5860     GL_LINEAR_MIPMAP_NEAREST:
5861       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5862     GL_NEAREST_MIPMAP_LINEAR:
5863       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5864     GL_LINEAR_MIPMAP_LINEAR:
5865       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5866     else
5867       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5868   end;
5869
5870   //check MAG filter
5871   case aMag of
5872     GL_NEAREST:
5873       fFilterMag := GL_NEAREST;
5874     GL_LINEAR:
5875       fFilterMag := GL_LINEAR;
5876     else
5877       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5878   end;
5879
5880   //apply filter
5881   if (ID > 0) then begin
5882     Bind(false);
5883     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5884
5885     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5886       case fFilterMin of
5887         GL_NEAREST, GL_LINEAR:
5888           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5889         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5890           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5891         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5892           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5893       end;
5894     end else
5895       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5896   end;
5897 end;
5898
5899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5900 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5901
5902   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5903   begin
5904     case aValue of
5905       GL_CLAMP:
5906         aTarget := GL_CLAMP;
5907
5908       GL_REPEAT:
5909         aTarget := GL_REPEAT;
5910
5911       GL_CLAMP_TO_EDGE: begin
5912         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5913           aTarget := GL_CLAMP_TO_EDGE
5914         else
5915           aTarget := GL_CLAMP;
5916       end;
5917
5918       GL_CLAMP_TO_BORDER: begin
5919         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5920           aTarget := GL_CLAMP_TO_BORDER
5921         else
5922           aTarget := GL_CLAMP;
5923       end;
5924
5925       GL_MIRRORED_REPEAT: begin
5926         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5927           aTarget := GL_MIRRORED_REPEAT
5928         else
5929           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5930       end;
5931     else
5932       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5933     end;
5934   end;
5935
5936 begin
5937   CheckAndSetWrap(S, fWrapS);
5938   CheckAndSetWrap(T, fWrapT);
5939   CheckAndSetWrap(R, fWrapR);
5940
5941   if (ID > 0) then begin
5942     Bind(false);
5943     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5944     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5945     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5946   end;
5947 end;
5948
5949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5950 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5951
5952   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5953   begin
5954     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5955        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5956       fSwizzle[aIndex] := aValue
5957     else
5958       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5959   end;
5960
5961 begin
5962   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5963     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5964   CheckAndSetValue(r, 0);
5965   CheckAndSetValue(g, 1);
5966   CheckAndSetValue(b, 2);
5967   CheckAndSetValue(a, 3);
5968
5969   if (ID > 0) then begin
5970     Bind(false);
5971     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5972   end;
5973 end;
5974
5975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5976 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5977 begin
5978   if aEnableTextureUnit then
5979     glEnable(Target);
5980   if (ID > 0) then
5981     glBindTexture(Target, ID);
5982 end;
5983
5984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5985 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5986 begin
5987   if aDisableTextureUnit then
5988     glDisable(Target);
5989   glBindTexture(Target, 0);
5990 end;
5991
5992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5993 constructor TglBitmap.Create;
5994 begin
5995   if (ClassType = TglBitmap) then
5996     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5997 {$IFDEF GLB_NATIVE_OGL}
5998   glbReadOpenGLExtensions;
5999 {$ENDIF}
6000   inherited Create;
6001   fFormat            := glBitmapGetDefaultFormat;
6002   fFreeDataOnDestroy := true;
6003 end;
6004
6005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6006 constructor TglBitmap.Create(const aFileName: String);
6007 begin
6008   Create;
6009   LoadFromFile(aFileName);
6010 end;
6011
6012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6013 constructor TglBitmap.Create(const aStream: TStream);
6014 begin
6015   Create;
6016   LoadFromStream(aStream);
6017 end;
6018
6019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6020 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6021 var
6022   ImageSize: Integer;
6023 begin
6024   Create;
6025   if not Assigned(aData) then begin
6026     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6027     GetMem(aData, ImageSize);
6028     try
6029       FillChar(aData^, ImageSize, #$FF);
6030       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6031     except
6032       if Assigned(aData) then
6033         FreeMem(aData);
6034       raise;
6035     end;
6036   end else begin
6037     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6038     fFreeDataOnDestroy := false;
6039   end;
6040 end;
6041
6042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6043 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6044 begin
6045   Create;
6046   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6047 end;
6048
6049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6050 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6051 begin
6052   Create;
6053   LoadFromResource(aInstance, aResource, aResType);
6054 end;
6055
6056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6057 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6058 begin
6059   Create;
6060   LoadFromResourceID(aInstance, aResourceID, aResType);
6061 end;
6062
6063 {$IFDEF GLB_SUPPORT_PNG_READ}
6064 {$IF DEFINED(GLB_LAZ_PNG)}
6065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6066 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6068 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6069 const
6070   MAGIC_LEN = 8;
6071   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6072 var
6073   reader: TLazReaderPNG;
6074   intf: TLazIntfImage;
6075   StreamPos: Int64;
6076   magic: String[MAGIC_LEN];
6077 begin
6078   result := true;
6079   StreamPos := aStream.Position;
6080
6081   SetLength(magic, MAGIC_LEN);
6082   aStream.Read(magic[1], MAGIC_LEN);
6083   aStream.Position := StreamPos;
6084   if (magic <> PNG_MAGIC) then begin
6085     result := false;
6086     exit;
6087   end;
6088
6089   intf   := TLazIntfImage.Create(0, 0);
6090   reader := TLazReaderPNG.Create;
6091   try try
6092     reader.UpdateDescription := true;
6093     reader.ImageRead(aStream, intf);
6094     AssignFromLazIntfImage(intf);
6095   except
6096     result := false;
6097     aStream.Position := StreamPos;
6098     exit;
6099   end;
6100   finally
6101     reader.Free;
6102     intf.Free;
6103   end;
6104 end;
6105
6106 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6108 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6109 var
6110   Surface: PSDL_Surface;
6111   RWops: PSDL_RWops;
6112 begin
6113   result := false;
6114   RWops := glBitmapCreateRWops(aStream);
6115   try
6116     if IMG_isPNG(RWops) > 0 then begin
6117       Surface := IMG_LoadPNG_RW(RWops);
6118       try
6119         AssignFromSurface(Surface);
6120         result := true;
6121       finally
6122         SDL_FreeSurface(Surface);
6123       end;
6124     end;
6125   finally
6126     SDL_FreeRW(RWops);
6127   end;
6128 end;
6129
6130 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6132 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6133 begin
6134   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6135 end;
6136
6137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6138 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6139 var
6140   StreamPos: Int64;
6141   signature: array [0..7] of byte;
6142   png: png_structp;
6143   png_info: png_infop;
6144
6145   TempHeight, TempWidth: Integer;
6146   Format: TglBitmapFormat;
6147
6148   png_data: pByte;
6149   png_rows: array of pByte;
6150   Row, LineSize: Integer;
6151 begin
6152   result := false;
6153
6154   if not init_libPNG then
6155     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6156
6157   try
6158     // signature
6159     StreamPos := aStream.Position;
6160     aStream.Read(signature{%H-}, 8);
6161     aStream.Position := StreamPos;
6162
6163     if png_check_sig(@signature, 8) <> 0 then begin
6164       // png read struct
6165       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6166       if png = nil then
6167         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6168
6169       // png info
6170       png_info := png_create_info_struct(png);
6171       if png_info = nil then begin
6172         png_destroy_read_struct(@png, nil, nil);
6173         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6174       end;
6175
6176       // set read callback
6177       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6178
6179       // read informations
6180       png_read_info(png, png_info);
6181
6182       // size
6183       TempHeight := png_get_image_height(png, png_info);
6184       TempWidth := png_get_image_width(png, png_info);
6185
6186       // format
6187       case png_get_color_type(png, png_info) of
6188         PNG_COLOR_TYPE_GRAY:
6189           Format := tfLuminance8ub1;
6190         PNG_COLOR_TYPE_GRAY_ALPHA:
6191           Format := tfLuminance8Alpha8us1;
6192         PNG_COLOR_TYPE_RGB:
6193           Format := tfRGB8ub3;
6194         PNG_COLOR_TYPE_RGB_ALPHA:
6195           Format := tfRGBA8ub4;
6196         else
6197           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6198       end;
6199
6200       // cut upper 8 bit from 16 bit formats
6201       if png_get_bit_depth(png, png_info) > 8 then
6202         png_set_strip_16(png);
6203
6204       // expand bitdepth smaller than 8
6205       if png_get_bit_depth(png, png_info) < 8 then
6206         png_set_expand(png);
6207
6208       // allocating mem for scanlines
6209       LineSize := png_get_rowbytes(png, png_info);
6210       GetMem(png_data, TempHeight * LineSize);
6211       try
6212         SetLength(png_rows, TempHeight);
6213         for Row := Low(png_rows) to High(png_rows) do begin
6214           png_rows[Row] := png_data;
6215           Inc(png_rows[Row], Row * LineSize);
6216         end;
6217
6218         // read complete image into scanlines
6219         png_read_image(png, @png_rows[0]);
6220
6221         // read end
6222         png_read_end(png, png_info);
6223
6224         // destroy read struct
6225         png_destroy_read_struct(@png, @png_info, nil);
6226
6227         SetLength(png_rows, 0);
6228
6229         // set new data
6230         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6231
6232         result := true;
6233       except
6234         if Assigned(png_data) then
6235           FreeMem(png_data);
6236         raise;
6237       end;
6238     end;
6239   finally
6240     quit_libPNG;
6241   end;
6242 end;
6243
6244 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6245 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6246 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6247 var
6248   StreamPos: Int64;
6249   Png: TPNGObject;
6250   Header: String[8];
6251   Row, Col, PixSize, LineSize: Integer;
6252   NewImage, pSource, pDest, pAlpha: pByte;
6253   PngFormat: TglBitmapFormat;
6254   FormatDesc: TFormatDescriptor;
6255
6256 const
6257   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6258
6259 begin
6260   result := false;
6261
6262   StreamPos := aStream.Position;
6263   aStream.Read(Header[0], SizeOf(Header));
6264   aStream.Position := StreamPos;
6265
6266   {Test if the header matches}
6267   if Header = PngHeader then begin
6268     Png := TPNGObject.Create;
6269     try
6270       Png.LoadFromStream(aStream);
6271
6272       case Png.Header.ColorType of
6273         COLOR_GRAYSCALE:
6274           PngFormat := tfLuminance8ub1;
6275         COLOR_GRAYSCALEALPHA:
6276           PngFormat := tfLuminance8Alpha8us1;
6277         COLOR_RGB:
6278           PngFormat := tfBGR8ub3;
6279         COLOR_RGBALPHA:
6280           PngFormat := tfBGRA8ub4;
6281         else
6282           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6283       end;
6284
6285       FormatDesc := TFormatDescriptor.Get(PngFormat);
6286       PixSize    := Round(FormatDesc.PixelSize);
6287       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6288
6289       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6290       try
6291         pDest := NewImage;
6292
6293         case Png.Header.ColorType of
6294           COLOR_RGB, COLOR_GRAYSCALE:
6295             begin
6296               for Row := 0 to Png.Height -1 do begin
6297                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6298                 Inc(pDest, LineSize);
6299               end;
6300             end;
6301           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6302             begin
6303               PixSize := PixSize -1;
6304
6305               for Row := 0 to Png.Height -1 do begin
6306                 pSource := Png.Scanline[Row];
6307                 pAlpha := pByte(Png.AlphaScanline[Row]);
6308
6309                 for Col := 0 to Png.Width -1 do begin
6310                   Move (pSource^, pDest^, PixSize);
6311                   Inc(pSource, PixSize);
6312                   Inc(pDest, PixSize);
6313
6314                   pDest^ := pAlpha^;
6315                   inc(pAlpha);
6316                   Inc(pDest);
6317                 end;
6318               end;
6319             end;
6320           else
6321             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6322         end;
6323
6324         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6325
6326         result := true;
6327       except
6328         if Assigned(NewImage) then
6329           FreeMem(NewImage);
6330         raise;
6331       end;
6332     finally
6333       Png.Free;
6334     end;
6335   end;
6336 end;
6337 {$IFEND}
6338 {$ENDIF}
6339
6340 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6341 {$IFDEF GLB_LIB_PNG}
6342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6343 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6344 begin
6345   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6346 end;
6347 {$ENDIF}
6348
6349 {$IF DEFINED(GLB_LAZ_PNG)}
6350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6351 procedure TglBitmap.SavePNG(const aStream: TStream);
6352 var
6353   png: TPortableNetworkGraphic;
6354   intf: TLazIntfImage;
6355   raw: TRawImage;
6356 begin
6357   png  := TPortableNetworkGraphic.Create;
6358   intf := TLazIntfImage.Create(0, 0);
6359   try
6360     if not AssignToLazIntfImage(intf) then
6361       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6362     intf.GetRawImage(raw);
6363     png.LoadFromRawImage(raw, false);
6364     png.SaveToStream(aStream);
6365   finally
6366     png.Free;
6367     intf.Free;
6368   end;
6369 end;
6370
6371 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6373 procedure TglBitmap.SavePNG(const aStream: TStream);
6374 var
6375   png: png_structp;
6376   png_info: png_infop;
6377   png_rows: array of pByte;
6378   LineSize: Integer;
6379   ColorType: Integer;
6380   Row: Integer;
6381   FormatDesc: TFormatDescriptor;
6382 begin
6383   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6384     raise EglBitmapUnsupportedFormat.Create(Format);
6385
6386   if not init_libPNG then
6387     raise Exception.Create('unable to initialize libPNG.');
6388
6389   try
6390     case Format of
6391       tfAlpha8ub1, tfLuminance8ub1:
6392         ColorType := PNG_COLOR_TYPE_GRAY;
6393       tfLuminance8Alpha8us1:
6394         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6395       tfBGR8ub3, tfRGB8ub3:
6396         ColorType := PNG_COLOR_TYPE_RGB;
6397       tfBGRA8ub4, tfRGBA8ub4:
6398         ColorType := PNG_COLOR_TYPE_RGBA;
6399       else
6400         raise EglBitmapUnsupportedFormat.Create(Format);
6401     end;
6402
6403     FormatDesc := TFormatDescriptor.Get(Format);
6404     LineSize := FormatDesc.GetSize(Width, 1);
6405
6406     // creating array for scanline
6407     SetLength(png_rows, Height);
6408     try
6409       for Row := 0 to Height - 1 do begin
6410         png_rows[Row] := Data;
6411         Inc(png_rows[Row], Row * LineSize)
6412       end;
6413
6414       // write struct
6415       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6416       if png = nil then
6417         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6418
6419       // create png info
6420       png_info := png_create_info_struct(png);
6421       if png_info = nil then begin
6422         png_destroy_write_struct(@png, nil);
6423         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6424       end;
6425
6426       // set read callback
6427       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6428
6429       // set compression
6430       png_set_compression_level(png, 6);
6431
6432       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6433         png_set_bgr(png);
6434
6435       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6436       png_write_info(png, png_info);
6437       png_write_image(png, @png_rows[0]);
6438       png_write_end(png, png_info);
6439       png_destroy_write_struct(@png, @png_info);
6440     finally
6441       SetLength(png_rows, 0);
6442     end;
6443   finally
6444     quit_libPNG;
6445   end;
6446 end;
6447
6448 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6450 procedure TglBitmap.SavePNG(const aStream: TStream);
6451 var
6452   Png: TPNGObject;
6453
6454   pSource, pDest: pByte;
6455   X, Y, PixSize: Integer;
6456   ColorType: Cardinal;
6457   Alpha: Boolean;
6458
6459   pTemp: pByte;
6460   Temp: Byte;
6461 begin
6462   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6463     raise EglBitmapUnsupportedFormat.Create(Format);
6464
6465   case Format of
6466     tfAlpha8ub1, tfLuminance8ub1: begin
6467       ColorType := COLOR_GRAYSCALE;
6468       PixSize   := 1;
6469       Alpha     := false;
6470     end;
6471     tfLuminance8Alpha8us1: begin
6472       ColorType := COLOR_GRAYSCALEALPHA;
6473       PixSize   := 1;
6474       Alpha     := true;
6475     end;
6476     tfBGR8ub3, tfRGB8ub3: begin
6477       ColorType := COLOR_RGB;
6478       PixSize   := 3;
6479       Alpha     := false;
6480     end;
6481     tfBGRA8ub4, tfRGBA8ub4: begin
6482       ColorType := COLOR_RGBALPHA;
6483       PixSize   := 3;
6484       Alpha     := true
6485     end;
6486   else
6487     raise EglBitmapUnsupportedFormat.Create(Format);
6488   end;
6489
6490   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6491   try
6492     // Copy ImageData
6493     pSource := Data;
6494     for Y := 0 to Height -1 do begin
6495       pDest := png.ScanLine[Y];
6496       for X := 0 to Width -1 do begin
6497         Move(pSource^, pDest^, PixSize);
6498         Inc(pDest, PixSize);
6499         Inc(pSource, PixSize);
6500         if Alpha then begin
6501           png.AlphaScanline[Y]^[X] := pSource^;
6502           Inc(pSource);
6503         end;
6504       end;
6505
6506       // convert RGB line to BGR
6507       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6508         pTemp := png.ScanLine[Y];
6509         for X := 0 to Width -1 do begin
6510           Temp := pByteArray(pTemp)^[0];
6511           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6512           pByteArray(pTemp)^[2] := Temp;
6513           Inc(pTemp, 3);
6514         end;
6515       end;
6516     end;
6517
6518     // Save to Stream
6519     Png.CompressionLevel := 6;
6520     Png.SaveToStream(aStream);
6521   finally
6522     FreeAndNil(Png);
6523   end;
6524 end;
6525 {$IFEND}
6526 {$ENDIF}
6527
6528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6529 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6531 {$IFDEF GLB_LIB_JPEG}
6532 type
6533   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6534   glBitmap_libJPEG_source_mgr = record
6535     pub: jpeg_source_mgr;
6536
6537     SrcStream: TStream;
6538     SrcBuffer: array [1..4096] of byte;
6539   end;
6540
6541   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6542   glBitmap_libJPEG_dest_mgr = record
6543     pub: jpeg_destination_mgr;
6544
6545     DestStream: TStream;
6546     DestBuffer: array [1..4096] of byte;
6547   end;
6548
6549 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6550 begin
6551   //DUMMY
6552 end;
6553
6554
6555 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6556 begin
6557   //DUMMY
6558 end;
6559
6560
6561 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6562 begin
6563   //DUMMY
6564 end;
6565
6566 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6567 begin
6568   //DUMMY
6569 end;
6570
6571
6572 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6573 begin
6574   //DUMMY
6575 end;
6576
6577
6578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6579 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6580 var
6581   src: glBitmap_libJPEG_source_mgr_ptr;
6582   bytes: integer;
6583 begin
6584   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6585
6586   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6587         if (bytes <= 0) then begin
6588                 src^.SrcBuffer[1] := $FF;
6589                 src^.SrcBuffer[2] := JPEG_EOI;
6590                 bytes := 2;
6591         end;
6592
6593         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6594         src^.pub.bytes_in_buffer := bytes;
6595
6596   result := true;
6597 end;
6598
6599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6600 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6601 var
6602   src: glBitmap_libJPEG_source_mgr_ptr;
6603 begin
6604   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6605
6606   if num_bytes > 0 then begin
6607     // wanted byte isn't in buffer so set stream position and read buffer
6608     if num_bytes > src^.pub.bytes_in_buffer then begin
6609       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6610       src^.pub.fill_input_buffer(cinfo);
6611     end else begin
6612       // wanted byte is in buffer so only skip
6613                 inc(src^.pub.next_input_byte, num_bytes);
6614                 dec(src^.pub.bytes_in_buffer, num_bytes);
6615     end;
6616   end;
6617 end;
6618
6619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6620 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6621 var
6622   dest: glBitmap_libJPEG_dest_mgr_ptr;
6623 begin
6624   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6625
6626   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6627     // write complete buffer
6628     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6629
6630     // reset buffer
6631     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6632     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6633   end;
6634
6635   result := true;
6636 end;
6637
6638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6639 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6640 var
6641   Idx: Integer;
6642   dest: glBitmap_libJPEG_dest_mgr_ptr;
6643 begin
6644   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6645
6646   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6647     // check for endblock
6648     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6649       // write endblock
6650       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6651
6652       // leave
6653       break;
6654     end else
6655       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6656   end;
6657 end;
6658 {$ENDIF}
6659
6660 {$IFDEF GLB_SUPPORT_JPEG_READ}
6661 {$IF DEFINED(GLB_LAZ_JPEG)}
6662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6663 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6664 const
6665   MAGIC_LEN = 2;
6666   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6667 var
6668   intf: TLazIntfImage;
6669   reader: TFPReaderJPEG;
6670   StreamPos: Int64;
6671   magic: String[MAGIC_LEN];
6672 begin
6673   result := true;
6674   StreamPos := aStream.Position;
6675
6676   SetLength(magic, MAGIC_LEN);
6677   aStream.Read(magic[1], MAGIC_LEN);
6678   aStream.Position := StreamPos;
6679   if (magic <> JPEG_MAGIC) then begin
6680     result := false;
6681     exit;
6682   end;
6683
6684   reader := TFPReaderJPEG.Create;
6685   intf := TLazIntfImage.Create(0, 0);
6686   try try
6687     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6688     reader.ImageRead(aStream, intf);
6689     AssignFromLazIntfImage(intf);
6690   except
6691     result := false;
6692     aStream.Position := StreamPos;
6693     exit;
6694   end;
6695   finally
6696     reader.Free;
6697     intf.Free;
6698   end;
6699 end;
6700
6701 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6703 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6704 var
6705   Surface: PSDL_Surface;
6706   RWops: PSDL_RWops;
6707 begin
6708   result := false;
6709
6710   RWops := glBitmapCreateRWops(aStream);
6711   try
6712     if IMG_isJPG(RWops) > 0 then begin
6713       Surface := IMG_LoadJPG_RW(RWops);
6714       try
6715         AssignFromSurface(Surface);
6716         result := true;
6717       finally
6718         SDL_FreeSurface(Surface);
6719       end;
6720     end;
6721   finally
6722     SDL_FreeRW(RWops);
6723   end;
6724 end;
6725
6726 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6728 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6729 var
6730   StreamPos: Int64;
6731   Temp: array[0..1]of Byte;
6732
6733   jpeg: jpeg_decompress_struct;
6734   jpeg_err: jpeg_error_mgr;
6735
6736   IntFormat: TglBitmapFormat;
6737   pImage: pByte;
6738   TempHeight, TempWidth: Integer;
6739
6740   pTemp: pByte;
6741   Row: Integer;
6742
6743   FormatDesc: TFormatDescriptor;
6744 begin
6745   result := false;
6746
6747   if not init_libJPEG then
6748     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6749
6750   try
6751     // reading first two bytes to test file and set cursor back to begin
6752     StreamPos := aStream.Position;
6753     aStream.Read({%H-}Temp[0], 2);
6754     aStream.Position := StreamPos;
6755
6756     // if Bitmap then read file.
6757     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6758       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6759       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6760
6761       // error managment
6762       jpeg.err := jpeg_std_error(@jpeg_err);
6763       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6764       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6765
6766       // decompression struct
6767       jpeg_create_decompress(@jpeg);
6768
6769       // allocation space for streaming methods
6770       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6771
6772       // seeting up custom functions
6773       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6774         pub.init_source       := glBitmap_libJPEG_init_source;
6775         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6776         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6777         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6778         pub.term_source       := glBitmap_libJPEG_term_source;
6779
6780         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6781         pub.next_input_byte := nil;   // until buffer loaded
6782
6783         SrcStream := aStream;
6784       end;
6785
6786       // set global decoding state
6787       jpeg.global_state := DSTATE_START;
6788
6789       // read header of jpeg
6790       jpeg_read_header(@jpeg, false);
6791
6792       // setting output parameter
6793       case jpeg.jpeg_color_space of
6794         JCS_GRAYSCALE:
6795           begin
6796             jpeg.out_color_space := JCS_GRAYSCALE;
6797             IntFormat := tfLuminance8ub1;
6798           end;
6799         else
6800           jpeg.out_color_space := JCS_RGB;
6801           IntFormat := tfRGB8ub3;
6802       end;
6803
6804       // reading image
6805       jpeg_start_decompress(@jpeg);
6806
6807       TempHeight := jpeg.output_height;
6808       TempWidth := jpeg.output_width;
6809
6810       FormatDesc := TFormatDescriptor.Get(IntFormat);
6811
6812       // creating new image
6813       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6814       try
6815         pTemp := pImage;
6816
6817         for Row := 0 to TempHeight -1 do begin
6818           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6819           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6820         end;
6821
6822         // finish decompression
6823         jpeg_finish_decompress(@jpeg);
6824
6825         // destroy decompression
6826         jpeg_destroy_decompress(@jpeg);
6827
6828         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6829
6830         result := true;
6831       except
6832         if Assigned(pImage) then
6833           FreeMem(pImage);
6834         raise;
6835       end;
6836     end;
6837   finally
6838     quit_libJPEG;
6839   end;
6840 end;
6841
6842 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6844 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6845 var
6846   bmp: TBitmap;
6847   jpg: TJPEGImage;
6848   StreamPos: Int64;
6849   Temp: array[0..1]of Byte;
6850 begin
6851   result := false;
6852
6853   // reading first two bytes to test file and set cursor back to begin
6854   StreamPos := aStream.Position;
6855   aStream.Read(Temp[0], 2);
6856   aStream.Position := StreamPos;
6857
6858   // if Bitmap then read file.
6859   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6860     bmp := TBitmap.Create;
6861     try
6862       jpg := TJPEGImage.Create;
6863       try
6864         jpg.LoadFromStream(aStream);
6865         bmp.Assign(jpg);
6866         result := AssignFromBitmap(bmp);
6867       finally
6868         jpg.Free;
6869       end;
6870     finally
6871       bmp.Free;
6872     end;
6873   end;
6874 end;
6875 {$IFEND}
6876 {$ENDIF}
6877
6878 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6879 {$IF DEFINED(GLB_LAZ_JPEG)}
6880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6881 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6882 var
6883   jpeg: TJPEGImage;
6884   intf: TLazIntfImage;
6885   raw: TRawImage;
6886 begin
6887   jpeg := TJPEGImage.Create;
6888   intf := TLazIntfImage.Create(0, 0);
6889   try
6890     if not AssignToLazIntfImage(intf) then
6891       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6892     intf.GetRawImage(raw);
6893     jpeg.LoadFromRawImage(raw, false);
6894     jpeg.SaveToStream(aStream);
6895   finally
6896     intf.Free;
6897     jpeg.Free;
6898   end;
6899 end;
6900
6901 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6903 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6904 var
6905   jpeg: jpeg_compress_struct;
6906   jpeg_err: jpeg_error_mgr;
6907   Row: Integer;
6908   pTemp, pTemp2: pByte;
6909
6910   procedure CopyRow(pDest, pSource: pByte);
6911   var
6912     X: Integer;
6913   begin
6914     for X := 0 to Width - 1 do begin
6915       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6916       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6917       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6918       Inc(pDest, 3);
6919       Inc(pSource, 3);
6920     end;
6921   end;
6922
6923 begin
6924   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6925     raise EglBitmapUnsupportedFormat.Create(Format);
6926
6927   if not init_libJPEG then
6928     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6929
6930   try
6931     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6932     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6933
6934     // error managment
6935     jpeg.err := jpeg_std_error(@jpeg_err);
6936     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6937     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6938
6939     // compression struct
6940     jpeg_create_compress(@jpeg);
6941
6942     // allocation space for streaming methods
6943     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6944
6945     // seeting up custom functions
6946     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6947       pub.init_destination    := glBitmap_libJPEG_init_destination;
6948       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6949       pub.term_destination    := glBitmap_libJPEG_term_destination;
6950
6951       pub.next_output_byte  := @DestBuffer[1];
6952       pub.free_in_buffer    := Length(DestBuffer);
6953
6954       DestStream := aStream;
6955     end;
6956
6957     // very important state
6958     jpeg.global_state := CSTATE_START;
6959     jpeg.image_width  := Width;
6960     jpeg.image_height := Height;
6961     case Format of
6962       tfAlpha8ub1, tfLuminance8ub1: begin
6963         jpeg.input_components := 1;
6964         jpeg.in_color_space   := JCS_GRAYSCALE;
6965       end;
6966       tfRGB8ub3, tfBGR8ub3: begin
6967         jpeg.input_components := 3;
6968         jpeg.in_color_space   := JCS_RGB;
6969       end;
6970     end;
6971
6972     jpeg_set_defaults(@jpeg);
6973     jpeg_set_quality(@jpeg, 95, true);
6974     jpeg_start_compress(@jpeg, true);
6975     pTemp := Data;
6976
6977     if Format = tfBGR8ub3 then
6978       GetMem(pTemp2, fRowSize)
6979     else
6980       pTemp2 := pTemp;
6981
6982     try
6983       for Row := 0 to jpeg.image_height -1 do begin
6984         // prepare row
6985         if Format = tfBGR8ub3 then
6986           CopyRow(pTemp2, pTemp)
6987         else
6988           pTemp2 := pTemp;
6989
6990         // write row
6991         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6992         inc(pTemp, fRowSize);
6993       end;
6994     finally
6995       // free memory
6996       if Format = tfBGR8ub3 then
6997         FreeMem(pTemp2);
6998     end;
6999     jpeg_finish_compress(@jpeg);
7000     jpeg_destroy_compress(@jpeg);
7001   finally
7002     quit_libJPEG;
7003   end;
7004 end;
7005
7006 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7008 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7009 var
7010   Bmp: TBitmap;
7011   Jpg: TJPEGImage;
7012 begin
7013   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7014     raise EglBitmapUnsupportedFormat.Create(Format);
7015
7016   Bmp := TBitmap.Create;
7017   try
7018     Jpg := TJPEGImage.Create;
7019     try
7020       AssignToBitmap(Bmp);
7021       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7022         Jpg.Grayscale   := true;
7023         Jpg.PixelFormat := jf8Bit;
7024       end;
7025       Jpg.Assign(Bmp);
7026       Jpg.SaveToStream(aStream);
7027     finally
7028       FreeAndNil(Jpg);
7029     end;
7030   finally
7031     FreeAndNil(Bmp);
7032   end;
7033 end;
7034 {$IFEND}
7035 {$ENDIF}
7036
7037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7038 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7040 type
7041   RawHeader = packed record
7042     Magic:        String[5];
7043     Version:      Byte;
7044     Width:        Integer;
7045     Height:       Integer;
7046     DataSize:     Integer;
7047     BitsPerPixel: Integer;
7048     Precision:    TglBitmapRec4ub;
7049     Shift:        TglBitmapRec4ub;
7050   end;
7051
7052 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7053 var
7054   header: RawHeader;
7055   StartPos: Int64;
7056   fd: TFormatDescriptor;
7057   buf: PByte;
7058 begin
7059   result := false;
7060   StartPos := aStream.Position;
7061   aStream.Read(header{%H-}, SizeOf(header));
7062   if (header.Magic <> 'glBMP') then begin
7063     aStream.Position := StartPos;
7064     exit;
7065   end;
7066
7067   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7068   if (fd.Format = tfEmpty) then
7069     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7070
7071   buf := GetMem(header.DataSize);
7072   aStream.Read(buf^, header.DataSize);
7073   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7074
7075   result := true;
7076 end;
7077
7078 procedure TglBitmap.SaveRAW(const aStream: TStream);
7079 var
7080   header: RawHeader;
7081   fd: TFormatDescriptor;
7082 begin
7083   fd := TFormatDescriptor.Get(Format);
7084   header.Magic        := 'glBMP';
7085   header.Version      := 1;
7086   header.Width        := Width;
7087   header.Height       := Height;
7088   header.DataSize     := fd.GetSize(fDimension);
7089   header.BitsPerPixel := fd.BitsPerPixel;
7090   header.Precision    := fd.Precision;
7091   header.Shift        := fd.Shift;
7092   aStream.Write(header, SizeOf(header));
7093   aStream.Write(Data^,  header.DataSize);
7094 end;
7095
7096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7097 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7099 const
7100   BMP_MAGIC          = $4D42;
7101
7102   BMP_COMP_RGB       = 0;
7103   BMP_COMP_RLE8      = 1;
7104   BMP_COMP_RLE4      = 2;
7105   BMP_COMP_BITFIELDS = 3;
7106
7107 type
7108   TBMPHeader = packed record
7109     bfType: Word;
7110     bfSize: Cardinal;
7111     bfReserved1: Word;
7112     bfReserved2: Word;
7113     bfOffBits: Cardinal;
7114   end;
7115
7116   TBMPInfo = packed record
7117     biSize: Cardinal;
7118     biWidth: Longint;
7119     biHeight: Longint;
7120     biPlanes: Word;
7121     biBitCount: Word;
7122     biCompression: Cardinal;
7123     biSizeImage: Cardinal;
7124     biXPelsPerMeter: Longint;
7125     biYPelsPerMeter: Longint;
7126     biClrUsed: Cardinal;
7127     biClrImportant: Cardinal;
7128   end;
7129
7130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7131 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7132
7133   //////////////////////////////////////////////////////////////////////////////////////////////////
7134   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7135   begin
7136     result := tfEmpty;
7137     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7138     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7139
7140     //Read Compression
7141     case aInfo.biCompression of
7142       BMP_COMP_RLE4,
7143       BMP_COMP_RLE8: begin
7144         raise EglBitmap.Create('RLE compression is not supported');
7145       end;
7146       BMP_COMP_BITFIELDS: begin
7147         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7148           aStream.Read(aMask.r, SizeOf(aMask.r));
7149           aStream.Read(aMask.g, SizeOf(aMask.g));
7150           aStream.Read(aMask.b, SizeOf(aMask.b));
7151           aStream.Read(aMask.a, SizeOf(aMask.a));
7152         end else
7153           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7154       end;
7155     end;
7156
7157     //get suitable format
7158     case aInfo.biBitCount of
7159        8: result := tfLuminance8ub1;
7160       16: result := tfX1RGB5us1;
7161       24: result := tfBGR8ub3;
7162       32: result := tfXRGB8ui1;
7163     end;
7164   end;
7165
7166   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7167   var
7168     i, c: Integer;
7169     ColorTable: TbmpColorTable;
7170   begin
7171     result := nil;
7172     if (aInfo.biBitCount >= 16) then
7173       exit;
7174     aFormat := tfLuminance8ub1;
7175     c := aInfo.biClrUsed;
7176     if (c = 0) then
7177       c := 1 shl aInfo.biBitCount;
7178     SetLength(ColorTable, c);
7179     for i := 0 to c-1 do begin
7180       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7181       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7182         aFormat := tfRGB8ub3;
7183     end;
7184
7185     result := TbmpColorTableFormat.Create;
7186     result.BitsPerPixel := aInfo.biBitCount;
7187     result.ColorTable   := ColorTable;
7188     result.CalcValues;
7189   end;
7190
7191   //////////////////////////////////////////////////////////////////////////////////////////////////
7192   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7193   var
7194     FormatDesc: TFormatDescriptor;
7195   begin
7196     result := nil;
7197     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7198       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7199       if (FormatDesc.Format = tfEmpty) then
7200         exit;
7201       aFormat := FormatDesc.Format;
7202       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7203         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7204       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7205         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7206
7207       result := TbmpBitfieldFormat.Create;
7208       result.SetValues(aInfo.biBitCount, aMask);
7209     end;
7210   end;
7211
7212 var
7213   //simple types
7214   StartPos: Int64;
7215   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7216   PaddingBuff: Cardinal;
7217   LineBuf, ImageData, TmpData: PByte;
7218   SourceMD, DestMD: Pointer;
7219   BmpFormat: TglBitmapFormat;
7220
7221   //records
7222   Mask: TglBitmapRec4ul;
7223   Header: TBMPHeader;
7224   Info: TBMPInfo;
7225
7226   //classes
7227   SpecialFormat: TFormatDescriptor;
7228   FormatDesc: TFormatDescriptor;
7229
7230   //////////////////////////////////////////////////////////////////////////////////////////////////
7231   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7232   var
7233     i: Integer;
7234     Pixel: TglBitmapPixelData;
7235   begin
7236     aStream.Read(aLineBuf^, rbLineSize);
7237     SpecialFormat.PreparePixel(Pixel);
7238     for i := 0 to Info.biWidth-1 do begin
7239       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7240       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7241       FormatDesc.Map(Pixel, aData, DestMD);
7242     end;
7243   end;
7244
7245 begin
7246   result        := false;
7247   BmpFormat     := tfEmpty;
7248   SpecialFormat := nil;
7249   LineBuf       := nil;
7250   SourceMD      := nil;
7251   DestMD        := nil;
7252
7253   // Header
7254   StartPos := aStream.Position;
7255   aStream.Read(Header{%H-}, SizeOf(Header));
7256
7257   if Header.bfType = BMP_MAGIC then begin
7258     try try
7259       BmpFormat        := ReadInfo(Info, Mask);
7260       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7261       if not Assigned(SpecialFormat) then
7262         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7263       aStream.Position := StartPos + Header.bfOffBits;
7264
7265       if (BmpFormat <> tfEmpty) then begin
7266         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7267         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7268         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7269         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7270
7271         //get Memory
7272         DestMD    := FormatDesc.CreateMappingData;
7273         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7274         GetMem(ImageData, ImageSize);
7275         if Assigned(SpecialFormat) then begin
7276           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7277           SourceMD := SpecialFormat.CreateMappingData;
7278         end;
7279
7280         //read Data
7281         try try
7282           FillChar(ImageData^, ImageSize, $FF);
7283           TmpData := ImageData;
7284           if (Info.biHeight > 0) then
7285             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7286           for i := 0 to Abs(Info.biHeight)-1 do begin
7287             if Assigned(SpecialFormat) then
7288               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7289             else
7290               aStream.Read(TmpData^, wbLineSize);   //else only read data
7291             if (Info.biHeight > 0) then
7292               dec(TmpData, wbLineSize)
7293             else
7294               inc(TmpData, wbLineSize);
7295             aStream.Read(PaddingBuff{%H-}, Padding);
7296           end;
7297           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7298           result := true;
7299         finally
7300           if Assigned(LineBuf) then
7301             FreeMem(LineBuf);
7302           if Assigned(SourceMD) then
7303             SpecialFormat.FreeMappingData(SourceMD);
7304           FormatDesc.FreeMappingData(DestMD);
7305         end;
7306         except
7307           if Assigned(ImageData) then
7308             FreeMem(ImageData);
7309           raise;
7310         end;
7311       end else
7312         raise EglBitmap.Create('LoadBMP - No suitable format found');
7313     except
7314       aStream.Position := StartPos;
7315       raise;
7316     end;
7317     finally
7318       FreeAndNil(SpecialFormat);
7319     end;
7320   end
7321     else aStream.Position := StartPos;
7322 end;
7323
7324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7325 procedure TglBitmap.SaveBMP(const aStream: TStream);
7326 var
7327   Header: TBMPHeader;
7328   Info: TBMPInfo;
7329   Converter: TFormatDescriptor;
7330   FormatDesc: TFormatDescriptor;
7331   SourceFD, DestFD: Pointer;
7332   pData, srcData, dstData, ConvertBuffer: pByte;
7333
7334   Pixel: TglBitmapPixelData;
7335   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7336   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7337
7338   PaddingBuff: Cardinal;
7339
7340   function GetLineWidth : Integer;
7341   begin
7342     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7343   end;
7344
7345 begin
7346   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7347     raise EglBitmapUnsupportedFormat.Create(Format);
7348
7349   Converter  := nil;
7350   FormatDesc := TFormatDescriptor.Get(Format);
7351   ImageSize  := FormatDesc.GetSize(Dimension);
7352
7353   FillChar(Header{%H-}, SizeOf(Header), 0);
7354   Header.bfType      := BMP_MAGIC;
7355   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7356   Header.bfReserved1 := 0;
7357   Header.bfReserved2 := 0;
7358   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7359
7360   FillChar(Info{%H-}, SizeOf(Info), 0);
7361   Info.biSize        := SizeOf(Info);
7362   Info.biWidth       := Width;
7363   Info.biHeight      := Height;
7364   Info.biPlanes      := 1;
7365   Info.biCompression := BMP_COMP_RGB;
7366   Info.biSizeImage   := ImageSize;
7367
7368   try
7369     case Format of
7370       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7371       begin
7372         Info.biBitCount  :=  8;
7373         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7374         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7375         Converter := TbmpColorTableFormat.Create;
7376         with (Converter as TbmpColorTableFormat) do begin
7377           SetValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7378           CreateColorTable;
7379         end;
7380       end;
7381
7382       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7383       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7384       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7385       begin
7386         Info.biBitCount    := 16;
7387         Info.biCompression := BMP_COMP_BITFIELDS;
7388       end;
7389
7390       tfBGR8ub3, tfRGB8ub3:
7391       begin
7392         Info.biBitCount := 24;
7393         if (Format = tfRGB8ub3) then
7394           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7395       end;
7396
7397       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7398       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7399       begin
7400         Info.biBitCount    := 32;
7401         Info.biCompression := BMP_COMP_BITFIELDS;
7402       end;
7403     else
7404       raise EglBitmapUnsupportedFormat.Create(Format);
7405     end;
7406     Info.biXPelsPerMeter := 2835;
7407     Info.biYPelsPerMeter := 2835;
7408
7409     // prepare bitmasks
7410     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7411       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7412       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7413
7414       RedMask    := FormatDesc.Mask.r;
7415       GreenMask  := FormatDesc.Mask.g;
7416       BlueMask   := FormatDesc.Mask.b;
7417       AlphaMask  := FormatDesc.Mask.a;
7418     end;
7419
7420     // headers
7421     aStream.Write(Header, SizeOf(Header));
7422     aStream.Write(Info, SizeOf(Info));
7423
7424     // colortable
7425     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7426       with (Converter as TbmpColorTableFormat) do
7427         aStream.Write(ColorTable[0].b,
7428           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7429
7430     // bitmasks
7431     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7432       aStream.Write(RedMask,   SizeOf(Cardinal));
7433       aStream.Write(GreenMask, SizeOf(Cardinal));
7434       aStream.Write(BlueMask,  SizeOf(Cardinal));
7435       aStream.Write(AlphaMask, SizeOf(Cardinal));
7436     end;
7437
7438     // image data
7439     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7440     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7441     Padding     := GetLineWidth - wbLineSize;
7442     PaddingBuff := 0;
7443
7444     pData := Data;
7445     inc(pData, (Height-1) * rbLineSize);
7446
7447     // prepare row buffer. But only for RGB because RGBA supports color masks
7448     // so it's possible to change color within the image.
7449     if Assigned(Converter) then begin
7450       FormatDesc.PreparePixel(Pixel);
7451       GetMem(ConvertBuffer, wbLineSize);
7452       SourceFD := FormatDesc.CreateMappingData;
7453       DestFD   := Converter.CreateMappingData;
7454     end else
7455       ConvertBuffer := nil;
7456
7457     try
7458       for LineIdx := 0 to Height - 1 do begin
7459         // preparing row
7460         if Assigned(Converter) then begin
7461           srcData := pData;
7462           dstData := ConvertBuffer;
7463           for PixelIdx := 0 to Info.biWidth-1 do begin
7464             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7465             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7466             Converter.Map(Pixel, dstData, DestFD);
7467           end;
7468           aStream.Write(ConvertBuffer^, wbLineSize);
7469         end else begin
7470           aStream.Write(pData^, rbLineSize);
7471         end;
7472         dec(pData, rbLineSize);
7473         if (Padding > 0) then
7474           aStream.Write(PaddingBuff, Padding);
7475       end;
7476     finally
7477       // destroy row buffer
7478       if Assigned(ConvertBuffer) then begin
7479         FormatDesc.FreeMappingData(SourceFD);
7480         Converter.FreeMappingData(DestFD);
7481         FreeMem(ConvertBuffer);
7482       end;
7483     end;
7484   finally
7485     if Assigned(Converter) then
7486       Converter.Free;
7487   end;
7488 end;
7489
7490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7491 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7493 type
7494   TTGAHeader = packed record
7495     ImageID: Byte;
7496     ColorMapType: Byte;
7497     ImageType: Byte;
7498     //ColorMapSpec: Array[0..4] of Byte;
7499     ColorMapStart: Word;
7500     ColorMapLength: Word;
7501     ColorMapEntrySize: Byte;
7502     OrigX: Word;
7503     OrigY: Word;
7504     Width: Word;
7505     Height: Word;
7506     Bpp: Byte;
7507     ImageDesc: Byte;
7508   end;
7509
7510 const
7511   TGA_UNCOMPRESSED_RGB  =  2;
7512   TGA_UNCOMPRESSED_GRAY =  3;
7513   TGA_COMPRESSED_RGB    = 10;
7514   TGA_COMPRESSED_GRAY   = 11;
7515
7516   TGA_NONE_COLOR_TABLE  = 0;
7517
7518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7519 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7520 var
7521   Header: TTGAHeader;
7522   ImageData: System.PByte;
7523   StartPosition: Int64;
7524   PixelSize, LineSize: Integer;
7525   tgaFormat: TglBitmapFormat;
7526   FormatDesc: TFormatDescriptor;
7527   Counter: packed record
7528     X, Y: packed record
7529       low, high, dir: Integer;
7530     end;
7531   end;
7532
7533 const
7534   CACHE_SIZE = $4000;
7535
7536   ////////////////////////////////////////////////////////////////////////////////////////
7537   procedure ReadUncompressed;
7538   var
7539     i, j: Integer;
7540     buf, tmp1, tmp2: System.PByte;
7541   begin
7542     buf := nil;
7543     if (Counter.X.dir < 0) then
7544       GetMem(buf, LineSize);
7545     try
7546       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7547         tmp1 := ImageData;
7548         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7549         if (Counter.X.dir < 0) then begin               //flip X
7550           aStream.Read(buf^, LineSize);
7551           tmp2 := buf;
7552           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7553           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7554             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7555               tmp1^ := tmp2^;
7556               inc(tmp1);
7557               inc(tmp2);
7558             end;
7559             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7560           end;
7561         end else
7562           aStream.Read(tmp1^, LineSize);
7563         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7564       end;
7565     finally
7566       if Assigned(buf) then
7567         FreeMem(buf);
7568     end;
7569   end;
7570
7571   ////////////////////////////////////////////////////////////////////////////////////////
7572   procedure ReadCompressed;
7573
7574     /////////////////////////////////////////////////////////////////
7575     var
7576       TmpData: System.PByte;
7577       LinePixelsRead: Integer;
7578     procedure CheckLine;
7579     begin
7580       if (LinePixelsRead >= Header.Width) then begin
7581         LinePixelsRead := 0;
7582         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7583         TmpData := ImageData;
7584         inc(TmpData, Counter.Y.low * LineSize);           //set line
7585         if (Counter.X.dir < 0) then                       //if x flipped then
7586           inc(TmpData, LineSize - PixelSize);             //set last pixel
7587       end;
7588     end;
7589
7590     /////////////////////////////////////////////////////////////////
7591     var
7592       Cache: PByte;
7593       CacheSize, CachePos: Integer;
7594     procedure CachedRead(out Buffer; Count: Integer);
7595     var
7596       BytesRead: Integer;
7597     begin
7598       if (CachePos + Count > CacheSize) then begin
7599         //if buffer overflow save non read bytes
7600         BytesRead := 0;
7601         if (CacheSize - CachePos > 0) then begin
7602           BytesRead := CacheSize - CachePos;
7603           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7604           inc(CachePos, BytesRead);
7605         end;
7606
7607         //load cache from file
7608         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7609         aStream.Read(Cache^, CacheSize);
7610         CachePos := 0;
7611
7612         //read rest of requested bytes
7613         if (Count - BytesRead > 0) then begin
7614           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7615           inc(CachePos, Count - BytesRead);
7616         end;
7617       end else begin
7618         //if no buffer overflow just read the data
7619         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7620         inc(CachePos, Count);
7621       end;
7622     end;
7623
7624     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7625     begin
7626       case PixelSize of
7627         1: begin
7628           aBuffer^ := aData^;
7629           inc(aBuffer, Counter.X.dir);
7630         end;
7631         2: begin
7632           PWord(aBuffer)^ := PWord(aData)^;
7633           inc(aBuffer, 2 * Counter.X.dir);
7634         end;
7635         3: begin
7636           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7637           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7638           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7639           inc(aBuffer, 3 * Counter.X.dir);
7640         end;
7641         4: begin
7642           PCardinal(aBuffer)^ := PCardinal(aData)^;
7643           inc(aBuffer, 4 * Counter.X.dir);
7644         end;
7645       end;
7646     end;
7647
7648   var
7649     TotalPixelsToRead, TotalPixelsRead: Integer;
7650     Temp: Byte;
7651     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7652     PixelRepeat: Boolean;
7653     PixelsToRead, PixelCount: Integer;
7654   begin
7655     CacheSize := 0;
7656     CachePos  := 0;
7657
7658     TotalPixelsToRead := Header.Width * Header.Height;
7659     TotalPixelsRead   := 0;
7660     LinePixelsRead    := 0;
7661
7662     GetMem(Cache, CACHE_SIZE);
7663     try
7664       TmpData := ImageData;
7665       inc(TmpData, Counter.Y.low * LineSize);           //set line
7666       if (Counter.X.dir < 0) then                       //if x flipped then
7667         inc(TmpData, LineSize - PixelSize);             //set last pixel
7668
7669       repeat
7670         //read CommandByte
7671         CachedRead(Temp, 1);
7672         PixelRepeat  := (Temp and $80) > 0;
7673         PixelsToRead := (Temp and $7F) + 1;
7674         inc(TotalPixelsRead, PixelsToRead);
7675
7676         if PixelRepeat then
7677           CachedRead(buf[0], PixelSize);
7678         while (PixelsToRead > 0) do begin
7679           CheckLine;
7680           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7681           while (PixelCount > 0) do begin
7682             if not PixelRepeat then
7683               CachedRead(buf[0], PixelSize);
7684             PixelToBuffer(@buf[0], TmpData);
7685             inc(LinePixelsRead);
7686             dec(PixelsToRead);
7687             dec(PixelCount);
7688           end;
7689         end;
7690       until (TotalPixelsRead >= TotalPixelsToRead);
7691     finally
7692       FreeMem(Cache);
7693     end;
7694   end;
7695
7696   function IsGrayFormat: Boolean;
7697   begin
7698     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7699   end;
7700
7701 begin
7702   result := false;
7703
7704   // reading header to test file and set cursor back to begin
7705   StartPosition := aStream.Position;
7706   aStream.Read(Header{%H-}, SizeOf(Header));
7707
7708   // no colormapped files
7709   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7710     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7711   begin
7712     try
7713       if Header.ImageID <> 0 then       // skip image ID
7714         aStream.Position := aStream.Position + Header.ImageID;
7715
7716       tgaFormat := tfEmpty;
7717       case Header.Bpp of
7718          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7719                0: tgaFormat := tfLuminance8ub1;
7720                8: tgaFormat := tfAlpha8ub1;
7721             end;
7722
7723         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7724                0: tgaFormat := tfLuminance16us1;
7725                8: tgaFormat := tfLuminance8Alpha8ub2;
7726             end else case (Header.ImageDesc and $F) of
7727                0: tgaFormat := tfX1RGB5us1;
7728                1: tgaFormat := tfA1RGB5us1;
7729                4: tgaFormat := tfARGB4us1;
7730             end;
7731
7732         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7733                0: tgaFormat := tfBGR8ub3;
7734             end;
7735
7736         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7737                0: tgaFormat := tfDepth32ui1;
7738             end else case (Header.ImageDesc and $F) of
7739                0: tgaFormat := tfX2RGB10ui1;
7740                2: tgaFormat := tfA2RGB10ui1;
7741                8: tgaFormat := tfARGB8ui1;
7742             end;
7743       end;
7744
7745       if (tgaFormat = tfEmpty) then
7746         raise EglBitmap.Create('LoadTga - unsupported format');
7747
7748       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7749       PixelSize  := FormatDesc.GetSize(1, 1);
7750       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7751
7752       GetMem(ImageData, LineSize * Header.Height);
7753       try
7754         //column direction
7755         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7756           Counter.X.low  := Header.Height-1;;
7757           Counter.X.high := 0;
7758           Counter.X.dir  := -1;
7759         end else begin
7760           Counter.X.low  := 0;
7761           Counter.X.high := Header.Height-1;
7762           Counter.X.dir  := 1;
7763         end;
7764
7765         // Row direction
7766         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7767           Counter.Y.low  := 0;
7768           Counter.Y.high := Header.Height-1;
7769           Counter.Y.dir  := 1;
7770         end else begin
7771           Counter.Y.low  := Header.Height-1;;
7772           Counter.Y.high := 0;
7773           Counter.Y.dir  := -1;
7774         end;
7775
7776         // Read Image
7777         case Header.ImageType of
7778           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7779             ReadUncompressed;
7780           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7781             ReadCompressed;
7782         end;
7783
7784         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7785         result := true;
7786       except
7787         if Assigned(ImageData) then
7788           FreeMem(ImageData);
7789         raise;
7790       end;
7791     finally
7792       aStream.Position := StartPosition;
7793     end;
7794   end
7795     else aStream.Position := StartPosition;
7796 end;
7797
7798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7799 procedure TglBitmap.SaveTGA(const aStream: TStream);
7800 var
7801   Header: TTGAHeader;
7802   Size: Integer;
7803   FormatDesc: TFormatDescriptor;
7804 begin
7805   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7806     raise EglBitmapUnsupportedFormat.Create(Format);
7807
7808   //prepare header
7809   FormatDesc := TFormatDescriptor.Get(Format);
7810   FillChar(Header{%H-}, SizeOf(Header), 0);
7811   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
7812   Header.Bpp       := FormatDesc.BitsPerPixel;
7813   Header.Width     := Width;
7814   Header.Height    := Height;
7815   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7816   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
7817     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7818   else
7819     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7820   aStream.Write(Header, SizeOf(Header));
7821
7822   // write Data
7823   Size := FormatDesc.GetSize(Dimension);
7824   aStream.Write(Data^, Size);
7825 end;
7826
7827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7828 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7830 const
7831   DDS_MAGIC: Cardinal         = $20534444;
7832
7833   // DDS_header.dwFlags
7834   DDSD_CAPS                   = $00000001;
7835   DDSD_HEIGHT                 = $00000002;
7836   DDSD_WIDTH                  = $00000004;
7837   DDSD_PIXELFORMAT            = $00001000;
7838
7839   // DDS_header.sPixelFormat.dwFlags
7840   DDPF_ALPHAPIXELS            = $00000001;
7841   DDPF_ALPHA                  = $00000002;
7842   DDPF_FOURCC                 = $00000004;
7843   DDPF_RGB                    = $00000040;
7844   DDPF_LUMINANCE              = $00020000;
7845
7846   // DDS_header.sCaps.dwCaps1
7847   DDSCAPS_TEXTURE             = $00001000;
7848
7849   // DDS_header.sCaps.dwCaps2
7850   DDSCAPS2_CUBEMAP            = $00000200;
7851
7852   D3DFMT_DXT1                 = $31545844;
7853   D3DFMT_DXT3                 = $33545844;
7854   D3DFMT_DXT5                 = $35545844;
7855
7856 type
7857   TDDSPixelFormat = packed record
7858     dwSize: Cardinal;
7859     dwFlags: Cardinal;
7860     dwFourCC: Cardinal;
7861     dwRGBBitCount: Cardinal;
7862     dwRBitMask: Cardinal;
7863     dwGBitMask: Cardinal;
7864     dwBBitMask: Cardinal;
7865     dwABitMask: Cardinal;
7866   end;
7867
7868   TDDSCaps = packed record
7869     dwCaps1: Cardinal;
7870     dwCaps2: Cardinal;
7871     dwDDSX: Cardinal;
7872     dwReserved: Cardinal;
7873   end;
7874
7875   TDDSHeader = packed record
7876     dwSize: Cardinal;
7877     dwFlags: Cardinal;
7878     dwHeight: Cardinal;
7879     dwWidth: Cardinal;
7880     dwPitchOrLinearSize: Cardinal;
7881     dwDepth: Cardinal;
7882     dwMipMapCount: Cardinal;
7883     dwReserved: array[0..10] of Cardinal;
7884     PixelFormat: TDDSPixelFormat;
7885     Caps: TDDSCaps;
7886     dwReserved2: Cardinal;
7887   end;
7888
7889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7890 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7891 var
7892   Header: TDDSHeader;
7893   Converter: TbmpBitfieldFormat;
7894
7895   function GetDDSFormat: TglBitmapFormat;
7896   var
7897     fd: TFormatDescriptor;
7898     i: Integer;
7899     Mask: TglBitmapRec4ul;
7900     Range: TglBitmapRec4ui;
7901     match: Boolean;
7902   begin
7903     result := tfEmpty;
7904     with Header.PixelFormat do begin
7905       // Compresses
7906       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7907         case Header.PixelFormat.dwFourCC of
7908           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7909           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7910           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7911         end;
7912       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
7913         // prepare masks
7914         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
7915           Mask.r := dwRBitMask;
7916           Mask.g := dwGBitMask;
7917           Mask.b := dwBBitMask;
7918         end else begin
7919           Mask.r := dwRBitMask;
7920           Mask.g := dwRBitMask;
7921           Mask.b := dwRBitMask;
7922         end;
7923         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
7924           Mask.a := dwABitMask
7925         else
7926           Mask.a := 0;;
7927
7928         //find matching format
7929         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
7930         result := fd.Format;
7931         if (result <> tfEmpty) then
7932           exit;
7933
7934         //find format with same Range
7935         for i := 0 to 3 do
7936           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
7937         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7938           fd := TFormatDescriptor.Get(result);
7939           match := true;
7940           for i := 0 to 3 do
7941             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7942               match := false;
7943               break;
7944             end;
7945           if match then
7946             break;
7947         end;
7948
7949         //no format with same range found -> use default
7950         if (result = tfEmpty) then begin
7951           if (dwABitMask > 0) then
7952             result := tfRGBA8ui1
7953           else
7954             result := tfRGB8ub3;
7955         end;
7956
7957         Converter := TbmpBitfieldFormat.Create;
7958         Converter.SetValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
7959       end;
7960     end;
7961   end;
7962
7963 var
7964   StreamPos: Int64;
7965   x, y, LineSize, RowSize, Magic: Cardinal;
7966   NewImage, TmpData, RowData, SrcData: System.PByte;
7967   SourceMD, DestMD: Pointer;
7968   Pixel: TglBitmapPixelData;
7969   ddsFormat: TglBitmapFormat;
7970   FormatDesc: TFormatDescriptor;
7971
7972 begin
7973   result    := false;
7974   Converter := nil;
7975   StreamPos := aStream.Position;
7976
7977   // Magic
7978   aStream.Read(Magic{%H-}, sizeof(Magic));
7979   if (Magic <> DDS_MAGIC) then begin
7980     aStream.Position := StreamPos;
7981     exit;
7982   end;
7983
7984   //Header
7985   aStream.Read(Header{%H-}, sizeof(Header));
7986   if (Header.dwSize <> SizeOf(Header)) or
7987      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7988         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7989   begin
7990     aStream.Position := StreamPos;
7991     exit;
7992   end;
7993
7994   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7995     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7996
7997   ddsFormat := GetDDSFormat;
7998   try
7999     if (ddsFormat = tfEmpty) then
8000       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8001
8002     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8003     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8004     GetMem(NewImage, Header.dwHeight * LineSize);
8005     try
8006       TmpData := NewImage;
8007
8008       //Converter needed
8009       if Assigned(Converter) then begin
8010         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8011         GetMem(RowData, RowSize);
8012         SourceMD := Converter.CreateMappingData;
8013         DestMD   := FormatDesc.CreateMappingData;
8014         try
8015           for y := 0 to Header.dwHeight-1 do begin
8016             TmpData := NewImage;
8017             inc(TmpData, y * LineSize);
8018             SrcData := RowData;
8019             aStream.Read(SrcData^, RowSize);
8020             for x := 0 to Header.dwWidth-1 do begin
8021               Converter.Unmap(SrcData, Pixel, SourceMD);
8022               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8023               FormatDesc.Map(Pixel, TmpData, DestMD);
8024             end;
8025           end;
8026         finally
8027           Converter.FreeMappingData(SourceMD);
8028           FormatDesc.FreeMappingData(DestMD);
8029           FreeMem(RowData);
8030         end;
8031       end else
8032
8033       // Compressed
8034       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8035         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8036         for Y := 0 to Header.dwHeight-1 do begin
8037           aStream.Read(TmpData^, RowSize);
8038           Inc(TmpData, LineSize);
8039         end;
8040       end else
8041
8042       // Uncompressed
8043       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8044         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8045         for Y := 0 to Header.dwHeight-1 do begin
8046           aStream.Read(TmpData^, RowSize);
8047           Inc(TmpData, LineSize);
8048         end;
8049       end else
8050         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8051
8052       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8053       result := true;
8054     except
8055       if Assigned(NewImage) then
8056         FreeMem(NewImage);
8057       raise;
8058     end;
8059   finally
8060     FreeAndNil(Converter);
8061   end;
8062 end;
8063
8064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8065 procedure TglBitmap.SaveDDS(const aStream: TStream);
8066 var
8067   Header: TDDSHeader;
8068   FormatDesc: TFormatDescriptor;
8069 begin
8070   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8071     raise EglBitmapUnsupportedFormat.Create(Format);
8072
8073   FormatDesc := TFormatDescriptor.Get(Format);
8074
8075   // Generell
8076   FillChar(Header{%H-}, SizeOf(Header), 0);
8077   Header.dwSize  := SizeOf(Header);
8078   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8079
8080   Header.dwWidth  := Max(1, Width);
8081   Header.dwHeight := Max(1, Height);
8082
8083   // Caps
8084   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8085
8086   // Pixelformat
8087   Header.PixelFormat.dwSize := sizeof(Header);
8088   if (FormatDesc.IsCompressed) then begin
8089     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8090     case Format of
8091       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8092       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8093       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8094     end;
8095   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8096     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8097     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8098     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8099   end else if FormatDesc.IsGrayscale then begin
8100     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8101     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8102     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8103     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8104   end else begin
8105     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8106     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8107     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8108     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8109     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8110     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8111   end;
8112
8113   if (FormatDesc.HasAlpha) then
8114     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8115
8116   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8117   aStream.Write(Header, SizeOf(Header));
8118   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8119 end;
8120
8121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8122 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8124 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8125   const aWidth: Integer; const aHeight: Integer);
8126 var
8127   pTemp: pByte;
8128   Size: Integer;
8129 begin
8130   if (aHeight > 1) then begin
8131     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8132     GetMem(pTemp, Size);
8133     try
8134       Move(aData^, pTemp^, Size);
8135       FreeMem(aData);
8136       aData := nil;
8137     except
8138       FreeMem(pTemp);
8139       raise;
8140     end;
8141   end else
8142     pTemp := aData;
8143   inherited SetDataPointer(pTemp, aFormat, aWidth);
8144 end;
8145
8146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8147 function TglBitmap1D.FlipHorz: Boolean;
8148 var
8149   Col: Integer;
8150   pTempDest, pDest, pSource: PByte;
8151 begin
8152   result := inherited FlipHorz;
8153   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8154     pSource := Data;
8155     GetMem(pDest, fRowSize);
8156     try
8157       pTempDest := pDest;
8158       Inc(pTempDest, fRowSize);
8159       for Col := 0 to Width-1 do begin
8160         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8161         Move(pSource^, pTempDest^, fPixelSize);
8162         Inc(pSource, fPixelSize);
8163       end;
8164       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8165       result := true;
8166     except
8167       if Assigned(pDest) then
8168         FreeMem(pDest);
8169       raise;
8170     end;
8171   end;
8172 end;
8173
8174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8175 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8176 var
8177   FormatDesc: TFormatDescriptor;
8178 begin
8179   // Upload data
8180   FormatDesc := TFormatDescriptor.Get(Format);
8181   if FormatDesc.IsCompressed then begin
8182     if not Assigned(glCompressedTexImage1D) then
8183       raise EglBitmap.Create('compressed formats not supported by video adapter');
8184     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8185   end else if aBuildWithGlu then
8186     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8187   else
8188     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8189
8190   // Free Data
8191   if (FreeDataAfterGenTexture) then
8192     FreeData;
8193 end;
8194
8195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8196 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8197 var
8198   BuildWithGlu, TexRec: Boolean;
8199   TexSize: Integer;
8200 begin
8201   if Assigned(Data) then begin
8202     // Check Texture Size
8203     if (aTestTextureSize) then begin
8204       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8205
8206       if (Width > TexSize) then
8207         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8208
8209       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8210                 (Target = GL_TEXTURE_RECTANGLE);
8211       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8212         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8213     end;
8214
8215     CreateId;
8216     SetupParameters(BuildWithGlu);
8217     UploadData(BuildWithGlu);
8218     glAreTexturesResident(1, @fID, @fIsResident);
8219   end;
8220 end;
8221
8222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8223 procedure TglBitmap1D.AfterConstruction;
8224 begin
8225   inherited;
8226   Target := GL_TEXTURE_1D;
8227 end;
8228
8229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8230 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8232 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8233 begin
8234   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8235     result := fLines[aIndex]
8236   else
8237     result := nil;
8238 end;
8239
8240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8241 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8242   const aWidth: Integer; const aHeight: Integer);
8243 var
8244   Idx, LineWidth: Integer;
8245 begin
8246   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8247
8248   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8249     // Assigning Data
8250     if Assigned(Data) then begin
8251       SetLength(fLines, GetHeight);
8252       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8253
8254       for Idx := 0 to GetHeight-1 do begin
8255         fLines[Idx] := Data;
8256         Inc(fLines[Idx], Idx * LineWidth);
8257       end;
8258     end
8259       else SetLength(fLines, 0);
8260   end else begin
8261     SetLength(fLines, 0);
8262   end;
8263 end;
8264
8265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8266 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8267 var
8268   FormatDesc: TFormatDescriptor;
8269 begin
8270   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8271
8272   FormatDesc := TFormatDescriptor.Get(Format);
8273   if FormatDesc.IsCompressed then begin
8274     if not Assigned(glCompressedTexImage2D) then
8275       raise EglBitmap.Create('compressed formats not supported by video adapter');
8276     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8277   end else if aBuildWithGlu then begin
8278     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8279       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8280   end else begin
8281     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8282       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8283   end;
8284
8285   // Freigeben
8286   if (FreeDataAfterGenTexture) then
8287     FreeData;
8288 end;
8289
8290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8291 procedure TglBitmap2D.AfterConstruction;
8292 begin
8293   inherited;
8294   Target := GL_TEXTURE_2D;
8295 end;
8296
8297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8298 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8299 var
8300   Temp: pByte;
8301   Size, w, h: Integer;
8302   FormatDesc: TFormatDescriptor;
8303 begin
8304   FormatDesc := TFormatDescriptor.Get(aFormat);
8305   if FormatDesc.IsCompressed then
8306     raise EglBitmapUnsupportedFormat.Create(aFormat);
8307
8308   w    := aRight  - aLeft;
8309   h    := aBottom - aTop;
8310   Size := FormatDesc.GetSize(w, h);
8311   GetMem(Temp, Size);
8312   try
8313     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8314     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8315     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8316     FlipVert;
8317   except
8318     if Assigned(Temp) then
8319       FreeMem(Temp);
8320     raise;
8321   end;
8322 end;
8323
8324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8325 procedure TglBitmap2D.GetDataFromTexture;
8326 var
8327   Temp: PByte;
8328   TempWidth, TempHeight: Integer;
8329   TempIntFormat: GLint;
8330   IntFormat: TglBitmapFormat;
8331   FormatDesc: TFormatDescriptor;
8332 begin
8333   Bind;
8334
8335   // Request Data
8336   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8337   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8338   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8339
8340   IntFormat  := tfEmpty;
8341   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8342   IntFormat  := FormatDesc.Format;
8343
8344   // Getting data from OpenGL
8345   FormatDesc := TFormatDescriptor.Get(IntFormat);
8346   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8347   try
8348     if FormatDesc.IsCompressed then begin
8349       if not Assigned(glGetCompressedTexImage) then
8350         raise EglBitmap.Create('compressed formats not supported by video adapter');
8351       glGetCompressedTexImage(Target, 0, Temp)
8352     end else
8353       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8354     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8355   except
8356     if Assigned(Temp) then
8357       FreeMem(Temp);
8358     raise;
8359   end;
8360 end;
8361
8362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8363 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8364 var
8365   BuildWithGlu, PotTex, TexRec: Boolean;
8366   TexSize: Integer;
8367 begin
8368   if Assigned(Data) then begin
8369     // Check Texture Size
8370     if (aTestTextureSize) then begin
8371       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8372
8373       if ((Height > TexSize) or (Width > TexSize)) then
8374         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8375
8376       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8377       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8378       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8379         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8380     end;
8381
8382     CreateId;
8383     SetupParameters(BuildWithGlu);
8384     UploadData(Target, BuildWithGlu);
8385     glAreTexturesResident(1, @fID, @fIsResident);
8386   end;
8387 end;
8388
8389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8390 function TglBitmap2D.FlipHorz: Boolean;
8391 var
8392   Col, Row: Integer;
8393   TempDestData, DestData, SourceData: PByte;
8394   ImgSize: Integer;
8395 begin
8396   result := inherited FlipHorz;
8397   if Assigned(Data) then begin
8398     SourceData := Data;
8399     ImgSize := Height * fRowSize;
8400     GetMem(DestData, ImgSize);
8401     try
8402       TempDestData := DestData;
8403       Dec(TempDestData, fRowSize + fPixelSize);
8404       for Row := 0 to Height -1 do begin
8405         Inc(TempDestData, fRowSize * 2);
8406         for Col := 0 to Width -1 do begin
8407           Move(SourceData^, TempDestData^, fPixelSize);
8408           Inc(SourceData, fPixelSize);
8409           Dec(TempDestData, fPixelSize);
8410         end;
8411       end;
8412       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8413       result := true;
8414     except
8415       if Assigned(DestData) then
8416         FreeMem(DestData);
8417       raise;
8418     end;
8419   end;
8420 end;
8421
8422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8423 function TglBitmap2D.FlipVert: Boolean;
8424 var
8425   Row: Integer;
8426   TempDestData, DestData, SourceData: PByte;
8427 begin
8428   result := inherited FlipVert;
8429   if Assigned(Data) then begin
8430     SourceData := Data;
8431     GetMem(DestData, Height * fRowSize);
8432     try
8433       TempDestData := DestData;
8434       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8435       for Row := 0 to Height -1 do begin
8436         Move(SourceData^, TempDestData^, fRowSize);
8437         Dec(TempDestData, fRowSize);
8438         Inc(SourceData, fRowSize);
8439       end;
8440       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8441       result := true;
8442     except
8443       if Assigned(DestData) then
8444         FreeMem(DestData);
8445       raise;
8446     end;
8447   end;
8448 end;
8449
8450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8453 type
8454   TMatrixItem = record
8455     X, Y: Integer;
8456     W: Single;
8457   end;
8458
8459   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8460   TglBitmapToNormalMapRec = Record
8461     Scale: Single;
8462     Heights: array of Single;
8463     MatrixU : array of TMatrixItem;
8464     MatrixV : array of TMatrixItem;
8465   end;
8466
8467 const
8468   ONE_OVER_255 = 1 / 255;
8469
8470   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8471 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8472 var
8473   Val: Single;
8474 begin
8475   with FuncRec do begin
8476     Val :=
8477       Source.Data.r * LUMINANCE_WEIGHT_R +
8478       Source.Data.g * LUMINANCE_WEIGHT_G +
8479       Source.Data.b * LUMINANCE_WEIGHT_B;
8480     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8481   end;
8482 end;
8483
8484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8485 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8486 begin
8487   with FuncRec do
8488     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8489 end;
8490
8491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8492 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8493 type
8494   TVec = Array[0..2] of Single;
8495 var
8496   Idx: Integer;
8497   du, dv: Double;
8498   Len: Single;
8499   Vec: TVec;
8500
8501   function GetHeight(X, Y: Integer): Single;
8502   begin
8503     with FuncRec do begin
8504       X := Max(0, Min(Size.X -1, X));
8505       Y := Max(0, Min(Size.Y -1, Y));
8506       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8507     end;
8508   end;
8509
8510 begin
8511   with FuncRec do begin
8512     with PglBitmapToNormalMapRec(Args)^ do begin
8513       du := 0;
8514       for Idx := Low(MatrixU) to High(MatrixU) do
8515         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8516
8517       dv := 0;
8518       for Idx := Low(MatrixU) to High(MatrixU) do
8519         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8520
8521       Vec[0] := -du * Scale;
8522       Vec[1] := -dv * Scale;
8523       Vec[2] := 1;
8524     end;
8525
8526     // Normalize
8527     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8528     if Len <> 0 then begin
8529       Vec[0] := Vec[0] * Len;
8530       Vec[1] := Vec[1] * Len;
8531       Vec[2] := Vec[2] * Len;
8532     end;
8533
8534     // Farbe zuweisem
8535     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8536     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8537     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8538   end;
8539 end;
8540
8541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8542 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8543 var
8544   Rec: TglBitmapToNormalMapRec;
8545
8546   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8547   begin
8548     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8549       Matrix[Index].X := X;
8550       Matrix[Index].Y := Y;
8551       Matrix[Index].W := W;
8552     end;
8553   end;
8554
8555 begin
8556   if TFormatDescriptor.Get(Format).IsCompressed then
8557     raise EglBitmapUnsupportedFormat.Create(Format);
8558
8559   if aScale > 100 then
8560     Rec.Scale := 100
8561   else if aScale < -100 then
8562     Rec.Scale := -100
8563   else
8564     Rec.Scale := aScale;
8565
8566   SetLength(Rec.Heights, Width * Height);
8567   try
8568     case aFunc of
8569       nm4Samples: begin
8570         SetLength(Rec.MatrixU, 2);
8571         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8572         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8573
8574         SetLength(Rec.MatrixV, 2);
8575         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8576         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8577       end;
8578
8579       nmSobel: begin
8580         SetLength(Rec.MatrixU, 6);
8581         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8582         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8583         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8584         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8585         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8586         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8587
8588         SetLength(Rec.MatrixV, 6);
8589         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8590         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8591         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8592         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8593         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8594         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8595       end;
8596
8597       nm3x3: begin
8598         SetLength(Rec.MatrixU, 6);
8599         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8600         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8601         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8602         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8603         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8604         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8605
8606         SetLength(Rec.MatrixV, 6);
8607         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8608         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8609         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8610         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8611         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8612         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8613       end;
8614
8615       nm5x5: begin
8616         SetLength(Rec.MatrixU, 20);
8617         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8618         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8619         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8620         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8621         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8622         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8623         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8624         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8625         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8626         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8627         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8628         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8629         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8630         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8631         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8632         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8633         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8634         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8635         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8636         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8637
8638         SetLength(Rec.MatrixV, 20);
8639         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8640         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8641         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8642         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8643         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8644         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8645         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8646         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8647         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8648         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8649         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8650         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8651         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8652         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8653         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8654         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8655         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8656         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8657         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8658         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8659       end;
8660     end;
8661
8662     // Daten Sammeln
8663     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8664       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8665     else
8666       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8667     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8668   finally
8669     SetLength(Rec.Heights, 0);
8670   end;
8671 end;
8672
8673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8674 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8676 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8677 begin
8678   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8679 end;
8680
8681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8682 procedure TglBitmapCubeMap.AfterConstruction;
8683 begin
8684   inherited;
8685
8686   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8687     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8688
8689   SetWrap;
8690   Target   := GL_TEXTURE_CUBE_MAP;
8691   fGenMode := GL_REFLECTION_MAP;
8692 end;
8693
8694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8695 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8696 var
8697   BuildWithGlu: Boolean;
8698   TexSize: Integer;
8699 begin
8700   if (aTestTextureSize) then begin
8701     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8702
8703     if (Height > TexSize) or (Width > TexSize) then
8704       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8705
8706     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8707       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8708   end;
8709
8710   if (ID = 0) then
8711     CreateID;
8712   SetupParameters(BuildWithGlu);
8713   UploadData(aCubeTarget, BuildWithGlu);
8714 end;
8715
8716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8717 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8718 begin
8719   inherited Bind (aEnableTextureUnit);
8720   if aEnableTexCoordsGen then begin
8721     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8722     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8723     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8724     glEnable(GL_TEXTURE_GEN_S);
8725     glEnable(GL_TEXTURE_GEN_T);
8726     glEnable(GL_TEXTURE_GEN_R);
8727   end;
8728 end;
8729
8730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8731 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8732 begin
8733   inherited Unbind(aDisableTextureUnit);
8734   if aDisableTexCoordsGen then begin
8735     glDisable(GL_TEXTURE_GEN_S);
8736     glDisable(GL_TEXTURE_GEN_T);
8737     glDisable(GL_TEXTURE_GEN_R);
8738   end;
8739 end;
8740
8741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8742 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8744 type
8745   TVec = Array[0..2] of Single;
8746   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8747
8748   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8749   TglBitmapNormalMapRec = record
8750     HalfSize : Integer;
8751     Func: TglBitmapNormalMapGetVectorFunc;
8752   end;
8753
8754   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8755 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8756 begin
8757   aVec[0] := aHalfSize;
8758   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8759   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8760 end;
8761
8762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8763 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8764 begin
8765   aVec[0] := - aHalfSize;
8766   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8767   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8768 end;
8769
8770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8771 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8772 begin
8773   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8774   aVec[1] := aHalfSize;
8775   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8776 end;
8777
8778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8779 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8780 begin
8781   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8782   aVec[1] := - aHalfSize;
8783   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8784 end;
8785
8786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8787 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8788 begin
8789   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8790   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8791   aVec[2] := aHalfSize;
8792 end;
8793
8794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8795 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8796 begin
8797   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8798   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8799   aVec[2] := - aHalfSize;
8800 end;
8801
8802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8803 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8804 var
8805   i: Integer;
8806   Vec: TVec;
8807   Len: Single;
8808 begin
8809   with FuncRec do begin
8810     with PglBitmapNormalMapRec(Args)^ do begin
8811       Func(Vec, Position, HalfSize);
8812
8813       // Normalize
8814       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8815       if Len <> 0 then begin
8816         Vec[0] := Vec[0] * Len;
8817         Vec[1] := Vec[1] * Len;
8818         Vec[2] := Vec[2] * Len;
8819       end;
8820
8821       // Scale Vector and AddVectro
8822       Vec[0] := Vec[0] * 0.5 + 0.5;
8823       Vec[1] := Vec[1] * 0.5 + 0.5;
8824       Vec[2] := Vec[2] * 0.5 + 0.5;
8825     end;
8826
8827     // Set Color
8828     for i := 0 to 2 do
8829       Dest.Data.arr[i] := Round(Vec[i] * 255);
8830   end;
8831 end;
8832
8833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8834 procedure TglBitmapNormalMap.AfterConstruction;
8835 begin
8836   inherited;
8837   fGenMode := GL_NORMAL_MAP;
8838 end;
8839
8840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8841 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8842 var
8843   Rec: TglBitmapNormalMapRec;
8844   SizeRec: TglBitmapPixelPosition;
8845 begin
8846   Rec.HalfSize := aSize div 2;
8847   FreeDataAfterGenTexture := false;
8848
8849   SizeRec.Fields := [ffX, ffY];
8850   SizeRec.X := aSize;
8851   SizeRec.Y := aSize;
8852
8853   // Positive X
8854   Rec.Func := glBitmapNormalMapPosX;
8855   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8856   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8857
8858   // Negative X
8859   Rec.Func := glBitmapNormalMapNegX;
8860   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8861   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8862
8863   // Positive Y
8864   Rec.Func := glBitmapNormalMapPosY;
8865   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8866   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8867
8868   // Negative Y
8869   Rec.Func := glBitmapNormalMapNegY;
8870   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8871   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8872
8873   // Positive Z
8874   Rec.Func := glBitmapNormalMapPosZ;
8875   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8876   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8877
8878   // Negative Z
8879   Rec.Func := glBitmapNormalMapNegZ;
8880   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8881   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8882 end;
8883
8884
8885 initialization
8886   glBitmapSetDefaultFormat (tfEmpty);
8887   glBitmapSetDefaultMipmap (mmMipmap);
8888   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8889   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8890   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8891
8892   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8893   glBitmapSetDefaultDeleteTextureOnFree    (true);
8894
8895   TFormatDescriptor.Init;
8896
8897 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8898   OpenGLInitialized := false;
8899   InitOpenGLCS := TCriticalSection.Create;
8900 {$ENDIF}
8901
8902 finalization
8903   TFormatDescriptor.Finalize;
8904
8905 {$IFDEF GLB_NATIVE_OGL}
8906   if Assigned(GL_LibHandle) then
8907     glbFreeLibrary(GL_LibHandle);
8908
8909 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8910   if Assigned(GLU_LibHandle) then
8911     glbFreeLibrary(GLU_LibHandle);
8912   FreeAndNil(InitOpenGLCS);
8913 {$ENDIF}
8914 {$ENDIF}
8915
8916 end.