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    TglBitmapFileTypes = set of TglBitmapFileType;
 864
 865    TglBitmapMipMap = (
 866      mmNone,
 867      mmMipmap,
 868      mmMipmapGlu);
 869
 870    TglBitmapNormalMapFunc = (
 871      nm4Samples,
 872      nmSobel,
 873      nm3x3,
 874      nm5x5);
 875
 876  ////////////////////////////////////////////////////////////////////////////////////////////////////
 877    EglBitmap                  = class(Exception);
 878    EglBitmapNotSupported      = class(Exception);
 879    EglBitmapSizeToLarge       = class(EglBitmap);
 880    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 881    EglBitmapUnsupportedFormat = class(EglBitmap)
 882    public
 883      constructor Create(const aFormat: TglBitmapFormat); overload;
 884      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 885    end;
 886
 887 ////////////////////////////////////////////////////////////////////////////////////////////////////
 888   TglBitmapRec4ui = packed record
 889   case Integer of
 890     0: (r, g, b, a: Cardinal);
 891     1: (arr: array[0..3] of Cardinal);
 892   end;
 893
 894   TglBitmapRec4ub = packed record
 895   case Integer of
 896     0: (r, g, b, a: Byte);
 897     1: (arr: array[0..3] of Byte);
 898   end;
 899
 900   TglBitmapRec4ul = packed record
 901   case Integer of
 902     0: (r, g, b, a: QWord);
 903     1: (arr: array[0..3] of QWord);
 904   end;
 905
 906   TglBitmapFormatDescriptor = class(TObject)
 907   strict private
 908     // cached properties
 909     fBytesPerPixel: Single;
 910     fChannelCount: Integer;
 911     fMask: TglBitmapRec4ul;
 912     fRange: TglBitmapRec4ui;
 913
 914     function GetHasRed: Boolean;
 915     function GetHasGreen: Boolean;
 916     function GetHasBlue: Boolean;
 917     function GetHasAlpha: Boolean;
 918     function GetHasColor: Boolean;
 919     function GetIsGrayscale: Boolean;
 920   protected
 921     fFormat:        TglBitmapFormat;
 922     fWithAlpha:     TglBitmapFormat;
 923     fWithoutAlpha:  TglBitmapFormat;
 924     fOpenGLFormat:  TglBitmapFormat;
 925     fRGBInverted:   TglBitmapFormat;
 926     fUncompressed:  TglBitmapFormat;
 927
 928     fBitsPerPixel: Integer;
 929     fIsCompressed: Boolean;
 930
 931     fPrecision: TglBitmapRec4ub;
 932     fShift:     TglBitmapRec4ub;
 933
 934     fglFormat:         GLenum;
 935     fglInternalFormat: GLenum;
 936     fglDataFormat:     GLenum;
 937
 938     procedure SetValues; virtual;
 939     procedure CalcValues;
 940   public
 941     property Format:        TglBitmapFormat read fFormat;
 942     property ChannelCount:  Integer         read fChannelCount;
 943     property IsCompressed:  Boolean         read fIsCompressed;
 944     property BitsPerPixel:  Integer         read fBitsPerPixel;
 945     property BytesPerPixel: Single          read fBytesPerPixel;
 946
 947     property Precision: TglBitmapRec4ub read fPrecision;
 948     property Shift:     TglBitmapRec4ub read fShift;
 949     property Range:     TglBitmapRec4ui read fRange;
 950     property Mask:      TglBitmapRec4ul read fMask;
 951
 952     property RGBInverted:  TglBitmapFormat read fRGBInverted;
 953     property WithAlpha:    TglBitmapFormat read fWithAlpha;
 954     property WithoutAlpha: TglBitmapFormat read fWithAlpha;
 955     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
 956     property Uncompressed: TglBitmapFormat read fUncompressed;
 957
 958     property glFormat:         GLenum  read fglFormat;
 959     property glInternalFormat: GLenum  read fglInternalFormat;
 960     property glDataFormat:     GLenum  read fglDataFormat;
 961
 962     property HasRed:       Boolean read GetHasRed;
 963     property HasGreen:     Boolean read GetHasGreen;
 964     property HasBlue:      Boolean read GetHasBlue;
 965     property HasAlpha:     Boolean read GetHasAlpha;
 966     property HasColor:     Boolean read GetHasColor;
 967     property IsGrayscale:  Boolean read GetIsGrayscale;
 968
 969     constructor Create;
 970   public
 971     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 972   end;
 973
 974 ////////////////////////////////////////////////////////////////////////////////////////////////////
 975   TglBitmapPixelData = packed record
 976     Data:   TglBitmapRec4ui;
 977     Range:  TglBitmapRec4ui;
 978     Format: TglBitmapFormat;
 979   end;
 980   PglBitmapPixelData = ^TglBitmapPixelData;
 981
 982   TglBitmapPixelPositionFields = set of (ffX, ffY);
 983   TglBitmapPixelPosition = record
 984     Fields : TglBitmapPixelPositionFields;
 985     X : Word;
 986     Y : Word;
 987   end;
 988
 989 ////////////////////////////////////////////////////////////////////////////////////////////////////
 990   TglBitmap = class;
 991   TglBitmapFunctionRec = record
 992     Sender:   TglBitmap;
 993     Size:     TglBitmapPixelPosition;
 994     Position: TglBitmapPixelPosition;
 995     Source:   TglBitmapPixelData;
 996     Dest:     TglBitmapPixelData;
 997     Args:     Pointer;
 998   end;
 999   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
1000
1001 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1002   TglBitmap = class
1003   private
1004     function GetFormatDesc: TglBitmapFormatDescriptor;
1005   protected
1006     fID: GLuint;
1007     fTarget: GLuint;
1008     fAnisotropic: Integer;
1009     fDeleteTextureOnFree: Boolean;
1010     fFreeDataOnDestroy: Boolean;
1011     fFreeDataAfterGenTexture: Boolean;
1012     fData: PByte;
1013     fIsResident: GLboolean;
1014     fBorderColor: array[0..3] of Single;
1015
1016     fDimension: TglBitmapPixelPosition;
1017     fMipMap: TglBitmapMipMap;
1018     fFormat: TglBitmapFormat;
1019
1020     // Mapping
1021     fPixelSize: Integer;
1022     fRowSize: Integer;
1023
1024     // Filtering
1025     fFilterMin: GLenum;
1026     fFilterMag: GLenum;
1027
1028     // TexturWarp
1029     fWrapS: GLenum;
1030     fWrapT: GLenum;
1031     fWrapR: GLenum;
1032
1033     //Swizzle
1034     fSwizzle: array[0..3] of GLenum;
1035
1036     // CustomData
1037     fFilename: String;
1038     fCustomName: String;
1039     fCustomNameW: WideString;
1040     fCustomData: Pointer;
1041
1042     //Getter
1043     function GetWidth:  Integer; virtual;
1044     function GetHeight: Integer; virtual;
1045
1046     function GetFileWidth:  Integer; virtual;
1047     function GetFileHeight: Integer; virtual;
1048
1049     //Setter
1050     procedure SetCustomData(const aValue: Pointer);
1051     procedure SetCustomName(const aValue: String);
1052     procedure SetCustomNameW(const aValue: WideString);
1053     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1054     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1055     procedure SetFormat(const aValue: TglBitmapFormat);
1056     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1057     procedure SetID(const aValue: Cardinal);
1058     procedure SetMipMap(const aValue: TglBitmapMipMap);
1059     procedure SetTarget(const aValue: Cardinal);
1060     procedure SetAnisotropic(const aValue: Integer);
1061
1062     procedure CreateID;
1063     procedure SetupParameters(out aBuildWithGlu: Boolean);
1064     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1065       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1066     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1067
1068     function FlipHorz: Boolean; virtual;
1069     function FlipVert: Boolean; virtual;
1070
1071     property Width:  Integer read GetWidth;
1072     property Height: Integer read GetHeight;
1073
1074     property FileWidth:  Integer read GetFileWidth;
1075     property FileHeight: Integer read GetFileHeight;
1076   public
1077     //Properties
1078     property ID:           Cardinal        read fID          write SetID;
1079     property Target:       Cardinal        read fTarget      write SetTarget;
1080     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1081     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1082     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1083
1084     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1085
1086     property Filename:    String     read fFilename;
1087     property CustomName:  String     read fCustomName  write SetCustomName;
1088     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1089     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1090
1091     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1092     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1093     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1094
1095     property Dimension:  TglBitmapPixelPosition  read fDimension;
1096     property Data:       PByte                   read fData;
1097     property IsResident: GLboolean               read fIsResident;
1098
1099     procedure AfterConstruction; override;
1100     procedure BeforeDestruction; override;
1101
1102     procedure PrepareResType(var aResource: String; var aResType: PChar);
1103
1104     //Load
1105     procedure LoadFromFile(const aFilename: String);
1106     procedure LoadFromStream(const aStream: TStream); virtual;
1107     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1108       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1109     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1110     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1111
1112     //Save
1113     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1114     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1115
1116     //Convert
1117     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1118     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1119       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1120   public
1121     //Alpha & Co
1122     {$IFDEF GLB_SDL}
1123     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1124     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1125     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1126     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1127       const aArgs: Pointer = nil): Boolean;
1128     {$ENDIF}
1129
1130     {$IFDEF GLB_DELPHI}
1131     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1132     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1133     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1134     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1135       const aArgs: Pointer = nil): Boolean;
1136     {$ENDIF}
1137
1138     {$IFDEF GLB_LAZARUS}
1139     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1140     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1141     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1142     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1143       const aArgs: Pointer = nil): Boolean;
1144     {$ENDIF}
1145
1146     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1147       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1148     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1149       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1150
1151     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1152     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1153     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1154     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1155
1156     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1157     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1158     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1159
1160     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1161     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1162     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1163
1164     function RemoveAlpha: Boolean; virtual;
1165   public
1166     //Common
1167     function Clone: TglBitmap;
1168     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1169     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1170     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1171     procedure FreeData;
1172
1173     //ColorFill
1174     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1175     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1176     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1177
1178     //TexParameters
1179     procedure SetFilter(const aMin, aMag: GLenum);
1180     procedure SetWrap(
1181       const S: GLenum = GL_CLAMP_TO_EDGE;
1182       const T: GLenum = GL_CLAMP_TO_EDGE;
1183       const R: GLenum = GL_CLAMP_TO_EDGE);
1184     procedure SetSwizzle(const r, g, b, a: GLenum);
1185
1186     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1187     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1188
1189     //Constructors
1190     constructor Create; overload;
1191     constructor Create(const aFileName: String); overload;
1192     constructor Create(const aStream: TStream); overload;
1193     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1194     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1195     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1196     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1197   private
1198     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1199     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1200
1201     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1202     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1203
1204     function LoadBMP(const aStream: TStream): Boolean; virtual;
1205     procedure SaveBMP(const aStream: TStream); virtual;
1206
1207     function LoadTGA(const aStream: TStream): Boolean; virtual;
1208     procedure SaveTGA(const aStream: TStream); virtual;
1209
1210     function LoadDDS(const aStream: TStream): Boolean; virtual;
1211     procedure SaveDDS(const aStream: TStream); virtual;
1212   end;
1213
1214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1215   TglBitmap1D = class(TglBitmap)
1216   protected
1217     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1218       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1219     procedure UploadData(const aBuildWithGlu: Boolean);
1220   public
1221     property Width;
1222     procedure AfterConstruction; override;
1223     function FlipHorz: Boolean; override;
1224     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1225   end;
1226
1227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1228   TglBitmap2D = class(TglBitmap)
1229   protected
1230     fLines: array of PByte;
1231     function GetScanline(const aIndex: Integer): Pointer;
1232     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1233       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1234     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1235   public
1236     property Width;
1237     property Height;
1238     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1239
1240     procedure AfterConstruction; override;
1241
1242     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1243     procedure GetDataFromTexture;
1244     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1245
1246     function FlipHorz: Boolean; override;
1247     function FlipVert: Boolean; override;
1248
1249     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1250       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1251   end;
1252
1253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1254   TglBitmapCubeMap = class(TglBitmap2D)
1255   protected
1256     fGenMode: Integer;
1257     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1258   public
1259     procedure AfterConstruction; override;
1260     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1261     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1262     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1263   end;
1264
1265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1266   TglBitmapNormalMap = class(TglBitmapCubeMap)
1267   public
1268     procedure AfterConstruction; override;
1269     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1270   end;
1271
1272 const
1273   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1274
1275 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1276 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1277 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1278 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1279 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1280 procedure glBitmapSetDefaultWrap(
1281   const S: Cardinal = GL_CLAMP_TO_EDGE;
1282   const T: Cardinal = GL_CLAMP_TO_EDGE;
1283   const R: Cardinal = GL_CLAMP_TO_EDGE);
1284
1285 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1286 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1287 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1288 function glBitmapGetDefaultFormat: TglBitmapFormat;
1289 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1290 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1291
1292 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1293 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1294 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1295 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1296 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1297
1298 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1299
1300 var
1301   glBitmapDefaultDeleteTextureOnFree: Boolean;
1302   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1303   glBitmapDefaultFormat: TglBitmapFormat;
1304   glBitmapDefaultMipmap: TglBitmapMipMap;
1305   glBitmapDefaultFilterMin: Cardinal;
1306   glBitmapDefaultFilterMag: Cardinal;
1307   glBitmapDefaultWrapS: Cardinal;
1308   glBitmapDefaultWrapT: Cardinal;
1309   glBitmapDefaultWrapR: Cardinal;
1310   glDefaultSwizzle: array[0..3] of GLenum;
1311
1312 {$IFDEF GLB_DELPHI}
1313 function CreateGrayPalette: HPALETTE;
1314 {$ENDIF}
1315
1316 implementation
1317
1318 uses
1319   Math, syncobjs, typinfo
1320   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1321
1322 type
1323 {$IFNDEF fpc}
1324   QWord   = System.UInt64;
1325   PQWord  = ^QWord;
1326
1327   PtrInt  = Longint;
1328   PtrUInt = DWord;
1329 {$ENDIF}
1330
1331 ////////////////////////////////////////////////////////////////////////////////////////////////////
1332   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1333   public
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1336
1337     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1338     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1339
1340     function CreateMappingData: Pointer; virtual;
1341     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1342
1343     function IsEmpty: Boolean; virtual;
1344     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1345
1346     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1347   public
1348     class procedure Init;
1349     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1350     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1351     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1352     class procedure Clear;
1353     class procedure Finalize;
1354   end;
1355   TFormatDescriptorClass = class of TFormatDescriptor;
1356
1357   TfdEmpty = class(TFormatDescriptor);
1358
1359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1360   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363   end;
1364
1365   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1366     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1367     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1368   end;
1369
1370   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1371     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1372     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1373   end;
1374
1375   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1376     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1377     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1378   end;
1379
1380   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1381     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1382     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1383   end;
1384
1385   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388   end;
1389
1390   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1391     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1392     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1393   end;
1394
1395   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1396     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1397     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1398   end;
1399
1400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1401   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1402     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1403     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1404   end;
1405
1406   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409   end;
1410
1411   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1412     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1413     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1414   end;
1415
1416   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1417     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1418     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1419   end;
1420
1421   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1422     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1423     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1424   end;
1425
1426   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1427     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1428     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1429   end;
1430
1431   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1432     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1433     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1434   end;
1435
1436   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1437     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1438     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1439   end;
1440
1441   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1442     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1443     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1444   end;
1445
1446   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1447     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1448     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1449   end;
1450
1451   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1452     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1453     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1454   end;
1455
1456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1457   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1458     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1459     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1460   end;
1461
1462   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1463     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1464     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1465   end;
1466
1467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1468   TfdAlpha4ub1 = class(TfdAlphaUB1)
1469     procedure SetValues; override;
1470   end;
1471
1472   TfdAlpha8ub1 = class(TfdAlphaUB1)
1473     procedure SetValues; override;
1474   end;
1475
1476   TfdAlpha16us1 = class(TfdAlphaUS1)
1477     procedure SetValues; override;
1478   end;
1479
1480   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1481     procedure SetValues; override;
1482   end;
1483
1484   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1485     procedure SetValues; override;
1486   end;
1487
1488   TfdLuminance16us1 = class(TfdLuminanceUS1)
1489     procedure SetValues; override;
1490   end;
1491
1492   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1493     procedure SetValues; override;
1494   end;
1495
1496   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1497     procedure SetValues; override;
1498   end;
1499
1500   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1501     procedure SetValues; override;
1502   end;
1503
1504   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1505     procedure SetValues; override;
1506   end;
1507
1508   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1509     procedure SetValues; override;
1510   end;
1511
1512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1513   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1514     procedure SetValues; override;
1515   end;
1516
1517   TfdRGBX4us1 = class(TfdUniversalUS1)
1518     procedure SetValues; override;
1519   end;
1520
1521   TfdXRGB4us1 = class(TfdUniversalUS1)
1522     procedure SetValues; override;
1523   end;
1524
1525   TfdR5G6B5us1 = class(TfdUniversalUS1)
1526     procedure SetValues; override;
1527   end;
1528
1529   TfdRGB5X1us1 = class(TfdUniversalUS1)
1530     procedure SetValues; override;
1531   end;
1532
1533   TfdX1RGB5us1 = class(TfdUniversalUS1)
1534     procedure SetValues; override;
1535   end;
1536
1537   TfdRGB8ub3 = class(TfdRGBub3)
1538     procedure SetValues; override;
1539   end;
1540
1541   TfdRGBX8ui1 = class(TfdUniversalUI1)
1542     procedure SetValues; override;
1543   end;
1544
1545   TfdXRGB8ui1 = class(TfdUniversalUI1)
1546     procedure SetValues; override;
1547   end;
1548
1549   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1550     procedure SetValues; override;
1551   end;
1552
1553   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1554     procedure SetValues; override;
1555   end;
1556
1557   TfdRGB16us3 = class(TfdRGBus3)
1558     procedure SetValues; override;
1559   end;
1560
1561   TfdRGBA4us1 = class(TfdUniversalUS1)
1562     procedure SetValues; override;
1563   end;
1564
1565   TfdARGB4us1 = class(TfdUniversalUS1)
1566     procedure SetValues; override;
1567   end;
1568
1569   TfdRGB5A1us1 = class(TfdUniversalUS1)
1570     procedure SetValues; override;
1571   end;
1572
1573   TfdA1RGB5us1 = class(TfdUniversalUS1)
1574     procedure SetValues; override;
1575   end;
1576
1577   TfdRGBA8ui1 = class(TfdUniversalUI1)
1578     procedure SetValues; override;
1579   end;
1580
1581   TfdARGB8ui1 = class(TfdUniversalUI1)
1582     procedure SetValues; override;
1583   end;
1584
1585   TfdRGBA8ub4 = class(TfdRGBAub4)
1586     procedure SetValues; override;
1587   end;
1588
1589   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1590     procedure SetValues; override;
1591   end;
1592
1593   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1594     procedure SetValues; override;
1595   end;
1596
1597   TfdRGBA16us4 = class(TfdRGBAus4)
1598     procedure SetValues; override;
1599   end;
1600
1601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1602   TfdBGRX4us1 = class(TfdUniversalUS1)
1603     procedure SetValues; override;
1604   end;
1605
1606   TfdXBGR4us1 = class(TfdUniversalUS1)
1607     procedure SetValues; override;
1608   end;
1609
1610   TfdB5G6R5us1 = class(TfdUniversalUS1)
1611     procedure SetValues; override;
1612   end;
1613
1614   TfdBGR5X1us1 = class(TfdUniversalUS1)
1615     procedure SetValues; override;
1616   end;
1617
1618   TfdX1BGR5us1 = class(TfdUniversalUS1)
1619     procedure SetValues; override;
1620   end;
1621
1622   TfdBGR8ub3 = class(TfdBGRub3)
1623     procedure SetValues; override;
1624   end;
1625
1626   TfdBGRX8ui1 = class(TfdUniversalUI1)
1627     procedure SetValues; override;
1628   end;
1629
1630   TfdXBGR8ui1 = class(TfdUniversalUI1)
1631     procedure SetValues; override;
1632   end;
1633
1634   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1635     procedure SetValues; override;
1636   end;
1637
1638   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1639     procedure SetValues; override;
1640   end;
1641
1642   TfdBGR16us3 = class(TfdBGRus3)
1643     procedure SetValues; override;
1644   end;
1645
1646   TfdBGRA4us1 = class(TfdUniversalUS1)
1647     procedure SetValues; override;
1648   end;
1649
1650   TfdABGR4us1 = class(TfdUniversalUS1)
1651     procedure SetValues; override;
1652   end;
1653
1654   TfdBGR5A1us1 = class(TfdUniversalUS1)
1655     procedure SetValues; override;
1656   end;
1657
1658   TfdA1BGR5us1 = class(TfdUniversalUS1)
1659     procedure SetValues; override;
1660   end;
1661
1662   TfdBGRA8ui1 = class(TfdUniversalUI1)
1663     procedure SetValues; override;
1664   end;
1665
1666   TfdABGR8ui1 = class(TfdUniversalUI1)
1667     procedure SetValues; override;
1668   end;
1669
1670   TfdBGRA8ub4 = class(TfdBGRAub4)
1671     procedure SetValues; override;
1672   end;
1673
1674   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1675     procedure SetValues; override;
1676   end;
1677
1678   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1679     procedure SetValues; override;
1680   end;
1681
1682   TfdBGRA16us4 = class(TfdBGRAus4)
1683     procedure SetValues; override;
1684   end;
1685
1686   TfdDepth16us1 = class(TfdDepthUS1)
1687     procedure SetValues; override;
1688   end;
1689
1690   TfdDepth24ui1 = class(TfdDepthUI1)
1691     procedure SetValues; override;
1692   end;
1693
1694   TfdDepth32ui1 = class(TfdDepthUI1)
1695     procedure SetValues; override;
1696   end;
1697
1698   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1699     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1700     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1701     procedure SetValues; override;
1702   end;
1703
1704   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1705     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1706     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1707     procedure SetValues; override;
1708   end;
1709
1710   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1711     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1712     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1713     procedure SetValues; override;
1714   end;
1715
1716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1717   TbmpBitfieldFormat = class(TFormatDescriptor)
1718   public
1719     procedure SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1720     procedure SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1721     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1722     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1723   end;
1724
1725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1726   TbmpColorTableEnty = packed record
1727     b, g, r, a: Byte;
1728   end;
1729   TbmpColorTable = array of TbmpColorTableEnty;
1730   TbmpColorTableFormat = class(TFormatDescriptor)
1731   private
1732     fBitsPerPixel: Integer;
1733     fColorTable: TbmpColorTable;
1734   protected
1735     procedure SetValues; override; overload;
1736   public
1737     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1738     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1739
1740     procedure SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1741     procedure CalcValues;
1742     procedure CreateColorTable;
1743
1744     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1745     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1746     destructor Destroy; override;
1747   end;
1748
1749 const
1750   LUMINANCE_WEIGHT_R = 0.30;
1751   LUMINANCE_WEIGHT_G = 0.59;
1752   LUMINANCE_WEIGHT_B = 0.11;
1753
1754   ALPHA_WEIGHT_R = 0.30;
1755   ALPHA_WEIGHT_G = 0.59;
1756   ALPHA_WEIGHT_B = 0.11;
1757
1758   DEPTH_WEIGHT_R = 0.333333333;
1759   DEPTH_WEIGHT_G = 0.333333333;
1760   DEPTH_WEIGHT_B = 0.333333333;
1761
1762   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1763     TfdEmpty,
1764
1765     TfdAlpha4ub1,
1766     TfdAlpha8ub1,
1767     TfdAlpha16us1,
1768
1769     TfdLuminance4ub1,
1770     TfdLuminance8ub1,
1771     TfdLuminance16us1,
1772
1773     TfdLuminance4Alpha4ub2,
1774     TfdLuminance6Alpha2ub2,
1775     TfdLuminance8Alpha8ub2,
1776     TfdLuminance12Alpha4us2,
1777     TfdLuminance16Alpha16us2,
1778
1779     TfdR3G3B2ub1,
1780     TfdRGBX4us1,
1781     TfdXRGB4us1,
1782     TfdR5G6B5us1,
1783     TfdRGB5X1us1,
1784     TfdX1RGB5us1,
1785     TfdRGB8ub3,
1786     TfdRGBX8ui1,
1787     TfdXRGB8ui1,
1788     TfdRGB10X2ui1,
1789     TfdX2RGB10ui1,
1790     TfdRGB16us3,
1791
1792     TfdRGBA4us1,
1793     TfdARGB4us1,
1794     TfdRGB5A1us1,
1795     TfdA1RGB5us1,
1796     TfdRGBA8ui1,
1797     TfdARGB8ui1,
1798     TfdRGBA8ub4,
1799     TfdRGB10A2ui1,
1800     TfdA2RGB10ui1,
1801     TfdRGBA16us4,
1802
1803     TfdBGRX4us1,
1804     TfdXBGR4us1,
1805     TfdB5G6R5us1,
1806     TfdBGR5X1us1,
1807     TfdX1BGR5us1,
1808     TfdBGR8ub3,
1809     TfdBGRX8ui1,
1810     TfdXBGR8ui1,
1811     TfdBGR10X2ui1,
1812     TfdX2BGR10ui1,
1813     TfdBGR16us3,
1814
1815     TfdBGRA4us1,
1816     TfdABGR4us1,
1817     TfdBGR5A1us1,
1818     TfdA1BGR5us1,
1819     TfdBGRA8ui1,
1820     TfdABGR8ui1,
1821     TfdBGRA8ub4,
1822     TfdBGR10A2ui1,
1823     TfdA2BGR10ui1,
1824     TfdBGRA16us4,
1825
1826     TfdDepth16us1,
1827     TfdDepth24ui1,
1828     TfdDepth32ui1,
1829
1830     TfdS3tcDtx1RGBA,
1831     TfdS3tcDtx3RGBA,
1832     TfdS3tcDtx5RGBA
1833   );
1834
1835 var
1836   FormatDescriptorCS: TCriticalSection;
1837   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1838
1839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1840 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1841 begin
1842   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1843 end;
1844
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1847 begin
1848   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1849 end;
1850
1851 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1852 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1853 begin
1854   result.Fields := [];
1855
1856   if X >= 0 then
1857     result.Fields := result.Fields + [ffX];
1858   if Y >= 0 then
1859     result.Fields := result.Fields + [ffY];
1860
1861   result.X := Max(0, X);
1862   result.Y := Max(0, Y);
1863 end;
1864
1865 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1866 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1867 begin
1868   result.r := r;
1869   result.g := g;
1870   result.b := b;
1871   result.a := a;
1872 end;
1873
1874 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1875 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1876 begin
1877   result.r := r;
1878   result.g := g;
1879   result.b := b;
1880   result.a := a;
1881 end;
1882
1883 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1884 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1885 begin
1886   result.r := r;
1887   result.g := g;
1888   result.b := b;
1889   result.a := a;
1890 end;
1891
1892 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1893 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1894 var
1895   i: Integer;
1896 begin
1897   result := false;
1898   for i := 0 to high(r1.arr) do
1899     if (r1.arr[i] <> r2.arr[i]) then
1900       exit;
1901   result := true;
1902 end;
1903
1904 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1905 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1906 var
1907   desc: TFormatDescriptor;
1908   p, tmp: PByte;
1909   x, y, i: Integer;
1910   md: Pointer;
1911   px: TglBitmapPixelData;
1912 begin
1913   result := nil;
1914   desc := TFormatDescriptor.Get(aFormat);
1915   if (desc.IsCompressed) or (desc.glFormat = 0) then
1916     exit;
1917
1918   p := GetMem(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1919   md := desc.CreateMappingData;
1920   try
1921     tmp := p;
1922     desc.PreparePixel(px);
1923     for y := 0 to 4 do
1924       for x := 0 to 4 do begin
1925         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1926         for i := 0 to 3 do begin
1927           if ((y < 3) and (y = i)) or
1928              ((y = 3) and (i < 3)) or
1929              ((y = 4) and (i = 3))
1930           then
1931             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1932           else if ((y < 4) and (i = 3)) or
1933                   ((y = 4) and (i < 3))
1934           then
1935             px.Data.arr[i] := px.Range.arr[i]
1936           else
1937             px.Data.arr[i] := 0; //px.Range.arr[i];
1938         end;
1939         desc.Map(px, tmp, md);
1940       end;
1941   finally
1942     desc.FreeMappingData(md);
1943   end;
1944
1945   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1946   result.FreeDataOnDestroy       := true;
1947   result.FreeDataAfterGenTexture := false;
1948   result.SetFilter(GL_NEAREST, GL_NEAREST);
1949 end;
1950
1951 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1952 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1953 begin
1954   result.r := r;
1955   result.g := g;
1956   result.b := b;
1957   result.a := a;
1958 end;
1959
1960 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1961 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1962 begin
1963   result := [];
1964
1965   if (aFormat in [
1966         //8bpp
1967         tfAlpha4ub1, tfAlpha8ub1,
1968         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1969
1970         //16bpp
1971         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1972         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1973         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1974
1975         //24bpp
1976         tfBGR8ub3, tfRGB8ub3,
1977
1978         //32bpp
1979         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1980         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1981   then
1982     result := result + [ ftBMP ];
1983
1984   if (aFormat in [
1985         //8bbp
1986         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1987
1988         //16bbp
1989         tfAlpha16us1, tfLuminance16us1,
1990         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1991         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1992
1993         //24bbp
1994         tfBGR8ub3,
1995
1996         //32bbp
1997         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1998         tfDepth24ui1, tfDepth32ui1])
1999   then
2000     result := result + [ftTGA];
2001
2002   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2003     result := result + [ftDDS];
2004
2005 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2006   if aFormat in [
2007       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2008       tfRGB8ub3, tfRGBA8ui1,
2009       tfBGR8ub3, tfBGRA8ui1] then
2010     result := result + [ftPNG];
2011 {$ENDIF}
2012
2013 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2014   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2015     result := result + [ftJPEG];
2016 {$ENDIF}
2017 end;
2018
2019 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2020 function IsPowerOfTwo(aNumber: Integer): Boolean;
2021 begin
2022   while (aNumber and 1) = 0 do
2023     aNumber := aNumber shr 1;
2024   result := aNumber = 1;
2025 end;
2026
2027 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2028 function GetTopMostBit(aBitSet: QWord): Integer;
2029 begin
2030   result := 0;
2031   while aBitSet > 0 do begin
2032     inc(result);
2033     aBitSet := aBitSet shr 1;
2034   end;
2035 end;
2036
2037 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2038 function CountSetBits(aBitSet: QWord): Integer;
2039 begin
2040   result := 0;
2041   while aBitSet > 0 do begin
2042     if (aBitSet and 1) = 1 then
2043       inc(result);
2044     aBitSet := aBitSet shr 1;
2045   end;
2046 end;
2047
2048 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2049 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2050 begin
2051   result := Trunc(
2052     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2053     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2054     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2055 end;
2056
2057 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2058 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2059 begin
2060   result := Trunc(
2061     DEPTH_WEIGHT_R * aPixel.Data.r +
2062     DEPTH_WEIGHT_G * aPixel.Data.g +
2063     DEPTH_WEIGHT_B * aPixel.Data.b);
2064 end;
2065
2066 {$IFDEF GLB_NATIVE_OGL}
2067 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2070 var
2071   GL_LibHandle: Pointer = nil;
2072
2073 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2074 begin
2075   if not Assigned(aLibHandle) then
2076     aLibHandle := GL_LibHandle;
2077
2078 {$IF DEFINED(GLB_WIN)}
2079   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2080   if Assigned(result) then
2081     exit;
2082
2083   if Assigned(wglGetProcAddress) then
2084     result := wglGetProcAddress(aProcName);
2085 {$ELSEIF DEFINED(GLB_LINUX)}
2086   if Assigned(glXGetProcAddress) then begin
2087     result := glXGetProcAddress(aProcName);
2088     if Assigned(result) then
2089       exit;
2090   end;
2091
2092   if Assigned(glXGetProcAddressARB) then begin
2093     result := glXGetProcAddressARB(aProcName);
2094     if Assigned(result) then
2095       exit;
2096   end;
2097
2098   result := dlsym(aLibHandle, aProcName);
2099 {$IFEND}
2100   if not Assigned(result) and aRaiseOnErr then
2101     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2102 end;
2103
2104 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2105 var
2106   GLU_LibHandle: Pointer = nil;
2107   OpenGLInitialized: Boolean;
2108   InitOpenGLCS: TCriticalSection;
2109
2110 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2111 procedure glbInitOpenGL;
2112
2113   ////////////////////////////////////////////////////////////////////////////////
2114   function glbLoadLibrary(const aName: PChar): Pointer;
2115   begin
2116     {$IF DEFINED(GLB_WIN)}
2117     result := {%H-}Pointer(LoadLibrary(aName));
2118     {$ELSEIF DEFINED(GLB_LINUX)}
2119     result := dlopen(Name, RTLD_LAZY);
2120     {$ELSE}
2121     result := nil;
2122     {$IFEND}
2123   end;
2124
2125   ////////////////////////////////////////////////////////////////////////////////
2126   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2127   begin
2128     result := false;
2129     if not Assigned(aLibHandle) then
2130       exit;
2131
2132     {$IF DEFINED(GLB_WIN)}
2133     Result := FreeLibrary({%H-}HINST(aLibHandle));
2134     {$ELSEIF DEFINED(GLB_LINUX)}
2135     Result := dlclose(aLibHandle) = 0;
2136     {$IFEND}
2137   end;
2138
2139 begin
2140   if Assigned(GL_LibHandle) then
2141     glbFreeLibrary(GL_LibHandle);
2142
2143   if Assigned(GLU_LibHandle) then
2144     glbFreeLibrary(GLU_LibHandle);
2145
2146   GL_LibHandle := glbLoadLibrary(libopengl);
2147   if not Assigned(GL_LibHandle) then
2148     raise EglBitmap.Create('unable to load library: ' + libopengl);
2149
2150   GLU_LibHandle := glbLoadLibrary(libglu);
2151   if not Assigned(GLU_LibHandle) then
2152     raise EglBitmap.Create('unable to load library: ' + libglu);
2153
2154 {$IF DEFINED(GLB_WIN)}
2155   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2156 {$ELSEIF DEFINED(GLB_LINUX)}
2157   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2158   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2159 {$IFEND}
2160
2161   glEnable := glbGetProcAddress('glEnable');
2162   glDisable := glbGetProcAddress('glDisable');
2163   glGetString := glbGetProcAddress('glGetString');
2164   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2165   glTexParameteri := glbGetProcAddress('glTexParameteri');
2166   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2167   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2168   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2169   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2170   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2171   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2172   glTexGeni := glbGetProcAddress('glTexGeni');
2173   glGenTextures := glbGetProcAddress('glGenTextures');
2174   glBindTexture := glbGetProcAddress('glBindTexture');
2175   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2176   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2177   glReadPixels := glbGetProcAddress('glReadPixels');
2178   glPixelStorei := glbGetProcAddress('glPixelStorei');
2179   glTexImage1D := glbGetProcAddress('glTexImage1D');
2180   glTexImage2D := glbGetProcAddress('glTexImage2D');
2181   glGetTexImage := glbGetProcAddress('glGetTexImage');
2182
2183   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2184   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2185 end;
2186 {$ENDIF}
2187
2188 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2189 procedure glbReadOpenGLExtensions;
2190 var
2191   Buffer: AnsiString;
2192   MajorVersion, MinorVersion: Integer;
2193
2194   ///////////////////////////////////////////////////////////////////////////////////////////
2195   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2196   var
2197     Separator: Integer;
2198   begin
2199     aMinor := 0;
2200     aMajor := 0;
2201
2202     Separator := Pos(AnsiString('.'), aBuffer);
2203     if (Separator > 1) and (Separator < Length(aBuffer)) and
2204        (aBuffer[Separator - 1] in ['0'..'9']) and
2205        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2206
2207       Dec(Separator);
2208       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2209         Dec(Separator);
2210
2211       Delete(aBuffer, 1, Separator);
2212       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2213
2214       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2215         Inc(Separator);
2216
2217       Delete(aBuffer, Separator, 255);
2218       Separator := Pos(AnsiString('.'), aBuffer);
2219
2220       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2221       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2222     end;
2223   end;
2224
2225   ///////////////////////////////////////////////////////////////////////////////////////////
2226   function CheckExtension(const Extension: AnsiString): Boolean;
2227   var
2228     ExtPos: Integer;
2229   begin
2230     ExtPos := Pos(Extension, Buffer);
2231     result := ExtPos > 0;
2232     if result then
2233       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2234   end;
2235
2236   ///////////////////////////////////////////////////////////////////////////////////////////
2237   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2238   begin
2239     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2240   end;
2241
2242 begin
2243 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2244   InitOpenGLCS.Enter;
2245   try
2246     if not OpenGLInitialized then begin
2247       glbInitOpenGL;
2248       OpenGLInitialized := true;
2249     end;
2250   finally
2251     InitOpenGLCS.Leave;
2252   end;
2253 {$ENDIF}
2254
2255   // Version
2256   Buffer := glGetString(GL_VERSION);
2257   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2258
2259   GL_VERSION_1_2 := CheckVersion(1, 2);
2260   GL_VERSION_1_3 := CheckVersion(1, 3);
2261   GL_VERSION_1_4 := CheckVersion(1, 4);
2262   GL_VERSION_2_0 := CheckVersion(2, 0);
2263   GL_VERSION_3_3 := CheckVersion(3, 3);
2264
2265   // Extensions
2266   Buffer := glGetString(GL_EXTENSIONS);
2267   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2268   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2269   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2270   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2271   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2272   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2273   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2274   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2275   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2276   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2277   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2278   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2279   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2280   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2281
2282   if GL_VERSION_1_3 then begin
2283     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2284     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2285     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2286   end else begin
2287     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2288     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2289     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2290   end;
2291 end;
2292 {$ENDIF}
2293
2294 {$IFDEF GLB_SDL_IMAGE}
2295 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2299 begin
2300   result := TStream(context^.unknown.data1).Seek(offset, whence);
2301 end;
2302
2303 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2304 begin
2305   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2306 end;
2307
2308 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2309 begin
2310   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2311 end;
2312
2313 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2314 begin
2315   result := 0;
2316 end;
2317
2318 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2319 begin
2320   result := SDL_AllocRW;
2321
2322   if result = nil then
2323     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2324
2325   result^.seek := glBitmapRWseek;
2326   result^.read := glBitmapRWread;
2327   result^.write := glBitmapRWwrite;
2328   result^.close := glBitmapRWclose;
2329   result^.unknown.data1 := Stream;
2330 end;
2331 {$ENDIF}
2332
2333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2335 begin
2336   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2337 end;
2338
2339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2340 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2341 begin
2342   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2343 end;
2344
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2347 begin
2348   glBitmapDefaultMipmap := aValue;
2349 end;
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2353 begin
2354   glBitmapDefaultFormat := aFormat;
2355 end;
2356
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2359 begin
2360   glBitmapDefaultFilterMin := aMin;
2361   glBitmapDefaultFilterMag := aMag;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2366 begin
2367   glBitmapDefaultWrapS := S;
2368   glBitmapDefaultWrapT := T;
2369   glBitmapDefaultWrapR := R;
2370 end;
2371
2372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2373 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2374 begin
2375   glDefaultSwizzle[0] := r;
2376   glDefaultSwizzle[1] := g;
2377   glDefaultSwizzle[2] := b;
2378   glDefaultSwizzle[3] := a;
2379 end;
2380
2381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2382 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2383 begin
2384   result := glBitmapDefaultDeleteTextureOnFree;
2385 end;
2386
2387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2388 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2389 begin
2390   result := glBitmapDefaultFreeDataAfterGenTextures;
2391 end;
2392
2393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2394 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2395 begin
2396   result := glBitmapDefaultMipmap;
2397 end;
2398
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 function glBitmapGetDefaultFormat: TglBitmapFormat;
2401 begin
2402   result := glBitmapDefaultFormat;
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2407 begin
2408   aMin := glBitmapDefaultFilterMin;
2409   aMag := glBitmapDefaultFilterMag;
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2414 begin
2415   S := glBitmapDefaultWrapS;
2416   T := glBitmapDefaultWrapT;
2417   R := glBitmapDefaultWrapR;
2418 end;
2419
2420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2421 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2422 begin
2423   r := glDefaultSwizzle[0];
2424   g := glDefaultSwizzle[1];
2425   b := glDefaultSwizzle[2];
2426   a := glDefaultSwizzle[3];
2427 end;
2428
2429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2430 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2433 var
2434   w, h: Integer;
2435 begin
2436   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2437     w := Max(1, aSize.X);
2438     h := Max(1, aSize.Y);
2439     result := GetSize(w, h);
2440   end else
2441     result := 0;
2442 end;
2443
2444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2445 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2446 begin
2447   result := 0;
2448   if (aWidth <= 0) or (aHeight <= 0) then
2449     exit;
2450   result := Ceil(aWidth * aHeight * BytesPerPixel);
2451 end;
2452
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 function TFormatDescriptor.CreateMappingData: Pointer;
2455 begin
2456   result := nil;
2457 end;
2458
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2461 begin
2462   //DUMMY
2463 end;
2464
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 function TFormatDescriptor.IsEmpty: Boolean;
2467 begin
2468   result := (fFormat = tfEmpty);
2469 end;
2470
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2473 var
2474   i: Integer;
2475   m: TglBitmapRec4ul;
2476 begin
2477   result := false;
2478   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2479     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2480   m := Mask;
2481   for i := 0 to 3 do
2482     if (aMask.arr[i] <> m.arr[i]) then
2483       exit;
2484   result := true;
2485 end;
2486
2487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2489 begin
2490   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2491   aPixel.Data   := Range;
2492   aPixel.Format := fFormat;
2493   aPixel.Range  := Range;
2494 end;
2495
2496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2497 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2500 begin
2501   aData^ := aPixel.Data.a;
2502   inc(aData);
2503 end;
2504
2505 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2506 begin
2507   aPixel.Data.r := 0;
2508   aPixel.Data.g := 0;
2509   aPixel.Data.b := 0;
2510   aPixel.Data.a := aData^;
2511   inc(aData);
2512 end;
2513
2514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2515 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2518 begin
2519   aData^ := LuminanceWeight(aPixel);
2520   inc(aData);
2521 end;
2522
2523 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2524 begin
2525   aPixel.Data.r := aData^;
2526   aPixel.Data.g := aData^;
2527   aPixel.Data.b := aData^;
2528   aPixel.Data.a := 0;
2529   inc(aData);
2530 end;
2531
2532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2533 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2535 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2536 var
2537   i: Integer;
2538 begin
2539   aData^ := 0;
2540   for i := 0 to 3 do
2541     if (Range.arr[i] > 0) then
2542       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2543   inc(aData);
2544 end;
2545
2546 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2547 var
2548   i: Integer;
2549 begin
2550   for i := 0 to 3 do
2551     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2552   inc(aData);
2553 end;
2554
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2559 begin
2560   inherited Map(aPixel, aData, aMapData);
2561   aData^ := aPixel.Data.a;
2562   inc(aData);
2563 end;
2564
2565 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2566 begin
2567   inherited Unmap(aData, aPixel, aMapData);
2568   aPixel.Data.a := aData^;
2569   inc(aData);
2570 end;
2571
2572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2573 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2576 begin
2577   aData^ := aPixel.Data.r;
2578   inc(aData);
2579   aData^ := aPixel.Data.g;
2580   inc(aData);
2581   aData^ := aPixel.Data.b;
2582   inc(aData);
2583 end;
2584
2585 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2586 begin
2587   aPixel.Data.r := aData^;
2588   inc(aData);
2589   aPixel.Data.g := aData^;
2590   inc(aData);
2591   aPixel.Data.b := aData^;
2592   inc(aData);
2593   aPixel.Data.a := 0;
2594 end;
2595
2596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2597 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2600 begin
2601   aData^ := aPixel.Data.b;
2602   inc(aData);
2603   aData^ := aPixel.Data.g;
2604   inc(aData);
2605   aData^ := aPixel.Data.r;
2606   inc(aData);
2607 end;
2608
2609 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2610 begin
2611   aPixel.Data.b := aData^;
2612   inc(aData);
2613   aPixel.Data.g := aData^;
2614   inc(aData);
2615   aPixel.Data.r := aData^;
2616   inc(aData);
2617   aPixel.Data.a := 0;
2618 end;
2619
2620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2621 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2624 begin
2625   inherited Map(aPixel, aData, aMapData);
2626   aData^ := aPixel.Data.a;
2627   inc(aData);
2628 end;
2629
2630 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2631 begin
2632   inherited Unmap(aData, aPixel, aMapData);
2633   aPixel.Data.a := aData^;
2634   inc(aData);
2635 end;
2636
2637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2638 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2641 begin
2642   inherited Map(aPixel, aData, aMapData);
2643   aData^ := aPixel.Data.a;
2644   inc(aData);
2645 end;
2646
2647 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2648 begin
2649   inherited Unmap(aData, aPixel, aMapData);
2650   aPixel.Data.a := aData^;
2651   inc(aData);
2652 end;
2653
2654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2655 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2657 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2658 begin
2659   PWord(aData)^ := aPixel.Data.a;
2660   inc(aData, 2);
2661 end;
2662
2663 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2664 begin
2665   aPixel.Data.r := 0;
2666   aPixel.Data.g := 0;
2667   aPixel.Data.b := 0;
2668   aPixel.Data.a := PWord(aData)^;
2669   inc(aData, 2);
2670 end;
2671
2672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2673 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2675 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2676 begin
2677   PWord(aData)^ := LuminanceWeight(aPixel);
2678   inc(aData, 2);
2679 end;
2680
2681 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2682 begin
2683   aPixel.Data.r := PWord(aData)^;
2684   aPixel.Data.g := PWord(aData)^;
2685   aPixel.Data.b := PWord(aData)^;
2686   aPixel.Data.a := 0;
2687   inc(aData, 2);
2688 end;
2689
2690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2691 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2693 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2694 var
2695   i: Integer;
2696 begin
2697   PWord(aData)^ := 0;
2698   for i := 0 to 3 do
2699     if (Range.arr[i] > 0) then
2700       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2701   inc(aData, 2);
2702 end;
2703
2704 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2705 var
2706   i: Integer;
2707 begin
2708   for i := 0 to 3 do
2709     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2710   inc(aData, 2);
2711 end;
2712
2713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2716 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2717 begin
2718   PWord(aData)^ := DepthWeight(aPixel);
2719   inc(aData, 2);
2720 end;
2721
2722 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2723 begin
2724   aPixel.Data.r := PWord(aData)^;
2725   aPixel.Data.g := PWord(aData)^;
2726   aPixel.Data.b := PWord(aData)^;
2727   aPixel.Data.a := PWord(aData)^;;
2728   inc(aData, 2);
2729 end;
2730
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2735 begin
2736   inherited Map(aPixel, aData, aMapData);
2737   PWord(aData)^ := aPixel.Data.a;
2738   inc(aData, 2);
2739 end;
2740
2741 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2742 begin
2743   inherited Unmap(aData, aPixel, aMapData);
2744   aPixel.Data.a := PWord(aData)^;
2745   inc(aData, 2);
2746 end;
2747
2748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2749 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2751 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2752 begin
2753   PWord(aData)^ := aPixel.Data.r;
2754   inc(aData, 2);
2755   PWord(aData)^ := aPixel.Data.g;
2756   inc(aData, 2);
2757   PWord(aData)^ := aPixel.Data.b;
2758   inc(aData, 2);
2759 end;
2760
2761 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2762 begin
2763   aPixel.Data.r := PWord(aData)^;
2764   inc(aData, 2);
2765   aPixel.Data.g := PWord(aData)^;
2766   inc(aData, 2);
2767   aPixel.Data.b := PWord(aData)^;
2768   inc(aData, 2);
2769   aPixel.Data.a := 0;
2770 end;
2771
2772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2773 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2776 begin
2777   PWord(aData)^ := aPixel.Data.b;
2778   inc(aData, 2);
2779   PWord(aData)^ := aPixel.Data.g;
2780   inc(aData, 2);
2781   PWord(aData)^ := aPixel.Data.r;
2782   inc(aData, 2);
2783 end;
2784
2785 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2786 begin
2787   aPixel.Data.b := PWord(aData)^;
2788   inc(aData, 2);
2789   aPixel.Data.g := PWord(aData)^;
2790   inc(aData, 2);
2791   aPixel.Data.r := PWord(aData)^;
2792   inc(aData, 2);
2793   aPixel.Data.a := 0;
2794 end;
2795
2796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2800 begin
2801   inherited Map(aPixel, aData, aMapData);
2802   PWord(aData)^ := aPixel.Data.a;
2803   inc(aData, 2);
2804 end;
2805
2806 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2807 begin
2808   inherited Unmap(aData, aPixel, aMapData);
2809   aPixel.Data.a := PWord(aData)^;
2810   inc(aData, 2);
2811 end;
2812
2813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2814 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2817 begin
2818   PWord(aData)^ := aPixel.Data.a;
2819   inc(aData, 2);
2820   inherited Map(aPixel, aData, aMapData);
2821 end;
2822
2823 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2824 begin
2825   aPixel.Data.a := PWord(aData)^;
2826   inc(aData, 2);
2827   inherited Unmap(aData, aPixel, aMapData);
2828 end;
2829
2830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2831 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2833 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2834 begin
2835   inherited Map(aPixel, aData, aMapData);
2836   PWord(aData)^ := aPixel.Data.a;
2837   inc(aData, 2);
2838 end;
2839
2840 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2841 begin
2842   inherited Unmap(aData, aPixel, aMapData);
2843   aPixel.Data.a := PWord(aData)^;
2844   inc(aData, 2);
2845 end;
2846
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2850 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2851 begin
2852   PWord(aData)^ := aPixel.Data.a;
2853   inc(aData, 2);
2854   inherited Map(aPixel, aData, aMapData);
2855 end;
2856
2857 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2858 begin
2859   aPixel.Data.a := PWord(aData)^;
2860   inc(aData, 2);
2861   inherited Unmap(aData, aPixel, aMapData);
2862 end;
2863
2864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2865 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2867 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2868 var
2869   i: Integer;
2870 begin
2871   PCardinal(aData)^ := 0;
2872   for i := 0 to 3 do
2873     if (Range.arr[i] > 0) then
2874       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2875   inc(aData, 4);
2876 end;
2877
2878 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2879 var
2880   i: Integer;
2881 begin
2882   for i := 0 to 3 do
2883     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2884   inc(aData, 2);
2885 end;
2886
2887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2888 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2890 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2891 begin
2892   PCardinal(aData)^ := DepthWeight(aPixel);
2893   inc(aData, 4);
2894 end;
2895
2896 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2897 begin
2898   aPixel.Data.r := PCardinal(aData)^;
2899   aPixel.Data.g := PCardinal(aData)^;
2900   aPixel.Data.b := PCardinal(aData)^;
2901   aPixel.Data.a := PCardinal(aData)^;
2902   inc(aData, 4);
2903 end;
2904
2905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2908 procedure TfdAlpha4ub1.SetValues;
2909 begin
2910   inherited SetValues;
2911   fBitsPerPixel     := 8;
2912   fFormat           := tfAlpha4ub1;
2913   fWithAlpha        := tfAlpha4ub1;
2914   fOpenGLFormat     := tfAlpha4ub1;
2915   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2916   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2917   fglFormat         := GL_ALPHA;
2918   fglInternalFormat := GL_ALPHA4;
2919   fglDataFormat     := GL_UNSIGNED_BYTE;
2920 end;
2921
2922 procedure TfdAlpha8ub1.SetValues;
2923 begin
2924   inherited SetValues;
2925   fBitsPerPixel     := 8;
2926   fFormat           := tfAlpha8ub1;
2927   fWithAlpha        := tfAlpha8ub1;
2928   fOpenGLFormat     := tfAlpha8ub1;
2929   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2930   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2931   fglFormat         := GL_ALPHA;
2932   fglInternalFormat := GL_ALPHA8;
2933   fglDataFormat     := GL_UNSIGNED_BYTE;
2934 end;
2935
2936 procedure TfdAlpha16us1.SetValues;
2937 begin
2938   inherited SetValues;
2939   fBitsPerPixel     := 16;
2940   fFormat           := tfAlpha16us1;
2941   fWithAlpha        := tfAlpha16us1;
2942   fOpenGLFormat     := tfAlpha16us1;
2943   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2944   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2945   fglFormat         := GL_ALPHA;
2946   fglInternalFormat := GL_ALPHA16;
2947   fglDataFormat     := GL_UNSIGNED_SHORT;
2948 end;
2949
2950 procedure TfdLuminance4ub1.SetValues;
2951 begin
2952   inherited SetValues;
2953   fBitsPerPixel     := 8;
2954   fFormat           := tfLuminance4ub1;
2955   fWithAlpha        := tfLuminance4Alpha4ub2;
2956   fWithoutAlpha     := tfLuminance4ub1;
2957   fOpenGLFormat     := tfLuminance4ub1;
2958   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2959   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2960   fglFormat         := GL_LUMINANCE;
2961   fglInternalFormat := GL_LUMINANCE4;
2962   fglDataFormat     := GL_UNSIGNED_BYTE;
2963 end;
2964
2965 procedure TfdLuminance8ub1.SetValues;
2966 begin
2967   inherited SetValues;
2968   fBitsPerPixel     := 8;
2969   fFormat           := tfLuminance8ub1;
2970   fWithAlpha        := tfLuminance8Alpha8ub2;
2971   fWithoutAlpha     := tfLuminance8ub1;
2972   fOpenGLFormat     := tfLuminance8ub1;
2973   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2974   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2975   fglFormat         := GL_LUMINANCE;
2976   fglInternalFormat := GL_LUMINANCE8;
2977   fglDataFormat     := GL_UNSIGNED_BYTE;
2978 end;
2979
2980 procedure TfdLuminance16us1.SetValues;
2981 begin
2982   inherited SetValues;
2983   fBitsPerPixel     := 16;
2984   fFormat           := tfLuminance16us1;
2985   fWithAlpha        := tfLuminance16Alpha16us2;
2986   fWithoutAlpha     := tfLuminance16us1;
2987   fOpenGLFormat     := tfLuminance16us1;
2988   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2989   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2990   fglFormat         := GL_LUMINANCE;
2991   fglInternalFormat := GL_LUMINANCE16;
2992   fglDataFormat     := GL_UNSIGNED_SHORT;
2993 end;
2994
2995 procedure TfdLuminance4Alpha4ub2.SetValues;
2996 begin
2997   inherited SetValues;
2998   fBitsPerPixel     := 16;
2999   fFormat           := tfLuminance4Alpha4ub2;
3000   fWithAlpha        := tfLuminance4Alpha4ub2;
3001   fWithoutAlpha     := tfLuminance4ub1;
3002   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3003   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3004   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3005   fglFormat         := GL_LUMINANCE_ALPHA;
3006   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3007   fglDataFormat     := GL_UNSIGNED_BYTE;
3008 end;
3009
3010 procedure TfdLuminance6Alpha2ub2.SetValues;
3011 begin
3012   inherited SetValues;
3013   fBitsPerPixel     := 16;
3014   fFormat           := tfLuminance6Alpha2ub2;
3015   fWithAlpha        := tfLuminance6Alpha2ub2;
3016   fWithoutAlpha     := tfLuminance8ub1;
3017   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3018   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3019   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3020   fglFormat         := GL_LUMINANCE_ALPHA;
3021   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3022   fglDataFormat     := GL_UNSIGNED_BYTE;
3023 end;
3024
3025 procedure TfdLuminance8Alpha8ub2.SetValues;
3026 begin
3027   inherited SetValues;
3028   fBitsPerPixel     := 16;
3029   fFormat           := tfLuminance8Alpha8ub2;
3030   fWithAlpha        := tfLuminance8Alpha8ub2;
3031   fWithoutAlpha     := tfLuminance8ub1;
3032   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3033   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3034   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3035   fglFormat         := GL_LUMINANCE_ALPHA;
3036   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3037   fglDataFormat     := GL_UNSIGNED_BYTE;
3038 end;
3039
3040 procedure TfdLuminance12Alpha4us2.SetValues;
3041 begin
3042   inherited SetValues;
3043   fBitsPerPixel     := 32;
3044   fFormat           := tfLuminance12Alpha4us2;
3045   fWithAlpha        := tfLuminance12Alpha4us2;
3046   fWithoutAlpha     := tfLuminance16us1;
3047   fOpenGLFormat     := tfLuminance12Alpha4us2;
3048   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3049   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3050   fglFormat         := GL_LUMINANCE_ALPHA;
3051   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3052   fglDataFormat     := GL_UNSIGNED_SHORT;
3053 end;
3054
3055 procedure TfdLuminance16Alpha16us2.SetValues;
3056 begin
3057   inherited SetValues;
3058   fBitsPerPixel     := 32;
3059   fFormat           := tfLuminance16Alpha16us2;
3060   fWithAlpha        := tfLuminance16Alpha16us2;
3061   fWithoutAlpha     := tfLuminance16us1;
3062   fOpenGLFormat     := tfLuminance16Alpha16us2;
3063   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3064   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3065   fglFormat         := GL_LUMINANCE_ALPHA;
3066   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3067   fglDataFormat     := GL_UNSIGNED_SHORT;
3068 end;
3069
3070 procedure TfdR3G3B2ub1.SetValues;
3071 begin
3072   inherited SetValues;
3073   fBitsPerPixel     := 8;
3074   fFormat           := tfR3G3B2ub1;
3075   fWithAlpha        := tfRGBA4us1;
3076   fWithoutAlpha     := tfR3G3B2ub1;
3077   fOpenGLFormat     := tfR3G3B2ub1;
3078   fRGBInverted      := tfEmpty;
3079   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3080   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3081   fglFormat         := GL_RGB;
3082   fglInternalFormat := GL_R3_G3_B2;
3083   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3084 end;
3085
3086 procedure TfdRGBX4us1.SetValues;
3087 begin
3088   inherited SetValues;
3089   fBitsPerPixel     := 16;
3090   fFormat           := tfRGBX4us1;
3091   fWithAlpha        := tfRGBA4us1;
3092   fWithoutAlpha     := tfRGBX4us1;
3093   fOpenGLFormat     := tfRGBX4us1;
3094   fRGBInverted      := tfBGRX4us1;
3095   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3096   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3097   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3098   fglInternalFormat := GL_RGB4;
3099   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3100 end;
3101
3102 procedure TfdXRGB4us1.SetValues;
3103 begin
3104   inherited SetValues;
3105   fBitsPerPixel     := 16;
3106   fFormat           := tfXRGB4us1;
3107   fWithAlpha        := tfARGB4us1;
3108   fWithoutAlpha     := tfXRGB4us1;
3109   fOpenGLFormat     := tfXRGB4us1;
3110   fRGBInverted      := tfXBGR4us1;
3111   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3112   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3113   fglFormat         := GL_BGRA;
3114   fglInternalFormat := GL_RGB4;
3115   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3116 end;
3117
3118 procedure TfdR5G6B5us1.SetValues;
3119 begin
3120   inherited SetValues;
3121   fBitsPerPixel     := 16;
3122   fFormat           := tfR5G6B5us1;
3123   fWithAlpha        := tfRGB5A1us1;
3124   fWithoutAlpha     := tfR5G6B5us1;
3125   fOpenGLFormat     := tfR5G6B5us1;
3126   fRGBInverted      := tfB5G6R5us1;
3127   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3128   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3129   fglFormat         := GL_RGB;
3130   fglInternalFormat := GL_RGB565;
3131   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3132 end;
3133
3134 procedure TfdRGB5X1us1.SetValues;
3135 begin
3136   inherited SetValues;
3137   fBitsPerPixel     := 16;
3138   fFormat           := tfRGB5X1us1;
3139   fWithAlpha        := tfRGB5A1us1;
3140   fWithoutAlpha     := tfRGB5X1us1;
3141   fOpenGLFormat     := tfRGB5X1us1;
3142   fRGBInverted      := tfBGR5X1us1;
3143   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3144   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3145   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3146   fglInternalFormat := GL_RGB5;
3147   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3148 end;
3149
3150 procedure TfdX1RGB5us1.SetValues;
3151 begin
3152   inherited SetValues;
3153   fBitsPerPixel     := 16;
3154   fFormat           := tfX1RGB5us1;
3155   fWithAlpha        := tfA1RGB5us1;
3156   fWithoutAlpha     := tfX1RGB5us1;
3157   fOpenGLFormat     := tfX1RGB5us1;
3158   fRGBInverted      := tfX1BGR5us1;
3159   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3160   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3161   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3162   fglInternalFormat := GL_RGB5;
3163   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3164 end;
3165
3166 procedure TfdRGB8ub3.SetValues;
3167 begin
3168   inherited SetValues;
3169   fBitsPerPixel     := 24;
3170   fFormat           := tfRGB8ub3;
3171   fWithAlpha        := tfRGBA8ub4;
3172   fWithoutAlpha     := tfRGB8ub3;
3173   fOpenGLFormat     := tfRGB8ub3;
3174   fRGBInverted      := tfBGR8ub3;
3175   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3176   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3177   fglFormat         := GL_RGB;
3178   fglInternalFormat := GL_RGB8;
3179   fglDataFormat     := GL_UNSIGNED_BYTE;
3180 end;
3181
3182 procedure TfdRGBX8ui1.SetValues;
3183 begin
3184   inherited SetValues;
3185   fBitsPerPixel     := 32;
3186   fFormat           := tfRGBX8ui1;
3187   fWithAlpha        := tfRGBA8ui1;
3188   fWithoutAlpha     := tfRGBX8ui1;
3189   fOpenGLFormat     := tfRGB8ub3;
3190   fRGBInverted      := tfBGRX8ui1;
3191   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3192   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3193   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3194   fglInternalFormat := GL_RGB8;
3195   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3196 end;
3197
3198 procedure TfdXRGB8ui1.SetValues;
3199 begin
3200   inherited SetValues;
3201   fBitsPerPixel     := 32;
3202   fFormat           := tfXRGB8ui1;
3203   fWithAlpha        := tfXRGB8ui1;
3204   fWithoutAlpha     := tfXRGB8ui1;
3205   fOpenGLFormat     := tfRGB8ub3;
3206   fRGBInverted      := tfXBGR8ui1;
3207   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3208   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3209   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3210   fglInternalFormat := GL_RGB8;
3211   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3212 end;
3213
3214 procedure TfdRGB10X2ui1.SetValues;
3215 begin
3216   inherited SetValues;
3217   fBitsPerPixel     := 32;
3218   fFormat           := tfRGB10X2ui1;
3219   fWithAlpha        := tfRGB10A2ui1;
3220   fWithoutAlpha     := tfRGB10X2ui1;
3221   fOpenGLFormat     := tfRGB10X2ui1;
3222   fRGBInverted      := tfBGR10X2ui1;
3223   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3224   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3225   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3226   fglInternalFormat := GL_RGB10;
3227   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3228 end;
3229
3230 procedure TfdX2RGB10ui1.SetValues;
3231 begin
3232   inherited SetValues;
3233   fBitsPerPixel     := 32;
3234   fFormat           := tfX2RGB10ui1;
3235   fWithAlpha        := tfA2RGB10ui1;
3236   fWithoutAlpha     := tfX2RGB10ui1;
3237   fOpenGLFormat     := tfX2RGB10ui1;
3238   fRGBInverted      := tfX2BGR10ui1;
3239   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3240   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3241   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3242   fglInternalFormat := GL_RGB10;
3243   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3244 end;
3245
3246 procedure TfdRGB16us3.SetValues;
3247 begin
3248   inherited SetValues;
3249   fBitsPerPixel     := 48;
3250   fFormat           := tfRGB16us3;
3251   fWithAlpha        := tfRGBA16us4;
3252   fWithoutAlpha     := tfRGB16us3;
3253   fOpenGLFormat     := tfRGB16us3;
3254   fRGBInverted      := tfBGR16us3;
3255   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3256   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3257   fglFormat         := GL_RGB;
3258   fglInternalFormat := GL_RGB16;
3259   fglDataFormat     := GL_UNSIGNED_SHORT;
3260 end;
3261
3262 procedure TfdRGBA4us1.SetValues;
3263 begin
3264   inherited SetValues;
3265   fBitsPerPixel     := 16;
3266   fFormat           := tfRGBA4us1;
3267   fWithAlpha        := tfRGBA4us1;
3268   fWithoutAlpha     := tfRGBX4us1;
3269   fOpenGLFormat     := tfRGBA4us1;
3270   fRGBInverted      := tfBGRA4us1;
3271   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3272   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3273   fglFormat         := GL_RGBA;
3274   fglInternalFormat := GL_RGBA4;
3275   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3276 end;
3277
3278 procedure TfdARGB4us1.SetValues;
3279 begin
3280   inherited SetValues;
3281   fBitsPerPixel     := 16;
3282   fFormat           := tfARGB4us1;
3283   fWithAlpha        := tfARGB4us1;
3284   fWithoutAlpha     := tfXRGB4us1;
3285   fOpenGLFormat     := tfARGB4us1;
3286   fRGBInverted      := tfABGR4us1;
3287   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3288   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3289   fglFormat         := GL_BGRA;
3290   fglInternalFormat := GL_RGBA4;
3291   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3292 end;
3293
3294 procedure TfdRGB5A1us1.SetValues;
3295 begin
3296   inherited SetValues;
3297   fBitsPerPixel     := 16;
3298   fFormat           := tfRGB5A1us1;
3299   fWithAlpha        := tfRGB5A1us1;
3300   fWithoutAlpha     := tfRGB5X1us1;
3301   fOpenGLFormat     := tfRGB5A1us1;
3302   fRGBInverted      := tfBGR5A1us1;
3303   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3304   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3305   fglFormat         := GL_RGBA;
3306   fglInternalFormat := GL_RGB5_A1;
3307   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3308 end;
3309
3310 procedure TfdA1RGB5us1.SetValues;
3311 begin
3312   inherited SetValues;
3313   fBitsPerPixel     := 16;
3314   fFormat           := tfA1RGB5us1;
3315   fWithAlpha        := tfA1RGB5us1;
3316   fWithoutAlpha     := tfX1RGB5us1;
3317   fOpenGLFormat     := tfA1RGB5us1;
3318   fRGBInverted      := tfA1BGR5us1;
3319   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3320   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3321   fglFormat         := GL_BGRA;
3322   fglInternalFormat := GL_RGB5_A1;
3323   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3324 end;
3325
3326 procedure TfdRGBA8ui1.SetValues;
3327 begin
3328   inherited SetValues;
3329   fBitsPerPixel     := 32;
3330   fFormat           := tfRGBA8ui1;
3331   fWithAlpha        := tfRGBA8ui1;
3332   fWithoutAlpha     := tfRGBX8ui1;
3333   fOpenGLFormat     := tfRGBA8ui1;
3334   fRGBInverted      := tfBGRA8ui1;
3335   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3336   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3337   fglFormat         := GL_RGBA;
3338   fglInternalFormat := GL_RGBA8;
3339   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3340 end;
3341
3342 procedure TfdARGB8ui1.SetValues;
3343 begin
3344   inherited SetValues;
3345   fBitsPerPixel     := 32;
3346   fFormat           := tfARGB8ui1;
3347   fWithAlpha        := tfARGB8ui1;
3348   fWithoutAlpha     := tfXRGB8ui1;
3349   fOpenGLFormat     := tfARGB8ui1;
3350   fRGBInverted      := tfABGR8ui1;
3351   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3352   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3353   fglFormat         := GL_BGRA;
3354   fglInternalFormat := GL_RGBA8;
3355   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3356 end;
3357
3358 procedure TfdRGBA8ub4.SetValues;
3359 begin
3360   inherited SetValues;
3361   fBitsPerPixel     := 32;
3362   fFormat           := tfRGBA8ub4;
3363   fWithAlpha        := tfRGBA8ub4;
3364   fWithoutAlpha     := tfRGB8ub3;
3365   fOpenGLFormat     := tfRGBA8ub4;
3366   fRGBInverted      := tfBGRA8ub4;
3367   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3368   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3369   fglFormat         := GL_RGBA;
3370   fglInternalFormat := GL_RGBA8;
3371   fglDataFormat     := GL_UNSIGNED_BYTE;
3372 end;
3373
3374 procedure TfdRGB10A2ui1.SetValues;
3375 begin
3376   inherited SetValues;
3377   fBitsPerPixel     := 32;
3378   fFormat           := tfRGB10A2ui1;
3379   fWithAlpha        := tfRGB10A2ui1;
3380   fWithoutAlpha     := tfRGB10X2ui1;
3381   fOpenGLFormat     := tfRGB10A2ui1;
3382   fRGBInverted      := tfBGR10A2ui1;
3383   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3384   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3385   fglFormat         := GL_RGBA;
3386   fglInternalFormat := GL_RGB10_A2;
3387   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3388 end;
3389
3390 procedure TfdA2RGB10ui1.SetValues;
3391 begin
3392   inherited SetValues;
3393   fBitsPerPixel     := 32;
3394   fFormat           := tfA2RGB10ui1;
3395   fWithAlpha        := tfA2RGB10ui1;
3396   fWithoutAlpha     := tfX2RGB10ui1;
3397   fOpenGLFormat     := tfA2RGB10ui1;
3398   fRGBInverted      := tfA2BGR10ui1;
3399   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3400   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3401   fglFormat         := GL_BGRA;
3402   fglInternalFormat := GL_RGB10_A2;
3403   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3404 end;
3405
3406 procedure TfdRGBA16us4.SetValues;
3407 begin
3408   inherited SetValues;
3409   fBitsPerPixel     := 64;
3410   fFormat           := tfRGBA16us4;
3411   fWithAlpha        := tfRGBA16us4;
3412   fWithoutAlpha     := tfRGB16us3;
3413   fOpenGLFormat     := tfRGBA16us4;
3414   fRGBInverted      := tfBGRA16us4;
3415   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3416   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3417   fglFormat         := GL_RGBA;
3418   fglInternalFormat := GL_RGBA16;
3419   fglDataFormat     := GL_UNSIGNED_SHORT;
3420 end;
3421
3422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3425 procedure TfdBGRX4us1.SetValues;
3426 begin
3427   inherited SetValues;
3428   fBitsPerPixel     := 16;
3429   fFormat           := tfBGRX4us1;
3430   fWithAlpha        := tfBGRA4us1;
3431   fWithoutAlpha     := tfBGRX4us1;
3432   fOpenGLFormat     := tfBGRX4us1;
3433   fRGBInverted      := tfRGBX4us1;
3434   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3435   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3436   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3437   fglInternalFormat := GL_RGB4;
3438   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3439 end;
3440
3441 procedure TfdXBGR4us1.SetValues;
3442 begin
3443   inherited SetValues;
3444   fBitsPerPixel     := 16;
3445   fFormat           := tfXBGR4us1;
3446   fWithAlpha        := tfABGR4us1;
3447   fWithoutAlpha     := tfXBGR4us1;
3448   fOpenGLFormat     := tfXBGR4us1;
3449   fRGBInverted      := tfXRGB4us1;
3450   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3451   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3452   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3453   fglInternalFormat := GL_RGB4;
3454   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3455 end;
3456
3457 procedure TfdB5G6R5us1.SetValues;
3458 begin
3459   inherited SetValues;
3460   fBitsPerPixel     := 16;
3461   fFormat           := tfB5G6R5us1;
3462   fWithAlpha        := tfBGR5A1us1;
3463   fWithoutAlpha     := tfB5G6R5us1;
3464   fOpenGLFormat     := tfB5G6R5us1;
3465   fRGBInverted      := tfR5G6B5us1;
3466   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3467   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3468   fglFormat         := GL_RGB;
3469   fglInternalFormat := GL_RGB565;
3470   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3471 end;
3472
3473 procedure TfdBGR5X1us1.SetValues;
3474 begin
3475   inherited SetValues;
3476   fBitsPerPixel     := 16;
3477   fFormat           := tfBGR5X1us1;
3478   fWithAlpha        := tfBGR5A1us1;
3479   fWithoutAlpha     := tfBGR5X1us1;
3480   fOpenGLFormat     := tfBGR5X1us1;
3481   fRGBInverted      := tfRGB5X1us1;
3482   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3483   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3484   fglFormat         := GL_BGRA;
3485   fglInternalFormat := GL_RGB5;
3486   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3487 end;
3488
3489 procedure TfdX1BGR5us1.SetValues;
3490 begin
3491   inherited SetValues;
3492   fBitsPerPixel     := 16;
3493   fFormat           := tfX1BGR5us1;
3494   fWithAlpha        := tfA1BGR5us1;
3495   fWithoutAlpha     := tfX1BGR5us1;
3496   fOpenGLFormat     := tfX1BGR5us1;
3497   fRGBInverted      := tfX1RGB5us1;
3498   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3499   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3500   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3501   fglInternalFormat := GL_RGB5;
3502   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3503 end;
3504
3505 procedure TfdBGR8ub3.SetValues;
3506 begin
3507   inherited SetValues;
3508   fBitsPerPixel     := 24;
3509   fFormat           := tfBGR8ub3;
3510   fWithAlpha        := tfBGRA8ub4;
3511   fWithoutAlpha     := tfBGR8ub3;
3512   fOpenGLFormat     := tfBGR8ub3;
3513   fRGBInverted      := tfRGB8ub3;
3514   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3515   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3516   fglFormat         := GL_BGR;
3517   fglInternalFormat := GL_RGB8;
3518   fglDataFormat     := GL_UNSIGNED_BYTE;
3519 end;
3520
3521 procedure TfdBGRX8ui1.SetValues;
3522 begin
3523   inherited SetValues;
3524   fBitsPerPixel     := 32;
3525   fFormat           := tfBGRX8ui1;
3526   fWithAlpha        := tfBGRA8ui1;
3527   fWithoutAlpha     := tfBGRX8ui1;
3528   fOpenGLFormat     := tfBGRX8ui1;
3529   fRGBInverted      := tfRGBX8ui1;
3530   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3531   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3532   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3533   fglInternalFormat := GL_RGB8;
3534   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3535 end;
3536
3537 procedure TfdXBGR8ui1.SetValues;
3538 begin
3539   inherited SetValues;
3540   fBitsPerPixel     := 32;
3541   fFormat           := tfXBGR8ui1;
3542   fWithAlpha        := tfABGR8ui1;
3543   fWithoutAlpha     := tfXBGR8ui1;
3544   fOpenGLFormat     := tfXBGR8ui1;
3545   fRGBInverted      := tfXRGB8ui1;
3546   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3547   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3548   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3549   fglInternalFormat := GL_RGB8;
3550   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3551 end;
3552
3553 procedure TfdBGR10X2ui1.SetValues;
3554 begin
3555   inherited SetValues;
3556   fBitsPerPixel     := 32;
3557   fFormat           := tfBGR10X2ui1;
3558   fWithAlpha        := tfBGR10A2ui1;
3559   fWithoutAlpha     := tfBGR10X2ui1;
3560   fOpenGLFormat     := tfBGR10X2ui1;
3561   fRGBInverted      := tfRGB10X2ui1;
3562   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3563   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3564   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3565   fglInternalFormat := GL_RGB10;
3566   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3567 end;
3568
3569 procedure TfdX2BGR10ui1.SetValues;
3570 begin
3571   inherited SetValues;
3572   fBitsPerPixel     := 32;
3573   fFormat           := tfX2BGR10ui1;
3574   fWithAlpha        := tfA2BGR10ui1;
3575   fWithoutAlpha     := tfX2BGR10ui1;
3576   fOpenGLFormat     := tfX2BGR10ui1;
3577   fRGBInverted      := tfX2RGB10ui1;
3578   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3579   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3580   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3581   fglInternalFormat := GL_RGB10;
3582   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3583 end;
3584
3585 procedure TfdBGR16us3.SetValues;
3586 begin
3587   inherited SetValues;
3588   fBitsPerPixel     := 48;
3589   fFormat           := tfBGR16us3;
3590   fWithAlpha        := tfBGRA16us4;
3591   fWithoutAlpha     := tfBGR16us3;
3592   fOpenGLFormat     := tfBGR16us3;
3593   fRGBInverted      := tfRGB16us3;
3594   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3595   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3596   fglFormat         := GL_BGR;
3597   fglInternalFormat := GL_RGB16;
3598   fglDataFormat     := GL_UNSIGNED_SHORT;
3599 end;
3600
3601 procedure TfdBGRA4us1.SetValues;
3602 begin
3603   inherited SetValues;
3604   fBitsPerPixel     := 16;
3605   fFormat           := tfBGRA4us1;
3606   fWithAlpha        := tfBGRA4us1;
3607   fWithoutAlpha     := tfBGRX4us1;
3608   fOpenGLFormat     := tfBGRA4us1;
3609   fRGBInverted      := tfRGBA4us1;
3610   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3611   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3612   fglFormat         := GL_BGRA;
3613   fglInternalFormat := GL_RGBA4;
3614   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3615 end;
3616
3617 procedure TfdABGR4us1.SetValues;
3618 begin
3619   inherited SetValues;
3620   fBitsPerPixel     := 16;
3621   fFormat           := tfABGR4us1;
3622   fWithAlpha        := tfABGR4us1;
3623   fWithoutAlpha     := tfXBGR4us1;
3624   fOpenGLFormat     := tfABGR4us1;
3625   fRGBInverted      := tfARGB4us1;
3626   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3627   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3628   fglFormat         := GL_RGBA;
3629   fglInternalFormat := GL_RGBA4;
3630   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3631 end;
3632
3633 procedure TfdBGR5A1us1.SetValues;
3634 begin
3635   inherited SetValues;
3636   fBitsPerPixel     := 16;
3637   fFormat           := tfBGR5A1us1;
3638   fWithAlpha        := tfBGR5A1us1;
3639   fWithoutAlpha     := tfBGR5X1us1;
3640   fOpenGLFormat     := tfBGR5A1us1;
3641   fRGBInverted      := tfRGB5A1us1;
3642   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3643   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3644   fglFormat         := GL_BGRA;
3645   fglInternalFormat := GL_RGB5_A1;
3646   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3647 end;
3648
3649 procedure TfdA1BGR5us1.SetValues;
3650 begin
3651   inherited SetValues;
3652   fBitsPerPixel     := 16;
3653   fFormat           := tfA1BGR5us1;
3654   fWithAlpha        := tfA1BGR5us1;
3655   fWithoutAlpha     := tfX1BGR5us1;
3656   fOpenGLFormat     := tfA1BGR5us1;
3657   fRGBInverted      := tfA1RGB5us1;
3658   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3659   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3660   fglFormat         := GL_RGBA;
3661   fglInternalFormat := GL_RGB5_A1;
3662   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3663 end;
3664
3665 procedure TfdBGRA8ui1.SetValues;
3666 begin
3667   inherited SetValues;
3668   fBitsPerPixel     := 32;
3669   fFormat           := tfBGRA8ui1;
3670   fWithAlpha        := tfBGRA8ui1;
3671   fWithoutAlpha     := tfBGRX8ui1;
3672   fOpenGLFormat     := tfBGRA8ui1;
3673   fRGBInverted      := tfRGBA8ui1;
3674   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3675   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3676   fglFormat         := GL_BGRA;
3677   fglInternalFormat := GL_RGBA8;
3678   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3679 end;
3680
3681 procedure TfdABGR8ui1.SetValues;
3682 begin
3683   inherited SetValues;
3684   fBitsPerPixel     := 32;
3685   fFormat           := tfABGR8ui1;
3686   fWithAlpha        := tfABGR8ui1;
3687   fWithoutAlpha     := tfXBGR8ui1;
3688   fOpenGLFormat     := tfABGR8ui1;
3689   fRGBInverted      := tfARGB8ui1;
3690   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3691   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3692   fglFormat         := GL_RGBA;
3693   fglInternalFormat := GL_RGBA8;
3694   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3695 end;
3696
3697 procedure TfdBGRA8ub4.SetValues;
3698 begin
3699   inherited SetValues;
3700   fBitsPerPixel     := 32;
3701   fFormat           := tfBGRA8ub4;
3702   fWithAlpha        := tfBGRA8ub4;
3703   fWithoutAlpha     := tfBGR8ub3;
3704   fOpenGLFormat     := tfBGRA8ub4;
3705   fRGBInverted      := tfRGBA8ub4;
3706   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3707   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3708   fglFormat         := GL_BGRA;
3709   fglInternalFormat := GL_RGBA8;
3710   fglDataFormat     := GL_UNSIGNED_BYTE;
3711 end;
3712
3713 procedure TfdBGR10A2ui1.SetValues;
3714 begin
3715   inherited SetValues;
3716   fBitsPerPixel     := 32;
3717   fFormat           := tfBGR10A2ui1;
3718   fWithAlpha        := tfBGR10A2ui1;
3719   fWithoutAlpha     := tfBGR10X2ui1;
3720   fOpenGLFormat     := tfBGR10A2ui1;
3721   fRGBInverted      := tfRGB10A2ui1;
3722   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3723   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3724   fglFormat         := GL_BGRA;
3725   fglInternalFormat := GL_RGB10_A2;
3726   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3727 end;
3728
3729 procedure TfdA2BGR10ui1.SetValues;
3730 begin
3731   inherited SetValues;
3732   fBitsPerPixel     := 32;
3733   fFormat           := tfA2BGR10ui1;
3734   fWithAlpha        := tfA2BGR10ui1;
3735   fWithoutAlpha     := tfX2BGR10ui1;
3736   fOpenGLFormat     := tfA2BGR10ui1;
3737   fRGBInverted      := tfA2RGB10ui1;
3738   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3739   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3740   fglFormat         := GL_RGBA;
3741   fglInternalFormat := GL_RGB10_A2;
3742   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3743 end;
3744
3745 procedure TfdBGRA16us4.SetValues;
3746 begin
3747   inherited SetValues;
3748   fBitsPerPixel     := 64;
3749   fFormat           := tfBGRA16us4;
3750   fWithAlpha        := tfBGRA16us4;
3751   fWithoutAlpha     := tfBGR16us3;
3752   fOpenGLFormat     := tfBGRA16us4;
3753   fRGBInverted      := tfRGBA16us4;
3754   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3755   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3756   fglFormat         := GL_BGRA;
3757   fglInternalFormat := GL_RGBA16;
3758   fglDataFormat     := GL_UNSIGNED_SHORT;
3759 end;
3760
3761 procedure TfdDepth16us1.SetValues;
3762 begin
3763   inherited SetValues;
3764   fBitsPerPixel     := 16;
3765   fFormat           := tfDepth16us1;
3766   fWithoutAlpha     := tfDepth16us1;
3767   fOpenGLFormat     := tfDepth16us1;
3768   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3769   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3770   fglFormat         := GL_DEPTH_COMPONENT;
3771   fglInternalFormat := GL_DEPTH_COMPONENT16;
3772   fglDataFormat     := GL_UNSIGNED_SHORT;
3773 end;
3774
3775 procedure TfdDepth24ui1.SetValues;
3776 begin
3777   inherited SetValues;
3778   fBitsPerPixel     := 32;
3779   fFormat           := tfDepth24ui1;
3780   fWithoutAlpha     := tfDepth24ui1;
3781   fOpenGLFormat     := tfDepth24ui1;
3782   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3783   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3784   fglFormat         := GL_DEPTH_COMPONENT;
3785   fglInternalFormat := GL_DEPTH_COMPONENT24;
3786   fglDataFormat     := GL_UNSIGNED_INT;
3787 end;
3788
3789 procedure TfdDepth32ui1.SetValues;
3790 begin
3791   inherited SetValues;
3792   fBitsPerPixel     := 32;
3793   fFormat           := tfDepth32ui1;
3794   fWithoutAlpha     := tfDepth32ui1;
3795   fOpenGLFormat     := tfDepth32ui1;
3796   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3797   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3798   fglFormat         := GL_DEPTH_COMPONENT;
3799   fglInternalFormat := GL_DEPTH_COMPONENT32;
3800   fglDataFormat     := GL_UNSIGNED_INT;
3801 end;
3802
3803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3804 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3806 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3807 begin
3808   raise EglBitmap.Create('mapping for compressed formats is not supported');
3809 end;
3810
3811 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3812 begin
3813   raise EglBitmap.Create('mapping for compressed formats is not supported');
3814 end;
3815
3816 procedure TfdS3tcDtx1RGBA.SetValues;
3817 begin
3818   inherited SetValues;
3819   fFormat           := tfS3tcDtx1RGBA;
3820   fWithAlpha        := tfS3tcDtx1RGBA;
3821   fOpenGLFormat     := tfS3tcDtx1RGBA;
3822   fUncompressed     := tfRGB5A1us1;
3823   fBitsPerPixel     := 4;
3824   fIsCompressed     := true;
3825   fglFormat         := GL_COMPRESSED_RGBA;
3826   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3827   fglDataFormat     := GL_UNSIGNED_BYTE;
3828 end;
3829
3830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3831 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3833 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3834 begin
3835   raise EglBitmap.Create('mapping for compressed formats is not supported');
3836 end;
3837
3838 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3839 begin
3840   raise EglBitmap.Create('mapping for compressed formats is not supported');
3841 end;
3842
3843 procedure TfdS3tcDtx3RGBA.SetValues;
3844 begin
3845   inherited SetValues;
3846   fFormat           := tfS3tcDtx3RGBA;
3847   fWithAlpha        := tfS3tcDtx3RGBA;
3848   fOpenGLFormat     := tfS3tcDtx3RGBA;
3849   fUncompressed     := tfRGBA8ub4;
3850   fBitsPerPixel     := 8;
3851   fIsCompressed     := true;
3852   fglFormat         := GL_COMPRESSED_RGBA;
3853   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3854   fglDataFormat     := GL_UNSIGNED_BYTE;
3855 end;
3856
3857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3858 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3860 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3861 begin
3862   raise EglBitmap.Create('mapping for compressed formats is not supported');
3863 end;
3864
3865 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3866 begin
3867   raise EglBitmap.Create('mapping for compressed formats is not supported');
3868 end;
3869
3870 procedure TfdS3tcDtx5RGBA.SetValues;
3871 begin
3872   inherited Create;
3873   fFormat           := tfS3tcDtx3RGBA;
3874   fWithAlpha        := tfS3tcDtx3RGBA;
3875   fOpenGLFormat     := tfS3tcDtx3RGBA;
3876   fUncompressed     := tfRGBA8ub4;
3877   fBitsPerPixel     := 8;
3878   fIsCompressed     := true;
3879   fglFormat         := GL_COMPRESSED_RGBA;
3880   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3881   fglDataFormat     := GL_UNSIGNED_BYTE;
3882 end;
3883
3884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3885 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3887 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3888 begin
3889   result := (fPrecision.r > 0);
3890 end;
3891
3892 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3893 begin
3894   result := (fPrecision.g > 0);
3895 end;
3896
3897 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3898 begin
3899   result := (fPrecision.b > 0);
3900 end;
3901
3902 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3903 begin
3904   result := (fPrecision.a > 0);
3905 end;
3906
3907 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3908 begin
3909   result := HasRed or HasGreen or HasBlue;
3910 end;
3911
3912 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3913 begin
3914   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3915 end;
3916
3917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3918 procedure TglBitmapFormatDescriptor.SetValues;
3919 begin
3920   fFormat       := tfEmpty;
3921   fWithAlpha    := tfEmpty;
3922   fWithoutAlpha := tfEmpty;
3923   fOpenGLFormat := tfEmpty;
3924   fRGBInverted  := tfEmpty;
3925   fUncompressed := tfEmpty;
3926
3927   fBitsPerPixel := 0;
3928   fIsCompressed := false;
3929
3930   fglFormat         := 0;
3931   fglInternalFormat := 0;
3932   fglDataFormat     := 0;
3933
3934   FillChar(fPrecision, 0, SizeOf(fPrecision));
3935   FillChar(fShift,     0, SizeOf(fShift));
3936 end;
3937
3938 procedure TglBitmapFormatDescriptor.CalcValues;
3939 var
3940   i: Integer;
3941 begin
3942   fBytesPerPixel := fBitsPerPixel / 8;
3943   fChannelCount  := 0;
3944   for i := 0 to 3 do begin
3945     if (fPrecision.arr[i] > 0) then
3946       inc(fChannelCount);
3947     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3948     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3949   end;
3950 end;
3951
3952 constructor TglBitmapFormatDescriptor.Create;
3953 begin
3954   inherited Create;
3955   SetValues;
3956   CalcValues;
3957 end;
3958
3959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3960 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3961 var
3962   f: TglBitmapFormat;
3963 begin
3964   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3965     result := TFormatDescriptor.Get(f);
3966     if (result.glInternalFormat = aInternalFormat) then
3967       exit;
3968   end;
3969   result := TFormatDescriptor.Get(tfEmpty);
3970 end;
3971
3972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3973 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3975 class procedure TFormatDescriptor.Init;
3976 begin
3977   if not Assigned(FormatDescriptorCS) then
3978     FormatDescriptorCS := TCriticalSection.Create;
3979 end;
3980
3981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3982 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3983 begin
3984   FormatDescriptorCS.Enter;
3985   try
3986     result := FormatDescriptors[aFormat];
3987     if not Assigned(result) then begin
3988       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3989       FormatDescriptors[aFormat] := result;
3990     end;
3991   finally
3992     FormatDescriptorCS.Leave;
3993   end;
3994 end;
3995
3996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3997 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3998 begin
3999   result := Get(Get(aFormat).WithAlpha);
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4004 var
4005   ft: TglBitmapFormat;
4006 begin
4007   // find matching format with OpenGL support
4008   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4009     result := Get(ft);
4010     if (result.MaskMatch(aMask))      and
4011        (result.glFormat <> 0)         and
4012        (result.glInternalFormat <> 0) and
4013        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4014     then
4015       exit;
4016   end;
4017
4018   // find matching format without OpenGL Support
4019   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4020     result := Get(ft);
4021     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4022       exit;
4023   end;
4024
4025   result := FormatDescriptors[tfEmpty];
4026 end;
4027
4028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4029 class procedure TFormatDescriptor.Clear;
4030 var
4031   f: TglBitmapFormat;
4032 begin
4033   FormatDescriptorCS.Enter;
4034   try
4035     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4036       FreeAndNil(FormatDescriptors[f]);
4037   finally
4038     FormatDescriptorCS.Leave;
4039   end;
4040 end;
4041
4042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4043 class procedure TFormatDescriptor.Finalize;
4044 begin
4045   Clear;
4046   FreeAndNil(FormatDescriptorCS);
4047 end;
4048
4049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4050 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4052 procedure TbmpBitfieldFormat.SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4053 var
4054   i: Integer;
4055 begin
4056   for i := 0 to 3 do begin
4057     fShift.arr[i] := 0;
4058     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4059       aMask.arr[i] := aMask.arr[i] shr 1;
4060       inc(fShift.arr[i]);
4061     end;
4062     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4063   end;
4064   CalcValues;
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 procedure TbmpBitfieldFormat.SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4069 begin
4070   fBitsPerPixel := aBBP;
4071   fPrecision    := aPrec;
4072   fShift        := aShift;
4073   CalcValues;
4074 end;
4075
4076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4077 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4078 var
4079   data: QWord;
4080 begin
4081   data :=
4082     ((aPixel.Data.r and Range.r) shl Shift.r) or
4083     ((aPixel.Data.g and Range.g) shl Shift.g) or
4084     ((aPixel.Data.b and Range.b) shl Shift.b) or
4085     ((aPixel.Data.a and Range.a) shl Shift.a);
4086   case BitsPerPixel of
4087     8:           aData^  := data;
4088    16:     PWord(aData)^ := data;
4089    32: PCardinal(aData)^ := data;
4090    64:    PQWord(aData)^ := data;
4091   else
4092     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4093   end;
4094   inc(aData, Round(BytesPerPixel));
4095 end;
4096
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4099 var
4100   data: QWord;
4101   i: Integer;
4102 begin
4103   case BitsPerPixel of
4104      8: data :=           aData^;
4105     16: data :=     PWord(aData)^;
4106     32: data := PCardinal(aData)^;
4107     64: data :=    PQWord(aData)^;
4108   else
4109     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4110   end;
4111   for i := 0 to 3 do
4112     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4113   inc(aData, Round(BytesPerPixel));
4114 end;
4115
4116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4117 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 procedure TbmpColorTableFormat.SetValues;
4120 begin
4121   inherited SetValues;
4122   fShift := glBitmapRec4ub(8, 8, 8, 0);
4123 end;
4124
4125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4126 procedure TbmpColorTableFormat.SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4127 begin
4128   fFormat       := aFormat;
4129   fBitsPerPixel := aBPP;
4130   fPrecision    := aPrec;
4131   fShift        := aShift;
4132   CalcValues;
4133 end;
4134
4135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4136 procedure TbmpColorTableFormat.CalcValues;
4137 begin
4138   inherited CalcValues;
4139 end;
4140
4141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4142 procedure TbmpColorTableFormat.CreateColorTable;
4143 var
4144   i: Integer;
4145 begin
4146   SetLength(fColorTable, 256);
4147   if not HasColor then begin
4148     // alpha
4149     for i := 0 to High(fColorTable) do begin
4150       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4151       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4152       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4153       fColorTable[i].a := 0;
4154     end;
4155   end else begin
4156     // normal
4157     for i := 0 to High(fColorTable) do begin
4158       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4159       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4160       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4161       fColorTable[i].a := 0;
4162     end;
4163   end;
4164 end;
4165
4166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4167 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4168 begin
4169   if (BitsPerPixel <> 8) then
4170     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4171   if not HasColor then
4172     // alpha
4173     aData^ := aPixel.Data.a
4174   else
4175     // normal
4176     aData^ := Round(
4177       ((aPixel.Data.r and Range.r) shl Shift.r) or
4178       ((aPixel.Data.g and Range.g) shl Shift.g) or
4179       ((aPixel.Data.b and Range.b) shl Shift.b));
4180   inc(aData);
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4185 begin
4186   if (BitsPerPixel <> 8) then
4187     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4188   with fColorTable[aData^] do begin
4189     aPixel.Data.r := r;
4190     aPixel.Data.g := g;
4191     aPixel.Data.b := b;
4192     aPixel.Data.a := a;
4193   end;
4194   inc(aData, 1);
4195 end;
4196
4197 destructor TbmpColorTableFormat.Destroy;
4198 begin
4199   SetLength(fColorTable, 0);
4200   inherited Destroy;
4201 end;
4202
4203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4204 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4206 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4207 var
4208   i: Integer;
4209 begin
4210   for i := 0 to 3 do begin
4211     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4212       if (aSourceFD.Range.arr[i] > 0) then
4213         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4214       else
4215         aPixel.Data.arr[i] := 0;
4216     end;
4217   end;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4222 begin
4223   with aFuncRec do begin
4224     if (Source.Range.r   > 0) then
4225       Dest.Data.r := Source.Data.r;
4226     if (Source.Range.g > 0) then
4227       Dest.Data.g := Source.Data.g;
4228     if (Source.Range.b  > 0) then
4229       Dest.Data.b := Source.Data.b;
4230     if (Source.Range.a > 0) then
4231       Dest.Data.a := Source.Data.a;
4232   end;
4233 end;
4234
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4237 var
4238   i: Integer;
4239 begin
4240   with aFuncRec do begin
4241     for i := 0 to 3 do
4242       if (Source.Range.arr[i] > 0) then
4243         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4244   end;
4245 end;
4246
4247 type
4248   TShiftData = packed record
4249     case Integer of
4250       0: (r, g, b, a: SmallInt);
4251       1: (arr: array[0..3] of SmallInt);
4252   end;
4253   PShiftData = ^TShiftData;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4257 var
4258   i: Integer;
4259 begin
4260   with aFuncRec do
4261     for i := 0 to 3 do
4262       if (Source.Range.arr[i] > 0) then
4263         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4268 begin
4269   with aFuncRec do begin
4270     Dest.Data := Source.Data;
4271     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4272       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4273       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4274       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4275     end;
4276     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4277       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4278     end;
4279   end;
4280 end;
4281
4282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4283 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4284 var
4285   i: Integer;
4286 begin
4287   with aFuncRec do begin
4288     for i := 0 to 3 do
4289       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4290   end;
4291 end;
4292
4293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4294 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4295 var
4296   Temp: Single;
4297 begin
4298   with FuncRec do begin
4299     if (FuncRec.Args = nil) then begin //source has no alpha
4300       Temp :=
4301         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4302         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4303         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4304       Dest.Data.a := Round(Dest.Range.a * Temp);
4305     end else
4306       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4307   end;
4308 end;
4309
4310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4311 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4312 type
4313   PglBitmapPixelData = ^TglBitmapPixelData;
4314 begin
4315   with FuncRec do begin
4316     Dest.Data.r := Source.Data.r;
4317     Dest.Data.g := Source.Data.g;
4318     Dest.Data.b := Source.Data.b;
4319
4320     with PglBitmapPixelData(Args)^ do
4321       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4322           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4323           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4324         Dest.Data.a := 0
4325       else
4326         Dest.Data.a := Dest.Range.a;
4327   end;
4328 end;
4329
4330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4331 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4332 begin
4333   with FuncRec do begin
4334     Dest.Data.r := Source.Data.r;
4335     Dest.Data.g := Source.Data.g;
4336     Dest.Data.b := Source.Data.b;
4337     Dest.Data.a := PCardinal(Args)^;
4338   end;
4339 end;
4340
4341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4342 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4343 type
4344   PRGBPix = ^TRGBPix;
4345   TRGBPix = array [0..2] of byte;
4346 var
4347   Temp: Byte;
4348 begin
4349   while aWidth > 0 do begin
4350     Temp := PRGBPix(aData)^[0];
4351     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4352     PRGBPix(aData)^[2] := Temp;
4353
4354     if aHasAlpha then
4355       Inc(aData, 4)
4356     else
4357       Inc(aData, 3);
4358     dec(aWidth);
4359   end;
4360 end;
4361
4362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4363 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4365 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4366 begin
4367   result := TFormatDescriptor.Get(Format);
4368 end;
4369
4370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4371 function TglBitmap.GetWidth: Integer;
4372 begin
4373   if (ffX in fDimension.Fields) then
4374     result := fDimension.X
4375   else
4376     result := -1;
4377 end;
4378
4379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4380 function TglBitmap.GetHeight: Integer;
4381 begin
4382   if (ffY in fDimension.Fields) then
4383     result := fDimension.Y
4384   else
4385     result := -1;
4386 end;
4387
4388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4389 function TglBitmap.GetFileWidth: Integer;
4390 begin
4391   result := Max(1, Width);
4392 end;
4393
4394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4395 function TglBitmap.GetFileHeight: Integer;
4396 begin
4397   result := Max(1, Height);
4398 end;
4399
4400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4401 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4402 begin
4403   if fCustomData = aValue then
4404     exit;
4405   fCustomData := aValue;
4406 end;
4407
4408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4409 procedure TglBitmap.SetCustomName(const aValue: String);
4410 begin
4411   if fCustomName = aValue then
4412     exit;
4413   fCustomName := aValue;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4418 begin
4419   if fCustomNameW = aValue then
4420     exit;
4421   fCustomNameW := aValue;
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4426 begin
4427   if fFreeDataOnDestroy = aValue then
4428     exit;
4429   fFreeDataOnDestroy := aValue;
4430 end;
4431
4432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4433 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4434 begin
4435   if fDeleteTextureOnFree = aValue then
4436     exit;
4437   fDeleteTextureOnFree := aValue;
4438 end;
4439
4440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4441 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4442 begin
4443   if fFormat = aValue then
4444     exit;
4445   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4446     raise EglBitmapUnsupportedFormat.Create(Format);
4447   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4452 begin
4453   if fFreeDataAfterGenTexture = aValue then
4454     exit;
4455   fFreeDataAfterGenTexture := aValue;
4456 end;
4457
4458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4459 procedure TglBitmap.SetID(const aValue: Cardinal);
4460 begin
4461   if fID = aValue then
4462     exit;
4463   fID := aValue;
4464 end;
4465
4466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4468 begin
4469   if fMipMap = aValue then
4470     exit;
4471   fMipMap := aValue;
4472 end;
4473
4474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4475 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4476 begin
4477   if fTarget = aValue then
4478     exit;
4479   fTarget := aValue;
4480 end;
4481
4482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4483 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4484 var
4485   MaxAnisotropic: Integer;
4486 begin
4487   fAnisotropic := aValue;
4488   if (ID > 0) then begin
4489     if GL_EXT_texture_filter_anisotropic then begin
4490       if fAnisotropic > 0 then begin
4491         Bind(false);
4492         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4493         if aValue > MaxAnisotropic then
4494           fAnisotropic := MaxAnisotropic;
4495         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4496       end;
4497     end else begin
4498       fAnisotropic := 0;
4499     end;
4500   end;
4501 end;
4502
4503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4504 procedure TglBitmap.CreateID;
4505 begin
4506   if (ID <> 0) then
4507     glDeleteTextures(1, @fID);
4508   glGenTextures(1, @fID);
4509   Bind(false);
4510 end;
4511
4512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4513 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4514 begin
4515   // Set Up Parameters
4516   SetWrap(fWrapS, fWrapT, fWrapR);
4517   SetFilter(fFilterMin, fFilterMag);
4518   SetAnisotropic(fAnisotropic);
4519   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4520
4521   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4522     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4523
4524   // Mip Maps Generation Mode
4525   aBuildWithGlu := false;
4526   if (MipMap = mmMipmap) then begin
4527     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4528       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4529     else
4530       aBuildWithGlu := true;
4531   end else if (MipMap = mmMipmapGlu) then
4532     aBuildWithGlu := true;
4533 end;
4534
4535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4536 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4537   const aWidth: Integer; const aHeight: Integer);
4538 var
4539   s: Single;
4540 begin
4541   if (Data <> aData) then begin
4542     if (Assigned(Data)) then
4543       FreeMem(Data);
4544     fData := aData;
4545   end;
4546
4547   if not Assigned(fData) then begin
4548     fPixelSize := 0;
4549     fRowSize   := 0;
4550   end else begin
4551     FillChar(fDimension, SizeOf(fDimension), 0);
4552     if aWidth <> -1 then begin
4553       fDimension.Fields := fDimension.Fields + [ffX];
4554       fDimension.X := aWidth;
4555     end;
4556
4557     if aHeight <> -1 then begin
4558       fDimension.Fields := fDimension.Fields + [ffY];
4559       fDimension.Y := aHeight;
4560     end;
4561
4562     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4563     fFormat    := aFormat;
4564     fPixelSize := Ceil(s);
4565     fRowSize   := Ceil(s * aWidth);
4566   end;
4567 end;
4568
4569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4570 function TglBitmap.FlipHorz: Boolean;
4571 begin
4572   result := false;
4573 end;
4574
4575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4576 function TglBitmap.FlipVert: Boolean;
4577 begin
4578   result := false;
4579 end;
4580
4581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4582 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4584 procedure TglBitmap.AfterConstruction;
4585 begin
4586   inherited AfterConstruction;
4587
4588   fID         := 0;
4589   fTarget     := 0;
4590   fIsResident := false;
4591
4592   fMipMap                  := glBitmapDefaultMipmap;
4593   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4594   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4595
4596   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4597   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4598   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4599 end;
4600
4601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4602 procedure TglBitmap.BeforeDestruction;
4603 var
4604   NewData: PByte;
4605 begin
4606   if fFreeDataOnDestroy then begin
4607     NewData := nil;
4608     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4609   end;
4610   if (fID > 0) and fDeleteTextureOnFree then
4611     glDeleteTextures(1, @fID);
4612   inherited BeforeDestruction;
4613 end;
4614
4615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4616 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4617 var
4618   TempPos: Integer;
4619 begin
4620   if not Assigned(aResType) then begin
4621     TempPos   := Pos('.', aResource);
4622     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4623     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4624   end;
4625 end;
4626
4627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4628 procedure TglBitmap.LoadFromFile(const aFilename: String);
4629 var
4630   fs: TFileStream;
4631 begin
4632   if not FileExists(aFilename) then
4633     raise EglBitmap.Create('file does not exist: ' + aFilename);
4634   fFilename := aFilename;
4635   fs := TFileStream.Create(fFilename, fmOpenRead);
4636   try
4637     fs.Position := 0;
4638     LoadFromStream(fs);
4639   finally
4640     fs.Free;
4641   end;
4642 end;
4643
4644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4645 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4646 begin
4647   {$IFDEF GLB_SUPPORT_PNG_READ}
4648   if not LoadPNG(aStream) then
4649   {$ENDIF}
4650   {$IFDEF GLB_SUPPORT_JPEG_READ}
4651   if not LoadJPEG(aStream) then
4652   {$ENDIF}
4653   if not LoadDDS(aStream) then
4654   if not LoadTGA(aStream) then
4655   if not LoadBMP(aStream) then
4656     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4657 end;
4658
4659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4660 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4661   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4662 var
4663   tmpData: PByte;
4664   size: Integer;
4665 begin
4666   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4667   GetMem(tmpData, size);
4668   try
4669     FillChar(tmpData^, size, #$FF);
4670     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4671   except
4672     if Assigned(tmpData) then
4673       FreeMem(tmpData);
4674     raise;
4675   end;
4676   AddFunc(Self, aFunc, false, aFormat, aArgs);
4677 end;
4678
4679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4680 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4681 var
4682   rs: TResourceStream;
4683 begin
4684   PrepareResType(aResource, aResType);
4685   rs := TResourceStream.Create(aInstance, aResource, aResType);
4686   try
4687     LoadFromStream(rs);
4688   finally
4689     rs.Free;
4690   end;
4691 end;
4692
4693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4694 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4695 var
4696   rs: TResourceStream;
4697 begin
4698   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4699   try
4700     LoadFromStream(rs);
4701   finally
4702     rs.Free;
4703   end;
4704 end;
4705
4706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4707 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4708 var
4709   fs: TFileStream;
4710 begin
4711   fs := TFileStream.Create(aFileName, fmCreate);
4712   try
4713     fs.Position := 0;
4714     SaveToStream(fs, aFileType);
4715   finally
4716     fs.Free;
4717   end;
4718 end;
4719
4720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4721 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4722 begin
4723   case aFileType of
4724     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4725     ftPNG:  SavePNG(aStream);
4726     {$ENDIF}
4727     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4728     ftJPEG: SaveJPEG(aStream);
4729     {$ENDIF}
4730     ftDDS:  SaveDDS(aStream);
4731     ftTGA:  SaveTGA(aStream);
4732     ftBMP:  SaveBMP(aStream);
4733   end;
4734 end;
4735
4736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4737 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4738 begin
4739   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4740 end;
4741
4742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4743 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4744   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4745 var
4746   DestData, TmpData, SourceData: pByte;
4747   TempHeight, TempWidth: Integer;
4748   SourceFD, DestFD: TFormatDescriptor;
4749   SourceMD, DestMD: Pointer;
4750
4751   FuncRec: TglBitmapFunctionRec;
4752 begin
4753   Assert(Assigned(Data));
4754   Assert(Assigned(aSource));
4755   Assert(Assigned(aSource.Data));
4756
4757   result := false;
4758   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4759     SourceFD := TFormatDescriptor.Get(aSource.Format);
4760     DestFD   := TFormatDescriptor.Get(aFormat);
4761
4762     if (SourceFD.IsCompressed) then
4763       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4764     if (DestFD.IsCompressed) then
4765       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4766
4767     // inkompatible Formats so CreateTemp
4768     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
4769       aCreateTemp := true;
4770
4771     // Values
4772     TempHeight := Max(1, aSource.Height);
4773     TempWidth  := Max(1, aSource.Width);
4774
4775     FuncRec.Sender := Self;
4776     FuncRec.Args   := aArgs;
4777
4778     TmpData := nil;
4779     if aCreateTemp then begin
4780       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4781       DestData := TmpData;
4782     end else
4783       DestData := Data;
4784
4785     try
4786       SourceFD.PreparePixel(FuncRec.Source);
4787       DestFD.PreparePixel  (FuncRec.Dest);
4788
4789       SourceMD := SourceFD.CreateMappingData;
4790       DestMD   := DestFD.CreateMappingData;
4791
4792       FuncRec.Size            := aSource.Dimension;
4793       FuncRec.Position.Fields := FuncRec.Size.Fields;
4794
4795       try
4796         SourceData := aSource.Data;
4797         FuncRec.Position.Y := 0;
4798         while FuncRec.Position.Y < TempHeight do begin
4799           FuncRec.Position.X := 0;
4800           while FuncRec.Position.X < TempWidth do begin
4801             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4802             aFunc(FuncRec);
4803             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4804             inc(FuncRec.Position.X);
4805           end;
4806           inc(FuncRec.Position.Y);
4807         end;
4808
4809         // Updating Image or InternalFormat
4810         if aCreateTemp then
4811           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4812         else if (aFormat <> fFormat) then
4813           Format := aFormat;
4814
4815         result := true;
4816       finally
4817         SourceFD.FreeMappingData(SourceMD);
4818         DestFD.FreeMappingData(DestMD);
4819       end;
4820     except
4821       if aCreateTemp and Assigned(TmpData) then
4822         FreeMem(TmpData);
4823       raise;
4824     end;
4825   end;
4826 end;
4827
4828 {$IFDEF GLB_SDL}
4829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4830 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4831 var
4832   Row, RowSize: Integer;
4833   SourceData, TmpData: PByte;
4834   TempDepth: Integer;
4835   FormatDesc: TFormatDescriptor;
4836
4837   function GetRowPointer(Row: Integer): pByte;
4838   begin
4839     result := aSurface.pixels;
4840     Inc(result, Row * RowSize);
4841   end;
4842
4843 begin
4844   result := false;
4845
4846   FormatDesc := TFormatDescriptor.Get(Format);
4847   if FormatDesc.IsCompressed then
4848     raise EglBitmapUnsupportedFormat.Create(Format);
4849
4850   if Assigned(Data) then begin
4851     case Trunc(FormatDesc.PixelSize) of
4852       1: TempDepth :=  8;
4853       2: TempDepth := 16;
4854       3: TempDepth := 24;
4855       4: TempDepth := 32;
4856     else
4857       raise EglBitmapUnsupportedFormat.Create(Format);
4858     end;
4859
4860     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4861       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4862     SourceData := Data;
4863     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4864
4865     for Row := 0 to FileHeight-1 do begin
4866       TmpData := GetRowPointer(Row);
4867       if Assigned(TmpData) then begin
4868         Move(SourceData^, TmpData^, RowSize);
4869         inc(SourceData, RowSize);
4870       end;
4871     end;
4872     result := true;
4873   end;
4874 end;
4875
4876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4877 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4878 var
4879   pSource, pData, pTempData: PByte;
4880   Row, RowSize, TempWidth, TempHeight: Integer;
4881   IntFormat: TglBitmapFormat;
4882   fd: TFormatDescriptor;
4883   Mask: TglBitmapMask;
4884
4885   function GetRowPointer(Row: Integer): pByte;
4886   begin
4887     result := aSurface^.pixels;
4888     Inc(result, Row * RowSize);
4889   end;
4890
4891 begin
4892   result := false;
4893   if (Assigned(aSurface)) then begin
4894     with aSurface^.format^ do begin
4895       Mask.r := RMask;
4896       Mask.g := GMask;
4897       Mask.b := BMask;
4898       Mask.a := AMask;
4899       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
4900       if (IntFormat = tfEmpty) then
4901         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
4902     end;
4903
4904     fd := TFormatDescriptor.Get(IntFormat);
4905     TempWidth  := aSurface^.w;
4906     TempHeight := aSurface^.h;
4907     RowSize := fd.GetSize(TempWidth, 1);
4908     GetMem(pData, TempHeight * RowSize);
4909     try
4910       pTempData := pData;
4911       for Row := 0 to TempHeight -1 do begin
4912         pSource := GetRowPointer(Row);
4913         if (Assigned(pSource)) then begin
4914           Move(pSource^, pTempData^, RowSize);
4915           Inc(pTempData, RowSize);
4916         end;
4917       end;
4918       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4919       result := true;
4920     except
4921       if Assigned(pData) then
4922         FreeMem(pData);
4923       raise;
4924     end;
4925   end;
4926 end;
4927
4928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4929 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4930 var
4931   Row, Col, AlphaInterleave: Integer;
4932   pSource, pDest: PByte;
4933
4934   function GetRowPointer(Row: Integer): pByte;
4935   begin
4936     result := aSurface.pixels;
4937     Inc(result, Row * Width);
4938   end;
4939
4940 begin
4941   result := false;
4942   if Assigned(Data) then begin
4943     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
4944       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4945
4946       AlphaInterleave := 0;
4947       case Format of
4948         tfLuminance8Alpha8ub2:
4949           AlphaInterleave := 1;
4950         tfBGRA8ub4, tfRGBA8ub4:
4951           AlphaInterleave := 3;
4952       end;
4953
4954       pSource := Data;
4955       for Row := 0 to Height -1 do begin
4956         pDest := GetRowPointer(Row);
4957         if Assigned(pDest) then begin
4958           for Col := 0 to Width -1 do begin
4959             Inc(pSource, AlphaInterleave);
4960             pDest^ := pSource^;
4961             Inc(pDest);
4962             Inc(pSource);
4963           end;
4964         end;
4965       end;
4966       result := true;
4967     end;
4968   end;
4969 end;
4970
4971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4972 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4973 var
4974   bmp: TglBitmap2D;
4975 begin
4976   bmp := TglBitmap2D.Create;
4977   try
4978     bmp.AssignFromSurface(aSurface);
4979     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4980   finally
4981     bmp.Free;
4982   end;
4983 end;
4984 {$ENDIF}
4985
4986 {$IFDEF GLB_DELPHI}
4987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4988 function CreateGrayPalette: HPALETTE;
4989 var
4990   Idx: Integer;
4991   Pal: PLogPalette;
4992 begin
4993   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4994
4995   Pal.palVersion := $300;
4996   Pal.palNumEntries := 256;
4997
4998   for Idx := 0 to Pal.palNumEntries - 1 do begin
4999     Pal.palPalEntry[Idx].peRed   := Idx;
5000     Pal.palPalEntry[Idx].peGreen := Idx;
5001     Pal.palPalEntry[Idx].peBlue  := Idx;
5002     Pal.palPalEntry[Idx].peFlags := 0;
5003   end;
5004   Result := CreatePalette(Pal^);
5005   FreeMem(Pal);
5006 end;
5007
5008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5009 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5010 var
5011   Row: Integer;
5012   pSource, pData: PByte;
5013 begin
5014   result := false;
5015   if Assigned(Data) then begin
5016     if Assigned(aBitmap) then begin
5017       aBitmap.Width  := Width;
5018       aBitmap.Height := Height;
5019
5020       case Format of
5021         tfAlpha8ub1, tfLuminance8ub1: begin
5022           aBitmap.PixelFormat := pf8bit;
5023           aBitmap.Palette     := CreateGrayPalette;
5024         end;
5025         tfRGB5A1us1:
5026           aBitmap.PixelFormat := pf15bit;
5027         tfR5G6B5us1:
5028           aBitmap.PixelFormat := pf16bit;
5029         tfRGB8ub3, tfBGR8ub3:
5030           aBitmap.PixelFormat := pf24bit;
5031         tfRGBA8ub4, tfBGRA8ub4:
5032           aBitmap.PixelFormat := pf32bit;
5033       else
5034         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5035       end;
5036
5037       pSource := Data;
5038       for Row := 0 to FileHeight -1 do begin
5039         pData := aBitmap.Scanline[Row];
5040         Move(pSource^, pData^, fRowSize);
5041         Inc(pSource, fRowSize);
5042         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5043           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5044       end;
5045       result := true;
5046     end;
5047   end;
5048 end;
5049
5050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5051 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5052 var
5053   pSource, pData, pTempData: PByte;
5054   Row, RowSize, TempWidth, TempHeight: Integer;
5055   IntFormat: TglBitmapFormat;
5056 begin
5057   result := false;
5058
5059   if (Assigned(aBitmap)) then begin
5060     case aBitmap.PixelFormat of
5061       pf8bit:
5062         IntFormat := tfLuminance8ub1;
5063       pf15bit:
5064         IntFormat := tfRGB5A1us1;
5065       pf16bit:
5066         IntFormat := tfR5G6B5us1;
5067       pf24bit:
5068         IntFormat := tfBGR8ub3;
5069       pf32bit:
5070         IntFormat := tfBGRA8ub4;
5071     else
5072       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5073     end;
5074
5075     TempWidth  := aBitmap.Width;
5076     TempHeight := aBitmap.Height;
5077     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5078     GetMem(pData, TempHeight * RowSize);
5079     try
5080       pTempData := pData;
5081       for Row := 0 to TempHeight -1 do begin
5082         pSource := aBitmap.Scanline[Row];
5083         if (Assigned(pSource)) then begin
5084           Move(pSource^, pTempData^, RowSize);
5085           Inc(pTempData, RowSize);
5086         end;
5087       end;
5088       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5089       result := true;
5090     except
5091       if Assigned(pData) then
5092         FreeMem(pData);
5093       raise;
5094     end;
5095   end;
5096 end;
5097
5098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5099 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5100 var
5101   Row, Col, AlphaInterleave: Integer;
5102   pSource, pDest: PByte;
5103 begin
5104   result := false;
5105
5106   if Assigned(Data) then begin
5107     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5108       if Assigned(aBitmap) then begin
5109         aBitmap.PixelFormat := pf8bit;
5110         aBitmap.Palette     := CreateGrayPalette;
5111         aBitmap.Width       := Width;
5112         aBitmap.Height      := Height;
5113
5114         case Format of
5115           tfLuminance8Alpha8ub2:
5116             AlphaInterleave := 1;
5117           tfRGBA8ub4, tfBGRA8ub4:
5118             AlphaInterleave := 3;
5119           else
5120             AlphaInterleave := 0;
5121         end;
5122
5123         // Copy Data
5124         pSource := Data;
5125
5126         for Row := 0 to Height -1 do begin
5127           pDest := aBitmap.Scanline[Row];
5128           if Assigned(pDest) then begin
5129             for Col := 0 to Width -1 do begin
5130               Inc(pSource, AlphaInterleave);
5131               pDest^ := pSource^;
5132               Inc(pDest);
5133               Inc(pSource);
5134             end;
5135           end;
5136         end;
5137         result := true;
5138       end;
5139     end;
5140   end;
5141 end;
5142
5143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5144 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5145 var
5146   tex: TglBitmap2D;
5147 begin
5148   tex := TglBitmap2D.Create;
5149   try
5150     tex.AssignFromBitmap(ABitmap);
5151     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5152   finally
5153     tex.Free;
5154   end;
5155 end;
5156 {$ENDIF}
5157
5158 {$IFDEF GLB_LAZARUS}
5159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5160 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5161 var
5162   rid: TRawImageDescription;
5163   FormatDesc: TFormatDescriptor;
5164 begin
5165   if not Assigned(Data) then
5166     raise EglBitmap.Create('no pixel data assigned. load data before save');
5167
5168   result := false;
5169   if not Assigned(aImage) or (Format = tfEmpty) then
5170     exit;
5171   FormatDesc := TFormatDescriptor.Get(Format);
5172   if FormatDesc.IsCompressed then
5173     exit;
5174
5175   FillChar(rid{%H-}, SizeOf(rid), 0);
5176   if FormatDesc.IsGrayscale then
5177     rid.Format := ricfGray
5178   else
5179     rid.Format := ricfRGBA;
5180
5181   rid.Width        := Width;
5182   rid.Height       := Height;
5183   rid.Depth        := FormatDesc.BitsPerPixel;
5184   rid.BitOrder     := riboBitsInOrder;
5185   rid.ByteOrder    := riboLSBFirst;
5186   rid.LineOrder    := riloTopToBottom;
5187   rid.LineEnd      := rileTight;
5188   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5189   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5190   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5191   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5192   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5193   rid.RedShift     := FormatDesc.Shift.r;
5194   rid.GreenShift   := FormatDesc.Shift.g;
5195   rid.BlueShift    := FormatDesc.Shift.b;
5196   rid.AlphaShift   := FormatDesc.Shift.a;
5197
5198   rid.MaskBitsPerPixel  := 0;
5199   rid.PaletteColorCount := 0;
5200
5201   aImage.DataDescription := rid;
5202   aImage.CreateData;
5203
5204   if not Assigned(aImage.PixelData) then
5205     raise EglBitmap.Create('error while creating LazIntfImage');
5206   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5207
5208   result := true;
5209 end;
5210
5211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5212 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5213 var
5214   f: TglBitmapFormat;
5215   FormatDesc: TFormatDescriptor;
5216   ImageData: PByte;
5217   ImageSize: Integer;
5218   CanCopy: Boolean;
5219   Mask: TglBitmapRec4ul;
5220
5221   procedure CopyConvert;
5222   var
5223     bfFormat: TbmpBitfieldFormat;
5224     pSourceLine, pDestLine: PByte;
5225     pSourceMD, pDestMD: Pointer;
5226     Shift, Prec: TglBitmapRec4ub;
5227     x, y: Integer;
5228     pixel: TglBitmapPixelData;
5229   begin
5230     bfFormat  := TbmpBitfieldFormat.Create;
5231     with aImage.DataDescription do begin
5232       Prec.r := RedPrec;
5233       Prec.g := GreenPrec;
5234       Prec.b := BluePrec;
5235       Prec.a := AlphaPrec;
5236       Shift.r := RedShift;
5237       Shift.g := GreenShift;
5238       Shift.b := BlueShift;
5239       Shift.a := AlphaShift;
5240       bfFormat.SetValues(BitsPerPixel, Prec, Shift);
5241     end;
5242     pSourceMD := bfFormat.CreateMappingData;
5243     pDestMD   := FormatDesc.CreateMappingData;
5244     try
5245       for y := 0 to aImage.Height-1 do begin
5246         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5247         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5248         for x := 0 to aImage.Width-1 do begin
5249           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5250           FormatDesc.Map(pixel, pDestLine, pDestMD);
5251         end;
5252       end;
5253     finally
5254       FormatDesc.FreeMappingData(pDestMD);
5255       bfFormat.FreeMappingData(pSourceMD);
5256       bfFormat.Free;
5257     end;
5258   end;
5259
5260 begin
5261   result := false;
5262   if not Assigned(aImage) then
5263     exit;
5264
5265   with aImage.DataDescription do begin
5266     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5267     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5268     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5269     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5270   end;
5271   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5272   f          := FormatDesc.Format;
5273   if (f = tfEmpty) then
5274     exit;
5275
5276   CanCopy :=
5277     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5278     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5279
5280   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5281   ImageData := GetMem(ImageSize);
5282   try
5283     if CanCopy then
5284       Move(aImage.PixelData^, ImageData^, ImageSize)
5285     else
5286       CopyConvert;
5287     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5288   except
5289     if Assigned(ImageData) then
5290       FreeMem(ImageData);
5291     raise;
5292   end;
5293
5294   result := true;
5295 end;
5296
5297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5298 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5299 var
5300   rid: TRawImageDescription;
5301   FormatDesc: TFormatDescriptor;
5302   Pixel: TglBitmapPixelData;
5303   x, y: Integer;
5304   srcMD: Pointer;
5305   src, dst: PByte;
5306 begin
5307   result := false;
5308   if not Assigned(aImage) or (Format = tfEmpty) then
5309     exit;
5310   FormatDesc := TFormatDescriptor.Get(Format);
5311   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5312     exit;
5313
5314   FillChar(rid{%H-}, SizeOf(rid), 0);
5315   rid.Format       := ricfGray;
5316   rid.Width        := Width;
5317   rid.Height       := Height;
5318   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5319   rid.BitOrder     := riboBitsInOrder;
5320   rid.ByteOrder    := riboLSBFirst;
5321   rid.LineOrder    := riloTopToBottom;
5322   rid.LineEnd      := rileTight;
5323   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5324   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5325   rid.GreenPrec    := 0;
5326   rid.BluePrec     := 0;
5327   rid.AlphaPrec    := 0;
5328   rid.RedShift     := 0;
5329   rid.GreenShift   := 0;
5330   rid.BlueShift    := 0;
5331   rid.AlphaShift   := 0;
5332
5333   rid.MaskBitsPerPixel  := 0;
5334   rid.PaletteColorCount := 0;
5335
5336   aImage.DataDescription := rid;
5337   aImage.CreateData;
5338
5339   srcMD := FormatDesc.CreateMappingData;
5340   try
5341     FormatDesc.PreparePixel(Pixel);
5342     src := Data;
5343     dst := aImage.PixelData;
5344     for y := 0 to Height-1 do
5345       for x := 0 to Width-1 do begin
5346         FormatDesc.Unmap(src, Pixel, srcMD);
5347         case rid.BitsPerPixel of
5348            8: begin
5349             dst^ := Pixel.Data.a;
5350             inc(dst);
5351           end;
5352           16: begin
5353             PWord(dst)^ := Pixel.Data.a;
5354             inc(dst, 2);
5355           end;
5356           24: begin
5357             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5358             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5359             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5360             inc(dst, 3);
5361           end;
5362           32: begin
5363             PCardinal(dst)^ := Pixel.Data.a;
5364             inc(dst, 4);
5365           end;
5366         else
5367           raise EglBitmapUnsupportedFormat.Create(Format);
5368         end;
5369       end;
5370   finally
5371     FormatDesc.FreeMappingData(srcMD);
5372   end;
5373   result := true;
5374 end;
5375
5376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5377 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5378 var
5379   tex: TglBitmap2D;
5380 begin
5381   tex := TglBitmap2D.Create;
5382   try
5383     tex.AssignFromLazIntfImage(aImage);
5384     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5385   finally
5386     tex.Free;
5387   end;
5388 end;
5389 {$ENDIF}
5390
5391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5392 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5393   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5394 var
5395   rs: TResourceStream;
5396 begin
5397   PrepareResType(aResource, aResType);
5398   rs := TResourceStream.Create(aInstance, aResource, aResType);
5399   try
5400     result := AddAlphaFromStream(rs, aFunc, aArgs);
5401   finally
5402     rs.Free;
5403   end;
5404 end;
5405
5406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5407 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5408   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5409 var
5410   rs: TResourceStream;
5411 begin
5412   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5413   try
5414     result := AddAlphaFromStream(rs, aFunc, aArgs);
5415   finally
5416     rs.Free;
5417   end;
5418 end;
5419
5420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5421 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5422 begin
5423   if TFormatDescriptor.Get(Format).IsCompressed then
5424     raise EglBitmapUnsupportedFormat.Create(Format);
5425   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5426 end;
5427
5428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5429 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5430 var
5431   FS: TFileStream;
5432 begin
5433   FS := TFileStream.Create(aFileName, fmOpenRead);
5434   try
5435     result := AddAlphaFromStream(FS, aFunc, aArgs);
5436   finally
5437     FS.Free;
5438   end;
5439 end;
5440
5441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5442 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5443 var
5444   tex: TglBitmap2D;
5445 begin
5446   tex := TglBitmap2D.Create(aStream);
5447   try
5448     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5449   finally
5450     tex.Free;
5451   end;
5452 end;
5453
5454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5455 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5456 var
5457   DestData, DestData2, SourceData: pByte;
5458   TempHeight, TempWidth: Integer;
5459   SourceFD, DestFD: TFormatDescriptor;
5460   SourceMD, DestMD, DestMD2: Pointer;
5461
5462   FuncRec: TglBitmapFunctionRec;
5463 begin
5464   result := false;
5465
5466   Assert(Assigned(Data));
5467   Assert(Assigned(aBitmap));
5468   Assert(Assigned(aBitmap.Data));
5469
5470   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5471     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5472
5473     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5474     DestFD   := TFormatDescriptor.Get(Format);
5475
5476     if not Assigned(aFunc) then begin
5477       aFunc        := glBitmapAlphaFunc;
5478       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5479     end else
5480       FuncRec.Args := aArgs;
5481
5482     // Values
5483     TempHeight := aBitmap.FileHeight;
5484     TempWidth  := aBitmap.FileWidth;
5485
5486     FuncRec.Sender          := Self;
5487     FuncRec.Size            := Dimension;
5488     FuncRec.Position.Fields := FuncRec.Size.Fields;
5489
5490     DestData   := Data;
5491     DestData2  := Data;
5492     SourceData := aBitmap.Data;
5493
5494     // Mapping
5495     SourceFD.PreparePixel(FuncRec.Source);
5496     DestFD.PreparePixel  (FuncRec.Dest);
5497
5498     SourceMD := SourceFD.CreateMappingData;
5499     DestMD   := DestFD.CreateMappingData;
5500     DestMD2  := DestFD.CreateMappingData;
5501     try
5502       FuncRec.Position.Y := 0;
5503       while FuncRec.Position.Y < TempHeight do begin
5504         FuncRec.Position.X := 0;
5505         while FuncRec.Position.X < TempWidth do begin
5506           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5507           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5508           aFunc(FuncRec);
5509           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5510           inc(FuncRec.Position.X);
5511         end;
5512         inc(FuncRec.Position.Y);
5513       end;
5514     finally
5515       SourceFD.FreeMappingData(SourceMD);
5516       DestFD.FreeMappingData(DestMD);
5517       DestFD.FreeMappingData(DestMD2);
5518     end;
5519   end;
5520 end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5524 begin
5525   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5526 end;
5527
5528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5529 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5530 var
5531   PixelData: TglBitmapPixelData;
5532 begin
5533   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5534   result := AddAlphaFromColorKeyFloat(
5535     aRed   / PixelData.Range.r,
5536     aGreen / PixelData.Range.g,
5537     aBlue  / PixelData.Range.b,
5538     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5539 end;
5540
5541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5542 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5543 var
5544   values: array[0..2] of Single;
5545   tmp: Cardinal;
5546   i: Integer;
5547   PixelData: TglBitmapPixelData;
5548 begin
5549   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5550   with PixelData do begin
5551     values[0] := aRed;
5552     values[1] := aGreen;
5553     values[2] := aBlue;
5554
5555     for i := 0 to 2 do begin
5556       tmp          := Trunc(Range.arr[i] * aDeviation);
5557       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5558       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5559     end;
5560     Data.a  := 0;
5561     Range.a := 0;
5562   end;
5563   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5564 end;
5565
5566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5567 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5568 begin
5569   result := AddAlphaFromValueFloat(aAlpha / $FF);
5570 end;
5571
5572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5573 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5574 var
5575   PixelData: TglBitmapPixelData;
5576 begin
5577   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5578   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5579 end;
5580
5581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5582 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5583 var
5584   PixelData: TglBitmapPixelData;
5585 begin
5586   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5587   with PixelData do
5588     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5589   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5590 end;
5591
5592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5593 function TglBitmap.RemoveAlpha: Boolean;
5594 var
5595   FormatDesc: TFormatDescriptor;
5596 begin
5597   result := false;
5598   FormatDesc := TFormatDescriptor.Get(Format);
5599   if Assigned(Data) then begin
5600     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5601       raise EglBitmapUnsupportedFormat.Create(Format);
5602     result := ConvertTo(FormatDesc.WithoutAlpha);
5603   end;
5604 end;
5605
5606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5607 function TglBitmap.Clone: TglBitmap;
5608 var
5609   Temp: TglBitmap;
5610   TempPtr: PByte;
5611   Size: Integer;
5612 begin
5613   result := nil;
5614   Temp := (ClassType.Create as TglBitmap);
5615   try
5616     // copy texture data if assigned
5617     if Assigned(Data) then begin
5618       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5619       GetMem(TempPtr, Size);
5620       try
5621         Move(Data^, TempPtr^, Size);
5622         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5623       except
5624         if Assigned(TempPtr) then
5625           FreeMem(TempPtr);
5626         raise;
5627       end;
5628     end else begin
5629       TempPtr := nil;
5630       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5631     end;
5632
5633         // copy properties
5634     Temp.fID                      := ID;
5635     Temp.fTarget                  := Target;
5636     Temp.fFormat                  := Format;
5637     Temp.fMipMap                  := MipMap;
5638     Temp.fAnisotropic             := Anisotropic;
5639     Temp.fBorderColor             := fBorderColor;
5640     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5641     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5642     Temp.fFilterMin               := fFilterMin;
5643     Temp.fFilterMag               := fFilterMag;
5644     Temp.fWrapS                   := fWrapS;
5645     Temp.fWrapT                   := fWrapT;
5646     Temp.fWrapR                   := fWrapR;
5647     Temp.fFilename                := fFilename;
5648     Temp.fCustomName              := fCustomName;
5649     Temp.fCustomNameW             := fCustomNameW;
5650     Temp.fCustomData              := fCustomData;
5651
5652     result := Temp;
5653   except
5654     FreeAndNil(Temp);
5655     raise;
5656   end;
5657 end;
5658
5659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5660 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5661 var
5662   SourceFD, DestFD: TFormatDescriptor;
5663   SourcePD, DestPD: TglBitmapPixelData;
5664   ShiftData: TShiftData;
5665
5666   function DataIsIdentical: Boolean;
5667   begin
5668     result := SourceFD.MaskMatch(DestFD.Mask);
5669   end;
5670
5671   function CanCopyDirect: Boolean;
5672   begin
5673     result :=
5674       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5675       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5676       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5677       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5678   end;
5679
5680   function CanShift: Boolean;
5681   begin
5682     result :=
5683       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5684       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5685       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5686       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5687   end;
5688
5689   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5690   begin
5691     result := 0;
5692     while (aSource > aDest) and (aSource > 0) do begin
5693       inc(result);
5694       aSource := aSource shr 1;
5695     end;
5696   end;
5697
5698 begin
5699   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5700     SourceFD := TFormatDescriptor.Get(Format);
5701     DestFD   := TFormatDescriptor.Get(aFormat);
5702
5703     if DataIsIdentical then begin
5704       result := true;
5705       Format := aFormat;
5706       exit;
5707     end;
5708
5709     SourceFD.PreparePixel(SourcePD);
5710     DestFD.PreparePixel  (DestPD);
5711
5712     if CanCopyDirect then
5713       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5714     else if CanShift then begin
5715       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5716       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5717       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5718       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5719       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5720     end else
5721       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5722   end else
5723     result := true;
5724 end;
5725
5726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5727 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5728 begin
5729   if aUseRGB or aUseAlpha then
5730     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5731       ((Byte(aUseAlpha) and 1) shl 1) or
5732        (Byte(aUseRGB)   and 1)      ));
5733 end;
5734
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5737 begin
5738   fBorderColor[0] := aRed;
5739   fBorderColor[1] := aGreen;
5740   fBorderColor[2] := aBlue;
5741   fBorderColor[3] := aAlpha;
5742   if (ID > 0) then begin
5743     Bind(false);
5744     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5745   end;
5746 end;
5747
5748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5749 procedure TglBitmap.FreeData;
5750 var
5751   TempPtr: PByte;
5752 begin
5753   TempPtr := nil;
5754   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5755 end;
5756
5757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5758 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5759   const aAlpha: Byte);
5760 begin
5761   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5762 end;
5763
5764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5765 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5766 var
5767   PixelData: TglBitmapPixelData;
5768 begin
5769   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5770   FillWithColorFloat(
5771     aRed   / PixelData.Range.r,
5772     aGreen / PixelData.Range.g,
5773     aBlue  / PixelData.Range.b,
5774     aAlpha / PixelData.Range.a);
5775 end;
5776
5777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5778 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5779 var
5780   PixelData: TglBitmapPixelData;
5781 begin
5782   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5783   with PixelData do begin
5784     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5785     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5786     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5787     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5788   end;
5789   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5790 end;
5791
5792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5793 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5794 begin
5795   //check MIN filter
5796   case aMin of
5797     GL_NEAREST:
5798       fFilterMin := GL_NEAREST;
5799     GL_LINEAR:
5800       fFilterMin := GL_LINEAR;
5801     GL_NEAREST_MIPMAP_NEAREST:
5802       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5803     GL_LINEAR_MIPMAP_NEAREST:
5804       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5805     GL_NEAREST_MIPMAP_LINEAR:
5806       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5807     GL_LINEAR_MIPMAP_LINEAR:
5808       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5809     else
5810       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5811   end;
5812
5813   //check MAG filter
5814   case aMag of
5815     GL_NEAREST:
5816       fFilterMag := GL_NEAREST;
5817     GL_LINEAR:
5818       fFilterMag := GL_LINEAR;
5819     else
5820       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5821   end;
5822
5823   //apply filter
5824   if (ID > 0) then begin
5825     Bind(false);
5826     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5827
5828     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5829       case fFilterMin of
5830         GL_NEAREST, GL_LINEAR:
5831           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5832         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5833           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5834         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5835           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5836       end;
5837     end else
5838       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5839   end;
5840 end;
5841
5842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5843 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5844
5845   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5846   begin
5847     case aValue of
5848       GL_CLAMP:
5849         aTarget := GL_CLAMP;
5850
5851       GL_REPEAT:
5852         aTarget := GL_REPEAT;
5853
5854       GL_CLAMP_TO_EDGE: begin
5855         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5856           aTarget := GL_CLAMP_TO_EDGE
5857         else
5858           aTarget := GL_CLAMP;
5859       end;
5860
5861       GL_CLAMP_TO_BORDER: begin
5862         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5863           aTarget := GL_CLAMP_TO_BORDER
5864         else
5865           aTarget := GL_CLAMP;
5866       end;
5867
5868       GL_MIRRORED_REPEAT: begin
5869         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5870           aTarget := GL_MIRRORED_REPEAT
5871         else
5872           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5873       end;
5874     else
5875       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5876     end;
5877   end;
5878
5879 begin
5880   CheckAndSetWrap(S, fWrapS);
5881   CheckAndSetWrap(T, fWrapT);
5882   CheckAndSetWrap(R, fWrapR);
5883
5884   if (ID > 0) then begin
5885     Bind(false);
5886     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5887     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5888     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5889   end;
5890 end;
5891
5892 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5893 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5894
5895   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5896   begin
5897     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5898        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5899       fSwizzle[aIndex] := aValue
5900     else
5901       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5902   end;
5903
5904 begin
5905   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5906     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5907   CheckAndSetValue(r, 0);
5908   CheckAndSetValue(g, 1);
5909   CheckAndSetValue(b, 2);
5910   CheckAndSetValue(a, 3);
5911
5912   if (ID > 0) then begin
5913     Bind(false);
5914     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5915   end;
5916 end;
5917
5918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5919 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5920 begin
5921   if aEnableTextureUnit then
5922     glEnable(Target);
5923   if (ID > 0) then
5924     glBindTexture(Target, ID);
5925 end;
5926
5927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5928 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5929 begin
5930   if aDisableTextureUnit then
5931     glDisable(Target);
5932   glBindTexture(Target, 0);
5933 end;
5934
5935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5936 constructor TglBitmap.Create;
5937 begin
5938   if (ClassType = TglBitmap) then
5939     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5940 {$IFDEF GLB_NATIVE_OGL}
5941   glbReadOpenGLExtensions;
5942 {$ENDIF}
5943   inherited Create;
5944   fFormat            := glBitmapGetDefaultFormat;
5945   fFreeDataOnDestroy := true;
5946 end;
5947
5948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5949 constructor TglBitmap.Create(const aFileName: String);
5950 begin
5951   Create;
5952   LoadFromFile(aFileName);
5953 end;
5954
5955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5956 constructor TglBitmap.Create(const aStream: TStream);
5957 begin
5958   Create;
5959   LoadFromStream(aStream);
5960 end;
5961
5962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5963 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5964 var
5965   ImageSize: Integer;
5966 begin
5967   Create;
5968   if not Assigned(aData) then begin
5969     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5970     GetMem(aData, ImageSize);
5971     try
5972       FillChar(aData^, ImageSize, #$FF);
5973       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5974     except
5975       if Assigned(aData) then
5976         FreeMem(aData);
5977       raise;
5978     end;
5979   end else begin
5980     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5981     fFreeDataOnDestroy := false;
5982   end;
5983 end;
5984
5985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5986 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5987 begin
5988   Create;
5989   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5990 end;
5991
5992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5993 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5994 begin
5995   Create;
5996   LoadFromResource(aInstance, aResource, aResType);
5997 end;
5998
5999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6000 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6001 begin
6002   Create;
6003   LoadFromResourceID(aInstance, aResourceID, aResType);
6004 end;
6005
6006 {$IFDEF GLB_SUPPORT_PNG_READ}
6007 {$IF DEFINED(GLB_LAZ_PNG)}
6008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6009 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6011 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6012 const
6013   MAGIC_LEN = 8;
6014   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6015 var
6016   reader: TLazReaderPNG;
6017   intf: TLazIntfImage;
6018   StreamPos: Int64;
6019   magic: String[MAGIC_LEN];
6020 begin
6021   result := true;
6022   StreamPos := aStream.Position;
6023
6024   SetLength(magic, MAGIC_LEN);
6025   aStream.Read(magic[1], MAGIC_LEN);
6026   aStream.Position := StreamPos;
6027   if (magic <> PNG_MAGIC) then begin
6028     result := false;
6029     exit;
6030   end;
6031
6032   intf   := TLazIntfImage.Create(0, 0);
6033   reader := TLazReaderPNG.Create;
6034   try try
6035     reader.UpdateDescription := true;
6036     reader.ImageRead(aStream, intf);
6037     AssignFromLazIntfImage(intf);
6038   except
6039     result := false;
6040     aStream.Position := StreamPos;
6041     exit;
6042   end;
6043   finally
6044     reader.Free;
6045     intf.Free;
6046   end;
6047 end;
6048
6049 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6051 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6052 var
6053   Surface: PSDL_Surface;
6054   RWops: PSDL_RWops;
6055 begin
6056   result := false;
6057   RWops := glBitmapCreateRWops(aStream);
6058   try
6059     if IMG_isPNG(RWops) > 0 then begin
6060       Surface := IMG_LoadPNG_RW(RWops);
6061       try
6062         AssignFromSurface(Surface);
6063         result := true;
6064       finally
6065         SDL_FreeSurface(Surface);
6066       end;
6067     end;
6068   finally
6069     SDL_FreeRW(RWops);
6070   end;
6071 end;
6072
6073 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6075 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6076 begin
6077   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6078 end;
6079
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6082 var
6083   StreamPos: Int64;
6084   signature: array [0..7] of byte;
6085   png: png_structp;
6086   png_info: png_infop;
6087
6088   TempHeight, TempWidth: Integer;
6089   Format: TglBitmapFormat;
6090
6091   png_data: pByte;
6092   png_rows: array of pByte;
6093   Row, LineSize: Integer;
6094 begin
6095   result := false;
6096
6097   if not init_libPNG then
6098     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6099
6100   try
6101     // signature
6102     StreamPos := aStream.Position;
6103     aStream.Read(signature{%H-}, 8);
6104     aStream.Position := StreamPos;
6105
6106     if png_check_sig(@signature, 8) <> 0 then begin
6107       // png read struct
6108       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6109       if png = nil then
6110         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6111
6112       // png info
6113       png_info := png_create_info_struct(png);
6114       if png_info = nil then begin
6115         png_destroy_read_struct(@png, nil, nil);
6116         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6117       end;
6118
6119       // set read callback
6120       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6121
6122       // read informations
6123       png_read_info(png, png_info);
6124
6125       // size
6126       TempHeight := png_get_image_height(png, png_info);
6127       TempWidth := png_get_image_width(png, png_info);
6128
6129       // format
6130       case png_get_color_type(png, png_info) of
6131         PNG_COLOR_TYPE_GRAY:
6132           Format := tfLuminance8ub1;
6133         PNG_COLOR_TYPE_GRAY_ALPHA:
6134           Format := tfLuminance8Alpha8us1;
6135         PNG_COLOR_TYPE_RGB:
6136           Format := tfRGB8ub3;
6137         PNG_COLOR_TYPE_RGB_ALPHA:
6138           Format := tfRGBA8ub4;
6139         else
6140           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6141       end;
6142
6143       // cut upper 8 bit from 16 bit formats
6144       if png_get_bit_depth(png, png_info) > 8 then
6145         png_set_strip_16(png);
6146
6147       // expand bitdepth smaller than 8
6148       if png_get_bit_depth(png, png_info) < 8 then
6149         png_set_expand(png);
6150
6151       // allocating mem for scanlines
6152       LineSize := png_get_rowbytes(png, png_info);
6153       GetMem(png_data, TempHeight * LineSize);
6154       try
6155         SetLength(png_rows, TempHeight);
6156         for Row := Low(png_rows) to High(png_rows) do begin
6157           png_rows[Row] := png_data;
6158           Inc(png_rows[Row], Row * LineSize);
6159         end;
6160
6161         // read complete image into scanlines
6162         png_read_image(png, @png_rows[0]);
6163
6164         // read end
6165         png_read_end(png, png_info);
6166
6167         // destroy read struct
6168         png_destroy_read_struct(@png, @png_info, nil);
6169
6170         SetLength(png_rows, 0);
6171
6172         // set new data
6173         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6174
6175         result := true;
6176       except
6177         if Assigned(png_data) then
6178           FreeMem(png_data);
6179         raise;
6180       end;
6181     end;
6182   finally
6183     quit_libPNG;
6184   end;
6185 end;
6186
6187 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6189 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6190 var
6191   StreamPos: Int64;
6192   Png: TPNGObject;
6193   Header: String[8];
6194   Row, Col, PixSize, LineSize: Integer;
6195   NewImage, pSource, pDest, pAlpha: pByte;
6196   PngFormat: TglBitmapFormat;
6197   FormatDesc: TFormatDescriptor;
6198
6199 const
6200   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6201
6202 begin
6203   result := false;
6204
6205   StreamPos := aStream.Position;
6206   aStream.Read(Header[0], SizeOf(Header));
6207   aStream.Position := StreamPos;
6208
6209   {Test if the header matches}
6210   if Header = PngHeader then begin
6211     Png := TPNGObject.Create;
6212     try
6213       Png.LoadFromStream(aStream);
6214
6215       case Png.Header.ColorType of
6216         COLOR_GRAYSCALE:
6217           PngFormat := tfLuminance8ub1;
6218         COLOR_GRAYSCALEALPHA:
6219           PngFormat := tfLuminance8Alpha8us1;
6220         COLOR_RGB:
6221           PngFormat := tfBGR8ub3;
6222         COLOR_RGBALPHA:
6223           PngFormat := tfBGRA8ub4;
6224         else
6225           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6226       end;
6227
6228       FormatDesc := TFormatDescriptor.Get(PngFormat);
6229       PixSize    := Round(FormatDesc.PixelSize);
6230       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6231
6232       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6233       try
6234         pDest := NewImage;
6235
6236         case Png.Header.ColorType of
6237           COLOR_RGB, COLOR_GRAYSCALE:
6238             begin
6239               for Row := 0 to Png.Height -1 do begin
6240                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6241                 Inc(pDest, LineSize);
6242               end;
6243             end;
6244           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6245             begin
6246               PixSize := PixSize -1;
6247
6248               for Row := 0 to Png.Height -1 do begin
6249                 pSource := Png.Scanline[Row];
6250                 pAlpha := pByte(Png.AlphaScanline[Row]);
6251
6252                 for Col := 0 to Png.Width -1 do begin
6253                   Move (pSource^, pDest^, PixSize);
6254                   Inc(pSource, PixSize);
6255                   Inc(pDest, PixSize);
6256
6257                   pDest^ := pAlpha^;
6258                   inc(pAlpha);
6259                   Inc(pDest);
6260                 end;
6261               end;
6262             end;
6263           else
6264             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6265         end;
6266
6267         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6268
6269         result := true;
6270       except
6271         if Assigned(NewImage) then
6272           FreeMem(NewImage);
6273         raise;
6274       end;
6275     finally
6276       Png.Free;
6277     end;
6278   end;
6279 end;
6280 {$IFEND}
6281 {$ENDIF}
6282
6283 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6284 {$IFDEF GLB_LIB_PNG}
6285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6286 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6287 begin
6288   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6289 end;
6290 {$ENDIF}
6291
6292 {$IF DEFINED(GLB_LAZ_PNG)}
6293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6294 procedure TglBitmap.SavePNG(const aStream: TStream);
6295 var
6296   png: TPortableNetworkGraphic;
6297   intf: TLazIntfImage;
6298   raw: TRawImage;
6299 begin
6300   png  := TPortableNetworkGraphic.Create;
6301   intf := TLazIntfImage.Create(0, 0);
6302   try
6303     if not AssignToLazIntfImage(intf) then
6304       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6305     intf.GetRawImage(raw);
6306     png.LoadFromRawImage(raw, false);
6307     png.SaveToStream(aStream);
6308   finally
6309     png.Free;
6310     intf.Free;
6311   end;
6312 end;
6313
6314 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6316 procedure TglBitmap.SavePNG(const aStream: TStream);
6317 var
6318   png: png_structp;
6319   png_info: png_infop;
6320   png_rows: array of pByte;
6321   LineSize: Integer;
6322   ColorType: Integer;
6323   Row: Integer;
6324   FormatDesc: TFormatDescriptor;
6325 begin
6326   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6327     raise EglBitmapUnsupportedFormat.Create(Format);
6328
6329   if not init_libPNG then
6330     raise Exception.Create('unable to initialize libPNG.');
6331
6332   try
6333     case Format of
6334       tfAlpha8ub1, tfLuminance8ub1:
6335         ColorType := PNG_COLOR_TYPE_GRAY;
6336       tfLuminance8Alpha8us1:
6337         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6338       tfBGR8ub3, tfRGB8ub3:
6339         ColorType := PNG_COLOR_TYPE_RGB;
6340       tfBGRA8ub4, tfRGBA8ub4:
6341         ColorType := PNG_COLOR_TYPE_RGBA;
6342       else
6343         raise EglBitmapUnsupportedFormat.Create(Format);
6344     end;
6345
6346     FormatDesc := TFormatDescriptor.Get(Format);
6347     LineSize := FormatDesc.GetSize(Width, 1);
6348
6349     // creating array for scanline
6350     SetLength(png_rows, Height);
6351     try
6352       for Row := 0 to Height - 1 do begin
6353         png_rows[Row] := Data;
6354         Inc(png_rows[Row], Row * LineSize)
6355       end;
6356
6357       // write struct
6358       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6359       if png = nil then
6360         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6361
6362       // create png info
6363       png_info := png_create_info_struct(png);
6364       if png_info = nil then begin
6365         png_destroy_write_struct(@png, nil);
6366         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6367       end;
6368
6369       // set read callback
6370       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6371
6372       // set compression
6373       png_set_compression_level(png, 6);
6374
6375       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6376         png_set_bgr(png);
6377
6378       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6379       png_write_info(png, png_info);
6380       png_write_image(png, @png_rows[0]);
6381       png_write_end(png, png_info);
6382       png_destroy_write_struct(@png, @png_info);
6383     finally
6384       SetLength(png_rows, 0);
6385     end;
6386   finally
6387     quit_libPNG;
6388   end;
6389 end;
6390
6391 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6393 procedure TglBitmap.SavePNG(const aStream: TStream);
6394 var
6395   Png: TPNGObject;
6396
6397   pSource, pDest: pByte;
6398   X, Y, PixSize: Integer;
6399   ColorType: Cardinal;
6400   Alpha: Boolean;
6401
6402   pTemp: pByte;
6403   Temp: Byte;
6404 begin
6405   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6406     raise EglBitmapUnsupportedFormat.Create(Format);
6407
6408   case Format of
6409     tfAlpha8ub1, tfLuminance8ub1: begin
6410       ColorType := COLOR_GRAYSCALE;
6411       PixSize   := 1;
6412       Alpha     := false;
6413     end;
6414     tfLuminance8Alpha8us1: begin
6415       ColorType := COLOR_GRAYSCALEALPHA;
6416       PixSize   := 1;
6417       Alpha     := true;
6418     end;
6419     tfBGR8ub3, tfRGB8ub3: begin
6420       ColorType := COLOR_RGB;
6421       PixSize   := 3;
6422       Alpha     := false;
6423     end;
6424     tfBGRA8ub4, tfRGBA8ub4: begin
6425       ColorType := COLOR_RGBALPHA;
6426       PixSize   := 3;
6427       Alpha     := true
6428     end;
6429   else
6430     raise EglBitmapUnsupportedFormat.Create(Format);
6431   end;
6432
6433   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6434   try
6435     // Copy ImageData
6436     pSource := Data;
6437     for Y := 0 to Height -1 do begin
6438       pDest := png.ScanLine[Y];
6439       for X := 0 to Width -1 do begin
6440         Move(pSource^, pDest^, PixSize);
6441         Inc(pDest, PixSize);
6442         Inc(pSource, PixSize);
6443         if Alpha then begin
6444           png.AlphaScanline[Y]^[X] := pSource^;
6445           Inc(pSource);
6446         end;
6447       end;
6448
6449       // convert RGB line to BGR
6450       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6451         pTemp := png.ScanLine[Y];
6452         for X := 0 to Width -1 do begin
6453           Temp := pByteArray(pTemp)^[0];
6454           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6455           pByteArray(pTemp)^[2] := Temp;
6456           Inc(pTemp, 3);
6457         end;
6458       end;
6459     end;
6460
6461     // Save to Stream
6462     Png.CompressionLevel := 6;
6463     Png.SaveToStream(aStream);
6464   finally
6465     FreeAndNil(Png);
6466   end;
6467 end;
6468 {$IFEND}
6469 {$ENDIF}
6470
6471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6472 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6474 {$IFDEF GLB_LIB_JPEG}
6475 type
6476   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6477   glBitmap_libJPEG_source_mgr = record
6478     pub: jpeg_source_mgr;
6479
6480     SrcStream: TStream;
6481     SrcBuffer: array [1..4096] of byte;
6482   end;
6483
6484   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6485   glBitmap_libJPEG_dest_mgr = record
6486     pub: jpeg_destination_mgr;
6487
6488     DestStream: TStream;
6489     DestBuffer: array [1..4096] of byte;
6490   end;
6491
6492 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6493 begin
6494   //DUMMY
6495 end;
6496
6497
6498 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6499 begin
6500   //DUMMY
6501 end;
6502
6503
6504 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6505 begin
6506   //DUMMY
6507 end;
6508
6509 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6510 begin
6511   //DUMMY
6512 end;
6513
6514
6515 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6516 begin
6517   //DUMMY
6518 end;
6519
6520
6521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6522 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6523 var
6524   src: glBitmap_libJPEG_source_mgr_ptr;
6525   bytes: integer;
6526 begin
6527   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6528
6529   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6530         if (bytes <= 0) then begin
6531                 src^.SrcBuffer[1] := $FF;
6532                 src^.SrcBuffer[2] := JPEG_EOI;
6533                 bytes := 2;
6534         end;
6535
6536         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6537         src^.pub.bytes_in_buffer := bytes;
6538
6539   result := true;
6540 end;
6541
6542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6543 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6544 var
6545   src: glBitmap_libJPEG_source_mgr_ptr;
6546 begin
6547   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6548
6549   if num_bytes > 0 then begin
6550     // wanted byte isn't in buffer so set stream position and read buffer
6551     if num_bytes > src^.pub.bytes_in_buffer then begin
6552       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6553       src^.pub.fill_input_buffer(cinfo);
6554     end else begin
6555       // wanted byte is in buffer so only skip
6556                 inc(src^.pub.next_input_byte, num_bytes);
6557                 dec(src^.pub.bytes_in_buffer, num_bytes);
6558     end;
6559   end;
6560 end;
6561
6562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6563 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6564 var
6565   dest: glBitmap_libJPEG_dest_mgr_ptr;
6566 begin
6567   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6568
6569   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6570     // write complete buffer
6571     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6572
6573     // reset buffer
6574     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6575     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6576   end;
6577
6578   result := true;
6579 end;
6580
6581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6582 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6583 var
6584   Idx: Integer;
6585   dest: glBitmap_libJPEG_dest_mgr_ptr;
6586 begin
6587   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6588
6589   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6590     // check for endblock
6591     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6592       // write endblock
6593       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6594
6595       // leave
6596       break;
6597     end else
6598       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6599   end;
6600 end;
6601 {$ENDIF}
6602
6603 {$IFDEF GLB_SUPPORT_JPEG_READ}
6604 {$IF DEFINED(GLB_LAZ_JPEG)}
6605 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6606 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6607 const
6608   MAGIC_LEN = 2;
6609   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6610 var
6611   intf: TLazIntfImage;
6612   reader: TFPReaderJPEG;
6613   StreamPos: Int64;
6614   magic: String[MAGIC_LEN];
6615 begin
6616   result := true;
6617   StreamPos := aStream.Position;
6618
6619   SetLength(magic, MAGIC_LEN);
6620   aStream.Read(magic[1], MAGIC_LEN);
6621   aStream.Position := StreamPos;
6622   if (magic <> JPEG_MAGIC) then begin
6623     result := false;
6624     exit;
6625   end;
6626
6627   reader := TFPReaderJPEG.Create;
6628   intf := TLazIntfImage.Create(0, 0);
6629   try try
6630     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6631     reader.ImageRead(aStream, intf);
6632     AssignFromLazIntfImage(intf);
6633   except
6634     result := false;
6635     aStream.Position := StreamPos;
6636     exit;
6637   end;
6638   finally
6639     reader.Free;
6640     intf.Free;
6641   end;
6642 end;
6643
6644 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6646 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6647 var
6648   Surface: PSDL_Surface;
6649   RWops: PSDL_RWops;
6650 begin
6651   result := false;
6652
6653   RWops := glBitmapCreateRWops(aStream);
6654   try
6655     if IMG_isJPG(RWops) > 0 then begin
6656       Surface := IMG_LoadJPG_RW(RWops);
6657       try
6658         AssignFromSurface(Surface);
6659         result := true;
6660       finally
6661         SDL_FreeSurface(Surface);
6662       end;
6663     end;
6664   finally
6665     SDL_FreeRW(RWops);
6666   end;
6667 end;
6668
6669 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6671 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6672 var
6673   StreamPos: Int64;
6674   Temp: array[0..1]of Byte;
6675
6676   jpeg: jpeg_decompress_struct;
6677   jpeg_err: jpeg_error_mgr;
6678
6679   IntFormat: TglBitmapFormat;
6680   pImage: pByte;
6681   TempHeight, TempWidth: Integer;
6682
6683   pTemp: pByte;
6684   Row: Integer;
6685
6686   FormatDesc: TFormatDescriptor;
6687 begin
6688   result := false;
6689
6690   if not init_libJPEG then
6691     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6692
6693   try
6694     // reading first two bytes to test file and set cursor back to begin
6695     StreamPos := aStream.Position;
6696     aStream.Read({%H-}Temp[0], 2);
6697     aStream.Position := StreamPos;
6698
6699     // if Bitmap then read file.
6700     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6701       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6702       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6703
6704       // error managment
6705       jpeg.err := jpeg_std_error(@jpeg_err);
6706       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6707       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6708
6709       // decompression struct
6710       jpeg_create_decompress(@jpeg);
6711
6712       // allocation space for streaming methods
6713       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6714
6715       // seeting up custom functions
6716       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6717         pub.init_source       := glBitmap_libJPEG_init_source;
6718         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6719         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6720         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6721         pub.term_source       := glBitmap_libJPEG_term_source;
6722
6723         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6724         pub.next_input_byte := nil;   // until buffer loaded
6725
6726         SrcStream := aStream;
6727       end;
6728
6729       // set global decoding state
6730       jpeg.global_state := DSTATE_START;
6731
6732       // read header of jpeg
6733       jpeg_read_header(@jpeg, false);
6734
6735       // setting output parameter
6736       case jpeg.jpeg_color_space of
6737         JCS_GRAYSCALE:
6738           begin
6739             jpeg.out_color_space := JCS_GRAYSCALE;
6740             IntFormat := tfLuminance8ub1;
6741           end;
6742         else
6743           jpeg.out_color_space := JCS_RGB;
6744           IntFormat := tfRGB8ub3;
6745       end;
6746
6747       // reading image
6748       jpeg_start_decompress(@jpeg);
6749
6750       TempHeight := jpeg.output_height;
6751       TempWidth := jpeg.output_width;
6752
6753       FormatDesc := TFormatDescriptor.Get(IntFormat);
6754
6755       // creating new image
6756       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6757       try
6758         pTemp := pImage;
6759
6760         for Row := 0 to TempHeight -1 do begin
6761           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6762           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6763         end;
6764
6765         // finish decompression
6766         jpeg_finish_decompress(@jpeg);
6767
6768         // destroy decompression
6769         jpeg_destroy_decompress(@jpeg);
6770
6771         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6772
6773         result := true;
6774       except
6775         if Assigned(pImage) then
6776           FreeMem(pImage);
6777         raise;
6778       end;
6779     end;
6780   finally
6781     quit_libJPEG;
6782   end;
6783 end;
6784
6785 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6787 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6788 var
6789   bmp: TBitmap;
6790   jpg: TJPEGImage;
6791   StreamPos: Int64;
6792   Temp: array[0..1]of Byte;
6793 begin
6794   result := false;
6795
6796   // reading first two bytes to test file and set cursor back to begin
6797   StreamPos := aStream.Position;
6798   aStream.Read(Temp[0], 2);
6799   aStream.Position := StreamPos;
6800
6801   // if Bitmap then read file.
6802   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6803     bmp := TBitmap.Create;
6804     try
6805       jpg := TJPEGImage.Create;
6806       try
6807         jpg.LoadFromStream(aStream);
6808         bmp.Assign(jpg);
6809         result := AssignFromBitmap(bmp);
6810       finally
6811         jpg.Free;
6812       end;
6813     finally
6814       bmp.Free;
6815     end;
6816   end;
6817 end;
6818 {$IFEND}
6819 {$ENDIF}
6820
6821 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6822 {$IF DEFINED(GLB_LAZ_JPEG)}
6823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6824 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6825 var
6826   jpeg: TJPEGImage;
6827   intf: TLazIntfImage;
6828   raw: TRawImage;
6829 begin
6830   jpeg := TJPEGImage.Create;
6831   intf := TLazIntfImage.Create(0, 0);
6832   try
6833     if not AssignToLazIntfImage(intf) then
6834       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6835     intf.GetRawImage(raw);
6836     jpeg.LoadFromRawImage(raw, false);
6837     jpeg.SaveToStream(aStream);
6838   finally
6839     intf.Free;
6840     jpeg.Free;
6841   end;
6842 end;
6843
6844 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6846 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6847 var
6848   jpeg: jpeg_compress_struct;
6849   jpeg_err: jpeg_error_mgr;
6850   Row: Integer;
6851   pTemp, pTemp2: pByte;
6852
6853   procedure CopyRow(pDest, pSource: pByte);
6854   var
6855     X: Integer;
6856   begin
6857     for X := 0 to Width - 1 do begin
6858       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6859       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6860       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6861       Inc(pDest, 3);
6862       Inc(pSource, 3);
6863     end;
6864   end;
6865
6866 begin
6867   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6868     raise EglBitmapUnsupportedFormat.Create(Format);
6869
6870   if not init_libJPEG then
6871     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6872
6873   try
6874     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6875     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6876
6877     // error managment
6878     jpeg.err := jpeg_std_error(@jpeg_err);
6879     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6880     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6881
6882     // compression struct
6883     jpeg_create_compress(@jpeg);
6884
6885     // allocation space for streaming methods
6886     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6887
6888     // seeting up custom functions
6889     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6890       pub.init_destination    := glBitmap_libJPEG_init_destination;
6891       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6892       pub.term_destination    := glBitmap_libJPEG_term_destination;
6893
6894       pub.next_output_byte  := @DestBuffer[1];
6895       pub.free_in_buffer    := Length(DestBuffer);
6896
6897       DestStream := aStream;
6898     end;
6899
6900     // very important state
6901     jpeg.global_state := CSTATE_START;
6902     jpeg.image_width  := Width;
6903     jpeg.image_height := Height;
6904     case Format of
6905       tfAlpha8ub1, tfLuminance8ub1: begin
6906         jpeg.input_components := 1;
6907         jpeg.in_color_space   := JCS_GRAYSCALE;
6908       end;
6909       tfRGB8ub3, tfBGR8ub3: begin
6910         jpeg.input_components := 3;
6911         jpeg.in_color_space   := JCS_RGB;
6912       end;
6913     end;
6914
6915     jpeg_set_defaults(@jpeg);
6916     jpeg_set_quality(@jpeg, 95, true);
6917     jpeg_start_compress(@jpeg, true);
6918     pTemp := Data;
6919
6920     if Format = tfBGR8ub3 then
6921       GetMem(pTemp2, fRowSize)
6922     else
6923       pTemp2 := pTemp;
6924
6925     try
6926       for Row := 0 to jpeg.image_height -1 do begin
6927         // prepare row
6928         if Format = tfBGR8ub3 then
6929           CopyRow(pTemp2, pTemp)
6930         else
6931           pTemp2 := pTemp;
6932
6933         // write row
6934         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6935         inc(pTemp, fRowSize);
6936       end;
6937     finally
6938       // free memory
6939       if Format = tfBGR8ub3 then
6940         FreeMem(pTemp2);
6941     end;
6942     jpeg_finish_compress(@jpeg);
6943     jpeg_destroy_compress(@jpeg);
6944   finally
6945     quit_libJPEG;
6946   end;
6947 end;
6948
6949 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6951 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6952 var
6953   Bmp: TBitmap;
6954   Jpg: TJPEGImage;
6955 begin
6956   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6957     raise EglBitmapUnsupportedFormat.Create(Format);
6958
6959   Bmp := TBitmap.Create;
6960   try
6961     Jpg := TJPEGImage.Create;
6962     try
6963       AssignToBitmap(Bmp);
6964       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
6965         Jpg.Grayscale   := true;
6966         Jpg.PixelFormat := jf8Bit;
6967       end;
6968       Jpg.Assign(Bmp);
6969       Jpg.SaveToStream(aStream);
6970     finally
6971       FreeAndNil(Jpg);
6972     end;
6973   finally
6974     FreeAndNil(Bmp);
6975   end;
6976 end;
6977 {$IFEND}
6978 {$ENDIF}
6979
6980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6981 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6983 const
6984   BMP_MAGIC          = $4D42;
6985
6986   BMP_COMP_RGB       = 0;
6987   BMP_COMP_RLE8      = 1;
6988   BMP_COMP_RLE4      = 2;
6989   BMP_COMP_BITFIELDS = 3;
6990
6991 type
6992   TBMPHeader = packed record
6993     bfType: Word;
6994     bfSize: Cardinal;
6995     bfReserved1: Word;
6996     bfReserved2: Word;
6997     bfOffBits: Cardinal;
6998   end;
6999
7000   TBMPInfo = packed record
7001     biSize: Cardinal;
7002     biWidth: Longint;
7003     biHeight: Longint;
7004     biPlanes: Word;
7005     biBitCount: Word;
7006     biCompression: Cardinal;
7007     biSizeImage: Cardinal;
7008     biXPelsPerMeter: Longint;
7009     biYPelsPerMeter: Longint;
7010     biClrUsed: Cardinal;
7011     biClrImportant: Cardinal;
7012   end;
7013
7014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7015 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7016
7017   //////////////////////////////////////////////////////////////////////////////////////////////////
7018   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7019   begin
7020     result := tfEmpty;
7021     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7022     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7023
7024     //Read Compression
7025     case aInfo.biCompression of
7026       BMP_COMP_RLE4,
7027       BMP_COMP_RLE8: begin
7028         raise EglBitmap.Create('RLE compression is not supported');
7029       end;
7030       BMP_COMP_BITFIELDS: begin
7031         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7032           aStream.Read(aMask.r, SizeOf(aMask.r));
7033           aStream.Read(aMask.g, SizeOf(aMask.g));
7034           aStream.Read(aMask.b, SizeOf(aMask.b));
7035           aStream.Read(aMask.a, SizeOf(aMask.a));
7036         end else
7037           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7038       end;
7039     end;
7040
7041     //get suitable format
7042     case aInfo.biBitCount of
7043        8: result := tfLuminance8ub1;
7044       16: result := tfX1RGB5us1;
7045       24: result := tfBGR8ub3;
7046       32: result := tfXRGB8ui1;
7047     end;
7048   end;
7049
7050   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7051   var
7052     i, c: Integer;
7053     ColorTable: TbmpColorTable;
7054   begin
7055     result := nil;
7056     if (aInfo.biBitCount >= 16) then
7057       exit;
7058     aFormat := tfLuminance8ub1;
7059     c := aInfo.biClrUsed;
7060     if (c = 0) then
7061       c := 1 shl aInfo.biBitCount;
7062     SetLength(ColorTable, c);
7063     for i := 0 to c-1 do begin
7064       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7065       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7066         aFormat := tfRGB8ub3;
7067     end;
7068
7069     result := TbmpColorTableFormat.Create;
7070     result.BitsPerPixel := aInfo.biBitCount;
7071     result.ColorTable   := ColorTable;
7072     result.CalcValues;
7073   end;
7074
7075   //////////////////////////////////////////////////////////////////////////////////////////////////
7076   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7077   var
7078     FormatDesc: TFormatDescriptor;
7079   begin
7080     result := nil;
7081     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7082       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7083       if (FormatDesc.Format = tfEmpty) then
7084         exit;
7085       aFormat := FormatDesc.Format;
7086       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7087         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7088       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7089         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7090
7091       result := TbmpBitfieldFormat.Create;
7092       result.SetValues(aInfo.biBitCount, aMask);
7093     end;
7094   end;
7095
7096 var
7097   //simple types
7098   StartPos: Int64;
7099   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7100   PaddingBuff: Cardinal;
7101   LineBuf, ImageData, TmpData: PByte;
7102   SourceMD, DestMD: Pointer;
7103   BmpFormat: TglBitmapFormat;
7104
7105   //records
7106   Mask: TglBitmapRec4ul;
7107   Header: TBMPHeader;
7108   Info: TBMPInfo;
7109
7110   //classes
7111   SpecialFormat: TFormatDescriptor;
7112   FormatDesc: TFormatDescriptor;
7113
7114   //////////////////////////////////////////////////////////////////////////////////////////////////
7115   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7116   var
7117     i: Integer;
7118     Pixel: TglBitmapPixelData;
7119   begin
7120     aStream.Read(aLineBuf^, rbLineSize);
7121     SpecialFormat.PreparePixel(Pixel);
7122     for i := 0 to Info.biWidth-1 do begin
7123       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7124       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7125       FormatDesc.Map(Pixel, aData, DestMD);
7126     end;
7127   end;
7128
7129 begin
7130   result        := false;
7131   BmpFormat     := tfEmpty;
7132   SpecialFormat := nil;
7133   LineBuf       := nil;
7134   SourceMD      := nil;
7135   DestMD        := nil;
7136
7137   // Header
7138   StartPos := aStream.Position;
7139   aStream.Read(Header{%H-}, SizeOf(Header));
7140
7141   if Header.bfType = BMP_MAGIC then begin
7142     try try
7143       BmpFormat        := ReadInfo(Info, Mask);
7144       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7145       if not Assigned(SpecialFormat) then
7146         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7147       aStream.Position := StartPos + Header.bfOffBits;
7148
7149       if (BmpFormat <> tfEmpty) then begin
7150         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7151         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7152         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7153         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7154
7155         //get Memory
7156         DestMD    := FormatDesc.CreateMappingData;
7157         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7158         GetMem(ImageData, ImageSize);
7159         if Assigned(SpecialFormat) then begin
7160           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7161           SourceMD := SpecialFormat.CreateMappingData;
7162         end;
7163
7164         //read Data
7165         try try
7166           FillChar(ImageData^, ImageSize, $FF);
7167           TmpData := ImageData;
7168           if (Info.biHeight > 0) then
7169             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7170           for i := 0 to Abs(Info.biHeight)-1 do begin
7171             if Assigned(SpecialFormat) then
7172               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7173             else
7174               aStream.Read(TmpData^, wbLineSize);   //else only read data
7175             if (Info.biHeight > 0) then
7176               dec(TmpData, wbLineSize)
7177             else
7178               inc(TmpData, wbLineSize);
7179             aStream.Read(PaddingBuff{%H-}, Padding);
7180           end;
7181           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7182           result := true;
7183         finally
7184           if Assigned(LineBuf) then
7185             FreeMem(LineBuf);
7186           if Assigned(SourceMD) then
7187             SpecialFormat.FreeMappingData(SourceMD);
7188           FormatDesc.FreeMappingData(DestMD);
7189         end;
7190         except
7191           if Assigned(ImageData) then
7192             FreeMem(ImageData);
7193           raise;
7194         end;
7195       end else
7196         raise EglBitmap.Create('LoadBMP - No suitable format found');
7197     except
7198       aStream.Position := StartPos;
7199       raise;
7200     end;
7201     finally
7202       FreeAndNil(SpecialFormat);
7203     end;
7204   end
7205     else aStream.Position := StartPos;
7206 end;
7207
7208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7209 procedure TglBitmap.SaveBMP(const aStream: TStream);
7210 var
7211   Header: TBMPHeader;
7212   Info: TBMPInfo;
7213   Converter: TFormatDescriptor;
7214   FormatDesc: TFormatDescriptor;
7215   SourceFD, DestFD: Pointer;
7216   pData, srcData, dstData, ConvertBuffer: pByte;
7217
7218   Pixel: TglBitmapPixelData;
7219   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7220   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7221
7222   PaddingBuff: Cardinal;
7223
7224   function GetLineWidth : Integer;
7225   begin
7226     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7227   end;
7228
7229 begin
7230   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7231     raise EglBitmapUnsupportedFormat.Create(Format);
7232
7233   Converter  := nil;
7234   FormatDesc := TFormatDescriptor.Get(Format);
7235   ImageSize  := FormatDesc.GetSize(Dimension);
7236
7237   FillChar(Header{%H-}, SizeOf(Header), 0);
7238   Header.bfType      := BMP_MAGIC;
7239   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7240   Header.bfReserved1 := 0;
7241   Header.bfReserved2 := 0;
7242   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7243
7244   FillChar(Info{%H-}, SizeOf(Info), 0);
7245   Info.biSize        := SizeOf(Info);
7246   Info.biWidth       := Width;
7247   Info.biHeight      := Height;
7248   Info.biPlanes      := 1;
7249   Info.biCompression := BMP_COMP_RGB;
7250   Info.biSizeImage   := ImageSize;
7251
7252   try
7253     case Format of
7254       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7255       begin
7256         Info.biBitCount  :=  8;
7257         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7258         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7259         Converter := TbmpColorTableFormat.Create;
7260         with (Converter as TbmpColorTableFormat) do begin
7261           SetValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7262           CreateColorTable;
7263         end;
7264       end;
7265
7266       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7267       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7268       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7269       begin
7270         Info.biBitCount    := 16;
7271         Info.biCompression := BMP_COMP_BITFIELDS;
7272       end;
7273
7274       tfBGR8ub3, tfRGB8ub3:
7275       begin
7276         Info.biBitCount := 24;
7277         if (Format = tfRGB8ub3) then
7278           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7279       end;
7280
7281       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7282       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7283       begin
7284         Info.biBitCount    := 32;
7285         Info.biCompression := BMP_COMP_BITFIELDS;
7286       end;
7287     else
7288       raise EglBitmapUnsupportedFormat.Create(Format);
7289     end;
7290     Info.biXPelsPerMeter := 2835;
7291     Info.biYPelsPerMeter := 2835;
7292
7293     // prepare bitmasks
7294     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7295       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7296       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7297
7298       RedMask    := FormatDesc.Mask.r;
7299       GreenMask  := FormatDesc.Mask.g;
7300       BlueMask   := FormatDesc.Mask.b;
7301       AlphaMask  := FormatDesc.Mask.a;
7302     end;
7303
7304     // headers
7305     aStream.Write(Header, SizeOf(Header));
7306     aStream.Write(Info, SizeOf(Info));
7307
7308     // colortable
7309     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7310       with (Converter as TbmpColorTableFormat) do
7311         aStream.Write(ColorTable[0].b,
7312           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7313
7314     // bitmasks
7315     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7316       aStream.Write(RedMask,   SizeOf(Cardinal));
7317       aStream.Write(GreenMask, SizeOf(Cardinal));
7318       aStream.Write(BlueMask,  SizeOf(Cardinal));
7319       aStream.Write(AlphaMask, SizeOf(Cardinal));
7320     end;
7321
7322     // image data
7323     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7324     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7325     Padding     := GetLineWidth - wbLineSize;
7326     PaddingBuff := 0;
7327
7328     pData := Data;
7329     inc(pData, (Height-1) * rbLineSize);
7330
7331     // prepare row buffer. But only for RGB because RGBA supports color masks
7332     // so it's possible to change color within the image.
7333     if Assigned(Converter) then begin
7334       FormatDesc.PreparePixel(Pixel);
7335       GetMem(ConvertBuffer, wbLineSize);
7336       SourceFD := FormatDesc.CreateMappingData;
7337       DestFD   := Converter.CreateMappingData;
7338     end else
7339       ConvertBuffer := nil;
7340
7341     try
7342       for LineIdx := 0 to Height - 1 do begin
7343         // preparing row
7344         if Assigned(Converter) then begin
7345           srcData := pData;
7346           dstData := ConvertBuffer;
7347           for PixelIdx := 0 to Info.biWidth-1 do begin
7348             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7349             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7350             Converter.Map(Pixel, dstData, DestFD);
7351           end;
7352           aStream.Write(ConvertBuffer^, wbLineSize);
7353         end else begin
7354           aStream.Write(pData^, rbLineSize);
7355         end;
7356         dec(pData, rbLineSize);
7357         if (Padding > 0) then
7358           aStream.Write(PaddingBuff, Padding);
7359       end;
7360     finally
7361       // destroy row buffer
7362       if Assigned(ConvertBuffer) then begin
7363         FormatDesc.FreeMappingData(SourceFD);
7364         Converter.FreeMappingData(DestFD);
7365         FreeMem(ConvertBuffer);
7366       end;
7367     end;
7368   finally
7369     if Assigned(Converter) then
7370       Converter.Free;
7371   end;
7372 end;
7373
7374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7375 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7377 type
7378   TTGAHeader = packed record
7379     ImageID: Byte;
7380     ColorMapType: Byte;
7381     ImageType: Byte;
7382     //ColorMapSpec: Array[0..4] of Byte;
7383     ColorMapStart: Word;
7384     ColorMapLength: Word;
7385     ColorMapEntrySize: Byte;
7386     OrigX: Word;
7387     OrigY: Word;
7388     Width: Word;
7389     Height: Word;
7390     Bpp: Byte;
7391     ImageDesc: Byte;
7392   end;
7393
7394 const
7395   TGA_UNCOMPRESSED_RGB  =  2;
7396   TGA_UNCOMPRESSED_GRAY =  3;
7397   TGA_COMPRESSED_RGB    = 10;
7398   TGA_COMPRESSED_GRAY   = 11;
7399
7400   TGA_NONE_COLOR_TABLE  = 0;
7401
7402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7403 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7404 var
7405   Header: TTGAHeader;
7406   ImageData: System.PByte;
7407   StartPosition: Int64;
7408   PixelSize, LineSize: Integer;
7409   tgaFormat: TglBitmapFormat;
7410   FormatDesc: TFormatDescriptor;
7411   Counter: packed record
7412     X, Y: packed record
7413       low, high, dir: Integer;
7414     end;
7415   end;
7416
7417 const
7418   CACHE_SIZE = $4000;
7419
7420   ////////////////////////////////////////////////////////////////////////////////////////
7421   procedure ReadUncompressed;
7422   var
7423     i, j: Integer;
7424     buf, tmp1, tmp2: System.PByte;
7425   begin
7426     buf := nil;
7427     if (Counter.X.dir < 0) then
7428       GetMem(buf, LineSize);
7429     try
7430       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7431         tmp1 := ImageData;
7432         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7433         if (Counter.X.dir < 0) then begin               //flip X
7434           aStream.Read(buf^, LineSize);
7435           tmp2 := buf;
7436           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7437           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7438             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7439               tmp1^ := tmp2^;
7440               inc(tmp1);
7441               inc(tmp2);
7442             end;
7443             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7444           end;
7445         end else
7446           aStream.Read(tmp1^, LineSize);
7447         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7448       end;
7449     finally
7450       if Assigned(buf) then
7451         FreeMem(buf);
7452     end;
7453   end;
7454
7455   ////////////////////////////////////////////////////////////////////////////////////////
7456   procedure ReadCompressed;
7457
7458     /////////////////////////////////////////////////////////////////
7459     var
7460       TmpData: System.PByte;
7461       LinePixelsRead: Integer;
7462     procedure CheckLine;
7463     begin
7464       if (LinePixelsRead >= Header.Width) then begin
7465         LinePixelsRead := 0;
7466         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7467         TmpData := ImageData;
7468         inc(TmpData, Counter.Y.low * LineSize);           //set line
7469         if (Counter.X.dir < 0) then                       //if x flipped then
7470           inc(TmpData, LineSize - PixelSize);             //set last pixel
7471       end;
7472     end;
7473
7474     /////////////////////////////////////////////////////////////////
7475     var
7476       Cache: PByte;
7477       CacheSize, CachePos: Integer;
7478     procedure CachedRead(out Buffer; Count: Integer);
7479     var
7480       BytesRead: Integer;
7481     begin
7482       if (CachePos + Count > CacheSize) then begin
7483         //if buffer overflow save non read bytes
7484         BytesRead := 0;
7485         if (CacheSize - CachePos > 0) then begin
7486           BytesRead := CacheSize - CachePos;
7487           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7488           inc(CachePos, BytesRead);
7489         end;
7490
7491         //load cache from file
7492         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7493         aStream.Read(Cache^, CacheSize);
7494         CachePos := 0;
7495
7496         //read rest of requested bytes
7497         if (Count - BytesRead > 0) then begin
7498           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7499           inc(CachePos, Count - BytesRead);
7500         end;
7501       end else begin
7502         //if no buffer overflow just read the data
7503         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7504         inc(CachePos, Count);
7505       end;
7506     end;
7507
7508     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7509     begin
7510       case PixelSize of
7511         1: begin
7512           aBuffer^ := aData^;
7513           inc(aBuffer, Counter.X.dir);
7514         end;
7515         2: begin
7516           PWord(aBuffer)^ := PWord(aData)^;
7517           inc(aBuffer, 2 * Counter.X.dir);
7518         end;
7519         3: begin
7520           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7521           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7522           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7523           inc(aBuffer, 3 * Counter.X.dir);
7524         end;
7525         4: begin
7526           PCardinal(aBuffer)^ := PCardinal(aData)^;
7527           inc(aBuffer, 4 * Counter.X.dir);
7528         end;
7529       end;
7530     end;
7531
7532   var
7533     TotalPixelsToRead, TotalPixelsRead: Integer;
7534     Temp: Byte;
7535     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7536     PixelRepeat: Boolean;
7537     PixelsToRead, PixelCount: Integer;
7538   begin
7539     CacheSize := 0;
7540     CachePos  := 0;
7541
7542     TotalPixelsToRead := Header.Width * Header.Height;
7543     TotalPixelsRead   := 0;
7544     LinePixelsRead    := 0;
7545
7546     GetMem(Cache, CACHE_SIZE);
7547     try
7548       TmpData := ImageData;
7549       inc(TmpData, Counter.Y.low * LineSize);           //set line
7550       if (Counter.X.dir < 0) then                       //if x flipped then
7551         inc(TmpData, LineSize - PixelSize);             //set last pixel
7552
7553       repeat
7554         //read CommandByte
7555         CachedRead(Temp, 1);
7556         PixelRepeat  := (Temp and $80) > 0;
7557         PixelsToRead := (Temp and $7F) + 1;
7558         inc(TotalPixelsRead, PixelsToRead);
7559
7560         if PixelRepeat then
7561           CachedRead(buf[0], PixelSize);
7562         while (PixelsToRead > 0) do begin
7563           CheckLine;
7564           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7565           while (PixelCount > 0) do begin
7566             if not PixelRepeat then
7567               CachedRead(buf[0], PixelSize);
7568             PixelToBuffer(@buf[0], TmpData);
7569             inc(LinePixelsRead);
7570             dec(PixelsToRead);
7571             dec(PixelCount);
7572           end;
7573         end;
7574       until (TotalPixelsRead >= TotalPixelsToRead);
7575     finally
7576       FreeMem(Cache);
7577     end;
7578   end;
7579
7580   function IsGrayFormat: Boolean;
7581   begin
7582     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7583   end;
7584
7585 begin
7586   result := false;
7587
7588   // reading header to test file and set cursor back to begin
7589   StartPosition := aStream.Position;
7590   aStream.Read(Header{%H-}, SizeOf(Header));
7591
7592   // no colormapped files
7593   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7594     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7595   begin
7596     try
7597       if Header.ImageID <> 0 then       // skip image ID
7598         aStream.Position := aStream.Position + Header.ImageID;
7599
7600       tgaFormat := tfEmpty;
7601       case Header.Bpp of
7602          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7603                0: tgaFormat := tfLuminance8ub1;
7604                8: tgaFormat := tfAlpha8ub1;
7605             end;
7606
7607         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7608                0: tgaFormat := tfLuminance16us1;
7609                8: tgaFormat := tfLuminance8Alpha8ub2;
7610             end else case (Header.ImageDesc and $F) of
7611                0: tgaFormat := tfX1RGB5us1;
7612                1: tgaFormat := tfA1RGB5us1;
7613                4: tgaFormat := tfARGB4us1;
7614             end;
7615
7616         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7617                0: tgaFormat := tfBGR8ub3;
7618             end;
7619
7620         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7621                0: tgaFormat := tfDepth32ui1;
7622             end else case (Header.ImageDesc and $F) of
7623                0: tgaFormat := tfX2RGB10ui1;
7624                2: tgaFormat := tfA2RGB10ui1;
7625                8: tgaFormat := tfARGB8ui1;
7626             end;
7627       end;
7628
7629       if (tgaFormat = tfEmpty) then
7630         raise EglBitmap.Create('LoadTga - unsupported format');
7631
7632       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7633       PixelSize  := FormatDesc.GetSize(1, 1);
7634       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7635
7636       GetMem(ImageData, LineSize * Header.Height);
7637       try
7638         //column direction
7639         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7640           Counter.X.low  := Header.Height-1;;
7641           Counter.X.high := 0;
7642           Counter.X.dir  := -1;
7643         end else begin
7644           Counter.X.low  := 0;
7645           Counter.X.high := Header.Height-1;
7646           Counter.X.dir  := 1;
7647         end;
7648
7649         // Row direction
7650         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7651           Counter.Y.low  := 0;
7652           Counter.Y.high := Header.Height-1;
7653           Counter.Y.dir  := 1;
7654         end else begin
7655           Counter.Y.low  := Header.Height-1;;
7656           Counter.Y.high := 0;
7657           Counter.Y.dir  := -1;
7658         end;
7659
7660         // Read Image
7661         case Header.ImageType of
7662           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7663             ReadUncompressed;
7664           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7665             ReadCompressed;
7666         end;
7667
7668         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7669         result := true;
7670       except
7671         if Assigned(ImageData) then
7672           FreeMem(ImageData);
7673         raise;
7674       end;
7675     finally
7676       aStream.Position := StartPosition;
7677     end;
7678   end
7679     else aStream.Position := StartPosition;
7680 end;
7681
7682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7683 procedure TglBitmap.SaveTGA(const aStream: TStream);
7684 var
7685   Header: TTGAHeader;
7686   Size: Integer;
7687   FormatDesc: TFormatDescriptor;
7688 begin
7689   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7690     raise EglBitmapUnsupportedFormat.Create(Format);
7691
7692   //prepare header
7693   FormatDesc := TFormatDescriptor.Get(Format);
7694   FillChar(Header{%H-}, SizeOf(Header), 0);
7695   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
7696   Header.Bpp       := FormatDesc.BitsPerPixel;
7697   Header.Width     := Width;
7698   Header.Height    := Height;
7699   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7700   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
7701     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7702   else
7703     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7704   aStream.Write(Header, SizeOf(Header));
7705
7706   // write Data
7707   Size := FormatDesc.GetSize(Dimension);
7708   aStream.Write(Data^, Size);
7709 end;
7710
7711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7712 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7714 const
7715   DDS_MAGIC: Cardinal         = $20534444;
7716
7717   // DDS_header.dwFlags
7718   DDSD_CAPS                   = $00000001;
7719   DDSD_HEIGHT                 = $00000002;
7720   DDSD_WIDTH                  = $00000004;
7721   DDSD_PIXELFORMAT            = $00001000;
7722
7723   // DDS_header.sPixelFormat.dwFlags
7724   DDPF_ALPHAPIXELS            = $00000001;
7725   DDPF_ALPHA                  = $00000002;
7726   DDPF_FOURCC                 = $00000004;
7727   DDPF_RGB                    = $00000040;
7728   DDPF_LUMINANCE              = $00020000;
7729
7730   // DDS_header.sCaps.dwCaps1
7731   DDSCAPS_TEXTURE             = $00001000;
7732
7733   // DDS_header.sCaps.dwCaps2
7734   DDSCAPS2_CUBEMAP            = $00000200;
7735
7736   D3DFMT_DXT1                 = $31545844;
7737   D3DFMT_DXT3                 = $33545844;
7738   D3DFMT_DXT5                 = $35545844;
7739
7740 type
7741   TDDSPixelFormat = packed record
7742     dwSize: Cardinal;
7743     dwFlags: Cardinal;
7744     dwFourCC: Cardinal;
7745     dwRGBBitCount: Cardinal;
7746     dwRBitMask: Cardinal;
7747     dwGBitMask: Cardinal;
7748     dwBBitMask: Cardinal;
7749     dwABitMask: Cardinal;
7750   end;
7751
7752   TDDSCaps = packed record
7753     dwCaps1: Cardinal;
7754     dwCaps2: Cardinal;
7755     dwDDSX: Cardinal;
7756     dwReserved: Cardinal;
7757   end;
7758
7759   TDDSHeader = packed record
7760     dwSize: Cardinal;
7761     dwFlags: Cardinal;
7762     dwHeight: Cardinal;
7763     dwWidth: Cardinal;
7764     dwPitchOrLinearSize: Cardinal;
7765     dwDepth: Cardinal;
7766     dwMipMapCount: Cardinal;
7767     dwReserved: array[0..10] of Cardinal;
7768     PixelFormat: TDDSPixelFormat;
7769     Caps: TDDSCaps;
7770     dwReserved2: Cardinal;
7771   end;
7772
7773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7774 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7775 var
7776   Header: TDDSHeader;
7777   Converter: TbmpBitfieldFormat;
7778
7779   function GetDDSFormat: TglBitmapFormat;
7780   var
7781     fd: TFormatDescriptor;
7782     i: Integer;
7783     Mask: TglBitmapRec4ul;
7784     Range: TglBitmapRec4ui;
7785     match: Boolean;
7786   begin
7787     result := tfEmpty;
7788     with Header.PixelFormat do begin
7789       // Compresses
7790       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7791         case Header.PixelFormat.dwFourCC of
7792           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7793           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7794           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7795         end;
7796       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
7797         // prepare masks
7798         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
7799           Mask.r := dwRBitMask;
7800           Mask.g := dwGBitMask;
7801           Mask.b := dwBBitMask;
7802         end else begin
7803           Mask.r := dwRBitMask;
7804           Mask.g := dwRBitMask;
7805           Mask.b := dwRBitMask;
7806         end;
7807         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
7808           Mask.a := dwABitMask
7809         else
7810           Mask.a := 0;;
7811
7812         //find matching format
7813         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
7814         result := fd.Format;
7815         if (result <> tfEmpty) then
7816           exit;
7817
7818         //find format with same Range
7819         for i := 0 to 3 do
7820           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
7821         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7822           fd := TFormatDescriptor.Get(result);
7823           match := true;
7824           for i := 0 to 3 do
7825             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7826               match := false;
7827               break;
7828             end;
7829           if match then
7830             break;
7831         end;
7832
7833         //no format with same range found -> use default
7834         if (result = tfEmpty) then begin
7835           if (dwABitMask > 0) then
7836             result := tfRGBA8ui1
7837           else
7838             result := tfRGB8ub3;
7839         end;
7840
7841         Converter := TbmpBitfieldFormat.Create;
7842         Converter.SetValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
7843       end;
7844     end;
7845   end;
7846
7847 var
7848   StreamPos: Int64;
7849   x, y, LineSize, RowSize, Magic: Cardinal;
7850   NewImage, TmpData, RowData, SrcData: System.PByte;
7851   SourceMD, DestMD: Pointer;
7852   Pixel: TglBitmapPixelData;
7853   ddsFormat: TglBitmapFormat;
7854   FormatDesc: TFormatDescriptor;
7855
7856 begin
7857   result    := false;
7858   Converter := nil;
7859   StreamPos := aStream.Position;
7860
7861   // Magic
7862   aStream.Read(Magic{%H-}, sizeof(Magic));
7863   if (Magic <> DDS_MAGIC) then begin
7864     aStream.Position := StreamPos;
7865     exit;
7866   end;
7867
7868   //Header
7869   aStream.Read(Header{%H-}, sizeof(Header));
7870   if (Header.dwSize <> SizeOf(Header)) or
7871      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7872         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7873   begin
7874     aStream.Position := StreamPos;
7875     exit;
7876   end;
7877
7878   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7879     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7880
7881   ddsFormat := GetDDSFormat;
7882   try
7883     if (ddsFormat = tfEmpty) then
7884       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7885
7886     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7887     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
7888     GetMem(NewImage, Header.dwHeight * LineSize);
7889     try
7890       TmpData := NewImage;
7891
7892       //Converter needed
7893       if Assigned(Converter) then begin
7894         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7895         GetMem(RowData, RowSize);
7896         SourceMD := Converter.CreateMappingData;
7897         DestMD   := FormatDesc.CreateMappingData;
7898         try
7899           for y := 0 to Header.dwHeight-1 do begin
7900             TmpData := NewImage;
7901             inc(TmpData, y * LineSize);
7902             SrcData := RowData;
7903             aStream.Read(SrcData^, RowSize);
7904             for x := 0 to Header.dwWidth-1 do begin
7905               Converter.Unmap(SrcData, Pixel, SourceMD);
7906               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7907               FormatDesc.Map(Pixel, TmpData, DestMD);
7908             end;
7909           end;
7910         finally
7911           Converter.FreeMappingData(SourceMD);
7912           FormatDesc.FreeMappingData(DestMD);
7913           FreeMem(RowData);
7914         end;
7915       end else
7916
7917       // Compressed
7918       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7919         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7920         for Y := 0 to Header.dwHeight-1 do begin
7921           aStream.Read(TmpData^, RowSize);
7922           Inc(TmpData, LineSize);
7923         end;
7924       end else
7925
7926       // Uncompressed
7927       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7928         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7929         for Y := 0 to Header.dwHeight-1 do begin
7930           aStream.Read(TmpData^, RowSize);
7931           Inc(TmpData, LineSize);
7932         end;
7933       end else
7934         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7935
7936       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7937       result := true;
7938     except
7939       if Assigned(NewImage) then
7940         FreeMem(NewImage);
7941       raise;
7942     end;
7943   finally
7944     FreeAndNil(Converter);
7945   end;
7946 end;
7947
7948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7949 procedure TglBitmap.SaveDDS(const aStream: TStream);
7950 var
7951   Header: TDDSHeader;
7952   FormatDesc: TFormatDescriptor;
7953 begin
7954   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7955     raise EglBitmapUnsupportedFormat.Create(Format);
7956
7957   FormatDesc := TFormatDescriptor.Get(Format);
7958
7959   // Generell
7960   FillChar(Header{%H-}, SizeOf(Header), 0);
7961   Header.dwSize  := SizeOf(Header);
7962   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7963
7964   Header.dwWidth  := Max(1, Width);
7965   Header.dwHeight := Max(1, Height);
7966
7967   // Caps
7968   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7969
7970   // Pixelformat
7971   Header.PixelFormat.dwSize := sizeof(Header);
7972   if (FormatDesc.IsCompressed) then begin
7973     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7974     case Format of
7975       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7976       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7977       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7978     end;
7979   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
7980     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7981     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
7982     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
7983   end else if FormatDesc.IsGrayscale then begin
7984     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7985     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
7986     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
7987     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
7988   end else begin
7989     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7990     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
7991     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
7992     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
7993     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
7994     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
7995   end;
7996
7997   if (FormatDesc.HasAlpha) then
7998     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7999
8000   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8001   aStream.Write(Header, SizeOf(Header));
8002   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8003 end;
8004
8005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8006 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8008 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8009   const aWidth: Integer; const aHeight: Integer);
8010 var
8011   pTemp: pByte;
8012   Size: Integer;
8013 begin
8014   if (aHeight > 1) then begin
8015     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8016     GetMem(pTemp, Size);
8017     try
8018       Move(aData^, pTemp^, Size);
8019       FreeMem(aData);
8020       aData := nil;
8021     except
8022       FreeMem(pTemp);
8023       raise;
8024     end;
8025   end else
8026     pTemp := aData;
8027   inherited SetDataPointer(pTemp, aFormat, aWidth);
8028 end;
8029
8030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8031 function TglBitmap1D.FlipHorz: Boolean;
8032 var
8033   Col: Integer;
8034   pTempDest, pDest, pSource: PByte;
8035 begin
8036   result := inherited FlipHorz;
8037   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8038     pSource := Data;
8039     GetMem(pDest, fRowSize);
8040     try
8041       pTempDest := pDest;
8042       Inc(pTempDest, fRowSize);
8043       for Col := 0 to Width-1 do begin
8044         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8045         Move(pSource^, pTempDest^, fPixelSize);
8046         Inc(pSource, fPixelSize);
8047       end;
8048       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8049       result := true;
8050     except
8051       if Assigned(pDest) then
8052         FreeMem(pDest);
8053       raise;
8054     end;
8055   end;
8056 end;
8057
8058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8059 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8060 var
8061   FormatDesc: TFormatDescriptor;
8062 begin
8063   // Upload data
8064   FormatDesc := TFormatDescriptor.Get(Format);
8065   if FormatDesc.IsCompressed then begin
8066     if not Assigned(glCompressedTexImage1D) then
8067       raise EglBitmap.Create('compressed formats not supported by video adapter');
8068     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8069   end else if aBuildWithGlu then
8070     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8071   else
8072     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8073
8074   // Free Data
8075   if (FreeDataAfterGenTexture) then
8076     FreeData;
8077 end;
8078
8079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8080 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8081 var
8082   BuildWithGlu, TexRec: Boolean;
8083   TexSize: Integer;
8084 begin
8085   if Assigned(Data) then begin
8086     // Check Texture Size
8087     if (aTestTextureSize) then begin
8088       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8089
8090       if (Width > TexSize) then
8091         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8092
8093       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8094                 (Target = GL_TEXTURE_RECTANGLE);
8095       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8096         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8097     end;
8098
8099     CreateId;
8100     SetupParameters(BuildWithGlu);
8101     UploadData(BuildWithGlu);
8102     glAreTexturesResident(1, @fID, @fIsResident);
8103   end;
8104 end;
8105
8106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8107 procedure TglBitmap1D.AfterConstruction;
8108 begin
8109   inherited;
8110   Target := GL_TEXTURE_1D;
8111 end;
8112
8113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8114 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8116 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8117 begin
8118   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8119     result := fLines[aIndex]
8120   else
8121     result := nil;
8122 end;
8123
8124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8125 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8126   const aWidth: Integer; const aHeight: Integer);
8127 var
8128   Idx, LineWidth: Integer;
8129 begin
8130   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8131
8132   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8133     // Assigning Data
8134     if Assigned(Data) then begin
8135       SetLength(fLines, GetHeight);
8136       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8137
8138       for Idx := 0 to GetHeight-1 do begin
8139         fLines[Idx] := Data;
8140         Inc(fLines[Idx], Idx * LineWidth);
8141       end;
8142     end
8143       else SetLength(fLines, 0);
8144   end else begin
8145     SetLength(fLines, 0);
8146   end;
8147 end;
8148
8149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8150 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8151 var
8152   FormatDesc: TFormatDescriptor;
8153 begin
8154   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8155
8156   FormatDesc := TFormatDescriptor.Get(Format);
8157   if FormatDesc.IsCompressed then begin
8158     if not Assigned(glCompressedTexImage2D) then
8159       raise EglBitmap.Create('compressed formats not supported by video adapter');
8160     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8161   end else if aBuildWithGlu then begin
8162     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8163       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8164   end else begin
8165     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8166       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8167   end;
8168
8169   // Freigeben
8170   if (FreeDataAfterGenTexture) then
8171     FreeData;
8172 end;
8173
8174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8175 procedure TglBitmap2D.AfterConstruction;
8176 begin
8177   inherited;
8178   Target := GL_TEXTURE_2D;
8179 end;
8180
8181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8182 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8183 var
8184   Temp: pByte;
8185   Size, w, h: Integer;
8186   FormatDesc: TFormatDescriptor;
8187 begin
8188   FormatDesc := TFormatDescriptor.Get(aFormat);
8189   if FormatDesc.IsCompressed then
8190     raise EglBitmapUnsupportedFormat.Create(aFormat);
8191
8192   w    := aRight  - aLeft;
8193   h    := aBottom - aTop;
8194   Size := FormatDesc.GetSize(w, h);
8195   GetMem(Temp, Size);
8196   try
8197     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8198     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8199     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8200     FlipVert;
8201   except
8202     if Assigned(Temp) then
8203       FreeMem(Temp);
8204     raise;
8205   end;
8206 end;
8207
8208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8209 procedure TglBitmap2D.GetDataFromTexture;
8210 var
8211   Temp: PByte;
8212   TempWidth, TempHeight: Integer;
8213   TempIntFormat: GLint;
8214   IntFormat: TglBitmapFormat;
8215   FormatDesc: TFormatDescriptor;
8216 begin
8217   Bind;
8218
8219   // Request Data
8220   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8221   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8222   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8223
8224   IntFormat  := tfEmpty;
8225   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8226   IntFormat  := FormatDesc.Format;
8227
8228   // Getting data from OpenGL
8229   FormatDesc := TFormatDescriptor.Get(IntFormat);
8230   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8231   try
8232     if FormatDesc.IsCompressed then begin
8233       if not Assigned(glGetCompressedTexImage) then
8234         raise EglBitmap.Create('compressed formats not supported by video adapter');
8235       glGetCompressedTexImage(Target, 0, Temp)
8236     end else
8237       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8238     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8239   except
8240     if Assigned(Temp) then
8241       FreeMem(Temp);
8242     raise;
8243   end;
8244 end;
8245
8246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8247 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8248 var
8249   BuildWithGlu, PotTex, TexRec: Boolean;
8250   TexSize: Integer;
8251 begin
8252   if Assigned(Data) then begin
8253     // Check Texture Size
8254     if (aTestTextureSize) then begin
8255       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8256
8257       if ((Height > TexSize) or (Width > TexSize)) then
8258         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8259
8260       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8261       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8262       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8263         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8264     end;
8265
8266     CreateId;
8267     SetupParameters(BuildWithGlu);
8268     UploadData(Target, BuildWithGlu);
8269     glAreTexturesResident(1, @fID, @fIsResident);
8270   end;
8271 end;
8272
8273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8274 function TglBitmap2D.FlipHorz: Boolean;
8275 var
8276   Col, Row: Integer;
8277   TempDestData, DestData, SourceData: PByte;
8278   ImgSize: Integer;
8279 begin
8280   result := inherited FlipHorz;
8281   if Assigned(Data) then begin
8282     SourceData := Data;
8283     ImgSize := Height * fRowSize;
8284     GetMem(DestData, ImgSize);
8285     try
8286       TempDestData := DestData;
8287       Dec(TempDestData, fRowSize + fPixelSize);
8288       for Row := 0 to Height -1 do begin
8289         Inc(TempDestData, fRowSize * 2);
8290         for Col := 0 to Width -1 do begin
8291           Move(SourceData^, TempDestData^, fPixelSize);
8292           Inc(SourceData, fPixelSize);
8293           Dec(TempDestData, fPixelSize);
8294         end;
8295       end;
8296       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8297       result := true;
8298     except
8299       if Assigned(DestData) then
8300         FreeMem(DestData);
8301       raise;
8302     end;
8303   end;
8304 end;
8305
8306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8307 function TglBitmap2D.FlipVert: Boolean;
8308 var
8309   Row: Integer;
8310   TempDestData, DestData, SourceData: PByte;
8311 begin
8312   result := inherited FlipVert;
8313   if Assigned(Data) then begin
8314     SourceData := Data;
8315     GetMem(DestData, Height * fRowSize);
8316     try
8317       TempDestData := DestData;
8318       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8319       for Row := 0 to Height -1 do begin
8320         Move(SourceData^, TempDestData^, fRowSize);
8321         Dec(TempDestData, fRowSize);
8322         Inc(SourceData, fRowSize);
8323       end;
8324       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8325       result := true;
8326     except
8327       if Assigned(DestData) then
8328         FreeMem(DestData);
8329       raise;
8330     end;
8331   end;
8332 end;
8333
8334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8335 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8337 type
8338   TMatrixItem = record
8339     X, Y: Integer;
8340     W: Single;
8341   end;
8342
8343   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8344   TglBitmapToNormalMapRec = Record
8345     Scale: Single;
8346     Heights: array of Single;
8347     MatrixU : array of TMatrixItem;
8348     MatrixV : array of TMatrixItem;
8349   end;
8350
8351 const
8352   ONE_OVER_255 = 1 / 255;
8353
8354   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8355 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8356 var
8357   Val: Single;
8358 begin
8359   with FuncRec do begin
8360     Val :=
8361       Source.Data.r * LUMINANCE_WEIGHT_R +
8362       Source.Data.g * LUMINANCE_WEIGHT_G +
8363       Source.Data.b * LUMINANCE_WEIGHT_B;
8364     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8365   end;
8366 end;
8367
8368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8369 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8370 begin
8371   with FuncRec do
8372     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8373 end;
8374
8375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8376 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8377 type
8378   TVec = Array[0..2] of Single;
8379 var
8380   Idx: Integer;
8381   du, dv: Double;
8382   Len: Single;
8383   Vec: TVec;
8384
8385   function GetHeight(X, Y: Integer): Single;
8386   begin
8387     with FuncRec do begin
8388       X := Max(0, Min(Size.X -1, X));
8389       Y := Max(0, Min(Size.Y -1, Y));
8390       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8391     end;
8392   end;
8393
8394 begin
8395   with FuncRec do begin
8396     with PglBitmapToNormalMapRec(Args)^ do begin
8397       du := 0;
8398       for Idx := Low(MatrixU) to High(MatrixU) do
8399         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8400
8401       dv := 0;
8402       for Idx := Low(MatrixU) to High(MatrixU) do
8403         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8404
8405       Vec[0] := -du * Scale;
8406       Vec[1] := -dv * Scale;
8407       Vec[2] := 1;
8408     end;
8409
8410     // Normalize
8411     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8412     if Len <> 0 then begin
8413       Vec[0] := Vec[0] * Len;
8414       Vec[1] := Vec[1] * Len;
8415       Vec[2] := Vec[2] * Len;
8416     end;
8417
8418     // Farbe zuweisem
8419     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8420     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8421     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8422   end;
8423 end;
8424
8425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8426 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8427 var
8428   Rec: TglBitmapToNormalMapRec;
8429
8430   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8431   begin
8432     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8433       Matrix[Index].X := X;
8434       Matrix[Index].Y := Y;
8435       Matrix[Index].W := W;
8436     end;
8437   end;
8438
8439 begin
8440   if TFormatDescriptor.Get(Format).IsCompressed then
8441     raise EglBitmapUnsupportedFormat.Create(Format);
8442
8443   if aScale > 100 then
8444     Rec.Scale := 100
8445   else if aScale < -100 then
8446     Rec.Scale := -100
8447   else
8448     Rec.Scale := aScale;
8449
8450   SetLength(Rec.Heights, Width * Height);
8451   try
8452     case aFunc of
8453       nm4Samples: begin
8454         SetLength(Rec.MatrixU, 2);
8455         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8456         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8457
8458         SetLength(Rec.MatrixV, 2);
8459         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8460         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8461       end;
8462
8463       nmSobel: begin
8464         SetLength(Rec.MatrixU, 6);
8465         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8466         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8467         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8468         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8469         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8470         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8471
8472         SetLength(Rec.MatrixV, 6);
8473         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8474         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8475         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8476         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8477         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8478         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8479       end;
8480
8481       nm3x3: begin
8482         SetLength(Rec.MatrixU, 6);
8483         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8484         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8485         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8486         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8487         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8488         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8489
8490         SetLength(Rec.MatrixV, 6);
8491         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8492         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8493         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8494         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8495         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8496         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8497       end;
8498
8499       nm5x5: begin
8500         SetLength(Rec.MatrixU, 20);
8501         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8502         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8503         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8504         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8505         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8506         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8507         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8508         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8509         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8510         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8511         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8512         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8513         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8514         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8515         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8516         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8517         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8518         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8519         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8520         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8521
8522         SetLength(Rec.MatrixV, 20);
8523         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8524         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8525         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8526         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8527         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8528         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8529         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8530         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8531         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8532         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8533         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8534         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8535         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8536         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8537         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8538         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8539         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8540         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8541         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8542         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8543       end;
8544     end;
8545
8546     // Daten Sammeln
8547     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8548       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8549     else
8550       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8551     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8552   finally
8553     SetLength(Rec.Heights, 0);
8554   end;
8555 end;
8556
8557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8558 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8560 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8561 begin
8562   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8563 end;
8564
8565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8566 procedure TglBitmapCubeMap.AfterConstruction;
8567 begin
8568   inherited;
8569
8570   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8571     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8572
8573   SetWrap;
8574   Target   := GL_TEXTURE_CUBE_MAP;
8575   fGenMode := GL_REFLECTION_MAP;
8576 end;
8577
8578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8579 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8580 var
8581   BuildWithGlu: Boolean;
8582   TexSize: Integer;
8583 begin
8584   if (aTestTextureSize) then begin
8585     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8586
8587     if (Height > TexSize) or (Width > TexSize) then
8588       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8589
8590     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8591       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8592   end;
8593
8594   if (ID = 0) then
8595     CreateID;
8596   SetupParameters(BuildWithGlu);
8597   UploadData(aCubeTarget, BuildWithGlu);
8598 end;
8599
8600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8601 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8602 begin
8603   inherited Bind (aEnableTextureUnit);
8604   if aEnableTexCoordsGen then begin
8605     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8606     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8607     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8608     glEnable(GL_TEXTURE_GEN_S);
8609     glEnable(GL_TEXTURE_GEN_T);
8610     glEnable(GL_TEXTURE_GEN_R);
8611   end;
8612 end;
8613
8614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8615 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8616 begin
8617   inherited Unbind(aDisableTextureUnit);
8618   if aDisableTexCoordsGen then begin
8619     glDisable(GL_TEXTURE_GEN_S);
8620     glDisable(GL_TEXTURE_GEN_T);
8621     glDisable(GL_TEXTURE_GEN_R);
8622   end;
8623 end;
8624
8625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8626 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8628 type
8629   TVec = Array[0..2] of Single;
8630   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8631
8632   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8633   TglBitmapNormalMapRec = record
8634     HalfSize : Integer;
8635     Func: TglBitmapNormalMapGetVectorFunc;
8636   end;
8637
8638   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8639 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8640 begin
8641   aVec[0] := aHalfSize;
8642   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8643   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8644 end;
8645
8646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8647 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8648 begin
8649   aVec[0] := - aHalfSize;
8650   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8651   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8652 end;
8653
8654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8655 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8656 begin
8657   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8658   aVec[1] := aHalfSize;
8659   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8660 end;
8661
8662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8663 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8664 begin
8665   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8666   aVec[1] := - aHalfSize;
8667   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8668 end;
8669
8670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8671 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8672 begin
8673   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8674   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8675   aVec[2] := aHalfSize;
8676 end;
8677
8678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8679 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8680 begin
8681   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8682   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8683   aVec[2] := - aHalfSize;
8684 end;
8685
8686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8687 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8688 var
8689   i: Integer;
8690   Vec: TVec;
8691   Len: Single;
8692 begin
8693   with FuncRec do begin
8694     with PglBitmapNormalMapRec(Args)^ do begin
8695       Func(Vec, Position, HalfSize);
8696
8697       // Normalize
8698       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8699       if Len <> 0 then begin
8700         Vec[0] := Vec[0] * Len;
8701         Vec[1] := Vec[1] * Len;
8702         Vec[2] := Vec[2] * Len;
8703       end;
8704
8705       // Scale Vector and AddVectro
8706       Vec[0] := Vec[0] * 0.5 + 0.5;
8707       Vec[1] := Vec[1] * 0.5 + 0.5;
8708       Vec[2] := Vec[2] * 0.5 + 0.5;
8709     end;
8710
8711     // Set Color
8712     for i := 0 to 2 do
8713       Dest.Data.arr[i] := Round(Vec[i] * 255);
8714   end;
8715 end;
8716
8717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8718 procedure TglBitmapNormalMap.AfterConstruction;
8719 begin
8720   inherited;
8721   fGenMode := GL_NORMAL_MAP;
8722 end;
8723
8724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8725 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8726 var
8727   Rec: TglBitmapNormalMapRec;
8728   SizeRec: TglBitmapPixelPosition;
8729 begin
8730   Rec.HalfSize := aSize div 2;
8731   FreeDataAfterGenTexture := false;
8732
8733   SizeRec.Fields := [ffX, ffY];
8734   SizeRec.X := aSize;
8735   SizeRec.Y := aSize;
8736
8737   // Positive X
8738   Rec.Func := glBitmapNormalMapPosX;
8739   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8740   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8741
8742   // Negative X
8743   Rec.Func := glBitmapNormalMapNegX;
8744   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8745   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8746
8747   // Positive Y
8748   Rec.Func := glBitmapNormalMapPosY;
8749   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8750   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8751
8752   // Negative Y
8753   Rec.Func := glBitmapNormalMapNegY;
8754   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8755   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8756
8757   // Positive Z
8758   Rec.Func := glBitmapNormalMapPosZ;
8759   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8760   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8761
8762   // Negative Z
8763   Rec.Func := glBitmapNormalMapNegZ;
8764   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8765   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8766 end;
8767
8768
8769 initialization
8770   glBitmapSetDefaultFormat (tfEmpty);
8771   glBitmapSetDefaultMipmap (mmMipmap);
8772   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8773   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8774   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8775
8776   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8777   glBitmapSetDefaultDeleteTextureOnFree    (true);
8778
8779   TFormatDescriptor.Init;
8780
8781 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8782   OpenGLInitialized := false;
8783   InitOpenGLCS := TCriticalSection.Create;
8784 {$ENDIF}
8785
8786 finalization
8787   TFormatDescriptor.Finalize;
8788
8789 {$IFDEF GLB_NATIVE_OGL}
8790   if Assigned(GL_LibHandle) then
8791     glbFreeLibrary(GL_LibHandle);
8792
8793 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8794   if Assigned(GLU_LibHandle) then
8795     glbFreeLibrary(GLU_LibHandle);
8796   FreeAndNil(InitOpenGLCS);
8797 {$ENDIF}
8798 {$ENDIF}
8799
8800 end.