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   TglBitmapColorRec = 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   TglBitmapMask = packed record
 895   case Integer of
 896     0: (r, g, b, a: QWord);
 897     1: (arr: array[0..3] of QWord);
 898   end;
 899
 900   TglBitmapPixelData = packed record
 901     Data, Range: TglBitmapColorRec;
 902     Format: TglBitmapFormat;
 903   end;
 904   PglBitmapPixelData = ^TglBitmapPixelData;
 905
 906 ////////////////////////////////////////////////////////////////////////////////////////////////////
 907   TglBitmapPixelPositionFields = set of (ffX, ffY);
 908   TglBitmapPixelPosition = record
 909     Fields : TglBitmapPixelPositionFields;
 910     X : Word;
 911     Y : Word;
 912   end;
 913
 914   TglBitmapFormatDescriptor = class(TObject)
 915   protected
 916     function GetIsCompressed: Boolean; virtual; abstract;
 917     function GetHasRed:       Boolean; virtual; abstract;
 918     function GetHasGreen:     Boolean; virtual; abstract;
 919     function GetHasBlue:      Boolean; virtual; abstract;
 920     function GetHasAlpha:     Boolean; virtual; abstract;
 921     function GetHasColor:     Boolean; virtual; abstract;
 922     function GetIsGrayscale:  Boolean; virtual; abstract;
 923
 924     function GetRGBInverted:  TglBitmapFormat; virtual; abstract;
 925     function GetWithAlpha:    TglBitmapFormat; virtual; abstract;
 926     function GetWithoutAlpha: TglBitmapFormat; virtual; abstract;
 927     function GetOpenGLFormat: TglBitmapFormat; virtual; abstract;
 928     function GetUncompressed: TglBitmapFormat; virtual; abstract;
 929
 930     function GetglDataFormat:     GLenum;  virtual; abstract;
 931     function GetglFormat:         GLenum;  virtual; abstract;
 932     function GetglInternalFormat: GLenum;  virtual; abstract;
 933   public
 934     property IsCompressed: Boolean read GetIsCompressed;
 935     property HasRed:       Boolean read GetHasRed;
 936     property HasGreen:     Boolean read GetHasGreen;
 937     property HasBlue:      Boolean read GetHasBlue;
 938     property HasAlpha:     Boolean read GetHasAlpha;
 939     property HasColor:     Boolean read GetHasColor;
 940     property IsGrayscale:  Boolean read GetIsGrayscale;
 941
 942     property RGBInverted:  TglBitmapFormat read GetRGBInverted;
 943     property WithAlpha:    TglBitmapFormat read GetWithAlpha;
 944     property WithoutAlpha: TglBitmapFormat read GetWithoutAlpha;
 945     property OpenGLFormat: TglBitmapFormat read GetOpenGLFormat;
 946     property Uncompressed: TglBitmapFormat read GetUncompressed;
 947
 948     property glFormat:         GLenum  read GetglFormat;
 949     property glInternalFormat: GLenum  read GetglInternalFormat;
 950     property glDataFormat:     GLenum  read GetglDataFormat;
 951   public
 952     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 953   end;
 954
 955 ////////////////////////////////////////////////////////////////////////////////////////////////////
 956   TglBitmap = class;
 957   TglBitmapFunctionRec = record
 958     Sender:   TglBitmap;
 959     Size:     TglBitmapPixelPosition;
 960     Position: TglBitmapPixelPosition;
 961     Source:   TglBitmapPixelData;
 962     Dest:     TglBitmapPixelData;
 963     Args:     Pointer;
 964   end;
 965   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 966
 967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 968   TglBitmap = class
 969   private
 970     function GetFormatDesc: TglBitmapFormatDescriptor;
 971   protected
 972     fID: GLuint;
 973     fTarget: GLuint;
 974     fAnisotropic: Integer;
 975     fDeleteTextureOnFree: Boolean;
 976     fFreeDataOnDestroy: Boolean;
 977     fFreeDataAfterGenTexture: Boolean;
 978     fData: PByte;
 979     fIsResident: GLboolean;
 980     fBorderColor: array[0..3] of Single;
 981
 982     fDimension: TglBitmapPixelPosition;
 983     fMipMap: TglBitmapMipMap;
 984     fFormat: TglBitmapFormat;
 985
 986     // Mapping
 987     fPixelSize: Integer;
 988     fRowSize: Integer;
 989
 990     // Filtering
 991     fFilterMin: GLenum;
 992     fFilterMag: GLenum;
 993
 994     // TexturWarp
 995     fWrapS: GLenum;
 996     fWrapT: GLenum;
 997     fWrapR: GLenum;
 998
 999     //Swizzle
1000     fSwizzle: array[0..3] of GLenum;
1001
1002     // CustomData
1003     fFilename: String;
1004     fCustomName: String;
1005     fCustomNameW: WideString;
1006     fCustomData: Pointer;
1007
1008     //Getter
1009     function GetWidth:  Integer; virtual;
1010     function GetHeight: Integer; virtual;
1011
1012     function GetFileWidth:  Integer; virtual;
1013     function GetFileHeight: Integer; virtual;
1014
1015     //Setter
1016     procedure SetCustomData(const aValue: Pointer);
1017     procedure SetCustomName(const aValue: String);
1018     procedure SetCustomNameW(const aValue: WideString);
1019     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1020     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1021     procedure SetFormat(const aValue: TglBitmapFormat);
1022     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1023     procedure SetID(const aValue: Cardinal);
1024     procedure SetMipMap(const aValue: TglBitmapMipMap);
1025     procedure SetTarget(const aValue: Cardinal);
1026     procedure SetAnisotropic(const aValue: Integer);
1027
1028     procedure CreateID;
1029     procedure SetupParameters(out aBuildWithGlu: Boolean);
1030     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1031       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1032     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1033
1034     function FlipHorz: Boolean; virtual;
1035     function FlipVert: Boolean; virtual;
1036
1037     property Width:  Integer read GetWidth;
1038     property Height: Integer read GetHeight;
1039
1040     property FileWidth:  Integer read GetFileWidth;
1041     property FileHeight: Integer read GetFileHeight;
1042   public
1043     //Properties
1044     property ID:           Cardinal        read fID          write SetID;
1045     property Target:       Cardinal        read fTarget      write SetTarget;
1046     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1047     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1048     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1049
1050     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1051
1052     property Filename:    String     read fFilename;
1053     property CustomName:  String     read fCustomName  write SetCustomName;
1054     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1055     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1056
1057     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1058     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1059     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1060
1061     property Dimension:  TglBitmapPixelPosition  read fDimension;
1062     property Data:       PByte                   read fData;
1063     property IsResident: GLboolean               read fIsResident;
1064
1065     procedure AfterConstruction; override;
1066     procedure BeforeDestruction; override;
1067
1068     procedure PrepareResType(var aResource: String; var aResType: PChar);
1069
1070     //Load
1071     procedure LoadFromFile(const aFilename: String);
1072     procedure LoadFromStream(const aStream: TStream); virtual;
1073     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1074       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1075     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1076     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1077
1078     //Save
1079     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1080     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1081
1082     //Convert
1083     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1084     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1085       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1086   public
1087     //Alpha & Co
1088     {$IFDEF GLB_SDL}
1089     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1090     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1091     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1092     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1093       const aArgs: Pointer = nil): Boolean;
1094     {$ENDIF}
1095
1096     {$IFDEF GLB_DELPHI}
1097     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1098     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1099     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1100     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1101       const aArgs: Pointer = nil): Boolean;
1102     {$ENDIF}
1103
1104     {$IFDEF GLB_LAZARUS}
1105     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1106     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1107     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1108     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1109       const aArgs: Pointer = nil): Boolean;
1110     {$ENDIF}
1111
1112     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1113       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1114     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1115       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1116
1117     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1118     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1119     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1120     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1121
1122     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1123     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1124     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1125
1126     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1127     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1128     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1129
1130     function RemoveAlpha: Boolean; virtual;
1131   public
1132     //Common
1133     function Clone: TglBitmap;
1134     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1135     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1136     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1137     procedure FreeData;
1138
1139     //ColorFill
1140     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1141     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1142     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1143
1144     //TexParameters
1145     procedure SetFilter(const aMin, aMag: GLenum);
1146     procedure SetWrap(
1147       const S: GLenum = GL_CLAMP_TO_EDGE;
1148       const T: GLenum = GL_CLAMP_TO_EDGE;
1149       const R: GLenum = GL_CLAMP_TO_EDGE);
1150     procedure SetSwizzle(const r, g, b, a: GLenum);
1151
1152     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1153     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1154
1155     //Constructors
1156     constructor Create; overload;
1157     constructor Create(const aFileName: String); overload;
1158     constructor Create(const aStream: TStream); overload;
1159     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1160     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1161     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1162     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1163   private
1164     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1165     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1166
1167     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1168     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1169
1170     function LoadBMP(const aStream: TStream): Boolean; virtual;
1171     procedure SaveBMP(const aStream: TStream); virtual;
1172
1173     function LoadTGA(const aStream: TStream): Boolean; virtual;
1174     procedure SaveTGA(const aStream: TStream); virtual;
1175
1176     function LoadDDS(const aStream: TStream): Boolean; virtual;
1177     procedure SaveDDS(const aStream: TStream); virtual;
1178   end;
1179
1180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1181   TglBitmap1D = class(TglBitmap)
1182   protected
1183     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1184       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1185     procedure UploadData(const aBuildWithGlu: Boolean);
1186   public
1187     property Width;
1188     procedure AfterConstruction; override;
1189     function FlipHorz: Boolean; override;
1190     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1191   end;
1192
1193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1194   TglBitmap2D = class(TglBitmap)
1195   protected
1196     fLines: array of PByte;
1197     function GetScanline(const aIndex: Integer): Pointer;
1198     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1199       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1200     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1201   public
1202     property Width;
1203     property Height;
1204     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1205
1206     procedure AfterConstruction; override;
1207
1208     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1209     procedure GetDataFromTexture;
1210     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1211
1212     function FlipHorz: Boolean; override;
1213     function FlipVert: Boolean; override;
1214
1215     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1216       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1217   end;
1218
1219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1220   TglBitmapCubeMap = class(TglBitmap2D)
1221   protected
1222     fGenMode: Integer;
1223     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1224   public
1225     procedure AfterConstruction; override;
1226     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1227     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1228     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1229   end;
1230
1231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1232   TglBitmapNormalMap = class(TglBitmapCubeMap)
1233   public
1234     procedure AfterConstruction; override;
1235     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1236   end;
1237
1238 const
1239   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1240
1241 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1242 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1243 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1244 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1245 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1246 procedure glBitmapSetDefaultWrap(
1247   const S: Cardinal = GL_CLAMP_TO_EDGE;
1248   const T: Cardinal = GL_CLAMP_TO_EDGE;
1249   const R: Cardinal = GL_CLAMP_TO_EDGE);
1250
1251 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1252 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1253 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1254 function glBitmapGetDefaultFormat: TglBitmapFormat;
1255 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1256 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1257
1258 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1259 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1260 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1261
1262 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1263
1264 var
1265   glBitmapDefaultDeleteTextureOnFree: Boolean;
1266   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1267   glBitmapDefaultFormat: TglBitmapFormat;
1268   glBitmapDefaultMipmap: TglBitmapMipMap;
1269   glBitmapDefaultFilterMin: Cardinal;
1270   glBitmapDefaultFilterMag: Cardinal;
1271   glBitmapDefaultWrapS: Cardinal;
1272   glBitmapDefaultWrapT: Cardinal;
1273   glBitmapDefaultWrapR: Cardinal;
1274   glDefaultSwizzle: array[0..3] of GLenum;
1275
1276 {$IFDEF GLB_DELPHI}
1277 function CreateGrayPalette: HPALETTE;
1278 {$ENDIF}
1279
1280 implementation
1281
1282 uses
1283   Math, syncobjs, typinfo
1284   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1285
1286 type
1287 {$IFNDEF fpc}
1288   QWord   = System.UInt64;
1289   PQWord  = ^QWord;
1290
1291   PtrInt  = Longint;
1292   PtrUInt = DWord;
1293 {$ENDIF}
1294
1295 ////////////////////////////////////////////////////////////////////////////////////////////////////
1296   TShiftRec = packed record
1297   case Integer of
1298     0: (r, g, b, a: Byte);
1299     1: (arr: array[0..3] of Byte);
1300   end;
1301
1302   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1303   private
1304     function GetRedMask: QWord;
1305     function GetGreenMask: QWord;
1306     function GetBlueMask: QWord;
1307     function GetAlphaMask: QWord;
1308   protected
1309     fFormat: TglBitmapFormat;
1310     fWithAlpha: TglBitmapFormat;
1311     fWithoutAlpha: TglBitmapFormat;
1312     fOpenGLFormat: TglBitmapFormat;
1313     fRGBInverted: TglBitmapFormat;
1314     fUncompressed: TglBitmapFormat;
1315
1316     fPixelSize: Single;
1317     fIsCompressed: Boolean;
1318
1319     fRange: TglBitmapColorRec;
1320     fShift: TShiftRec;
1321
1322     fglFormat:         GLenum;
1323     fglInternalFormat: GLenum;
1324     fglDataFormat:     GLenum;
1325
1326     function GetIsCompressed: Boolean; override;
1327     function GetHasRed: Boolean; override;
1328     function GetHasGreen: Boolean; override;
1329     function GetHasBlue: Boolean; override;
1330     function GetHasAlpha: Boolean; override;
1331     function GetHasColor: Boolean; override;
1332     function GetIsGrayscale: Boolean; override;
1333
1334     function GetRGBInverted:  TglBitmapFormat; override;
1335     function GetWithAlpha:    TglBitmapFormat; override;
1336     function GetWithoutAlpha: TglBitmapFormat; override;
1337     function GetOpenGLFormat: TglBitmapFormat; override;
1338     function GetUncompressed: TglBitmapFormat; override;
1339
1340     function GetglFormat: GLenum; override;
1341     function GetglInternalFormat: GLenum; override;
1342     function GetglDataFormat: GLenum; override;
1343
1344     function GetComponents: Integer; virtual;
1345   public
1346     property Format:       TglBitmapFormat read fFormat;
1347     property Components:   Integer         read GetComponents;
1348     property PixelSize:    Single          read fPixelSize;
1349
1350     property Range: TglBitmapColorRec read fRange;
1351     property Shift: TShiftRec         read fShift;
1352
1353     property RedMask:   QWord read GetRedMask;
1354     property GreenMask: QWord read GetGreenMask;
1355     property BlueMask:  QWord read GetBlueMask;
1356     property AlphaMask: QWord read GetAlphaMask;
1357
1358     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1359     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1360
1361     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1362     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1363
1364     function CreateMappingData: Pointer; virtual;
1365     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1366
1367     function IsEmpty: Boolean; virtual;
1368     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual; overload;
1369     function MaskMatch(const aMask: TglBitmapMask): Boolean; virtual; overload;
1370
1371     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1372
1373     constructor Create; virtual;
1374   public
1375     class procedure Init;
1376     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1377     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1378     class function GetFromMask(const aMask: TglBitmapMask; const aBitCount: Integer = 0): TFormatDescriptor;
1379     class procedure Clear;
1380     class procedure Finalize;
1381   end;
1382   TFormatDescriptorClass = class of TFormatDescriptor;
1383
1384   TfdEmpty = class(TFormatDescriptor);
1385
1386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1387   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390   end;
1391
1392   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395   end;
1396
1397   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400   end;
1401
1402   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1403     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1404     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1405   end;
1406
1407   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1408     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1409     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1410   end;
1411
1412   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415   end;
1416
1417   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1418     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1419     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1420   end;
1421
1422   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425   end;
1426
1427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1428   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431   end;
1432
1433   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1434     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1435     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1436   end;
1437
1438   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441   end;
1442
1443   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446   end;
1447
1448   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1449     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1450     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1451   end;
1452
1453   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1454     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1455     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1456   end;
1457
1458   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1459     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1460     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1461   end;
1462
1463   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1464     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1465     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1466   end;
1467
1468   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1469     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1470     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1471   end;
1472
1473   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1474     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1475     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1476   end;
1477
1478   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1479     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1480     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1481   end;
1482
1483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1484   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1485     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1486     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1487   end;
1488
1489   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1490     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1491     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1492   end;
1493
1494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1495   TfdAlpha4ub1 = class(TfdAlphaUB1)
1496     constructor Create; override;
1497   end;
1498
1499   TfdAlpha8ub1 = class(TfdAlphaUB1)
1500     constructor Create; override;
1501   end;
1502
1503   TfdAlpha16us1 = class(TfdAlphaUS1)
1504     constructor Create; override;
1505   end;
1506
1507   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1508     constructor Create; override;
1509   end;
1510
1511   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1512     constructor Create; override;
1513   end;
1514
1515   TfdLuminance16us1 = class(TfdLuminanceUS1)
1516     constructor Create; override;
1517   end;
1518
1519   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1520     constructor Create; override;
1521   end;
1522
1523   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1524     constructor Create; override;
1525   end;
1526
1527   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1528     constructor Create; override;
1529   end;
1530
1531   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1532     constructor Create; override;
1533   end;
1534
1535   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1536     constructor Create; override;
1537   end;
1538
1539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1540   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1541     constructor Create; override;
1542   end;
1543
1544   TfdRGBX4us1 = class(TfdUniversalUS1)
1545     constructor Create; override;
1546   end;
1547
1548   TfdXRGB4us1 = class(TfdUniversalUS1)
1549     constructor Create; override;
1550   end;
1551
1552   TfdR5G6B5us1 = class(TfdUniversalUS1)
1553     constructor Create; override;
1554   end;
1555
1556   TfdRGB5X1us1 = class(TfdUniversalUS1)
1557     constructor Create; override;
1558   end;
1559
1560   TfdX1RGB5us1 = class(TfdUniversalUS1)
1561     constructor Create; override;
1562   end;
1563
1564   TfdRGB8ub3 = class(TfdRGBub3)
1565     constructor Create; override;
1566   end;
1567
1568   TfdRGBX8ui1 = class(TfdUniversalUI1)
1569     constructor Create; override;
1570   end;
1571
1572   TfdXRGB8ui1 = class(TfdUniversalUI1)
1573     constructor Create; override;
1574   end;
1575
1576   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1577     constructor Create; override;
1578   end;
1579
1580   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1581     constructor Create; override;
1582   end;
1583
1584   TfdRGB16us3 = class(TfdRGBus3)
1585     constructor Create; override;
1586   end;
1587
1588   TfdRGBA4us1 = class(TfdUniversalUS1)
1589     constructor Create; override;
1590   end;
1591
1592   TfdARGB4us1 = class(TfdUniversalUS1)
1593     constructor Create; override;
1594   end;
1595
1596   TfdRGB5A1us1 = class(TfdUniversalUS1)
1597     constructor Create; override;
1598   end;
1599
1600   TfdA1RGB5us1 = class(TfdUniversalUS1)
1601     constructor Create; override;
1602   end;
1603
1604   TfdRGBA8ui1 = class(TfdUniversalUI1)
1605     constructor Create; override;
1606   end;
1607
1608   TfdARGB8ui1 = class(TfdUniversalUI1)
1609     constructor Create; override;
1610   end;
1611
1612   TfdRGBA8ub4 = class(TfdRGBAub4)
1613     constructor Create; override;
1614   end;
1615
1616   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1617     constructor Create; override;
1618   end;
1619
1620   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1621     constructor Create; override;
1622   end;
1623
1624   TfdRGBA16us4 = class(TfdRGBAus4)
1625     constructor Create; override;
1626   end;
1627
1628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1629   TfdBGRX4us1 = class(TfdUniversalUS1)
1630     constructor Create; override;
1631   end;
1632
1633   TfdXBGR4us1 = class(TfdUniversalUS1)
1634     constructor Create; override;
1635   end;
1636
1637   TfdB5G6R5us1 = class(TfdUniversalUS1)
1638     constructor Create; override;
1639   end;
1640
1641   TfdBGR5X1us1 = class(TfdUniversalUS1)
1642     constructor Create; override;
1643   end;
1644
1645   TfdX1BGR5us1 = class(TfdUniversalUS1)
1646     constructor Create; override;
1647   end;
1648
1649   TfdBGR8ub3 = class(TfdBGRub3)
1650     constructor Create; override;
1651   end;
1652
1653   TfdBGRX8ui1 = class(TfdUniversalUI1)
1654     constructor Create; override;
1655   end;
1656
1657   TfdXBGR8ui1 = class(TfdUniversalUI1)
1658     constructor Create; override;
1659   end;
1660
1661   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1662     constructor Create; override;
1663   end;
1664
1665   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1666     constructor Create; override;
1667   end;
1668
1669   TfdBGR16us3 = class(TfdBGRus3)
1670     constructor Create; override;
1671   end;
1672
1673   TfdBGRA4us1 = class(TfdUniversalUS1)
1674     constructor Create; override;
1675   end;
1676
1677   TfdABGR4us1 = class(TfdUniversalUS1)
1678     constructor Create; override;
1679   end;
1680
1681   TfdBGR5A1us1 = class(TfdUniversalUS1)
1682     constructor Create; override;
1683   end;
1684
1685   TfdA1BGR5us1 = class(TfdUniversalUS1)
1686     constructor Create; override;
1687   end;
1688
1689   TfdBGRA8ui1 = class(TfdUniversalUI1)
1690     constructor Create; override;
1691   end;
1692
1693   TfdABGR8ui1 = class(TfdUniversalUI1)
1694     constructor Create; override;
1695   end;
1696
1697   TfdBGRA8ub4 = class(TfdBGRAub4)
1698     constructor Create; override;
1699   end;
1700
1701   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1702     constructor Create; override;
1703   end;
1704
1705   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1706     constructor Create; override;
1707   end;
1708
1709   TfdBGRA16us4 = class(TfdBGRAus4)
1710     constructor Create; override;
1711   end;
1712
1713   TfdDepth16us1 = class(TfdDepthUS1)
1714     constructor Create; override;
1715   end;
1716
1717   TfdDepth24ui1 = class(TfdDepthUI1)
1718     constructor Create; override;
1719   end;
1720
1721   TfdDepth32ui1 = class(TfdDepthUI1)
1722     constructor Create; override;
1723   end;
1724
1725   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1726     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1727     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1728     constructor Create; override;
1729   end;
1730
1731   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1732     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1733     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1734     constructor Create; override;
1735   end;
1736
1737   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1738     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1739     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1740     constructor Create; override;
1741   end;
1742
1743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1744   TbmpBitfieldFormat = class(TFormatDescriptor)
1745   private
1746     procedure SetRedMask  (const aValue: QWord);
1747     procedure SetGreenMask(const aValue: QWord);
1748     procedure SetBlueMask (const aValue: QWord);
1749     procedure SetAlphaMask(const aValue: QWord);
1750
1751     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1752   public
1753     property RedMask:   QWord read GetRedMask   write SetRedMask;
1754     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1755     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1756     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1757
1758     property PixelSize: Single read fPixelSize write fPixelSize;
1759
1760     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1761     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1762   end;
1763
1764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1765   TbmpColorTableEnty = packed record
1766     b, g, r, a: Byte;
1767   end;
1768   TbmpColorTable = array of TbmpColorTableEnty;
1769   TbmpColorTableFormat = class(TFormatDescriptor)
1770   private
1771     fColorTable: TbmpColorTable;
1772   public
1773     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1774     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1775     property Range:      TglBitmapColorRec read fRange      write fRange;
1776     property Shift:      TShiftRec         read fShift      write fShift;
1777     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1778
1779     procedure CreateColorTable;
1780
1781     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1782     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1783     destructor Destroy; override;
1784   end;
1785
1786 const
1787   LUMINANCE_WEIGHT_R = 0.30;
1788   LUMINANCE_WEIGHT_G = 0.59;
1789   LUMINANCE_WEIGHT_B = 0.11;
1790
1791   ALPHA_WEIGHT_R = 0.30;
1792   ALPHA_WEIGHT_G = 0.59;
1793   ALPHA_WEIGHT_B = 0.11;
1794
1795   DEPTH_WEIGHT_R = 0.333333333;
1796   DEPTH_WEIGHT_G = 0.333333333;
1797   DEPTH_WEIGHT_B = 0.333333333;
1798
1799   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1800     TfdEmpty,
1801
1802     TfdAlpha4ub1,
1803     TfdAlpha8ub1,
1804     TfdAlpha16us1,
1805
1806     TfdLuminance4ub1,
1807     TfdLuminance8ub1,
1808     TfdLuminance16us1,
1809
1810     TfdLuminance4Alpha4ub2,
1811     TfdLuminance6Alpha2ub2,
1812     TfdLuminance8Alpha8ub2,
1813     TfdLuminance12Alpha4us2,
1814     TfdLuminance16Alpha16us2,
1815
1816     TfdR3G3B2ub1,
1817     TfdRGBX4us1,
1818     TfdXRGB4us1,
1819     TfdR5G6B5us1,
1820     TfdRGB5X1us1,
1821     TfdX1RGB5us1,
1822     TfdRGB8ub3,
1823     TfdRGBX8ui1,
1824     TfdXRGB8ui1,
1825     TfdRGB10X2ui1,
1826     TfdX2RGB10ui1,
1827     TfdRGB16us3,
1828
1829     TfdRGBA4us1,
1830     TfdARGB4us1,
1831     TfdRGB5A1us1,
1832     TfdA1RGB5us1,
1833     TfdRGBA8ui1,
1834     TfdARGB8ui1,
1835     TfdRGBA8ub4,
1836     TfdRGB10A2ui1,
1837     TfdA2RGB10ui1,
1838     TfdRGBA16us4,
1839
1840     TfdBGRX4us1,
1841     TfdXBGR4us1,
1842     TfdB5G6R5us1,
1843     TfdBGR5X1us1,
1844     TfdX1BGR5us1,
1845     TfdBGR8ub3,
1846     TfdBGRX8ui1,
1847     TfdXBGR8ui1,
1848     TfdBGR10X2ui1,
1849     TfdX2BGR10ui1,
1850     TfdBGR16us3,
1851
1852     TfdBGRA4us1,
1853     TfdABGR4us1,
1854     TfdBGR5A1us1,
1855     TfdA1BGR5us1,
1856     TfdBGRA8ui1,
1857     TfdABGR8ui1,
1858     TfdBGRA8ub4,
1859     TfdBGR10A2ui1,
1860     TfdA2BGR10ui1,
1861     TfdBGRA16us4,
1862
1863     TfdDepth16us1,
1864     TfdDepth24ui1,
1865     TfdDepth32ui1,
1866
1867     TfdS3tcDtx1RGBA,
1868     TfdS3tcDtx3RGBA,
1869     TfdS3tcDtx5RGBA
1870   );
1871
1872 var
1873   FormatDescriptorCS: TCriticalSection;
1874   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1875
1876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1877 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1878 begin
1879   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1880 end;
1881
1882 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1883 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1884 begin
1885   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1886 end;
1887
1888 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1889 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1890 begin
1891   result.Fields := [];
1892
1893   if X >= 0 then
1894     result.Fields := result.Fields + [ffX];
1895   if Y >= 0 then
1896     result.Fields := result.Fields + [ffY];
1897
1898   result.X := Max(0, X);
1899   result.Y := Max(0, Y);
1900 end;
1901
1902 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1903 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1904 begin
1905   result.r := r;
1906   result.g := g;
1907   result.b := b;
1908   result.a := a;
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1913 var
1914   i: Integer;
1915 begin
1916   result := false;
1917   for i := 0 to high(r1.arr) do
1918     if (r1.arr[i] <> r2.arr[i]) then
1919       exit;
1920   result := true;
1921 end;
1922
1923 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1924 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1925 var
1926   desc: TFormatDescriptor;
1927   p, tmp: PByte;
1928   x, y, i: Integer;
1929   md: Pointer;
1930   px: TglBitmapPixelData;
1931 begin
1932   result := nil;
1933   desc := TFormatDescriptor.Get(aFormat);
1934   if (desc.IsCompressed) or (desc.glFormat = 0) then
1935     exit;
1936
1937   p := GetMem(ceil(25 * desc.PixelSize)); // 5 x 5 pixel
1938   md := desc.CreateMappingData;
1939   try
1940     tmp := p;
1941     desc.PreparePixel(px);
1942     for y := 0 to 4 do
1943       for x := 0 to 4 do begin
1944         px.Data := glBitmapColorRec(0, 0, 0, 0);
1945         for i := 0 to 3 do begin
1946           if ((y < 3) and (y = i)) or
1947              ((y = 3) and (i < 3)) or
1948              ((y = 4) and (i = 3))
1949           then
1950             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1951           else if ((y < 4) and (i = 3)) or
1952                   ((y = 4) and (i < 3))
1953           then
1954             px.Data.arr[i] := px.Range.arr[i]
1955           else
1956             px.Data.arr[i] := 0; //px.Range.arr[i];
1957         end;
1958         desc.Map(px, tmp, md);
1959       end;
1960   finally
1961     desc.FreeMappingData(md);
1962   end;
1963   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1964   result.FreeDataOnDestroy       := true;
1965   result.FreeDataAfterGenTexture := false;
1966   result.SetFilter(GL_NEAREST, GL_NEAREST);
1967 end;
1968
1969 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1970 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1971 begin
1972   result.r := r;
1973   result.g := g;
1974   result.b := b;
1975   result.a := a;
1976 end;
1977
1978 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1979 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1980 begin
1981   result := [];
1982
1983   if (aFormat in [
1984         //8bpp
1985         tfAlpha4ub1, tfAlpha8ub1,
1986         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1987
1988         //16bpp
1989         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1990         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1991         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1992
1993         //24bpp
1994         tfBGR8ub3, tfRGB8ub3,
1995
1996         //32bpp
1997         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1998         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1999   then
2000     result := result + [ ftBMP ];
2001
2002   if (aFormat in [
2003         //8bbp
2004         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2005
2006         //16bbp
2007         tfAlpha16us1, tfLuminance16us1,
2008         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2009         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2010
2011         //24bbp
2012         tfBGR8ub3,
2013
2014         //32bbp
2015         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2016         tfDepth24ui1, tfDepth32ui1])
2017   then
2018     result := result + [ftTGA];
2019
2020   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2021     result := result + [ftDDS];
2022
2023 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2024   if aFormat in [
2025       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2026       tfRGB8ub3, tfRGBA8ui1,
2027       tfBGR8ub3, tfBGRA8ui1] then
2028     result := result + [ftPNG];
2029 {$ENDIF}
2030
2031 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2032   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2033     result := result + [ftJPEG];
2034 {$ENDIF}
2035 end;
2036
2037 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2038 function IsPowerOfTwo(aNumber: Integer): Boolean;
2039 begin
2040   while (aNumber and 1) = 0 do
2041     aNumber := aNumber shr 1;
2042   result := aNumber = 1;
2043 end;
2044
2045 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2046 function GetTopMostBit(aBitSet: QWord): Integer;
2047 begin
2048   result := 0;
2049   while aBitSet > 0 do begin
2050     inc(result);
2051     aBitSet := aBitSet shr 1;
2052   end;
2053 end;
2054
2055 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 function CountSetBits(aBitSet: QWord): Integer;
2057 begin
2058   result := 0;
2059   while aBitSet > 0 do begin
2060     if (aBitSet and 1) = 1 then
2061       inc(result);
2062     aBitSet := aBitSet shr 1;
2063   end;
2064 end;
2065
2066 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2067 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2068 begin
2069   result := Trunc(
2070     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2071     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2072     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2073 end;
2074
2075 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2076 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2077 begin
2078   result := Trunc(
2079     DEPTH_WEIGHT_R * aPixel.Data.r +
2080     DEPTH_WEIGHT_G * aPixel.Data.g +
2081     DEPTH_WEIGHT_B * aPixel.Data.b);
2082 end;
2083
2084 {$IFDEF GLB_NATIVE_OGL}
2085 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2086 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 var
2089   GL_LibHandle: Pointer = nil;
2090
2091 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2092 begin
2093   if not Assigned(aLibHandle) then
2094     aLibHandle := GL_LibHandle;
2095
2096 {$IF DEFINED(GLB_WIN)}
2097   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2098   if Assigned(result) then
2099     exit;
2100
2101   if Assigned(wglGetProcAddress) then
2102     result := wglGetProcAddress(aProcName);
2103 {$ELSEIF DEFINED(GLB_LINUX)}
2104   if Assigned(glXGetProcAddress) then begin
2105     result := glXGetProcAddress(aProcName);
2106     if Assigned(result) then
2107       exit;
2108   end;
2109
2110   if Assigned(glXGetProcAddressARB) then begin
2111     result := glXGetProcAddressARB(aProcName);
2112     if Assigned(result) then
2113       exit;
2114   end;
2115
2116   result := dlsym(aLibHandle, aProcName);
2117 {$IFEND}
2118   if not Assigned(result) and aRaiseOnErr then
2119     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2120 end;
2121
2122 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2123 var
2124   GLU_LibHandle: Pointer = nil;
2125   OpenGLInitialized: Boolean;
2126   InitOpenGLCS: TCriticalSection;
2127
2128 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2129 procedure glbInitOpenGL;
2130
2131   ////////////////////////////////////////////////////////////////////////////////
2132   function glbLoadLibrary(const aName: PChar): Pointer;
2133   begin
2134     {$IF DEFINED(GLB_WIN)}
2135     result := {%H-}Pointer(LoadLibrary(aName));
2136     {$ELSEIF DEFINED(GLB_LINUX)}
2137     result := dlopen(Name, RTLD_LAZY);
2138     {$ELSE}
2139     result := nil;
2140     {$IFEND}
2141   end;
2142
2143   ////////////////////////////////////////////////////////////////////////////////
2144   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2145   begin
2146     result := false;
2147     if not Assigned(aLibHandle) then
2148       exit;
2149
2150     {$IF DEFINED(GLB_WIN)}
2151     Result := FreeLibrary({%H-}HINST(aLibHandle));
2152     {$ELSEIF DEFINED(GLB_LINUX)}
2153     Result := dlclose(aLibHandle) = 0;
2154     {$IFEND}
2155   end;
2156
2157 begin
2158   if Assigned(GL_LibHandle) then
2159     glbFreeLibrary(GL_LibHandle);
2160
2161   if Assigned(GLU_LibHandle) then
2162     glbFreeLibrary(GLU_LibHandle);
2163
2164   GL_LibHandle := glbLoadLibrary(libopengl);
2165   if not Assigned(GL_LibHandle) then
2166     raise EglBitmap.Create('unable to load library: ' + libopengl);
2167
2168   GLU_LibHandle := glbLoadLibrary(libglu);
2169   if not Assigned(GLU_LibHandle) then
2170     raise EglBitmap.Create('unable to load library: ' + libglu);
2171
2172 {$IF DEFINED(GLB_WIN)}
2173   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2174 {$ELSEIF DEFINED(GLB_LINUX)}
2175   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2176   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2177 {$IFEND}
2178
2179   glEnable := glbGetProcAddress('glEnable');
2180   glDisable := glbGetProcAddress('glDisable');
2181   glGetString := glbGetProcAddress('glGetString');
2182   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2183   glTexParameteri := glbGetProcAddress('glTexParameteri');
2184   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2185   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2186   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2187   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2188   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2189   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2190   glTexGeni := glbGetProcAddress('glTexGeni');
2191   glGenTextures := glbGetProcAddress('glGenTextures');
2192   glBindTexture := glbGetProcAddress('glBindTexture');
2193   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2194   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2195   glReadPixels := glbGetProcAddress('glReadPixels');
2196   glPixelStorei := glbGetProcAddress('glPixelStorei');
2197   glTexImage1D := glbGetProcAddress('glTexImage1D');
2198   glTexImage2D := glbGetProcAddress('glTexImage2D');
2199   glGetTexImage := glbGetProcAddress('glGetTexImage');
2200
2201   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2202   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2203 end;
2204 {$ENDIF}
2205
2206 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2207 procedure glbReadOpenGLExtensions;
2208 var
2209   Buffer: AnsiString;
2210   MajorVersion, MinorVersion: Integer;
2211
2212   ///////////////////////////////////////////////////////////////////////////////////////////
2213   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2214   var
2215     Separator: Integer;
2216   begin
2217     aMinor := 0;
2218     aMajor := 0;
2219
2220     Separator := Pos(AnsiString('.'), aBuffer);
2221     if (Separator > 1) and (Separator < Length(aBuffer)) and
2222        (aBuffer[Separator - 1] in ['0'..'9']) and
2223        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2224
2225       Dec(Separator);
2226       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2227         Dec(Separator);
2228
2229       Delete(aBuffer, 1, Separator);
2230       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2231
2232       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2233         Inc(Separator);
2234
2235       Delete(aBuffer, Separator, 255);
2236       Separator := Pos(AnsiString('.'), aBuffer);
2237
2238       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2239       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2240     end;
2241   end;
2242
2243   ///////////////////////////////////////////////////////////////////////////////////////////
2244   function CheckExtension(const Extension: AnsiString): Boolean;
2245   var
2246     ExtPos: Integer;
2247   begin
2248     ExtPos := Pos(Extension, Buffer);
2249     result := ExtPos > 0;
2250     if result then
2251       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2252   end;
2253
2254   ///////////////////////////////////////////////////////////////////////////////////////////
2255   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2256   begin
2257     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2258   end;
2259
2260 begin
2261 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2262   InitOpenGLCS.Enter;
2263   try
2264     if not OpenGLInitialized then begin
2265       glbInitOpenGL;
2266       OpenGLInitialized := true;
2267     end;
2268   finally
2269     InitOpenGLCS.Leave;
2270   end;
2271 {$ENDIF}
2272
2273   // Version
2274   Buffer := glGetString(GL_VERSION);
2275   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2276
2277   GL_VERSION_1_2 := CheckVersion(1, 2);
2278   GL_VERSION_1_3 := CheckVersion(1, 3);
2279   GL_VERSION_1_4 := CheckVersion(1, 4);
2280   GL_VERSION_2_0 := CheckVersion(2, 0);
2281   GL_VERSION_3_3 := CheckVersion(3, 3);
2282
2283   // Extensions
2284   Buffer := glGetString(GL_EXTENSIONS);
2285   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2286   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2287   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2288   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2289   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2290   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2291   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2292   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2293   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2294   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2295   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2296   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2297   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2298   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2299
2300   if GL_VERSION_1_3 then begin
2301     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2302     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2303     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2304   end else begin
2305     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2306     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2307     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2308   end;
2309 end;
2310 {$ENDIF}
2311
2312 {$IFDEF GLB_SDL_IMAGE}
2313 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2314 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2315 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2317 begin
2318   result := TStream(context^.unknown.data1).Seek(offset, whence);
2319 end;
2320
2321 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2322 begin
2323   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2324 end;
2325
2326 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2327 begin
2328   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2329 end;
2330
2331 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2332 begin
2333   result := 0;
2334 end;
2335
2336 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2337 begin
2338   result := SDL_AllocRW;
2339
2340   if result = nil then
2341     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2342
2343   result^.seek := glBitmapRWseek;
2344   result^.read := glBitmapRWread;
2345   result^.write := glBitmapRWwrite;
2346   result^.close := glBitmapRWclose;
2347   result^.unknown.data1 := Stream;
2348 end;
2349 {$ENDIF}
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2353 begin
2354   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2355 end;
2356
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2359 begin
2360   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2361 end;
2362
2363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2364 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2365 begin
2366   glBitmapDefaultMipmap := aValue;
2367 end;
2368
2369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2371 begin
2372   glBitmapDefaultFormat := aFormat;
2373 end;
2374
2375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2377 begin
2378   glBitmapDefaultFilterMin := aMin;
2379   glBitmapDefaultFilterMag := aMag;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2384 begin
2385   glBitmapDefaultWrapS := S;
2386   glBitmapDefaultWrapT := T;
2387   glBitmapDefaultWrapR := R;
2388 end;
2389
2390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2391 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2392 begin
2393   glDefaultSwizzle[0] := r;
2394   glDefaultSwizzle[1] := g;
2395   glDefaultSwizzle[2] := b;
2396   glDefaultSwizzle[3] := a;
2397 end;
2398
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2401 begin
2402   result := glBitmapDefaultDeleteTextureOnFree;
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2407 begin
2408   result := glBitmapDefaultFreeDataAfterGenTextures;
2409 end;
2410
2411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2412 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2413 begin
2414   result := glBitmapDefaultMipmap;
2415 end;
2416
2417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2418 function glBitmapGetDefaultFormat: TglBitmapFormat;
2419 begin
2420   result := glBitmapDefaultFormat;
2421 end;
2422
2423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2424 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2425 begin
2426   aMin := glBitmapDefaultFilterMin;
2427   aMag := glBitmapDefaultFilterMag;
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2432 begin
2433   S := glBitmapDefaultWrapS;
2434   T := glBitmapDefaultWrapT;
2435   R := glBitmapDefaultWrapR;
2436 end;
2437
2438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2439 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2440 begin
2441   r := glDefaultSwizzle[0];
2442   g := glDefaultSwizzle[1];
2443   b := glDefaultSwizzle[2];
2444   a := glDefaultSwizzle[3];
2445 end;
2446
2447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2448 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2450 function TFormatDescriptor.GetRedMask: QWord;
2451 begin
2452   result := fRange.r shl fShift.r;
2453 end;
2454
2455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 function TFormatDescriptor.GetGreenMask: QWord;
2457 begin
2458   result := fRange.g shl fShift.g;
2459 end;
2460
2461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2462 function TFormatDescriptor.GetBlueMask: QWord;
2463 begin
2464   result := fRange.b shl fShift.b;
2465 end;
2466
2467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2468 function TFormatDescriptor.GetAlphaMask: QWord;
2469 begin
2470   result := fRange.a shl fShift.a;
2471 end;
2472
2473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2474 function TFormatDescriptor.GetIsCompressed: Boolean;
2475 begin
2476   result := fIsCompressed;
2477 end;
2478
2479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2480 function TFormatDescriptor.GetHasRed: Boolean;
2481 begin
2482   result := (fRange.r > 0);
2483 end;
2484
2485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 function TFormatDescriptor.GetHasGreen: Boolean;
2487 begin
2488   result := (fRange.g > 0);
2489 end;
2490
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 function TFormatDescriptor.GetHasBlue: Boolean;
2493 begin
2494   result := (fRange.b > 0);
2495 end;
2496
2497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 function TFormatDescriptor.GetHasAlpha: Boolean;
2499 begin
2500   result := (fRange.a > 0);
2501 end;
2502
2503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2504 function TFormatDescriptor.GetHasColor: Boolean;
2505 begin
2506  result := HasRed or HasGreen or HasAlpha;
2507 end;
2508
2509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2510 function TFormatDescriptor.GetIsGrayscale: Boolean;
2511 var
2512   r, g, b: QWord;
2513 begin
2514   r := RedMask;
2515   g := GreenMask;
2516   b := BlueMask;
2517   result := (r = g) and (g = b) and (r > 0);
2518 end;
2519
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
2522 begin
2523   result := fRGBInverted;
2524 end;
2525
2526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
2528 begin
2529   result := fWithAlpha;
2530 end;
2531
2532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2533 function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
2534 begin
2535   result := fWithoutAlpha;
2536 end;
2537
2538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2539 function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
2540 begin
2541   result := fOpenGLFormat;
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
2546 begin
2547   result := fUncompressed;
2548 end;
2549
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 function TFormatDescriptor.GetglFormat: GLenum;
2552 begin
2553   result := fglFormat;
2554 end;
2555
2556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 function TFormatDescriptor.GetglInternalFormat: GLenum;
2558 begin
2559   result := fglInternalFormat;
2560 end;
2561
2562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2563 function TFormatDescriptor.GetglDataFormat: GLenum;
2564 begin
2565   result := fglDataFormat;
2566 end;
2567
2568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2569 function TFormatDescriptor.GetComponents: Integer;
2570 var
2571   i: Integer;
2572 begin
2573   result := 0;
2574   for i := 0 to 3 do
2575     if (fRange.arr[i] > 0) then
2576       inc(result);
2577 end;
2578
2579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2581 var
2582   w, h: Integer;
2583 begin
2584   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2585     w := Max(1, aSize.X);
2586     h := Max(1, aSize.Y);
2587     result := GetSize(w, h);
2588   end else
2589     result := 0;
2590 end;
2591
2592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2593 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2594 begin
2595   result := 0;
2596   if (aWidth <= 0) or (aHeight <= 0) then
2597     exit;
2598   result := Ceil(aWidth * aHeight * fPixelSize);
2599 end;
2600
2601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 function TFormatDescriptor.CreateMappingData: Pointer;
2603 begin
2604   result := nil;
2605 end;
2606
2607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2608 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2609 begin
2610   //DUMMY
2611 end;
2612
2613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 function TFormatDescriptor.IsEmpty: Boolean;
2615 begin
2616   result := (fFormat = tfEmpty);
2617 end;
2618
2619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2620 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2621 begin
2622   result := false;
2623   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2624     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2625   if (aRedMask   <> RedMask) then
2626     exit;
2627   if (aGreenMask <> GreenMask) then
2628     exit;
2629   if (aBlueMask  <> BlueMask) then
2630     exit;
2631   if (aAlphaMask <> AlphaMask) then
2632     exit;
2633   result := true;
2634 end;
2635
2636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2637 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapMask): Boolean;
2638 begin
2639   result := MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a);
2640 end;
2641
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2644 begin
2645   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2646   aPixel.Data   := fRange;
2647   aPixel.Range  := fRange;
2648   aPixel.Format := fFormat;
2649 end;
2650
2651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 constructor TFormatDescriptor.Create;
2653 begin
2654   inherited Create;
2655
2656   fFormat       := tfEmpty;
2657   fWithAlpha    := tfEmpty;
2658   fWithoutAlpha := tfEmpty;
2659   fOpenGLFormat := tfEmpty;
2660   fRGBInverted  := tfEmpty;
2661   fUncompressed := tfEmpty;
2662
2663   fPixelSize    := 0.0;
2664   fIsCompressed := false;
2665
2666   fglFormat         := 0;
2667   fglInternalFormat := 0;
2668   fglDataFormat     := 0;
2669
2670   FillChar(fRange, 0, SizeOf(fRange));
2671   FillChar(fShift, 0, SizeOf(fShift));
2672 end;
2673
2674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2675 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2678 begin
2679   aData^ := aPixel.Data.a;
2680   inc(aData);
2681 end;
2682
2683 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2684 begin
2685   aPixel.Data.r := 0;
2686   aPixel.Data.g := 0;
2687   aPixel.Data.b := 0;
2688   aPixel.Data.a := aData^;
2689   inc(aData);
2690 end;
2691
2692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2693 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2695 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2696 begin
2697   aData^ := LuminanceWeight(aPixel);
2698   inc(aData);
2699 end;
2700
2701 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2702 begin
2703   aPixel.Data.r := aData^;
2704   aPixel.Data.g := aData^;
2705   aPixel.Data.b := aData^;
2706   aPixel.Data.a := 0;
2707   inc(aData);
2708 end;
2709
2710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2711 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2714 var
2715   i: Integer;
2716 begin
2717   aData^ := 0;
2718   for i := 0 to 3 do
2719     if (fRange.arr[i] > 0) then
2720       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2721   inc(aData);
2722 end;
2723
2724 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2725 var
2726   i: Integer;
2727 begin
2728   for i := 0 to 3 do
2729     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2730   inc(aData);
2731 end;
2732
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2737 begin
2738   inherited Map(aPixel, aData, aMapData);
2739   aData^ := aPixel.Data.a;
2740   inc(aData);
2741 end;
2742
2743 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2744 begin
2745   inherited Unmap(aData, aPixel, aMapData);
2746   aPixel.Data.a := aData^;
2747   inc(aData);
2748 end;
2749
2750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2751 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2753 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2754 begin
2755   aData^ := aPixel.Data.r;
2756   inc(aData);
2757   aData^ := aPixel.Data.g;
2758   inc(aData);
2759   aData^ := aPixel.Data.b;
2760   inc(aData);
2761 end;
2762
2763 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2764 begin
2765   aPixel.Data.r := aData^;
2766   inc(aData);
2767   aPixel.Data.g := aData^;
2768   inc(aData);
2769   aPixel.Data.b := aData^;
2770   inc(aData);
2771   aPixel.Data.a := 0;
2772 end;
2773
2774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2777 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2778 begin
2779   aData^ := aPixel.Data.b;
2780   inc(aData);
2781   aData^ := aPixel.Data.g;
2782   inc(aData);
2783   aData^ := aPixel.Data.r;
2784   inc(aData);
2785 end;
2786
2787 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2788 begin
2789   aPixel.Data.b := aData^;
2790   inc(aData);
2791   aPixel.Data.g := aData^;
2792   inc(aData);
2793   aPixel.Data.r := aData^;
2794   inc(aData);
2795   aPixel.Data.a := 0;
2796 end;
2797
2798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2801 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2802 begin
2803   inherited Map(aPixel, aData, aMapData);
2804   aData^ := aPixel.Data.a;
2805   inc(aData);
2806 end;
2807
2808 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2809 begin
2810   inherited Unmap(aData, aPixel, aMapData);
2811   aPixel.Data.a := aData^;
2812   inc(aData);
2813 end;
2814
2815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2819 begin
2820   inherited Map(aPixel, aData, aMapData);
2821   aData^ := aPixel.Data.a;
2822   inc(aData);
2823 end;
2824
2825 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2826 begin
2827   inherited Unmap(aData, aPixel, aMapData);
2828   aPixel.Data.a := aData^;
2829   inc(aData);
2830 end;
2831
2832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2833 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2835 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2836 begin
2837   PWord(aData)^ := aPixel.Data.a;
2838   inc(aData, 2);
2839 end;
2840
2841 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2842 begin
2843   aPixel.Data.r := 0;
2844   aPixel.Data.g := 0;
2845   aPixel.Data.b := 0;
2846   aPixel.Data.a := PWord(aData)^;
2847   inc(aData, 2);
2848 end;
2849
2850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2851 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2854 begin
2855   PWord(aData)^ := LuminanceWeight(aPixel);
2856   inc(aData, 2);
2857 end;
2858
2859 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2860 begin
2861   aPixel.Data.r := PWord(aData)^;
2862   aPixel.Data.g := PWord(aData)^;
2863   aPixel.Data.b := PWord(aData)^;
2864   aPixel.Data.a := 0;
2865   inc(aData, 2);
2866 end;
2867
2868 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2869 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2871 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2872 var
2873   i: Integer;
2874 begin
2875   PWord(aData)^ := 0;
2876   for i := 0 to 3 do
2877     if (fRange.arr[i] > 0) then
2878       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2879   inc(aData, 2);
2880 end;
2881
2882 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2883 var
2884   i: Integer;
2885 begin
2886   for i := 0 to 3 do
2887     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2888   inc(aData, 2);
2889 end;
2890
2891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2892 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2894 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2895 begin
2896   PWord(aData)^ := DepthWeight(aPixel);
2897   inc(aData, 2);
2898 end;
2899
2900 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2901 begin
2902   aPixel.Data.r := PWord(aData)^;
2903   aPixel.Data.g := PWord(aData)^;
2904   aPixel.Data.b := PWord(aData)^;
2905   aPixel.Data.a := PWord(aData)^;;
2906   inc(aData, 2);
2907 end;
2908
2909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2913 begin
2914   inherited Map(aPixel, aData, aMapData);
2915   PWord(aData)^ := aPixel.Data.a;
2916   inc(aData, 2);
2917 end;
2918
2919 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2920 begin
2921   inherited Unmap(aData, aPixel, aMapData);
2922   aPixel.Data.a := PWord(aData)^;
2923   inc(aData, 2);
2924 end;
2925
2926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2927 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2929 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2930 begin
2931   PWord(aData)^ := aPixel.Data.r;
2932   inc(aData, 2);
2933   PWord(aData)^ := aPixel.Data.g;
2934   inc(aData, 2);
2935   PWord(aData)^ := aPixel.Data.b;
2936   inc(aData, 2);
2937 end;
2938
2939 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2940 begin
2941   aPixel.Data.r := PWord(aData)^;
2942   inc(aData, 2);
2943   aPixel.Data.g := PWord(aData)^;
2944   inc(aData, 2);
2945   aPixel.Data.b := PWord(aData)^;
2946   inc(aData, 2);
2947   aPixel.Data.a := 0;
2948 end;
2949
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2953 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2954 begin
2955   PWord(aData)^ := aPixel.Data.b;
2956   inc(aData, 2);
2957   PWord(aData)^ := aPixel.Data.g;
2958   inc(aData, 2);
2959   PWord(aData)^ := aPixel.Data.r;
2960   inc(aData, 2);
2961 end;
2962
2963 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2964 begin
2965   aPixel.Data.b := PWord(aData)^;
2966   inc(aData, 2);
2967   aPixel.Data.g := PWord(aData)^;
2968   inc(aData, 2);
2969   aPixel.Data.r := PWord(aData)^;
2970   inc(aData, 2);
2971   aPixel.Data.a := 0;
2972 end;
2973
2974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2978 begin
2979   inherited Map(aPixel, aData, aMapData);
2980   PWord(aData)^ := aPixel.Data.a;
2981   inc(aData, 2);
2982 end;
2983
2984 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2985 begin
2986   inherited Unmap(aData, aPixel, aMapData);
2987   aPixel.Data.a := PWord(aData)^;
2988   inc(aData, 2);
2989 end;
2990
2991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2992 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2994 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2995 begin
2996   PWord(aData)^ := aPixel.Data.a;
2997   inc(aData, 2);
2998   inherited Map(aPixel, aData, aMapData);
2999 end;
3000
3001 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3002 begin
3003   aPixel.Data.a := PWord(aData)^;
3004   inc(aData, 2);
3005   inherited Unmap(aData, aPixel, aMapData);
3006 end;
3007
3008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3009 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3011 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3012 begin
3013   inherited Map(aPixel, aData, aMapData);
3014   PWord(aData)^ := aPixel.Data.a;
3015   inc(aData, 2);
3016 end;
3017
3018 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3019 begin
3020   inherited Unmap(aData, aPixel, aMapData);
3021   aPixel.Data.a := PWord(aData)^;
3022   inc(aData, 2);
3023 end;
3024
3025 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3026 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3028 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3029 begin
3030   PWord(aData)^ := aPixel.Data.a;
3031   inc(aData, 2);
3032   inherited Map(aPixel, aData, aMapData);
3033 end;
3034
3035 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3036 begin
3037   aPixel.Data.a := PWord(aData)^;
3038   inc(aData, 2);
3039   inherited Unmap(aData, aPixel, aMapData);
3040 end;
3041
3042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3043 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3045 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3046 var
3047   i: Integer;
3048 begin
3049   PCardinal(aData)^ := 0;
3050   for i := 0 to 3 do
3051     if (fRange.arr[i] > 0) then
3052       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3053   inc(aData, 4);
3054 end;
3055
3056 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3057 var
3058   i: Integer;
3059 begin
3060   for i := 0 to 3 do
3061     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3062   inc(aData, 2);
3063 end;
3064
3065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3066 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3068 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3069 begin
3070   PCardinal(aData)^ := DepthWeight(aPixel);
3071   inc(aData, 4);
3072 end;
3073
3074 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3075 begin
3076   aPixel.Data.r := PCardinal(aData)^;
3077   aPixel.Data.g := PCardinal(aData)^;
3078   aPixel.Data.b := PCardinal(aData)^;
3079   aPixel.Data.a := PCardinal(aData)^;
3080   inc(aData, 4);
3081 end;
3082
3083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3086 constructor TfdAlpha4ub1.Create;
3087 begin
3088   inherited Create;
3089   fPixelSize        := 1.0;
3090   fFormat           := tfAlpha4ub1;
3091   fWithAlpha        := tfAlpha4ub1;
3092   fOpenGLFormat     := tfAlpha4ub1;
3093   fRange.a          := $FF;
3094   fglFormat         := GL_ALPHA;
3095   fglInternalFormat := GL_ALPHA4;
3096   fglDataFormat     := GL_UNSIGNED_BYTE;
3097 end;
3098
3099 constructor TfdAlpha8ub1.Create;
3100 begin
3101   inherited Create;
3102   fPixelSize        := 1.0;
3103   fFormat           := tfAlpha8ub1;
3104   fWithAlpha        := tfAlpha8ub1;
3105   fOpenGLFormat     := tfAlpha8ub1;
3106   fRange.a          := $FF;
3107   fglFormat         := GL_ALPHA;
3108   fglInternalFormat := GL_ALPHA8;
3109   fglDataFormat     := GL_UNSIGNED_BYTE;
3110 end;
3111
3112 constructor TfdAlpha16us1.Create;
3113 begin
3114   inherited Create;
3115   fPixelSize        := 2.0;
3116   fFormat           := tfAlpha16us1;
3117   fWithAlpha        := tfAlpha16us1;
3118   fOpenGLFormat     := tfAlpha16us1;
3119   fRange.a          := $FFFF;
3120   fglFormat         := GL_ALPHA;
3121   fglInternalFormat := GL_ALPHA16;
3122   fglDataFormat     := GL_UNSIGNED_SHORT;
3123 end;
3124
3125 constructor TfdLuminance4ub1.Create;
3126 begin
3127   inherited Create;
3128   fPixelSize        := 1.0;
3129   fFormat           := tfLuminance4ub1;
3130   fWithAlpha        := tfLuminance4Alpha4ub2;
3131   fWithoutAlpha     := tfLuminance4ub1;
3132   fOpenGLFormat     := tfLuminance4ub1;
3133   fRange.r          := $FF;
3134   fRange.g          := $FF;
3135   fRange.b          := $FF;
3136   fglFormat         := GL_LUMINANCE;
3137   fglInternalFormat := GL_LUMINANCE4;
3138   fglDataFormat     := GL_UNSIGNED_BYTE;
3139 end;
3140
3141 constructor TfdLuminance8ub1.Create;
3142 begin
3143   inherited Create;
3144   fPixelSize        := 1.0;
3145   fFormat           := tfLuminance8ub1;
3146   fWithAlpha        := tfLuminance8Alpha8ub2;
3147   fWithoutAlpha     := tfLuminance8ub1;
3148   fOpenGLFormat     := tfLuminance8ub1;
3149   fRange.r          := $FF;
3150   fRange.g          := $FF;
3151   fRange.b          := $FF;
3152   fglFormat         := GL_LUMINANCE;
3153   fglInternalFormat := GL_LUMINANCE8;
3154   fglDataFormat     := GL_UNSIGNED_BYTE;
3155 end;
3156
3157 constructor TfdLuminance16us1.Create;
3158 begin
3159   inherited Create;
3160   fPixelSize        := 2.0;
3161   fFormat           := tfLuminance16us1;
3162   fWithAlpha        := tfLuminance16Alpha16us2;
3163   fWithoutAlpha     := tfLuminance16us1;
3164   fOpenGLFormat     := tfLuminance16us1;
3165   fRange.r          := $FFFF;
3166   fRange.g          := $FFFF;
3167   fRange.b          := $FFFF;
3168   fglFormat         := GL_LUMINANCE;
3169   fglInternalFormat := GL_LUMINANCE16;
3170   fglDataFormat     := GL_UNSIGNED_SHORT;
3171 end;
3172
3173 constructor TfdLuminance4Alpha4ub2.Create;
3174 begin
3175   inherited Create;
3176   fPixelSize        := 2.0;
3177   fFormat           := tfLuminance4Alpha4ub2;
3178   fWithAlpha        := tfLuminance4Alpha4ub2;
3179   fWithoutAlpha     := tfLuminance4ub1;
3180   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3181   fRange.r          := $FF;
3182   fRange.g          := $FF;
3183   fRange.b          := $FF;
3184   fRange.a          := $FF;
3185   fShift.r          := 0;
3186   fShift.g          := 0;
3187   fShift.b          := 0;
3188   fShift.a          := 8;
3189   fglFormat         := GL_LUMINANCE_ALPHA;
3190   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3191   fglDataFormat     := GL_UNSIGNED_BYTE;
3192 end;
3193
3194 constructor TfdLuminance6Alpha2ub2.Create;
3195 begin
3196   inherited Create;
3197   fPixelSize        := 2.0;
3198   fFormat           := tfLuminance6Alpha2ub2;
3199   fWithAlpha        := tfLuminance6Alpha2ub2;
3200   fWithoutAlpha     := tfLuminance8ub1;
3201   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3202   fRange.r          := $FF;
3203   fRange.g          := $FF;
3204   fRange.b          := $FF;
3205   fRange.a          := $FF;
3206   fShift.r          := 0;
3207   fShift.g          := 0;
3208   fShift.b          := 0;
3209   fShift.a          := 8;
3210   fglFormat         := GL_LUMINANCE_ALPHA;
3211   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3212   fglDataFormat     := GL_UNSIGNED_BYTE;
3213 end;
3214
3215 constructor TfdLuminance8Alpha8ub2.Create;
3216 begin
3217   inherited Create;
3218   fPixelSize        := 2.0;
3219   fFormat           := tfLuminance8Alpha8ub2;
3220   fWithAlpha        := tfLuminance8Alpha8ub2;
3221   fWithoutAlpha     := tfLuminance8ub1;
3222   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3223   fRange.r          := $FF;
3224   fRange.g          := $FF;
3225   fRange.b          := $FF;
3226   fRange.a          := $FF;
3227   fShift.r          := 0;
3228   fShift.g          := 0;
3229   fShift.b          := 0;
3230   fShift.a          := 8;
3231   fglFormat         := GL_LUMINANCE_ALPHA;
3232   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3233   fglDataFormat     := GL_UNSIGNED_BYTE;
3234 end;
3235
3236 constructor TfdLuminance12Alpha4us2.Create;
3237 begin
3238   inherited Create;
3239   fPixelSize        := 4.0;
3240   fFormat           := tfLuminance12Alpha4us2;
3241   fWithAlpha        := tfLuminance12Alpha4us2;
3242   fWithoutAlpha     := tfLuminance16us1;
3243   fOpenGLFormat     := tfLuminance12Alpha4us2;
3244   fRange.r          := $FFFF;
3245   fRange.g          := $FFFF;
3246   fRange.b          := $FFFF;
3247   fRange.a          := $FFFF;
3248   fShift.r          := 0;
3249   fShift.g          := 0;
3250   fShift.b          := 0;
3251   fShift.a          := 16;
3252   fglFormat         := GL_LUMINANCE_ALPHA;
3253   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3254   fglDataFormat     := GL_UNSIGNED_SHORT;
3255 end;
3256
3257 constructor TfdLuminance16Alpha16us2.Create;
3258 begin
3259   inherited Create;
3260   fPixelSize        := 4.0;
3261   fFormat           := tfLuminance16Alpha16us2;
3262   fWithAlpha        := tfLuminance16Alpha16us2;
3263   fWithoutAlpha     := tfLuminance16us1;
3264   fOpenGLFormat     := tfLuminance16Alpha16us2;
3265   fRange.r          := $FFFF;
3266   fRange.g          := $FFFF;
3267   fRange.b          := $FFFF;
3268   fRange.a          := $FFFF;
3269   fShift.r          := 0;
3270   fShift.g          := 0;
3271   fShift.b          := 0;
3272   fShift.a          := 16;
3273   fglFormat         := GL_LUMINANCE_ALPHA;
3274   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3275   fglDataFormat     := GL_UNSIGNED_SHORT;
3276 end;
3277
3278 constructor TfdR3G3B2ub1.Create;
3279 begin
3280   inherited Create;
3281   fPixelSize        := 1.0;
3282   fFormat           := tfR3G3B2ub1;
3283   fWithAlpha        := tfRGBA4us1;
3284   fWithoutAlpha     := tfR3G3B2ub1;
3285   fOpenGLFormat     := tfR3G3B2ub1;
3286   fRGBInverted      := tfEmpty;
3287   fRange.r          := $07;
3288   fRange.g          := $07;
3289   fRange.b          := $03;
3290   fShift.r          := 5;
3291   fShift.g          := 2;
3292   fShift.b          := 0;
3293   fglFormat         := GL_RGB;
3294   fglInternalFormat := GL_R3_G3_B2;
3295   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3296 end;
3297
3298 constructor TfdRGBX4us1.Create;
3299 begin
3300   inherited Create;
3301   fPixelSize        := 2.0;
3302   fFormat           := tfRGBX4us1;
3303   fWithAlpha        := tfRGBA4us1;
3304   fWithoutAlpha     := tfRGBX4us1;
3305   fOpenGLFormat     := tfRGBX4us1;
3306   fRGBInverted      := tfBGRX4us1;
3307   fRange.r          := $0F;
3308   fRange.g          := $0F;
3309   fRange.b          := $0F;
3310   fRange.a          := $00;
3311   fShift.r          := 12;
3312   fShift.g          :=  8;
3313   fShift.b          :=  4;
3314   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3315   fglInternalFormat := GL_RGB4;
3316   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3317 end;
3318
3319 constructor TfdXRGB4us1.Create;
3320 begin
3321   inherited Create;
3322   fPixelSize        := 2.0;
3323   fFormat           := tfXRGB4us1;
3324   fWithAlpha        := tfARGB4us1;
3325   fWithoutAlpha     := tfXRGB4us1;
3326   fOpenGLFormat     := tfXRGB4us1;
3327   fRGBInverted      := tfXBGR4us1;
3328   fRange.r          := $0F;
3329   fRange.g          := $0F;
3330   fRange.b          := $0F;
3331   fShift.r          := 8;
3332   fShift.g          := 4;
3333   fShift.b          := 0;
3334   fglFormat         := GL_BGRA;
3335   fglInternalFormat := GL_RGB4;
3336   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3337 end;
3338
3339 constructor TfdR5G6B5us1.Create;
3340 begin
3341   inherited Create;
3342   fPixelSize        := 2.0;
3343   fFormat           := tfR5G6B5us1;
3344   fWithAlpha        := tfRGB5A1us1;
3345   fWithoutAlpha     := tfR5G6B5us1;
3346   fOpenGLFormat     := tfR5G6B5us1;
3347   fRGBInverted      := tfB5G6R5us1;
3348   fRange.r          := $1F;
3349   fRange.g          := $3F;
3350   fRange.b          := $1F;
3351   fShift.r          := 11;
3352   fShift.g          := 5;
3353   fShift.b          := 0;
3354   fglFormat         := GL_RGB;
3355   fglInternalFormat := GL_RGB565;
3356   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3357 end;
3358
3359 constructor TfdRGB5X1us1.Create;
3360 begin
3361   inherited Create;
3362   fPixelSize        := 2.0;
3363   fFormat           := tfRGB5X1us1;
3364   fWithAlpha        := tfRGB5A1us1;
3365   fWithoutAlpha     := tfRGB5X1us1;
3366   fOpenGLFormat     := tfRGB5X1us1;
3367   fRGBInverted      := tfBGR5X1us1;
3368   fRange.r          := $1F;
3369   fRange.g          := $1F;
3370   fRange.b          := $1F;
3371   fShift.r          := 11;
3372   fShift.g          :=  6;
3373   fShift.b          :=  1;
3374   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3375   fglInternalFormat := GL_RGB5;
3376   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3377 end;
3378
3379 constructor TfdX1RGB5us1.Create;
3380 begin
3381   inherited Create;
3382   fPixelSize        := 2.0;
3383   fFormat           := tfX1RGB5us1;
3384   fWithAlpha        := tfA1RGB5us1;
3385   fWithoutAlpha     := tfX1RGB5us1;
3386   fOpenGLFormat     := tfX1RGB5us1;
3387   fRGBInverted      := tfX1BGR5us1;
3388   fRange.r          := $1F;
3389   fRange.g          := $1F;
3390   fRange.b          := $1F;
3391   fShift.r          := 10;
3392   fShift.g          :=  5;
3393   fShift.b          :=  0;
3394   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3395   fglInternalFormat := GL_RGB5;
3396   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3397 end;
3398
3399 constructor TfdRGB8ub3.Create;
3400 begin
3401   inherited Create;
3402   fPixelSize        := 3.0;
3403   fFormat           := tfRGB8ub3;
3404   fWithAlpha        := tfRGBA8ub4;
3405   fWithoutAlpha     := tfRGB8ub3;
3406   fOpenGLFormat     := tfRGB8ub3;
3407   fRGBInverted      := tfBGR8ub3;
3408   fRange.r          := $FF;
3409   fRange.g          := $FF;
3410   fRange.b          := $FF;
3411   fShift.r          :=  0;
3412   fShift.g          :=  8;
3413   fShift.b          := 16;
3414   fglFormat         := GL_RGB;
3415   fglInternalFormat := GL_RGB8;
3416   fglDataFormat     := GL_UNSIGNED_BYTE;
3417 end;
3418
3419 constructor TfdRGBX8ui1.Create;
3420 begin
3421   inherited Create;
3422   fPixelSize        := 4.0;
3423   fFormat           := tfRGBX8ui1;
3424   fWithAlpha        := tfRGBA8ui1;
3425   fWithoutAlpha     := tfRGBX8ui1;
3426   fOpenGLFormat     := tfRGB8ub3;
3427   fRGBInverted      := tfBGRX8ui1;
3428   fRange.r          := $FF;
3429   fRange.g          := $FF;
3430   fRange.b          := $FF;
3431   fShift.r          := 24;
3432   fShift.g          := 16;
3433   fShift.b          := 8;
3434   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3435   fglInternalFormat := GL_RGB8;
3436   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3437 end;
3438
3439 constructor TfdXRGB8ui1.Create;
3440 begin
3441   inherited Create;
3442   fPixelSize        := 4.0;
3443   fFormat           := tfXRGB8ui1;
3444   fWithAlpha        := tfXRGB8ui1;
3445   fWithoutAlpha     := tfXRGB8ui1;
3446   fOpenGLFormat     := tfRGB8ub3;
3447   fRGBInverted      := tfXBGR8ui1;
3448   fRange.r          := $FF;
3449   fRange.g          := $FF;
3450   fRange.b          := $FF;
3451   fShift.r          := 16;
3452   fShift.g          :=  8;
3453   fShift.b          :=  0;
3454   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3455   fglInternalFormat := GL_RGB8;
3456   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3457 end;
3458
3459 constructor TfdRGB10X2ui1.Create;
3460 begin
3461   inherited Create;
3462   fPixelSize        := 4.0;
3463   fFormat           := tfRGB10X2ui1;
3464   fWithAlpha        := tfRGB10A2ui1;
3465   fWithoutAlpha     := tfRGB10X2ui1;
3466   fOpenGLFormat     := tfRGB10X2ui1;
3467   fRGBInverted      := tfBGR10X2ui1;
3468   fRange.r          := $03FF;
3469   fRange.g          := $03FF;
3470   fRange.b          := $03FF;
3471   fShift.r          := 22;
3472   fShift.g          := 12;
3473   fShift.b          :=  2;
3474   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3475   fglInternalFormat := GL_RGB10;
3476   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3477 end;
3478
3479 constructor TfdX2RGB10ui1.Create;
3480 begin
3481   inherited Create;
3482   fPixelSize        := 4.0;
3483   fFormat           := tfX2RGB10ui1;
3484   fWithAlpha        := tfA2RGB10ui1;
3485   fWithoutAlpha     := tfX2RGB10ui1;
3486   fOpenGLFormat     := tfX2RGB10ui1;
3487   fRGBInverted      := tfX2BGR10ui1;
3488   fRange.r          := $03FF;
3489   fRange.g          := $03FF;
3490   fRange.b          := $03FF;
3491   fShift.r          := 20;
3492   fShift.g          := 10;
3493   fShift.b          :=  0;
3494   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3495   fglInternalFormat := GL_RGB10;
3496   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3497 end;
3498
3499 constructor TfdRGB16us3.Create;
3500 begin
3501   inherited Create;
3502   fPixelSize        := 6.0;
3503   fFormat           := tfRGB16us3;
3504   fWithAlpha        := tfRGBA16us4;
3505   fWithoutAlpha     := tfRGB16us3;
3506   fOpenGLFormat     := tfRGB16us3;
3507   fRGBInverted      := tfBGR16us3;
3508   fRange.r          := $FFFF;
3509   fRange.g          := $FFFF;
3510   fRange.b          := $FFFF;
3511   fShift.r          :=  0;
3512   fShift.g          := 16;
3513   fShift.b          := 32;
3514   fglFormat         := GL_RGB;
3515   fglInternalFormat := GL_RGB16;
3516   fglDataFormat     := GL_UNSIGNED_SHORT;
3517 end;
3518
3519 constructor TfdRGBA4us1.Create;
3520 begin
3521   inherited Create;
3522   fPixelSize        := 2.0;
3523   fFormat           := tfRGBA4us1;
3524   fWithAlpha        := tfRGBA4us1;
3525   fWithoutAlpha     := tfRGBX4us1;
3526   fOpenGLFormat     := tfRGBA4us1;
3527   fRGBInverted      := tfBGRA4us1;
3528   fRange.r          := $0F;
3529   fRange.g          := $0F;
3530   fRange.b          := $0F;
3531   fRange.a          := $0F;
3532   fShift.r          := 12;
3533   fShift.g          :=  8;
3534   fShift.b          :=  4;
3535   fShift.a          :=  0;
3536   fglFormat         := GL_RGBA;
3537   fglInternalFormat := GL_RGBA4;
3538   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3539 end;
3540
3541 constructor TfdARGB4us1.Create;
3542 begin
3543   inherited Create;
3544   fPixelSize        := 2.0;
3545   fFormat           := tfARGB4us1;
3546   fWithAlpha        := tfARGB4us1;
3547   fWithoutAlpha     := tfXRGB4us1;
3548   fOpenGLFormat     := tfARGB4us1;
3549   fRGBInverted      := tfABGR4us1;
3550   fRange.r          := $0F;
3551   fRange.g          := $0F;
3552   fRange.b          := $0F;
3553   fRange.a          := $0F;
3554   fShift.r          :=  8;
3555   fShift.g          :=  4;
3556   fShift.b          :=  0;
3557   fShift.a          := 12;
3558   fglFormat         := GL_BGRA;
3559   fglInternalFormat := GL_RGBA4;
3560   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3561 end;
3562
3563 constructor TfdRGB5A1us1.Create;
3564 begin
3565   inherited Create;
3566   fPixelSize        := 2.0;
3567   fFormat           := tfRGB5A1us1;
3568   fWithAlpha        := tfRGB5A1us1;
3569   fWithoutAlpha     := tfRGB5X1us1;
3570   fOpenGLFormat     := tfRGB5A1us1;
3571   fRGBInverted      := tfBGR5A1us1;
3572   fRange.r          := $1F;
3573   fRange.g          := $1F;
3574   fRange.b          := $1F;
3575   fRange.a          := $01;
3576   fShift.r          := 11;
3577   fShift.g          :=  6;
3578   fShift.b          :=  1;
3579   fShift.a          :=  0;
3580   fglFormat         := GL_RGBA;
3581   fglInternalFormat := GL_RGB5_A1;
3582   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3583 end;
3584
3585 constructor TfdA1RGB5us1.Create;
3586 begin
3587   inherited Create;
3588   fPixelSize        := 2.0;
3589   fFormat           := tfA1RGB5us1;
3590   fWithAlpha        := tfA1RGB5us1;
3591   fWithoutAlpha     := tfX1RGB5us1;
3592   fOpenGLFormat     := tfA1RGB5us1;
3593   fRGBInverted      := tfA1BGR5us1;
3594   fRange.r          := $1F;
3595   fRange.g          := $1F;
3596   fRange.b          := $1F;
3597   fRange.a          := $01;
3598   fShift.r          := 10;
3599   fShift.g          :=  5;
3600   fShift.b          :=  0;
3601   fShift.a          := 15;
3602   fglFormat         := GL_BGRA;
3603   fglInternalFormat := GL_RGB5_A1;
3604   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3605 end;
3606
3607 constructor TfdRGBA8ui1.Create;
3608 begin
3609   inherited Create;
3610   fPixelSize        := 4.0;
3611   fFormat           := tfRGBA8ui1;
3612   fWithAlpha        := tfRGBA8ui1;
3613   fWithoutAlpha     := tfRGBX8ui1;
3614   fOpenGLFormat     := tfRGBA8ui1;
3615   fRGBInverted      := tfBGRA8ui1;
3616   fRange.r          := $FF;
3617   fRange.g          := $FF;
3618   fRange.b          := $FF;
3619   fRange.a          := $FF;
3620   fShift.r          := 24;
3621   fShift.g          := 16;
3622   fShift.b          :=  8;
3623   fShift.a          :=  0;
3624   fglFormat         := GL_RGBA;
3625   fglInternalFormat := GL_RGBA8;
3626   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3627 end;
3628
3629 constructor TfdARGB8ui1.Create;
3630 begin
3631   inherited Create;
3632   fPixelSize        := 4.0;
3633   fFormat           := tfARGB8ui1;
3634   fWithAlpha        := tfARGB8ui1;
3635   fWithoutAlpha     := tfXRGB8ui1;
3636   fOpenGLFormat     := tfARGB8ui1;
3637   fRGBInverted      := tfABGR8ui1;
3638   fRange.r          := $FF;
3639   fRange.g          := $FF;
3640   fRange.b          := $FF;
3641   fRange.a          := $FF;
3642   fShift.r          := 16;
3643   fShift.g          :=  8;
3644   fShift.b          :=  0;
3645   fShift.a          := 24;
3646   fglFormat         := GL_BGRA;
3647   fglInternalFormat := GL_RGBA8;
3648   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3649 end;
3650
3651 constructor TfdRGBA8ub4.Create;
3652 begin
3653   inherited Create;
3654   fPixelSize        := 4.0;
3655   fFormat           := tfRGBA8ub4;
3656   fWithAlpha        := tfRGBA8ub4;
3657   fWithoutAlpha     := tfRGB8ub3;
3658   fOpenGLFormat     := tfRGBA8ub4;
3659   fRGBInverted      := tfBGRA8ub4;
3660   fRange.r          := $FF;
3661   fRange.g          := $FF;
3662   fRange.b          := $FF;
3663   fRange.a          := $FF;
3664   fShift.r          :=  0;
3665   fShift.g          :=  8;
3666   fShift.b          := 16;
3667   fShift.a          := 24;
3668   fglFormat         := GL_RGBA;
3669   fglInternalFormat := GL_RGBA8;
3670   fglDataFormat     := GL_UNSIGNED_BYTE;
3671 end;
3672
3673 constructor TfdRGB10A2ui1.Create;
3674 begin
3675   inherited Create;
3676   fPixelSize        := 4.0;
3677   fFormat           := tfRGB10A2ui1;
3678   fWithAlpha        := tfRGB10A2ui1;
3679   fWithoutAlpha     := tfRGB10X2ui1;
3680   fOpenGLFormat     := tfRGB10A2ui1;
3681   fRGBInverted      := tfBGR10A2ui1;
3682   fRange.r          := $03FF;
3683   fRange.g          := $03FF;
3684   fRange.b          := $03FF;
3685   fRange.a          := $0003;
3686   fShift.r          := 22;
3687   fShift.g          := 12;
3688   fShift.b          :=  2;
3689   fShift.a          :=  0;
3690   fglFormat         := GL_RGBA;
3691   fglInternalFormat := GL_RGB10_A2;
3692   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3693 end;
3694
3695 constructor TfdA2RGB10ui1.Create;
3696 begin
3697   inherited Create;
3698   fPixelSize        := 4.0;
3699   fFormat           := tfA2RGB10ui1;
3700   fWithAlpha        := tfA2RGB10ui1;
3701   fWithoutAlpha     := tfX2RGB10ui1;
3702   fOpenGLFormat     := tfA2RGB10ui1;
3703   fRGBInverted      := tfA2BGR10ui1;
3704   fRange.r          := $03FF;
3705   fRange.g          := $03FF;
3706   fRange.b          := $03FF;
3707   fRange.a          := $0003;
3708   fShift.r          := 20;
3709   fShift.g          := 10;
3710   fShift.b          :=  0;
3711   fShift.a          := 30;
3712   fglFormat         := GL_BGRA;
3713   fglInternalFormat := GL_RGB10_A2;
3714   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3715 end;
3716
3717 constructor TfdRGBA16us4.Create;
3718 begin
3719   inherited Create;
3720   fPixelSize        := 8.0;
3721   fFormat           := tfRGBA16us4;
3722   fWithAlpha        := tfRGBA16us4;
3723   fWithoutAlpha     := tfRGB16us3;
3724   fOpenGLFormat     := tfRGBA16us4;
3725   fRGBInverted      := tfBGRA16us4;
3726   fRange.r          := $FFFF;
3727   fRange.g          := $FFFF;
3728   fRange.b          := $FFFF;
3729   fRange.a          := $FFFF;
3730   fShift.r          :=  0;
3731   fShift.g          := 16;
3732   fShift.b          := 32;
3733   fShift.a          := 48;
3734   fglFormat         := GL_RGBA;
3735   fglInternalFormat := GL_RGBA16;
3736   fglDataFormat     := GL_UNSIGNED_SHORT;
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3742 constructor TfdBGRX4us1.Create;
3743 begin
3744   inherited Create;
3745   fPixelSize        := 2.0;
3746   fFormat           := tfBGRX4us1;
3747   fWithAlpha        := tfBGRA4us1;
3748   fWithoutAlpha     := tfBGRX4us1;
3749   fOpenGLFormat     := tfBGRX4us1;
3750   fRGBInverted      := tfRGBX4us1;
3751   fRange.r          := $0F;
3752   fRange.g          := $0F;
3753   fRange.b          := $0F;
3754   fShift.r          :=  4;
3755   fShift.g          :=  8;
3756   fShift.b          := 12;
3757   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3758   fglInternalFormat := GL_RGB4;
3759   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3760 end;
3761
3762 constructor TfdXBGR4us1.Create;
3763 begin
3764   inherited Create;
3765   fPixelSize        := 2.0;
3766   fFormat           := tfXBGR4us1;
3767   fWithAlpha        := tfABGR4us1;
3768   fWithoutAlpha     := tfXBGR4us1;
3769   fOpenGLFormat     := tfXBGR4us1;
3770   fRGBInverted      := tfXRGB4us1;
3771   fRange.r          := $0F;
3772   fRange.g          := $0F;
3773   fRange.b          := $0F;
3774   fShift.r          := 0;
3775   fShift.g          := 4;
3776   fShift.b          := 8;
3777   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3778   fglInternalFormat := GL_RGB4;
3779   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3780 end;
3781
3782 constructor TfdB5G6R5us1.Create;
3783 begin
3784   inherited Create;
3785   fPixelSize        := 2.0;
3786   fFormat           := tfB5G6R5us1;
3787   fWithAlpha        := tfBGR5A1us1;
3788   fWithoutAlpha     := tfB5G6R5us1;
3789   fOpenGLFormat     := tfB5G6R5us1;
3790   fRGBInverted      := tfR5G6B5us1;
3791   fRange.r          := $1F;
3792   fRange.g          := $3F;
3793   fRange.b          := $1F;
3794   fShift.r          :=  0;
3795   fShift.g          :=  5;
3796   fShift.b          := 11;
3797   fglFormat         := GL_RGB;
3798   fglInternalFormat := GL_RGB565;
3799   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3800 end;
3801
3802 constructor TfdBGR5X1us1.Create;
3803 begin
3804   inherited Create;
3805   fPixelSize        := 2.0;
3806   fFormat           := tfBGR5X1us1;
3807   fWithAlpha        := tfBGR5A1us1;
3808   fWithoutAlpha     := tfBGR5X1us1;
3809   fOpenGLFormat     := tfBGR5X1us1;
3810   fRGBInverted      := tfRGB5X1us1;
3811   fRange.r          := $1F;
3812   fRange.g          := $1F;
3813   fRange.b          := $1F;
3814   fShift.r          :=  1;
3815   fShift.g          :=  6;
3816   fShift.b          := 11;
3817   fglFormat         := GL_BGRA;
3818   fglInternalFormat := GL_RGB5;
3819   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3820 end;
3821
3822 constructor TfdX1BGR5us1.Create;
3823 begin
3824   inherited Create;
3825   fPixelSize        := 2.0;
3826   fFormat           := tfX1BGR5us1;
3827   fWithAlpha        := tfA1BGR5us1;
3828   fWithoutAlpha     := tfX1BGR5us1;
3829   fOpenGLFormat     := tfX1BGR5us1;
3830   fRGBInverted      := tfX1RGB5us1;
3831   fRange.r          := $1F;
3832   fRange.g          := $1F;
3833   fRange.b          := $1F;
3834   fShift.r          :=  0;
3835   fShift.g          :=  5;
3836   fShift.b          := 10;
3837   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3838   fglInternalFormat := GL_RGB5;
3839   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3840 end;
3841
3842 constructor TfdBGR8ub3.Create;
3843 begin
3844   inherited Create;
3845   fPixelSize        := 3.0;
3846   fFormat           := tfBGR8ub3;
3847   fWithAlpha        := tfBGRA8ub4;
3848   fWithoutAlpha     := tfBGR8ub3;
3849   fOpenGLFormat     := tfBGR8ub3;
3850   fRGBInverted      := tfRGB8ub3;
3851   fRange.r          := $FF;
3852   fRange.g          := $FF;
3853   fRange.b          := $FF;
3854   fShift.r          := 16;
3855   fShift.g          :=  8;
3856   fShift.b          :=  0;
3857   fglFormat         := GL_BGR;
3858   fglInternalFormat := GL_RGB8;
3859   fglDataFormat     := GL_UNSIGNED_BYTE;
3860 end;
3861
3862 constructor TfdBGRX8ui1.Create;
3863 begin
3864   inherited Create;
3865   fPixelSize        := 4.0;
3866   fFormat           := tfBGRX8ui1;
3867   fWithAlpha        := tfBGRA8ui1;
3868   fWithoutAlpha     := tfBGRX8ui1;
3869   fOpenGLFormat     := tfBGRX8ui1;
3870   fRGBInverted      := tfRGBX8ui1;
3871   fRange.r          := $FF;
3872   fRange.g          := $FF;
3873   fRange.b          := $FF;
3874   fShift.r          :=  8;
3875   fShift.g          := 16;
3876   fShift.b          := 24;
3877   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3878   fglInternalFormat := GL_RGB8;
3879   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3880 end;
3881
3882 constructor TfdXBGR8ui1.Create;
3883 begin
3884   inherited Create;
3885   fPixelSize        := 4.0;
3886   fFormat           := tfXBGR8ui1;
3887   fWithAlpha        := tfABGR8ui1;
3888   fWithoutAlpha     := tfXBGR8ui1;
3889   fOpenGLFormat     := tfXBGR8ui1;
3890   fRGBInverted      := tfXRGB8ui1;
3891   fRange.r          := $FF;
3892   fRange.g          := $FF;
3893   fRange.b          := $FF;
3894   fShift.r          :=  0;
3895   fShift.g          :=  8;
3896   fShift.b          := 16;
3897   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3898   fglInternalFormat := GL_RGB8;
3899   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3900 end;
3901
3902 constructor TfdBGR10X2ui1.Create;
3903 begin
3904   inherited Create;
3905   fPixelSize        := 4.0;
3906   fFormat           := tfBGR10X2ui1;
3907   fWithAlpha        := tfBGR10A2ui1;
3908   fWithoutAlpha     := tfBGR10X2ui1;
3909   fOpenGLFormat     := tfBGR10X2ui1;
3910   fRGBInverted      := tfRGB10X2ui1;
3911   fRange.r          := $03FF;
3912   fRange.g          := $03FF;
3913   fRange.b          := $03FF;
3914   fShift.r          :=  2;
3915   fShift.g          := 12;
3916   fShift.b          := 22;
3917   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3918   fglInternalFormat := GL_RGB10;
3919   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3920 end;
3921
3922 constructor TfdX2BGR10ui1.Create;
3923 begin
3924   inherited Create;
3925   fPixelSize        := 4.0;
3926   fFormat           := tfX2BGR10ui1;
3927   fWithAlpha        := tfA2BGR10ui1;
3928   fWithoutAlpha     := tfX2BGR10ui1;
3929   fOpenGLFormat     := tfX2BGR10ui1;
3930   fRGBInverted      := tfX2RGB10ui1;
3931   fRange.r          := $03FF;
3932   fRange.g          := $03FF;
3933   fRange.b          := $03FF;
3934   fShift.r          :=  0;
3935   fShift.g          := 10;
3936   fShift.b          := 20;
3937   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3938   fglInternalFormat := GL_RGB10;
3939   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3940 end;
3941
3942 constructor TfdBGR16us3.Create;
3943 begin
3944   inherited Create;
3945   fPixelSize        := 6.0;
3946   fFormat           := tfBGR16us3;
3947   fWithAlpha        := tfBGRA16us4;
3948   fWithoutAlpha     := tfBGR16us3;
3949   fOpenGLFormat     := tfBGR16us3;
3950   fRGBInverted      := tfRGB16us3;
3951   fRange.r          := $FFFF;
3952   fRange.g          := $FFFF;
3953   fRange.b          := $FFFF;
3954   fShift.r          := 32;
3955   fShift.g          := 16;
3956   fShift.b          :=  0;
3957   fglFormat         := GL_BGR;
3958   fglInternalFormat := GL_RGB16;
3959   fglDataFormat     := GL_UNSIGNED_SHORT;
3960 end;
3961
3962 constructor TfdBGRA4us1.Create;
3963 begin
3964   inherited Create;
3965   fPixelSize        := 2.0;
3966   fFormat           := tfBGRA4us1;
3967   fWithAlpha        := tfBGRA4us1;
3968   fWithoutAlpha     := tfBGRX4us1;
3969   fOpenGLFormat     := tfBGRA4us1;
3970   fRGBInverted      := tfRGBA4us1;
3971   fRange.r          := $0F;
3972   fRange.g          := $0F;
3973   fRange.b          := $0F;
3974   fRange.a          := $0F;
3975   fShift.r          :=  4;
3976   fShift.g          :=  8;
3977   fShift.b          := 12;
3978   fShift.a          :=  0;
3979   fglFormat         := GL_BGRA;
3980   fglInternalFormat := GL_RGBA4;
3981   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3982 end;
3983
3984 constructor TfdABGR4us1.Create;
3985 begin
3986   inherited Create;
3987   fPixelSize        := 2.0;
3988   fFormat           := tfABGR4us1;
3989   fWithAlpha        := tfABGR4us1;
3990   fWithoutAlpha     := tfXBGR4us1;
3991   fOpenGLFormat     := tfABGR4us1;
3992   fRGBInverted      := tfARGB4us1;
3993   fRange.r          := $0F;
3994   fRange.g          := $0F;
3995   fRange.b          := $0F;
3996   fRange.a          := $0F;
3997   fShift.r          :=  0;
3998   fShift.g          :=  4;
3999   fShift.b          :=  8;
4000   fShift.a          := 12;
4001   fglFormat         := GL_RGBA;
4002   fglInternalFormat := GL_RGBA4;
4003   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
4004 end;
4005
4006 constructor TfdBGR5A1us1.Create;
4007 begin
4008   inherited Create;
4009   fPixelSize        := 2.0;
4010   fFormat           := tfBGR5A1us1;
4011   fWithAlpha        := tfBGR5A1us1;
4012   fWithoutAlpha     := tfBGR5X1us1;
4013   fOpenGLFormat     := tfBGR5A1us1;
4014   fRGBInverted      := tfRGB5A1us1;
4015   fRange.r          := $1F;
4016   fRange.g          := $1F;
4017   fRange.b          := $1F;
4018   fRange.a          := $01;
4019   fShift.r          :=  1;
4020   fShift.g          :=  6;
4021   fShift.b          := 11;
4022   fShift.a          :=  0;
4023   fglFormat         := GL_BGRA;
4024   fglInternalFormat := GL_RGB5_A1;
4025   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
4026 end;
4027
4028 constructor TfdA1BGR5us1.Create;
4029 begin
4030   inherited Create;
4031   fPixelSize        := 2.0;
4032   fFormat           := tfA1BGR5us1;
4033   fWithAlpha        := tfA1BGR5us1;
4034   fWithoutAlpha     := tfX1BGR5us1;
4035   fOpenGLFormat     := tfA1BGR5us1;
4036   fRGBInverted      := tfA1RGB5us1;
4037   fRange.r          := $1F;
4038   fRange.g          := $1F;
4039   fRange.b          := $1F;
4040   fRange.a          := $01;
4041   fShift.r          :=  0;
4042   fShift.g          :=  5;
4043   fShift.b          := 10;
4044   fShift.a          := 15;
4045   fglFormat         := GL_RGBA;
4046   fglInternalFormat := GL_RGB5_A1;
4047   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
4048 end;
4049
4050 constructor TfdBGRA8ui1.Create;
4051 begin
4052   inherited Create;
4053   fPixelSize        := 4.0;
4054   fFormat           := tfBGRA8ui1;
4055   fWithAlpha        := tfBGRA8ui1;
4056   fWithoutAlpha     := tfBGRX8ui1;
4057   fOpenGLFormat     := tfBGRA8ui1;
4058   fRGBInverted      := tfRGBA8ui1;
4059   fRange.r          := $FF;
4060   fRange.g          := $FF;
4061   fRange.b          := $FF;
4062   fRange.a          := $FF;
4063   fShift.r          :=  8;
4064   fShift.g          := 16;
4065   fShift.b          := 24;
4066   fShift.a          :=  0;
4067   fglFormat         := GL_BGRA;
4068   fglInternalFormat := GL_RGBA8;
4069   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
4070 end;
4071
4072 constructor TfdABGR8ui1.Create;
4073 begin
4074   inherited Create;
4075   fPixelSize        := 4.0;
4076   fFormat           := tfABGR8ui1;
4077   fWithAlpha        := tfABGR8ui1;
4078   fWithoutAlpha     := tfXBGR8ui1;
4079   fOpenGLFormat     := tfABGR8ui1;
4080   fRGBInverted      := tfARGB8ui1;
4081   fRange.r          := $FF;
4082   fRange.g          := $FF;
4083   fRange.b          := $FF;
4084   fRange.a          := $FF;
4085   fShift.r          :=  0;
4086   fShift.g          :=  8;
4087   fShift.b          := 16;
4088   fShift.a          := 24;
4089   fglFormat         := GL_RGBA;
4090   fglInternalFormat := GL_RGBA8;
4091   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
4092 end;
4093
4094 constructor TfdBGRA8ub4.Create;
4095 begin
4096   inherited Create;
4097   fPixelSize        := 4.0;
4098   fFormat           := tfBGRA8ub4;
4099   fWithAlpha        := tfBGRA8ub4;
4100   fWithoutAlpha     := tfBGR8ub3;
4101   fOpenGLFormat     := tfBGRA8ub4;
4102   fRGBInverted      := tfRGBA8ub4;
4103   fRange.r          := $FF;
4104   fRange.g          := $FF;
4105   fRange.b          := $FF;
4106   fRange.a          := $FF;
4107   fShift.r          := 16;
4108   fShift.g          :=  8;
4109   fShift.b          :=  0;
4110   fShift.a          := 24;
4111   fglFormat         := GL_BGRA;
4112   fglInternalFormat := GL_RGBA8;
4113   fglDataFormat     := GL_UNSIGNED_BYTE;
4114 end;
4115
4116 constructor TfdBGR10A2ui1.Create;
4117 begin
4118   inherited Create;
4119   fPixelSize        := 4.0;
4120   fFormat           := tfBGR10A2ui1;
4121   fWithAlpha        := tfBGR10A2ui1;
4122   fWithoutAlpha     := tfBGR10X2ui1;
4123   fOpenGLFormat     := tfBGR10A2ui1;
4124   fRGBInverted      := tfRGB10A2ui1;
4125   fRange.r          := $03FF;
4126   fRange.g          := $03FF;
4127   fRange.b          := $03FF;
4128   fRange.a          := $0003;
4129   fShift.r          :=  2;
4130   fShift.g          := 12;
4131   fShift.b          := 22;
4132   fShift.a          :=  0;
4133   fglFormat         := GL_BGRA;
4134   fglInternalFormat := GL_RGB10_A2;
4135   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
4136 end;
4137
4138 constructor TfdA2BGR10ui1.Create;
4139 begin
4140   inherited Create;
4141   fPixelSize        := 4.0;
4142   fFormat           := tfA2BGR10ui1;
4143   fWithAlpha        := tfA2BGR10ui1;
4144   fWithoutAlpha     := tfX2BGR10ui1;
4145   fOpenGLFormat     := tfA2BGR10ui1;
4146   fRGBInverted      := tfA2RGB10ui1;
4147   fRange.r          := $03FF;
4148   fRange.g          := $03FF;
4149   fRange.b          := $03FF;
4150   fRange.a          := $0003;
4151   fShift.r          :=  0;
4152   fShift.g          := 10;
4153   fShift.b          := 20;
4154   fShift.a          := 30;
4155   fglFormat         := GL_RGBA;
4156   fglInternalFormat := GL_RGB10_A2;
4157   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
4158 end;
4159
4160 constructor TfdBGRA16us4.Create;
4161 begin
4162   inherited Create;
4163   fPixelSize        := 8.0;
4164   fFormat           := tfBGRA16us4;
4165   fWithAlpha        := tfBGRA16us4;
4166   fWithoutAlpha     := tfBGR16us3;
4167   fOpenGLFormat     := tfBGRA16us4;
4168   fRGBInverted      := tfRGBA16us4;
4169   fRange.r          := $FFFF;
4170   fRange.g          := $FFFF;
4171   fRange.b          := $FFFF;
4172   fRange.a          := $FFFF;
4173   fShift.r          := 32;
4174   fShift.g          := 16;
4175   fShift.b          :=  0;
4176   fShift.a          := 48;
4177   fglFormat         := GL_BGRA;
4178   fglInternalFormat := GL_RGBA16;
4179   fglDataFormat     := GL_UNSIGNED_SHORT;
4180 end;
4181
4182 constructor TfdDepth16us1.Create;
4183 begin
4184   inherited Create;
4185   fPixelSize        := 2.0;
4186   fFormat           := tfDepth16us1;
4187   fWithoutAlpha     := tfDepth16us1;
4188   fOpenGLFormat     := tfDepth16us1;
4189   fRange.r          := $FFFF;
4190   fRange.g          := $FFFF;
4191   fRange.b          := $FFFF;
4192   fRange.a          := $FFFF;
4193   fglFormat         := GL_DEPTH_COMPONENT;
4194   fglInternalFormat := GL_DEPTH_COMPONENT16;
4195   fglDataFormat     := GL_UNSIGNED_SHORT;
4196 end;
4197
4198 constructor TfdDepth24ui1.Create;
4199 begin
4200   inherited Create;
4201   fPixelSize        := 4.0;
4202   fFormat           := tfDepth24ui1;
4203   fWithoutAlpha     := tfDepth24ui1;
4204   fOpenGLFormat     := tfDepth24ui1;
4205   fRange.r          := $FFFFFFFF;
4206   fRange.g          := $FFFFFFFF;
4207   fRange.b          := $FFFFFFFF;
4208   fRange.a          := $FFFFFFFF;
4209   fglFormat         := GL_DEPTH_COMPONENT;
4210   fglInternalFormat := GL_DEPTH_COMPONENT24;
4211   fglDataFormat     := GL_UNSIGNED_INT;
4212 end;
4213
4214 constructor TfdDepth32ui1.Create;
4215 begin
4216   inherited Create;
4217   fPixelSize        := 4.0;
4218   fFormat           := tfDepth32ui1;
4219   fWithoutAlpha     := tfDepth32ui1;
4220   fOpenGLFormat     := tfDepth32ui1;
4221   fRange.r          := $FFFFFFFF;
4222   fRange.g          := $FFFFFFFF;
4223   fRange.b          := $FFFFFFFF;
4224   fRange.a          := $FFFFFFFF;
4225   fglFormat         := GL_DEPTH_COMPONENT;
4226   fglInternalFormat := GL_DEPTH_COMPONENT32;
4227   fglDataFormat     := GL_UNSIGNED_INT;
4228 end;
4229
4230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4231 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4233 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4234 begin
4235   raise EglBitmap.Create('mapping for compressed formats is not supported');
4236 end;
4237
4238 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4239 begin
4240   raise EglBitmap.Create('mapping for compressed formats is not supported');
4241 end;
4242
4243 constructor TfdS3tcDtx1RGBA.Create;
4244 begin
4245   inherited Create;
4246   fFormat           := tfS3tcDtx1RGBA;
4247   fWithAlpha        := tfS3tcDtx1RGBA;
4248   fOpenGLFormat     := tfS3tcDtx1RGBA;
4249   fUncompressed     := tfRGB5A1us1;
4250   fPixelSize        := 0.5;
4251   fIsCompressed     := true;
4252   fglFormat         := GL_COMPRESSED_RGBA;
4253   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4254   fglDataFormat     := GL_UNSIGNED_BYTE;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4261 begin
4262   raise EglBitmap.Create('mapping for compressed formats is not supported');
4263 end;
4264
4265 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4266 begin
4267   raise EglBitmap.Create('mapping for compressed formats is not supported');
4268 end;
4269
4270 constructor TfdS3tcDtx3RGBA.Create;
4271 begin
4272   inherited Create;
4273   fFormat           := tfS3tcDtx3RGBA;
4274   fWithAlpha        := tfS3tcDtx3RGBA;
4275   fOpenGLFormat     := tfS3tcDtx3RGBA;
4276   fUncompressed     := tfRGBA8ub4;
4277   fPixelSize        := 1.0;
4278   fIsCompressed     := true;
4279   fglFormat         := GL_COMPRESSED_RGBA;
4280   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4281   fglDataFormat     := GL_UNSIGNED_BYTE;
4282 end;
4283
4284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4285 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4287 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4288 begin
4289   raise EglBitmap.Create('mapping for compressed formats is not supported');
4290 end;
4291
4292 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4293 begin
4294   raise EglBitmap.Create('mapping for compressed formats is not supported');
4295 end;
4296
4297 constructor TfdS3tcDtx5RGBA.Create;
4298 begin
4299   inherited Create;
4300   fFormat           := tfS3tcDtx3RGBA;
4301   fWithAlpha        := tfS3tcDtx3RGBA;
4302   fOpenGLFormat     := tfS3tcDtx3RGBA;
4303   fUncompressed     := tfRGBA8ub4;
4304   fPixelSize        := 1.0;
4305   fIsCompressed     := true;
4306   fglFormat         := GL_COMPRESSED_RGBA;
4307   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4308   fglDataFormat     := GL_UNSIGNED_BYTE;
4309 end;
4310
4311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4312 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4314 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4315 var
4316   f: TglBitmapFormat;
4317 begin
4318   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4319     result := TFormatDescriptor.Get(f);
4320     if (result.glInternalFormat = aInternalFormat) then
4321       exit;
4322   end;
4323   result := TFormatDescriptor.Get(tfEmpty);
4324 end;
4325
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4329 class procedure TFormatDescriptor.Init;
4330 begin
4331   if not Assigned(FormatDescriptorCS) then
4332     FormatDescriptorCS := TCriticalSection.Create;
4333 end;
4334
4335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4336 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4337 begin
4338   FormatDescriptorCS.Enter;
4339   try
4340     result := FormatDescriptors[aFormat];
4341     if not Assigned(result) then begin
4342       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4343       FormatDescriptors[aFormat] := result;
4344     end;
4345   finally
4346     FormatDescriptorCS.Leave;
4347   end;
4348 end;
4349
4350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4351 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4352 begin
4353   result := Get(Get(aFormat).WithAlpha);
4354 end;
4355
4356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4357 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapMask; const aBitCount: Integer): TFormatDescriptor;
4358 var
4359   ft: TglBitmapFormat;
4360 begin
4361   // find matching format with OpenGL support
4362   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4363     result := Get(ft);
4364     if (result.MaskMatch(aMask))      and
4365        (result.glFormat <> 0)         and
4366        (result.glInternalFormat <> 0) and
4367        ((aBitCount = 0) or (aBitCount = 8 * result.PixelSize))
4368     then
4369       exit;
4370   end;
4371
4372   // find matching format without OpenGL Support
4373   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4374     result := Get(ft);
4375     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = 8 * result.PixelSize)) then
4376       exit;
4377   end;
4378
4379   result := FormatDescriptors[tfEmpty];
4380 end;
4381
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 class procedure TFormatDescriptor.Clear;
4384 var
4385   f: TglBitmapFormat;
4386 begin
4387   FormatDescriptorCS.Enter;
4388   try
4389     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4390       FreeAndNil(FormatDescriptors[f]);
4391   finally
4392     FormatDescriptorCS.Leave;
4393   end;
4394 end;
4395
4396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4397 class procedure TFormatDescriptor.Finalize;
4398 begin
4399   Clear;
4400   FreeAndNil(FormatDescriptorCS);
4401 end;
4402
4403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4404 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4406 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
4407 begin
4408   Update(aValue, fRange.r, fShift.r);
4409 end;
4410
4411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4412 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
4413 begin
4414   Update(aValue, fRange.g, fShift.g);
4415 end;
4416
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
4419 begin
4420   Update(aValue, fRange.b, fShift.b);
4421 end;
4422
4423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4424 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
4425 begin
4426   Update(aValue, fRange.a, fShift.a);
4427 end;
4428
4429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4430 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
4431   aShift: Byte);
4432 begin
4433   aShift := 0;
4434   aRange := 0;
4435   if (aMask = 0) then
4436     exit;
4437   while (aMask > 0) and ((aMask and 1) = 0) do begin
4438     inc(aShift);
4439     aMask := aMask shr 1;
4440   end;
4441   aRange := 1;
4442   while (aMask > 0) do begin
4443     aRange := aRange shl 1;
4444     aMask  := aMask  shr 1;
4445   end;
4446   dec(aRange);
4447
4448   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
4449 end;
4450
4451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4452 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4453 var
4454   data: QWord;
4455   s: Integer;
4456 begin
4457   data :=
4458     ((aPixel.Data.r and fRange.r) shl fShift.r) or
4459     ((aPixel.Data.g and fRange.g) shl fShift.g) or
4460     ((aPixel.Data.b and fRange.b) shl fShift.b) or
4461     ((aPixel.Data.a and fRange.a) shl fShift.a);
4462   s := Round(fPixelSize);
4463   case s of
4464     1:           aData^  := data;
4465     2:     PWord(aData)^ := data;
4466     4: PCardinal(aData)^ := data;
4467     8:    PQWord(aData)^ := data;
4468   else
4469     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4470   end;
4471   inc(aData, s);
4472 end;
4473
4474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4475 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4476 var
4477   data: QWord;
4478   s, i: Integer;
4479 begin
4480   s := Round(fPixelSize);
4481   case s of
4482     1: data :=           aData^;
4483     2: data :=     PWord(aData)^;
4484     4: data := PCardinal(aData)^;
4485     8: data :=    PQWord(aData)^;
4486   else
4487     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4488   end;
4489   for i := 0 to 3 do
4490     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
4491   inc(aData, s);
4492 end;
4493
4494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4495 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4497 procedure TbmpColorTableFormat.CreateColorTable;
4498 var
4499   i: Integer;
4500 begin
4501   SetLength(fColorTable, 256);
4502   if (fRange.r = fRange.g) and (fRange.g = fRange.b) and (fRange.r = 0) then begin
4503     // alpha
4504     for i := 0 to High(fColorTable) do begin
4505       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4506       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4507       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4508       fColorTable[i].a := 0;
4509     end;
4510   end else begin
4511     // normal
4512     for i := 0 to High(fColorTable) do begin
4513       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4514       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4515       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4516       fColorTable[i].a := 0;
4517     end;
4518   end;
4519 end;
4520
4521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4522 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4523 begin
4524   if (fPixelSize <> 1.0) then
4525     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4526   if (fRange.r = fRange.g) and (fRange.g = fRange.b) and (fRange.r = 0) then
4527     // alpha
4528     aData^ := aPixel.Data.a
4529   else
4530     // normal
4531     aData^ := Round(
4532       ((aPixel.Data.r and Range.r) shl Shift.r) or
4533       ((aPixel.Data.g and Range.g) shl Shift.g) or
4534       ((aPixel.Data.b and Range.b) shl Shift.b));
4535   inc(aData);
4536 end;
4537
4538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4539 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4540 begin
4541   if (fPixelSize <> 1.0) then
4542     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4543   with fColorTable[aData^] do begin
4544     aPixel.Data.r := r;
4545     aPixel.Data.g := g;
4546     aPixel.Data.b := b;
4547     aPixel.Data.a := a;
4548   end;
4549   inc(aData, 1);
4550 end;
4551
4552 destructor TbmpColorTableFormat.Destroy;
4553 begin
4554   SetLength(fColorTable, 0);
4555   inherited Destroy;
4556 end;
4557
4558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4559 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4561 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4562 var
4563   i: Integer;
4564 begin
4565   for i := 0 to 3 do begin
4566     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4567       if (aSourceFD.Range.arr[i] > 0) then
4568         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4569       else
4570         aPixel.Data.arr[i] := 0;
4571     end;
4572   end;
4573 end;
4574
4575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4576 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4577 begin
4578   with aFuncRec do begin
4579     if (Source.Range.r   > 0) then
4580       Dest.Data.r := Source.Data.r;
4581     if (Source.Range.g > 0) then
4582       Dest.Data.g := Source.Data.g;
4583     if (Source.Range.b  > 0) then
4584       Dest.Data.b := Source.Data.b;
4585     if (Source.Range.a > 0) then
4586       Dest.Data.a := Source.Data.a;
4587   end;
4588 end;
4589
4590 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4591 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4592 var
4593   i: Integer;
4594 begin
4595   with aFuncRec do begin
4596     for i := 0 to 3 do
4597       if (Source.Range.arr[i] > 0) then
4598         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4599   end;
4600 end;
4601
4602 type
4603   TShiftData = packed record
4604     case Integer of
4605       0: (r, g, b, a: SmallInt);
4606       1: (arr: array[0..3] of SmallInt);
4607   end;
4608   PShiftData = ^TShiftData;
4609
4610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4611 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4612 var
4613   i: Integer;
4614 begin
4615   with aFuncRec do
4616     for i := 0 to 3 do
4617       if (Source.Range.arr[i] > 0) then
4618         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4619 end;
4620
4621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4622 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4623 begin
4624   with aFuncRec do begin
4625     Dest.Data := Source.Data;
4626     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4627       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4628       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4629       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4630     end;
4631     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4632       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4633     end;
4634   end;
4635 end;
4636
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4639 var
4640   i: Integer;
4641 begin
4642   with aFuncRec do begin
4643     for i := 0 to 3 do
4644       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4645   end;
4646 end;
4647
4648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4649 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4650 var
4651   Temp: Single;
4652 begin
4653   with FuncRec do begin
4654     if (FuncRec.Args = nil) then begin //source has no alpha
4655       Temp :=
4656         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4657         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4658         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4659       Dest.Data.a := Round(Dest.Range.a * Temp);
4660     end else
4661       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4662   end;
4663 end;
4664
4665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4666 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4667 type
4668   PglBitmapPixelData = ^TglBitmapPixelData;
4669 begin
4670   with FuncRec do begin
4671     Dest.Data.r := Source.Data.r;
4672     Dest.Data.g := Source.Data.g;
4673     Dest.Data.b := Source.Data.b;
4674
4675     with PglBitmapPixelData(Args)^ do
4676       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4677           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4678           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4679         Dest.Data.a := 0
4680       else
4681         Dest.Data.a := Dest.Range.a;
4682   end;
4683 end;
4684
4685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4686 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4687 begin
4688   with FuncRec do begin
4689     Dest.Data.r := Source.Data.r;
4690     Dest.Data.g := Source.Data.g;
4691     Dest.Data.b := Source.Data.b;
4692     Dest.Data.a := PCardinal(Args)^;
4693   end;
4694 end;
4695
4696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4697 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4698 type
4699   PRGBPix = ^TRGBPix;
4700   TRGBPix = array [0..2] of byte;
4701 var
4702   Temp: Byte;
4703 begin
4704   while aWidth > 0 do begin
4705     Temp := PRGBPix(aData)^[0];
4706     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4707     PRGBPix(aData)^[2] := Temp;
4708
4709     if aHasAlpha then
4710       Inc(aData, 4)
4711     else
4712       Inc(aData, 3);
4713     dec(aWidth);
4714   end;
4715 end;
4716
4717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4718 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4720 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4721 begin
4722   result := TFormatDescriptor.Get(Format);
4723 end;
4724
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 function TglBitmap.GetWidth: Integer;
4727 begin
4728   if (ffX in fDimension.Fields) then
4729     result := fDimension.X
4730   else
4731     result := -1;
4732 end;
4733
4734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4735 function TglBitmap.GetHeight: Integer;
4736 begin
4737   if (ffY in fDimension.Fields) then
4738     result := fDimension.Y
4739   else
4740     result := -1;
4741 end;
4742
4743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4744 function TglBitmap.GetFileWidth: Integer;
4745 begin
4746   result := Max(1, Width);
4747 end;
4748
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 function TglBitmap.GetFileHeight: Integer;
4751 begin
4752   result := Max(1, Height);
4753 end;
4754
4755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4756 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4757 begin
4758   if fCustomData = aValue then
4759     exit;
4760   fCustomData := aValue;
4761 end;
4762
4763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4764 procedure TglBitmap.SetCustomName(const aValue: String);
4765 begin
4766   if fCustomName = aValue then
4767     exit;
4768   fCustomName := aValue;
4769 end;
4770
4771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4772 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4773 begin
4774   if fCustomNameW = aValue then
4775     exit;
4776   fCustomNameW := aValue;
4777 end;
4778
4779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4780 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4781 begin
4782   if fFreeDataOnDestroy = aValue then
4783     exit;
4784   fFreeDataOnDestroy := aValue;
4785 end;
4786
4787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4788 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4789 begin
4790   if fDeleteTextureOnFree = aValue then
4791     exit;
4792   fDeleteTextureOnFree := aValue;
4793 end;
4794
4795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4796 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4797 begin
4798   if fFormat = aValue then
4799     exit;
4800   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4801     raise EglBitmapUnsupportedFormat.Create(Format);
4802   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4803 end;
4804
4805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4806 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4807 begin
4808   if fFreeDataAfterGenTexture = aValue then
4809     exit;
4810   fFreeDataAfterGenTexture := aValue;
4811 end;
4812
4813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4814 procedure TglBitmap.SetID(const aValue: Cardinal);
4815 begin
4816   if fID = aValue then
4817     exit;
4818   fID := aValue;
4819 end;
4820
4821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4822 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4823 begin
4824   if fMipMap = aValue then
4825     exit;
4826   fMipMap := aValue;
4827 end;
4828
4829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4830 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4831 begin
4832   if fTarget = aValue then
4833     exit;
4834   fTarget := aValue;
4835 end;
4836
4837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4838 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4839 var
4840   MaxAnisotropic: Integer;
4841 begin
4842   fAnisotropic := aValue;
4843   if (ID > 0) then begin
4844     if GL_EXT_texture_filter_anisotropic then begin
4845       if fAnisotropic > 0 then begin
4846         Bind(false);
4847         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4848         if aValue > MaxAnisotropic then
4849           fAnisotropic := MaxAnisotropic;
4850         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4851       end;
4852     end else begin
4853       fAnisotropic := 0;
4854     end;
4855   end;
4856 end;
4857
4858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4859 procedure TglBitmap.CreateID;
4860 begin
4861   if (ID <> 0) then
4862     glDeleteTextures(1, @fID);
4863   glGenTextures(1, @fID);
4864   Bind(false);
4865 end;
4866
4867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4868 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4869 begin
4870   // Set Up Parameters
4871   SetWrap(fWrapS, fWrapT, fWrapR);
4872   SetFilter(fFilterMin, fFilterMag);
4873   SetAnisotropic(fAnisotropic);
4874   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4875
4876   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4877     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4878
4879   // Mip Maps Generation Mode
4880   aBuildWithGlu := false;
4881   if (MipMap = mmMipmap) then begin
4882     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4883       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4884     else
4885       aBuildWithGlu := true;
4886   end else if (MipMap = mmMipmapGlu) then
4887     aBuildWithGlu := true;
4888 end;
4889
4890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4891 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4892   const aWidth: Integer; const aHeight: Integer);
4893 var
4894   s: Single;
4895 begin
4896   if (Data <> aData) then begin
4897     if (Assigned(Data)) then
4898       FreeMem(Data);
4899     fData := aData;
4900   end;
4901
4902   if not Assigned(fData) then begin
4903     fPixelSize := 0;
4904     fRowSize   := 0;
4905   end else begin
4906     FillChar(fDimension, SizeOf(fDimension), 0);
4907     if aWidth <> -1 then begin
4908       fDimension.Fields := fDimension.Fields + [ffX];
4909       fDimension.X := aWidth;
4910     end;
4911
4912     if aHeight <> -1 then begin
4913       fDimension.Fields := fDimension.Fields + [ffY];
4914       fDimension.Y := aHeight;
4915     end;
4916
4917     s := TFormatDescriptor.Get(aFormat).PixelSize;
4918     fFormat    := aFormat;
4919     fPixelSize := Ceil(s);
4920     fRowSize   := Ceil(s * aWidth);
4921   end;
4922 end;
4923
4924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4925 function TglBitmap.FlipHorz: Boolean;
4926 begin
4927   result := false;
4928 end;
4929
4930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4931 function TglBitmap.FlipVert: Boolean;
4932 begin
4933   result := false;
4934 end;
4935
4936 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4937 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4939 procedure TglBitmap.AfterConstruction;
4940 begin
4941   inherited AfterConstruction;
4942
4943   fID         := 0;
4944   fTarget     := 0;
4945   fIsResident := false;
4946
4947   fMipMap                  := glBitmapDefaultMipmap;
4948   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4949   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4950
4951   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4952   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4953   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4954 end;
4955
4956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4957 procedure TglBitmap.BeforeDestruction;
4958 var
4959   NewData: PByte;
4960 begin
4961   if fFreeDataOnDestroy then begin
4962     NewData := nil;
4963     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4964   end;
4965   if (fID > 0) and fDeleteTextureOnFree then
4966     glDeleteTextures(1, @fID);
4967   inherited BeforeDestruction;
4968 end;
4969
4970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4971 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4972 var
4973   TempPos: Integer;
4974 begin
4975   if not Assigned(aResType) then begin
4976     TempPos   := Pos('.', aResource);
4977     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4978     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4979   end;
4980 end;
4981
4982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4983 procedure TglBitmap.LoadFromFile(const aFilename: String);
4984 var
4985   fs: TFileStream;
4986 begin
4987   if not FileExists(aFilename) then
4988     raise EglBitmap.Create('file does not exist: ' + aFilename);
4989   fFilename := aFilename;
4990   fs := TFileStream.Create(fFilename, fmOpenRead);
4991   try
4992     fs.Position := 0;
4993     LoadFromStream(fs);
4994   finally
4995     fs.Free;
4996   end;
4997 end;
4998
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 procedure TglBitmap.LoadFromStream(const aStream: TStream);
5001 begin
5002   {$IFDEF GLB_SUPPORT_PNG_READ}
5003   if not LoadPNG(aStream) then
5004   {$ENDIF}
5005   {$IFDEF GLB_SUPPORT_JPEG_READ}
5006   if not LoadJPEG(aStream) then
5007   {$ENDIF}
5008   if not LoadDDS(aStream) then
5009   if not LoadTGA(aStream) then
5010   if not LoadBMP(aStream) then
5011     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
5012 end;
5013
5014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5015 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
5016   const aFormat: TglBitmapFormat; const aArgs: Pointer);
5017 var
5018   tmpData: PByte;
5019   size: Integer;
5020 begin
5021   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5022   GetMem(tmpData, size);
5023   try
5024     FillChar(tmpData^, size, #$FF);
5025     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5026   except
5027     if Assigned(tmpData) then
5028       FreeMem(tmpData);
5029     raise;
5030   end;
5031   AddFunc(Self, aFunc, false, aFormat, aArgs);
5032 end;
5033
5034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5035 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
5036 var
5037   rs: TResourceStream;
5038 begin
5039   PrepareResType(aResource, aResType);
5040   rs := TResourceStream.Create(aInstance, aResource, aResType);
5041   try
5042     LoadFromStream(rs);
5043   finally
5044     rs.Free;
5045   end;
5046 end;
5047
5048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5049 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5050 var
5051   rs: TResourceStream;
5052 begin
5053   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5054   try
5055     LoadFromStream(rs);
5056   finally
5057     rs.Free;
5058   end;
5059 end;
5060
5061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5062 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
5063 var
5064   fs: TFileStream;
5065 begin
5066   fs := TFileStream.Create(aFileName, fmCreate);
5067   try
5068     fs.Position := 0;
5069     SaveToStream(fs, aFileType);
5070   finally
5071     fs.Free;
5072   end;
5073 end;
5074
5075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5076 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
5077 begin
5078   case aFileType of
5079     {$IFDEF GLB_SUPPORT_PNG_WRITE}
5080     ftPNG:  SavePNG(aStream);
5081     {$ENDIF}
5082     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5083     ftJPEG: SaveJPEG(aStream);
5084     {$ENDIF}
5085     ftDDS:  SaveDDS(aStream);
5086     ftTGA:  SaveTGA(aStream);
5087     ftBMP:  SaveBMP(aStream);
5088   end;
5089 end;
5090
5091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5092 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
5093 begin
5094   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
5099   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
5100 var
5101   DestData, TmpData, SourceData: pByte;
5102   TempHeight, TempWidth: Integer;
5103   SourceFD, DestFD: TFormatDescriptor;
5104   SourceMD, DestMD: Pointer;
5105
5106   FuncRec: TglBitmapFunctionRec;
5107 begin
5108   Assert(Assigned(Data));
5109   Assert(Assigned(aSource));
5110   Assert(Assigned(aSource.Data));
5111
5112   result := false;
5113   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
5114     SourceFD := TFormatDescriptor.Get(aSource.Format);
5115     DestFD   := TFormatDescriptor.Get(aFormat);
5116
5117     if (SourceFD.IsCompressed) then
5118       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
5119     if (DestFD.IsCompressed) then
5120       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
5121
5122     // inkompatible Formats so CreateTemp
5123     if (SourceFD.PixelSize <> DestFD.PixelSize) then
5124       aCreateTemp := true;
5125
5126     // Values
5127     TempHeight := Max(1, aSource.Height);
5128     TempWidth  := Max(1, aSource.Width);
5129
5130     FuncRec.Sender := Self;
5131     FuncRec.Args   := aArgs;
5132
5133     TmpData := nil;
5134     if aCreateTemp then begin
5135       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5136       DestData := TmpData;
5137     end else
5138       DestData := Data;
5139
5140     try
5141       SourceFD.PreparePixel(FuncRec.Source);
5142       DestFD.PreparePixel  (FuncRec.Dest);
5143
5144       SourceMD := SourceFD.CreateMappingData;
5145       DestMD   := DestFD.CreateMappingData;
5146
5147       FuncRec.Size            := aSource.Dimension;
5148       FuncRec.Position.Fields := FuncRec.Size.Fields;
5149
5150       try
5151         SourceData := aSource.Data;
5152         FuncRec.Position.Y := 0;
5153         while FuncRec.Position.Y < TempHeight do begin
5154           FuncRec.Position.X := 0;
5155           while FuncRec.Position.X < TempWidth do begin
5156             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5157             aFunc(FuncRec);
5158             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5159             inc(FuncRec.Position.X);
5160           end;
5161           inc(FuncRec.Position.Y);
5162         end;
5163
5164         // Updating Image or InternalFormat
5165         if aCreateTemp then
5166           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5167         else if (aFormat <> fFormat) then
5168           Format := aFormat;
5169
5170         result := true;
5171       finally
5172         SourceFD.FreeMappingData(SourceMD);
5173         DestFD.FreeMappingData(DestMD);
5174       end;
5175     except
5176       if aCreateTemp and Assigned(TmpData) then
5177         FreeMem(TmpData);
5178       raise;
5179     end;
5180   end;
5181 end;
5182
5183 {$IFDEF GLB_SDL}
5184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5185 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5186 var
5187   Row, RowSize: Integer;
5188   SourceData, TmpData: PByte;
5189   TempDepth: Integer;
5190   FormatDesc: TFormatDescriptor;
5191
5192   function GetRowPointer(Row: Integer): pByte;
5193   begin
5194     result := aSurface.pixels;
5195     Inc(result, Row * RowSize);
5196   end;
5197
5198 begin
5199   result := false;
5200
5201   FormatDesc := TFormatDescriptor.Get(Format);
5202   if FormatDesc.IsCompressed then
5203     raise EglBitmapUnsupportedFormat.Create(Format);
5204
5205   if Assigned(Data) then begin
5206     case Trunc(FormatDesc.PixelSize) of
5207       1: TempDepth :=  8;
5208       2: TempDepth := 16;
5209       3: TempDepth := 24;
5210       4: TempDepth := 32;
5211     else
5212       raise EglBitmapUnsupportedFormat.Create(Format);
5213     end;
5214
5215     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5216       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5217     SourceData := Data;
5218     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5219
5220     for Row := 0 to FileHeight-1 do begin
5221       TmpData := GetRowPointer(Row);
5222       if Assigned(TmpData) then begin
5223         Move(SourceData^, TmpData^, RowSize);
5224         inc(SourceData, RowSize);
5225       end;
5226     end;
5227     result := true;
5228   end;
5229 end;
5230
5231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5232 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5233 var
5234   pSource, pData, pTempData: PByte;
5235   Row, RowSize, TempWidth, TempHeight: Integer;
5236   IntFormat: TglBitmapFormat;
5237   fd: TFormatDescriptor;
5238   Mask: TglBitmapMask;
5239
5240   function GetRowPointer(Row: Integer): pByte;
5241   begin
5242     result := aSurface^.pixels;
5243     Inc(result, Row * RowSize);
5244   end;
5245
5246 begin
5247   result := false;
5248   if (Assigned(aSurface)) then begin
5249     with aSurface^.format^ do begin
5250       Mask.r := RMask;
5251       Mask.g := GMask;
5252       Mask.b := BMask;
5253       Mask.a := AMask;
5254       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5255       if (IntFormat = tfEmpty) then
5256         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5257     end;
5258
5259     fd := TFormatDescriptor.Get(IntFormat);
5260     TempWidth  := aSurface^.w;
5261     TempHeight := aSurface^.h;
5262     RowSize := fd.GetSize(TempWidth, 1);
5263     GetMem(pData, TempHeight * RowSize);
5264     try
5265       pTempData := pData;
5266       for Row := 0 to TempHeight -1 do begin
5267         pSource := GetRowPointer(Row);
5268         if (Assigned(pSource)) then begin
5269           Move(pSource^, pTempData^, RowSize);
5270           Inc(pTempData, RowSize);
5271         end;
5272       end;
5273       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5274       result := true;
5275     except
5276       if Assigned(pData) then
5277         FreeMem(pData);
5278       raise;
5279     end;
5280   end;
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5285 var
5286   Row, Col, AlphaInterleave: Integer;
5287   pSource, pDest: PByte;
5288
5289   function GetRowPointer(Row: Integer): pByte;
5290   begin
5291     result := aSurface.pixels;
5292     Inc(result, Row * Width);
5293   end;
5294
5295 begin
5296   result := false;
5297   if Assigned(Data) then begin
5298     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5299       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5300
5301       AlphaInterleave := 0;
5302       case Format of
5303         tfLuminance8Alpha8ub2:
5304           AlphaInterleave := 1;
5305         tfBGRA8ub4, tfRGBA8ub4:
5306           AlphaInterleave := 3;
5307       end;
5308
5309       pSource := Data;
5310       for Row := 0 to Height -1 do begin
5311         pDest := GetRowPointer(Row);
5312         if Assigned(pDest) then begin
5313           for Col := 0 to Width -1 do begin
5314             Inc(pSource, AlphaInterleave);
5315             pDest^ := pSource^;
5316             Inc(pDest);
5317             Inc(pSource);
5318           end;
5319         end;
5320       end;
5321       result := true;
5322     end;
5323   end;
5324 end;
5325
5326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5327 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5328 var
5329   bmp: TglBitmap2D;
5330 begin
5331   bmp := TglBitmap2D.Create;
5332   try
5333     bmp.AssignFromSurface(aSurface);
5334     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5335   finally
5336     bmp.Free;
5337   end;
5338 end;
5339 {$ENDIF}
5340
5341 {$IFDEF GLB_DELPHI}
5342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5343 function CreateGrayPalette: HPALETTE;
5344 var
5345   Idx: Integer;
5346   Pal: PLogPalette;
5347 begin
5348   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5349
5350   Pal.palVersion := $300;
5351   Pal.palNumEntries := 256;
5352
5353   for Idx := 0 to Pal.palNumEntries - 1 do begin
5354     Pal.palPalEntry[Idx].peRed   := Idx;
5355     Pal.palPalEntry[Idx].peGreen := Idx;
5356     Pal.palPalEntry[Idx].peBlue  := Idx;
5357     Pal.palPalEntry[Idx].peFlags := 0;
5358   end;
5359   Result := CreatePalette(Pal^);
5360   FreeMem(Pal);
5361 end;
5362
5363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5364 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5365 var
5366   Row: Integer;
5367   pSource, pData: PByte;
5368 begin
5369   result := false;
5370   if Assigned(Data) then begin
5371     if Assigned(aBitmap) then begin
5372       aBitmap.Width  := Width;
5373       aBitmap.Height := Height;
5374
5375       case Format of
5376         tfAlpha8ub1, tfLuminance8ub1: begin
5377           aBitmap.PixelFormat := pf8bit;
5378           aBitmap.Palette     := CreateGrayPalette;
5379         end;
5380         tfRGB5A1us1:
5381           aBitmap.PixelFormat := pf15bit;
5382         tfR5G6B5us1:
5383           aBitmap.PixelFormat := pf16bit;
5384         tfRGB8ub3, tfBGR8ub3:
5385           aBitmap.PixelFormat := pf24bit;
5386         tfRGBA8ub4, tfBGRA8ub4:
5387           aBitmap.PixelFormat := pf32bit;
5388       else
5389         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5390       end;
5391
5392       pSource := Data;
5393       for Row := 0 to FileHeight -1 do begin
5394         pData := aBitmap.Scanline[Row];
5395         Move(pSource^, pData^, fRowSize);
5396         Inc(pSource, fRowSize);
5397         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5398           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5399       end;
5400       result := true;
5401     end;
5402   end;
5403 end;
5404
5405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5406 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5407 var
5408   pSource, pData, pTempData: PByte;
5409   Row, RowSize, TempWidth, TempHeight: Integer;
5410   IntFormat: TglBitmapFormat;
5411 begin
5412   result := false;
5413
5414   if (Assigned(aBitmap)) then begin
5415     case aBitmap.PixelFormat of
5416       pf8bit:
5417         IntFormat := tfLuminance8ub1;
5418       pf15bit:
5419         IntFormat := tfRGB5A1us1;
5420       pf16bit:
5421         IntFormat := tfR5G6B5us1;
5422       pf24bit:
5423         IntFormat := tfBGR8ub3;
5424       pf32bit:
5425         IntFormat := tfBGRA8ub4;
5426     else
5427       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5428     end;
5429
5430     TempWidth  := aBitmap.Width;
5431     TempHeight := aBitmap.Height;
5432     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5433     GetMem(pData, TempHeight * RowSize);
5434     try
5435       pTempData := pData;
5436       for Row := 0 to TempHeight -1 do begin
5437         pSource := aBitmap.Scanline[Row];
5438         if (Assigned(pSource)) then begin
5439           Move(pSource^, pTempData^, RowSize);
5440           Inc(pTempData, RowSize);
5441         end;
5442       end;
5443       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5444       result := true;
5445     except
5446       if Assigned(pData) then
5447         FreeMem(pData);
5448       raise;
5449     end;
5450   end;
5451 end;
5452
5453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5454 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5455 var
5456   Row, Col, AlphaInterleave: Integer;
5457   pSource, pDest: PByte;
5458 begin
5459   result := false;
5460
5461   if Assigned(Data) then begin
5462     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5463       if Assigned(aBitmap) then begin
5464         aBitmap.PixelFormat := pf8bit;
5465         aBitmap.Palette     := CreateGrayPalette;
5466         aBitmap.Width       := Width;
5467         aBitmap.Height      := Height;
5468
5469         case Format of
5470           tfLuminance8Alpha8ub2:
5471             AlphaInterleave := 1;
5472           tfRGBA8ub4, tfBGRA8ub4:
5473             AlphaInterleave := 3;
5474           else
5475             AlphaInterleave := 0;
5476         end;
5477
5478         // Copy Data
5479         pSource := Data;
5480
5481         for Row := 0 to Height -1 do begin
5482           pDest := aBitmap.Scanline[Row];
5483           if Assigned(pDest) then begin
5484             for Col := 0 to Width -1 do begin
5485               Inc(pSource, AlphaInterleave);
5486               pDest^ := pSource^;
5487               Inc(pDest);
5488               Inc(pSource);
5489             end;
5490           end;
5491         end;
5492         result := true;
5493       end;
5494     end;
5495   end;
5496 end;
5497
5498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5499 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5500 var
5501   tex: TglBitmap2D;
5502 begin
5503   tex := TglBitmap2D.Create;
5504   try
5505     tex.AssignFromBitmap(ABitmap);
5506     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5507   finally
5508     tex.Free;
5509   end;
5510 end;
5511 {$ENDIF}
5512
5513 {$IFDEF GLB_LAZARUS}
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5516 var
5517   rid: TRawImageDescription;
5518   FormatDesc: TFormatDescriptor;
5519 begin
5520   if not Assigned(Data) then
5521     raise EglBitmap.Create('no pixel data assigned. load data before save');
5522
5523   result := false;
5524   if not Assigned(aImage) or (Format = tfEmpty) then
5525     exit;
5526   FormatDesc := TFormatDescriptor.Get(Format);
5527   if FormatDesc.IsCompressed then
5528     exit;
5529
5530   FillChar(rid{%H-}, SizeOf(rid), 0);
5531   if FormatDesc.IsGrayscale then
5532     rid.Format := ricfGray
5533   else
5534     rid.Format := ricfRGBA;
5535
5536   rid.Width        := Width;
5537   rid.Height       := Height;
5538   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
5539   rid.BitOrder     := riboBitsInOrder;
5540   rid.ByteOrder    := riboLSBFirst;
5541   rid.LineOrder    := riloTopToBottom;
5542   rid.LineEnd      := rileTight;
5543   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
5544   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5545   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5546   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5547   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5548   rid.RedShift     := FormatDesc.Shift.r;
5549   rid.GreenShift   := FormatDesc.Shift.g;
5550   rid.BlueShift    := FormatDesc.Shift.b;
5551   rid.AlphaShift   := FormatDesc.Shift.a;
5552
5553   rid.MaskBitsPerPixel  := 0;
5554   rid.PaletteColorCount := 0;
5555
5556   aImage.DataDescription := rid;
5557   aImage.CreateData;
5558
5559   if not Assigned(aImage.PixelData) then
5560     raise EglBitmap.Create('error while creating LazIntfImage');
5561   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5562
5563   result := true;
5564 end;
5565
5566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5567 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5568 var
5569   f: TglBitmapFormat;
5570   FormatDesc: TFormatDescriptor;
5571   ImageData: PByte;
5572   ImageSize: Integer;
5573   CanCopy: Boolean;
5574   Mask: TglBitmapMask;
5575
5576   procedure CopyConvert;
5577   var
5578     bfFormat: TbmpBitfieldFormat;
5579     pSourceLine, pDestLine: PByte;
5580     pSourceMD, pDestMD: Pointer;
5581     x, y: Integer;
5582     pixel: TglBitmapPixelData;
5583   begin
5584     bfFormat  := TbmpBitfieldFormat.Create;
5585     with aImage.DataDescription do begin
5586       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5587       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5588       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5589       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5590       bfFormat.PixelSize := BitsPerPixel / 8;
5591     end;
5592     pSourceMD := bfFormat.CreateMappingData;
5593     pDestMD   := FormatDesc.CreateMappingData;
5594     try
5595       for y := 0 to aImage.Height-1 do begin
5596         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5597         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5598         for x := 0 to aImage.Width-1 do begin
5599           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5600           FormatDesc.Map(pixel, pDestLine, pDestMD);
5601         end;
5602       end;
5603     finally
5604       FormatDesc.FreeMappingData(pDestMD);
5605       bfFormat.FreeMappingData(pSourceMD);
5606       bfFormat.Free;
5607     end;
5608   end;
5609
5610 begin
5611   result := false;
5612   if not Assigned(aImage) then
5613     exit;
5614
5615   with aImage.DataDescription do begin
5616     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5617     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5618     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5619     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5620   end;
5621   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5622   f          := FormatDesc.Format;
5623   if (f = tfEmpty) then
5624     exit;
5625
5626   CanCopy :=
5627     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5628     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5629
5630   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5631   ImageData := GetMem(ImageSize);
5632   try
5633     if CanCopy then
5634       Move(aImage.PixelData^, ImageData^, ImageSize)
5635     else
5636       CopyConvert;
5637     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5638   except
5639     if Assigned(ImageData) then
5640       FreeMem(ImageData);
5641     raise;
5642   end;
5643
5644   result := true;
5645 end;
5646
5647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5648 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5649 var
5650   rid: TRawImageDescription;
5651   FormatDesc: TFormatDescriptor;
5652   Pixel: TglBitmapPixelData;
5653   x, y: Integer;
5654   srcMD: Pointer;
5655   src, dst: PByte;
5656 begin
5657   result := false;
5658   if not Assigned(aImage) or (Format = tfEmpty) then
5659     exit;
5660   FormatDesc := TFormatDescriptor.Get(Format);
5661   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5662     exit;
5663
5664   FillChar(rid{%H-}, SizeOf(rid), 0);
5665   rid.Format       := ricfGray;
5666   rid.Width        := Width;
5667   rid.Height       := Height;
5668   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5669   rid.BitOrder     := riboBitsInOrder;
5670   rid.ByteOrder    := riboLSBFirst;
5671   rid.LineOrder    := riloTopToBottom;
5672   rid.LineEnd      := rileTight;
5673   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5674   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5675   rid.GreenPrec    := 0;
5676   rid.BluePrec     := 0;
5677   rid.AlphaPrec    := 0;
5678   rid.RedShift     := 0;
5679   rid.GreenShift   := 0;
5680   rid.BlueShift    := 0;
5681   rid.AlphaShift   := 0;
5682
5683   rid.MaskBitsPerPixel  := 0;
5684   rid.PaletteColorCount := 0;
5685
5686   aImage.DataDescription := rid;
5687   aImage.CreateData;
5688
5689   srcMD := FormatDesc.CreateMappingData;
5690   try
5691     FormatDesc.PreparePixel(Pixel);
5692     src := Data;
5693     dst := aImage.PixelData;
5694     for y := 0 to Height-1 do
5695       for x := 0 to Width-1 do begin
5696         FormatDesc.Unmap(src, Pixel, srcMD);
5697         case rid.BitsPerPixel of
5698            8: begin
5699             dst^ := Pixel.Data.a;
5700             inc(dst);
5701           end;
5702           16: begin
5703             PWord(dst)^ := Pixel.Data.a;
5704             inc(dst, 2);
5705           end;
5706           24: begin
5707             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5708             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5709             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5710             inc(dst, 3);
5711           end;
5712           32: begin
5713             PCardinal(dst)^ := Pixel.Data.a;
5714             inc(dst, 4);
5715           end;
5716         else
5717           raise EglBitmapUnsupportedFormat.Create(Format);
5718         end;
5719       end;
5720   finally
5721     FormatDesc.FreeMappingData(srcMD);
5722   end;
5723   result := true;
5724 end;
5725
5726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5727 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5728 var
5729   tex: TglBitmap2D;
5730 begin
5731   tex := TglBitmap2D.Create;
5732   try
5733     tex.AssignFromLazIntfImage(aImage);
5734     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5735   finally
5736     tex.Free;
5737   end;
5738 end;
5739 {$ENDIF}
5740
5741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5742 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5743   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5744 var
5745   rs: TResourceStream;
5746 begin
5747   PrepareResType(aResource, aResType);
5748   rs := TResourceStream.Create(aInstance, aResource, aResType);
5749   try
5750     result := AddAlphaFromStream(rs, aFunc, aArgs);
5751   finally
5752     rs.Free;
5753   end;
5754 end;
5755
5756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5757 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5758   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5759 var
5760   rs: TResourceStream;
5761 begin
5762   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5763   try
5764     result := AddAlphaFromStream(rs, aFunc, aArgs);
5765   finally
5766     rs.Free;
5767   end;
5768 end;
5769
5770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5771 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5772 begin
5773   if TFormatDescriptor.Get(Format).IsCompressed then
5774     raise EglBitmapUnsupportedFormat.Create(Format);
5775   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5776 end;
5777
5778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5779 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5780 var
5781   FS: TFileStream;
5782 begin
5783   FS := TFileStream.Create(aFileName, fmOpenRead);
5784   try
5785     result := AddAlphaFromStream(FS, aFunc, aArgs);
5786   finally
5787     FS.Free;
5788   end;
5789 end;
5790
5791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5792 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5793 var
5794   tex: TglBitmap2D;
5795 begin
5796   tex := TglBitmap2D.Create(aStream);
5797   try
5798     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5799   finally
5800     tex.Free;
5801   end;
5802 end;
5803
5804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5805 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5806 var
5807   DestData, DestData2, SourceData: pByte;
5808   TempHeight, TempWidth: Integer;
5809   SourceFD, DestFD: TFormatDescriptor;
5810   SourceMD, DestMD, DestMD2: Pointer;
5811
5812   FuncRec: TglBitmapFunctionRec;
5813 begin
5814   result := false;
5815
5816   Assert(Assigned(Data));
5817   Assert(Assigned(aBitmap));
5818   Assert(Assigned(aBitmap.Data));
5819
5820   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5821     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5822
5823     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5824     DestFD   := TFormatDescriptor.Get(Format);
5825
5826     if not Assigned(aFunc) then begin
5827       aFunc        := glBitmapAlphaFunc;
5828       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5829     end else
5830       FuncRec.Args := aArgs;
5831
5832     // Values
5833     TempHeight := aBitmap.FileHeight;
5834     TempWidth  := aBitmap.FileWidth;
5835
5836     FuncRec.Sender          := Self;
5837     FuncRec.Size            := Dimension;
5838     FuncRec.Position.Fields := FuncRec.Size.Fields;
5839
5840     DestData   := Data;
5841     DestData2  := Data;
5842     SourceData := aBitmap.Data;
5843
5844     // Mapping
5845     SourceFD.PreparePixel(FuncRec.Source);
5846     DestFD.PreparePixel  (FuncRec.Dest);
5847
5848     SourceMD := SourceFD.CreateMappingData;
5849     DestMD   := DestFD.CreateMappingData;
5850     DestMD2  := DestFD.CreateMappingData;
5851     try
5852       FuncRec.Position.Y := 0;
5853       while FuncRec.Position.Y < TempHeight do begin
5854         FuncRec.Position.X := 0;
5855         while FuncRec.Position.X < TempWidth do begin
5856           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5857           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5858           aFunc(FuncRec);
5859           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5860           inc(FuncRec.Position.X);
5861         end;
5862         inc(FuncRec.Position.Y);
5863       end;
5864     finally
5865       SourceFD.FreeMappingData(SourceMD);
5866       DestFD.FreeMappingData(DestMD);
5867       DestFD.FreeMappingData(DestMD2);
5868     end;
5869   end;
5870 end;
5871
5872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5873 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5874 begin
5875   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5876 end;
5877
5878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5879 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5880 var
5881   PixelData: TglBitmapPixelData;
5882 begin
5883   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5884   result := AddAlphaFromColorKeyFloat(
5885     aRed   / PixelData.Range.r,
5886     aGreen / PixelData.Range.g,
5887     aBlue  / PixelData.Range.b,
5888     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5889 end;
5890
5891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5892 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5893 var
5894   values: array[0..2] of Single;
5895   tmp: Cardinal;
5896   i: Integer;
5897   PixelData: TglBitmapPixelData;
5898 begin
5899   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5900   with PixelData do begin
5901     values[0] := aRed;
5902     values[1] := aGreen;
5903     values[2] := aBlue;
5904
5905     for i := 0 to 2 do begin
5906       tmp          := Trunc(Range.arr[i] * aDeviation);
5907       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5908       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5909     end;
5910     Data.a  := 0;
5911     Range.a := 0;
5912   end;
5913   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5914 end;
5915
5916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5917 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5918 begin
5919   result := AddAlphaFromValueFloat(aAlpha / $FF);
5920 end;
5921
5922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5923 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5924 var
5925   PixelData: TglBitmapPixelData;
5926 begin
5927   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5928   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5929 end;
5930
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5933 var
5934   PixelData: TglBitmapPixelData;
5935 begin
5936   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5937   with PixelData do
5938     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5939   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5940 end;
5941
5942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5943 function TglBitmap.RemoveAlpha: Boolean;
5944 var
5945   FormatDesc: TFormatDescriptor;
5946 begin
5947   result := false;
5948   FormatDesc := TFormatDescriptor.Get(Format);
5949   if Assigned(Data) then begin
5950     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5951       raise EglBitmapUnsupportedFormat.Create(Format);
5952     result := ConvertTo(FormatDesc.WithoutAlpha);
5953   end;
5954 end;
5955
5956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5957 function TglBitmap.Clone: TglBitmap;
5958 var
5959   Temp: TglBitmap;
5960   TempPtr: PByte;
5961   Size: Integer;
5962 begin
5963   result := nil;
5964   Temp := (ClassType.Create as TglBitmap);
5965   try
5966     // copy texture data if assigned
5967     if Assigned(Data) then begin
5968       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5969       GetMem(TempPtr, Size);
5970       try
5971         Move(Data^, TempPtr^, Size);
5972         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5973       except
5974         if Assigned(TempPtr) then
5975           FreeMem(TempPtr);
5976         raise;
5977       end;
5978     end else begin
5979       TempPtr := nil;
5980       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5981     end;
5982
5983         // copy properties
5984     Temp.fID                      := ID;
5985     Temp.fTarget                  := Target;
5986     Temp.fFormat                  := Format;
5987     Temp.fMipMap                  := MipMap;
5988     Temp.fAnisotropic             := Anisotropic;
5989     Temp.fBorderColor             := fBorderColor;
5990     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5991     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5992     Temp.fFilterMin               := fFilterMin;
5993     Temp.fFilterMag               := fFilterMag;
5994     Temp.fWrapS                   := fWrapS;
5995     Temp.fWrapT                   := fWrapT;
5996     Temp.fWrapR                   := fWrapR;
5997     Temp.fFilename                := fFilename;
5998     Temp.fCustomName              := fCustomName;
5999     Temp.fCustomNameW             := fCustomNameW;
6000     Temp.fCustomData              := fCustomData;
6001
6002     result := Temp;
6003   except
6004     FreeAndNil(Temp);
6005     raise;
6006   end;
6007 end;
6008
6009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6010 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6011 var
6012   SourceFD, DestFD: TFormatDescriptor;
6013   SourcePD, DestPD: TglBitmapPixelData;
6014   ShiftData: TShiftData;
6015
6016   function DataIsIdentical: Boolean;
6017   begin
6018     result :=
6019       (SourceFD.RedMask   = DestFD.RedMask)   and
6020       (SourceFD.GreenMask = DestFD.GreenMask) and
6021       (SourceFD.BlueMask  = DestFD.BlueMask)  and
6022       (SourceFD.AlphaMask = DestFD.AlphaMask);
6023   end;
6024
6025   function CanCopyDirect: Boolean;
6026   begin
6027     result :=
6028       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6029       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6030       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6031       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6032   end;
6033
6034   function CanShift: Boolean;
6035   begin
6036     result :=
6037       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6038       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6039       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6040       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6041   end;
6042
6043   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6044   begin
6045     result := 0;
6046     while (aSource > aDest) and (aSource > 0) do begin
6047       inc(result);
6048       aSource := aSource shr 1;
6049     end;
6050   end;
6051
6052 begin
6053   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6054     SourceFD := TFormatDescriptor.Get(Format);
6055     DestFD   := TFormatDescriptor.Get(aFormat);
6056
6057     if DataIsIdentical then begin
6058       result := true;
6059       Format := aFormat;
6060       exit;
6061     end;
6062
6063     SourceFD.PreparePixel(SourcePD);
6064     DestFD.PreparePixel  (DestPD);
6065
6066     if CanCopyDirect then
6067       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
6068     else if CanShift then begin
6069       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6070       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6071       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6072       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6073       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6074     end else
6075       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6076   end else
6077     result := true;
6078 end;
6079
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
6082 begin
6083   if aUseRGB or aUseAlpha then
6084     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
6085       ((Byte(aUseAlpha) and 1) shl 1) or
6086        (Byte(aUseRGB)   and 1)      ));
6087 end;
6088
6089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6090 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
6091 begin
6092   fBorderColor[0] := aRed;
6093   fBorderColor[1] := aGreen;
6094   fBorderColor[2] := aBlue;
6095   fBorderColor[3] := aAlpha;
6096   if (ID > 0) then begin
6097     Bind(false);
6098     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6099   end;
6100 end;
6101
6102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6103 procedure TglBitmap.FreeData;
6104 var
6105   TempPtr: PByte;
6106 begin
6107   TempPtr := nil;
6108   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
6109 end;
6110
6111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6112 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
6113   const aAlpha: Byte);
6114 begin
6115   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
6116 end;
6117
6118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6119 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
6120 var
6121   PixelData: TglBitmapPixelData;
6122 begin
6123   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6124   FillWithColorFloat(
6125     aRed   / PixelData.Range.r,
6126     aGreen / PixelData.Range.g,
6127     aBlue  / PixelData.Range.b,
6128     aAlpha / PixelData.Range.a);
6129 end;
6130
6131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6132 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
6133 var
6134   PixelData: TglBitmapPixelData;
6135 begin
6136   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6137   with PixelData do begin
6138     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6139     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6140     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6141     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6142   end;
6143   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6144 end;
6145
6146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6147 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6148 begin
6149   //check MIN filter
6150   case aMin of
6151     GL_NEAREST:
6152       fFilterMin := GL_NEAREST;
6153     GL_LINEAR:
6154       fFilterMin := GL_LINEAR;
6155     GL_NEAREST_MIPMAP_NEAREST:
6156       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6157     GL_LINEAR_MIPMAP_NEAREST:
6158       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6159     GL_NEAREST_MIPMAP_LINEAR:
6160       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6161     GL_LINEAR_MIPMAP_LINEAR:
6162       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6163     else
6164       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6165   end;
6166
6167   //check MAG filter
6168   case aMag of
6169     GL_NEAREST:
6170       fFilterMag := GL_NEAREST;
6171     GL_LINEAR:
6172       fFilterMag := GL_LINEAR;
6173     else
6174       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6175   end;
6176
6177   //apply filter
6178   if (ID > 0) then begin
6179     Bind(false);
6180     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6181
6182     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
6183       case fFilterMin of
6184         GL_NEAREST, GL_LINEAR:
6185           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6186         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6187           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6188         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6189           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6190       end;
6191     end else
6192       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6193   end;
6194 end;
6195
6196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6197 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6198
6199   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6200   begin
6201     case aValue of
6202       GL_CLAMP:
6203         aTarget := GL_CLAMP;
6204
6205       GL_REPEAT:
6206         aTarget := GL_REPEAT;
6207
6208       GL_CLAMP_TO_EDGE: begin
6209         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
6210           aTarget := GL_CLAMP_TO_EDGE
6211         else
6212           aTarget := GL_CLAMP;
6213       end;
6214
6215       GL_CLAMP_TO_BORDER: begin
6216         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6217           aTarget := GL_CLAMP_TO_BORDER
6218         else
6219           aTarget := GL_CLAMP;
6220       end;
6221
6222       GL_MIRRORED_REPEAT: begin
6223         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6224           aTarget := GL_MIRRORED_REPEAT
6225         else
6226           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6227       end;
6228     else
6229       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6230     end;
6231   end;
6232
6233 begin
6234   CheckAndSetWrap(S, fWrapS);
6235   CheckAndSetWrap(T, fWrapT);
6236   CheckAndSetWrap(R, fWrapR);
6237
6238   if (ID > 0) then begin
6239     Bind(false);
6240     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6241     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6242     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6243   end;
6244 end;
6245
6246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6247 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6248
6249   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6250   begin
6251     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6252        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6253       fSwizzle[aIndex] := aValue
6254     else
6255       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6256   end;
6257
6258 begin
6259   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6260     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6261   CheckAndSetValue(r, 0);
6262   CheckAndSetValue(g, 1);
6263   CheckAndSetValue(b, 2);
6264   CheckAndSetValue(a, 3);
6265
6266   if (ID > 0) then begin
6267     Bind(false);
6268     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6269   end;
6270 end;
6271
6272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6273 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6274 begin
6275   if aEnableTextureUnit then
6276     glEnable(Target);
6277   if (ID > 0) then
6278     glBindTexture(Target, ID);
6279 end;
6280
6281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6282 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6283 begin
6284   if aDisableTextureUnit then
6285     glDisable(Target);
6286   glBindTexture(Target, 0);
6287 end;
6288
6289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6290 constructor TglBitmap.Create;
6291 begin
6292   if (ClassType = TglBitmap) then
6293     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6294 {$IFDEF GLB_NATIVE_OGL}
6295   glbReadOpenGLExtensions;
6296 {$ENDIF}
6297   inherited Create;
6298   fFormat            := glBitmapGetDefaultFormat;
6299   fFreeDataOnDestroy := true;
6300 end;
6301
6302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6303 constructor TglBitmap.Create(const aFileName: String);
6304 begin
6305   Create;
6306   LoadFromFile(aFileName);
6307 end;
6308
6309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6310 constructor TglBitmap.Create(const aStream: TStream);
6311 begin
6312   Create;
6313   LoadFromStream(aStream);
6314 end;
6315
6316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6317 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6318 var
6319   ImageSize: Integer;
6320 begin
6321   Create;
6322   if not Assigned(aData) then begin
6323     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6324     GetMem(aData, ImageSize);
6325     try
6326       FillChar(aData^, ImageSize, #$FF);
6327       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6328     except
6329       if Assigned(aData) then
6330         FreeMem(aData);
6331       raise;
6332     end;
6333   end else begin
6334     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6335     fFreeDataOnDestroy := false;
6336   end;
6337 end;
6338
6339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6340 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6341 begin
6342   Create;
6343   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6344 end;
6345
6346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6347 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6348 begin
6349   Create;
6350   LoadFromResource(aInstance, aResource, aResType);
6351 end;
6352
6353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6354 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6355 begin
6356   Create;
6357   LoadFromResourceID(aInstance, aResourceID, aResType);
6358 end;
6359
6360 {$IFDEF GLB_SUPPORT_PNG_READ}
6361 {$IF DEFINED(GLB_LAZ_PNG)}
6362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6363 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6365 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6366 const
6367   MAGIC_LEN = 8;
6368   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6369 var
6370   reader: TLazReaderPNG;
6371   intf: TLazIntfImage;
6372   StreamPos: Int64;
6373   magic: String[MAGIC_LEN];
6374 begin
6375   result := true;
6376   StreamPos := aStream.Position;
6377
6378   SetLength(magic, MAGIC_LEN);
6379   aStream.Read(magic[1], MAGIC_LEN);
6380   aStream.Position := StreamPos;
6381   if (magic <> PNG_MAGIC) then begin
6382     result := false;
6383     exit;
6384   end;
6385
6386   intf   := TLazIntfImage.Create(0, 0);
6387   reader := TLazReaderPNG.Create;
6388   try try
6389     reader.UpdateDescription := true;
6390     reader.ImageRead(aStream, intf);
6391     AssignFromLazIntfImage(intf);
6392   except
6393     result := false;
6394     aStream.Position := StreamPos;
6395     exit;
6396   end;
6397   finally
6398     reader.Free;
6399     intf.Free;
6400   end;
6401 end;
6402
6403 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6405 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6406 var
6407   Surface: PSDL_Surface;
6408   RWops: PSDL_RWops;
6409 begin
6410   result := false;
6411   RWops := glBitmapCreateRWops(aStream);
6412   try
6413     if IMG_isPNG(RWops) > 0 then begin
6414       Surface := IMG_LoadPNG_RW(RWops);
6415       try
6416         AssignFromSurface(Surface);
6417         result := true;
6418       finally
6419         SDL_FreeSurface(Surface);
6420       end;
6421     end;
6422   finally
6423     SDL_FreeRW(RWops);
6424   end;
6425 end;
6426
6427 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6429 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6430 begin
6431   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6432 end;
6433
6434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6435 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6436 var
6437   StreamPos: Int64;
6438   signature: array [0..7] of byte;
6439   png: png_structp;
6440   png_info: png_infop;
6441
6442   TempHeight, TempWidth: Integer;
6443   Format: TglBitmapFormat;
6444
6445   png_data: pByte;
6446   png_rows: array of pByte;
6447   Row, LineSize: Integer;
6448 begin
6449   result := false;
6450
6451   if not init_libPNG then
6452     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6453
6454   try
6455     // signature
6456     StreamPos := aStream.Position;
6457     aStream.Read(signature{%H-}, 8);
6458     aStream.Position := StreamPos;
6459
6460     if png_check_sig(@signature, 8) <> 0 then begin
6461       // png read struct
6462       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6463       if png = nil then
6464         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6465
6466       // png info
6467       png_info := png_create_info_struct(png);
6468       if png_info = nil then begin
6469         png_destroy_read_struct(@png, nil, nil);
6470         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6471       end;
6472
6473       // set read callback
6474       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6475
6476       // read informations
6477       png_read_info(png, png_info);
6478
6479       // size
6480       TempHeight := png_get_image_height(png, png_info);
6481       TempWidth := png_get_image_width(png, png_info);
6482
6483       // format
6484       case png_get_color_type(png, png_info) of
6485         PNG_COLOR_TYPE_GRAY:
6486           Format := tfLuminance8ub1;
6487         PNG_COLOR_TYPE_GRAY_ALPHA:
6488           Format := tfLuminance8Alpha8us1;
6489         PNG_COLOR_TYPE_RGB:
6490           Format := tfRGB8ub3;
6491         PNG_COLOR_TYPE_RGB_ALPHA:
6492           Format := tfRGBA8ub4;
6493         else
6494           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6495       end;
6496
6497       // cut upper 8 bit from 16 bit formats
6498       if png_get_bit_depth(png, png_info) > 8 then
6499         png_set_strip_16(png);
6500
6501       // expand bitdepth smaller than 8
6502       if png_get_bit_depth(png, png_info) < 8 then
6503         png_set_expand(png);
6504
6505       // allocating mem for scanlines
6506       LineSize := png_get_rowbytes(png, png_info);
6507       GetMem(png_data, TempHeight * LineSize);
6508       try
6509         SetLength(png_rows, TempHeight);
6510         for Row := Low(png_rows) to High(png_rows) do begin
6511           png_rows[Row] := png_data;
6512           Inc(png_rows[Row], Row * LineSize);
6513         end;
6514
6515         // read complete image into scanlines
6516         png_read_image(png, @png_rows[0]);
6517
6518         // read end
6519         png_read_end(png, png_info);
6520
6521         // destroy read struct
6522         png_destroy_read_struct(@png, @png_info, nil);
6523
6524         SetLength(png_rows, 0);
6525
6526         // set new data
6527         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6528
6529         result := true;
6530       except
6531         if Assigned(png_data) then
6532           FreeMem(png_data);
6533         raise;
6534       end;
6535     end;
6536   finally
6537     quit_libPNG;
6538   end;
6539 end;
6540
6541 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6543 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6544 var
6545   StreamPos: Int64;
6546   Png: TPNGObject;
6547   Header: String[8];
6548   Row, Col, PixSize, LineSize: Integer;
6549   NewImage, pSource, pDest, pAlpha: pByte;
6550   PngFormat: TglBitmapFormat;
6551   FormatDesc: TFormatDescriptor;
6552
6553 const
6554   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6555
6556 begin
6557   result := false;
6558
6559   StreamPos := aStream.Position;
6560   aStream.Read(Header[0], SizeOf(Header));
6561   aStream.Position := StreamPos;
6562
6563   {Test if the header matches}
6564   if Header = PngHeader then begin
6565     Png := TPNGObject.Create;
6566     try
6567       Png.LoadFromStream(aStream);
6568
6569       case Png.Header.ColorType of
6570         COLOR_GRAYSCALE:
6571           PngFormat := tfLuminance8ub1;
6572         COLOR_GRAYSCALEALPHA:
6573           PngFormat := tfLuminance8Alpha8us1;
6574         COLOR_RGB:
6575           PngFormat := tfBGR8ub3;
6576         COLOR_RGBALPHA:
6577           PngFormat := tfBGRA8ub4;
6578         else
6579           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6580       end;
6581
6582       FormatDesc := TFormatDescriptor.Get(PngFormat);
6583       PixSize    := Round(FormatDesc.PixelSize);
6584       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6585
6586       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6587       try
6588         pDest := NewImage;
6589
6590         case Png.Header.ColorType of
6591           COLOR_RGB, COLOR_GRAYSCALE:
6592             begin
6593               for Row := 0 to Png.Height -1 do begin
6594                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6595                 Inc(pDest, LineSize);
6596               end;
6597             end;
6598           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6599             begin
6600               PixSize := PixSize -1;
6601
6602               for Row := 0 to Png.Height -1 do begin
6603                 pSource := Png.Scanline[Row];
6604                 pAlpha := pByte(Png.AlphaScanline[Row]);
6605
6606                 for Col := 0 to Png.Width -1 do begin
6607                   Move (pSource^, pDest^, PixSize);
6608                   Inc(pSource, PixSize);
6609                   Inc(pDest, PixSize);
6610
6611                   pDest^ := pAlpha^;
6612                   inc(pAlpha);
6613                   Inc(pDest);
6614                 end;
6615               end;
6616             end;
6617           else
6618             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6619         end;
6620
6621         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6622
6623         result := true;
6624       except
6625         if Assigned(NewImage) then
6626           FreeMem(NewImage);
6627         raise;
6628       end;
6629     finally
6630       Png.Free;
6631     end;
6632   end;
6633 end;
6634 {$IFEND}
6635 {$ENDIF}
6636
6637 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6638 {$IFDEF GLB_LIB_PNG}
6639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6640 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6641 begin
6642   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6643 end;
6644 {$ENDIF}
6645
6646 {$IF DEFINED(GLB_LAZ_PNG)}
6647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6648 procedure TglBitmap.SavePNG(const aStream: TStream);
6649 var
6650   png: TPortableNetworkGraphic;
6651   intf: TLazIntfImage;
6652   raw: TRawImage;
6653 begin
6654   png  := TPortableNetworkGraphic.Create;
6655   intf := TLazIntfImage.Create(0, 0);
6656   try
6657     if not AssignToLazIntfImage(intf) then
6658       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6659     intf.GetRawImage(raw);
6660     png.LoadFromRawImage(raw, false);
6661     png.SaveToStream(aStream);
6662   finally
6663     png.Free;
6664     intf.Free;
6665   end;
6666 end;
6667
6668 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6670 procedure TglBitmap.SavePNG(const aStream: TStream);
6671 var
6672   png: png_structp;
6673   png_info: png_infop;
6674   png_rows: array of pByte;
6675   LineSize: Integer;
6676   ColorType: Integer;
6677   Row: Integer;
6678   FormatDesc: TFormatDescriptor;
6679 begin
6680   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6681     raise EglBitmapUnsupportedFormat.Create(Format);
6682
6683   if not init_libPNG then
6684     raise Exception.Create('unable to initialize libPNG.');
6685
6686   try
6687     case Format of
6688       tfAlpha8ub1, tfLuminance8ub1:
6689         ColorType := PNG_COLOR_TYPE_GRAY;
6690       tfLuminance8Alpha8us1:
6691         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6692       tfBGR8ub3, tfRGB8ub3:
6693         ColorType := PNG_COLOR_TYPE_RGB;
6694       tfBGRA8ub4, tfRGBA8ub4:
6695         ColorType := PNG_COLOR_TYPE_RGBA;
6696       else
6697         raise EglBitmapUnsupportedFormat.Create(Format);
6698     end;
6699
6700     FormatDesc := TFormatDescriptor.Get(Format);
6701     LineSize := FormatDesc.GetSize(Width, 1);
6702
6703     // creating array for scanline
6704     SetLength(png_rows, Height);
6705     try
6706       for Row := 0 to Height - 1 do begin
6707         png_rows[Row] := Data;
6708         Inc(png_rows[Row], Row * LineSize)
6709       end;
6710
6711       // write struct
6712       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6713       if png = nil then
6714         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6715
6716       // create png info
6717       png_info := png_create_info_struct(png);
6718       if png_info = nil then begin
6719         png_destroy_write_struct(@png, nil);
6720         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6721       end;
6722
6723       // set read callback
6724       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6725
6726       // set compression
6727       png_set_compression_level(png, 6);
6728
6729       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6730         png_set_bgr(png);
6731
6732       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6733       png_write_info(png, png_info);
6734       png_write_image(png, @png_rows[0]);
6735       png_write_end(png, png_info);
6736       png_destroy_write_struct(@png, @png_info);
6737     finally
6738       SetLength(png_rows, 0);
6739     end;
6740   finally
6741     quit_libPNG;
6742   end;
6743 end;
6744
6745 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6747 procedure TglBitmap.SavePNG(const aStream: TStream);
6748 var
6749   Png: TPNGObject;
6750
6751   pSource, pDest: pByte;
6752   X, Y, PixSize: Integer;
6753   ColorType: Cardinal;
6754   Alpha: Boolean;
6755
6756   pTemp: pByte;
6757   Temp: Byte;
6758 begin
6759   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6760     raise EglBitmapUnsupportedFormat.Create(Format);
6761
6762   case Format of
6763     tfAlpha8ub1, tfLuminance8ub1: begin
6764       ColorType := COLOR_GRAYSCALE;
6765       PixSize   := 1;
6766       Alpha     := false;
6767     end;
6768     tfLuminance8Alpha8us1: begin
6769       ColorType := COLOR_GRAYSCALEALPHA;
6770       PixSize   := 1;
6771       Alpha     := true;
6772     end;
6773     tfBGR8ub3, tfRGB8ub3: begin
6774       ColorType := COLOR_RGB;
6775       PixSize   := 3;
6776       Alpha     := false;
6777     end;
6778     tfBGRA8ub4, tfRGBA8ub4: begin
6779       ColorType := COLOR_RGBALPHA;
6780       PixSize   := 3;
6781       Alpha     := true
6782     end;
6783   else
6784     raise EglBitmapUnsupportedFormat.Create(Format);
6785   end;
6786
6787   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6788   try
6789     // Copy ImageData
6790     pSource := Data;
6791     for Y := 0 to Height -1 do begin
6792       pDest := png.ScanLine[Y];
6793       for X := 0 to Width -1 do begin
6794         Move(pSource^, pDest^, PixSize);
6795         Inc(pDest, PixSize);
6796         Inc(pSource, PixSize);
6797         if Alpha then begin
6798           png.AlphaScanline[Y]^[X] := pSource^;
6799           Inc(pSource);
6800         end;
6801       end;
6802
6803       // convert RGB line to BGR
6804       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6805         pTemp := png.ScanLine[Y];
6806         for X := 0 to Width -1 do begin
6807           Temp := pByteArray(pTemp)^[0];
6808           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6809           pByteArray(pTemp)^[2] := Temp;
6810           Inc(pTemp, 3);
6811         end;
6812       end;
6813     end;
6814
6815     // Save to Stream
6816     Png.CompressionLevel := 6;
6817     Png.SaveToStream(aStream);
6818   finally
6819     FreeAndNil(Png);
6820   end;
6821 end;
6822 {$IFEND}
6823 {$ENDIF}
6824
6825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6826 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6828 {$IFDEF GLB_LIB_JPEG}
6829 type
6830   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6831   glBitmap_libJPEG_source_mgr = record
6832     pub: jpeg_source_mgr;
6833
6834     SrcStream: TStream;
6835     SrcBuffer: array [1..4096] of byte;
6836   end;
6837
6838   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6839   glBitmap_libJPEG_dest_mgr = record
6840     pub: jpeg_destination_mgr;
6841
6842     DestStream: TStream;
6843     DestBuffer: array [1..4096] of byte;
6844   end;
6845
6846 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6847 begin
6848   //DUMMY
6849 end;
6850
6851
6852 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6853 begin
6854   //DUMMY
6855 end;
6856
6857
6858 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6859 begin
6860   //DUMMY
6861 end;
6862
6863 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6864 begin
6865   //DUMMY
6866 end;
6867
6868
6869 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6870 begin
6871   //DUMMY
6872 end;
6873
6874
6875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6876 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6877 var
6878   src: glBitmap_libJPEG_source_mgr_ptr;
6879   bytes: integer;
6880 begin
6881   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6882
6883   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6884         if (bytes <= 0) then begin
6885                 src^.SrcBuffer[1] := $FF;
6886                 src^.SrcBuffer[2] := JPEG_EOI;
6887                 bytes := 2;
6888         end;
6889
6890         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6891         src^.pub.bytes_in_buffer := bytes;
6892
6893   result := true;
6894 end;
6895
6896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6897 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6898 var
6899   src: glBitmap_libJPEG_source_mgr_ptr;
6900 begin
6901   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6902
6903   if num_bytes > 0 then begin
6904     // wanted byte isn't in buffer so set stream position and read buffer
6905     if num_bytes > src^.pub.bytes_in_buffer then begin
6906       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6907       src^.pub.fill_input_buffer(cinfo);
6908     end else begin
6909       // wanted byte is in buffer so only skip
6910                 inc(src^.pub.next_input_byte, num_bytes);
6911                 dec(src^.pub.bytes_in_buffer, num_bytes);
6912     end;
6913   end;
6914 end;
6915
6916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6917 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6918 var
6919   dest: glBitmap_libJPEG_dest_mgr_ptr;
6920 begin
6921   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6922
6923   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6924     // write complete buffer
6925     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6926
6927     // reset buffer
6928     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6929     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6930   end;
6931
6932   result := true;
6933 end;
6934
6935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6936 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6937 var
6938   Idx: Integer;
6939   dest: glBitmap_libJPEG_dest_mgr_ptr;
6940 begin
6941   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6942
6943   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6944     // check for endblock
6945     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6946       // write endblock
6947       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6948
6949       // leave
6950       break;
6951     end else
6952       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6953   end;
6954 end;
6955 {$ENDIF}
6956
6957 {$IFDEF GLB_SUPPORT_JPEG_READ}
6958 {$IF DEFINED(GLB_LAZ_JPEG)}
6959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6960 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6961 const
6962   MAGIC_LEN = 2;
6963   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6964 var
6965   intf: TLazIntfImage;
6966   reader: TFPReaderJPEG;
6967   StreamPos: Int64;
6968   magic: String[MAGIC_LEN];
6969 begin
6970   result := true;
6971   StreamPos := aStream.Position;
6972
6973   SetLength(magic, MAGIC_LEN);
6974   aStream.Read(magic[1], MAGIC_LEN);
6975   aStream.Position := StreamPos;
6976   if (magic <> JPEG_MAGIC) then begin
6977     result := false;
6978     exit;
6979   end;
6980
6981   reader := TFPReaderJPEG.Create;
6982   intf := TLazIntfImage.Create(0, 0);
6983   try try
6984     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6985     reader.ImageRead(aStream, intf);
6986     AssignFromLazIntfImage(intf);
6987   except
6988     result := false;
6989     aStream.Position := StreamPos;
6990     exit;
6991   end;
6992   finally
6993     reader.Free;
6994     intf.Free;
6995   end;
6996 end;
6997
6998 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7000 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7001 var
7002   Surface: PSDL_Surface;
7003   RWops: PSDL_RWops;
7004 begin
7005   result := false;
7006
7007   RWops := glBitmapCreateRWops(aStream);
7008   try
7009     if IMG_isJPG(RWops) > 0 then begin
7010       Surface := IMG_LoadJPG_RW(RWops);
7011       try
7012         AssignFromSurface(Surface);
7013         result := true;
7014       finally
7015         SDL_FreeSurface(Surface);
7016       end;
7017     end;
7018   finally
7019     SDL_FreeRW(RWops);
7020   end;
7021 end;
7022
7023 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7025 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7026 var
7027   StreamPos: Int64;
7028   Temp: array[0..1]of Byte;
7029
7030   jpeg: jpeg_decompress_struct;
7031   jpeg_err: jpeg_error_mgr;
7032
7033   IntFormat: TglBitmapFormat;
7034   pImage: pByte;
7035   TempHeight, TempWidth: Integer;
7036
7037   pTemp: pByte;
7038   Row: Integer;
7039
7040   FormatDesc: TFormatDescriptor;
7041 begin
7042   result := false;
7043
7044   if not init_libJPEG then
7045     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
7046
7047   try
7048     // reading first two bytes to test file and set cursor back to begin
7049     StreamPos := aStream.Position;
7050     aStream.Read({%H-}Temp[0], 2);
7051     aStream.Position := StreamPos;
7052
7053     // if Bitmap then read file.
7054     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7055       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
7056       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7057
7058       // error managment
7059       jpeg.err := jpeg_std_error(@jpeg_err);
7060       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7061       jpeg_err.output_message := glBitmap_libJPEG_output_message;
7062
7063       // decompression struct
7064       jpeg_create_decompress(@jpeg);
7065
7066       // allocation space for streaming methods
7067       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
7068
7069       // seeting up custom functions
7070       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
7071         pub.init_source       := glBitmap_libJPEG_init_source;
7072         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
7073         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
7074         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
7075         pub.term_source       := glBitmap_libJPEG_term_source;
7076
7077         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
7078         pub.next_input_byte := nil;   // until buffer loaded
7079
7080         SrcStream := aStream;
7081       end;
7082
7083       // set global decoding state
7084       jpeg.global_state := DSTATE_START;
7085
7086       // read header of jpeg
7087       jpeg_read_header(@jpeg, false);
7088
7089       // setting output parameter
7090       case jpeg.jpeg_color_space of
7091         JCS_GRAYSCALE:
7092           begin
7093             jpeg.out_color_space := JCS_GRAYSCALE;
7094             IntFormat := tfLuminance8ub1;
7095           end;
7096         else
7097           jpeg.out_color_space := JCS_RGB;
7098           IntFormat := tfRGB8ub3;
7099       end;
7100
7101       // reading image
7102       jpeg_start_decompress(@jpeg);
7103
7104       TempHeight := jpeg.output_height;
7105       TempWidth := jpeg.output_width;
7106
7107       FormatDesc := TFormatDescriptor.Get(IntFormat);
7108
7109       // creating new image
7110       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
7111       try
7112         pTemp := pImage;
7113
7114         for Row := 0 to TempHeight -1 do begin
7115           jpeg_read_scanlines(@jpeg, @pTemp, 1);
7116           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
7117         end;
7118
7119         // finish decompression
7120         jpeg_finish_decompress(@jpeg);
7121
7122         // destroy decompression
7123         jpeg_destroy_decompress(@jpeg);
7124
7125         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7126
7127         result := true;
7128       except
7129         if Assigned(pImage) then
7130           FreeMem(pImage);
7131         raise;
7132       end;
7133     end;
7134   finally
7135     quit_libJPEG;
7136   end;
7137 end;
7138
7139 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7141 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7142 var
7143   bmp: TBitmap;
7144   jpg: TJPEGImage;
7145   StreamPos: Int64;
7146   Temp: array[0..1]of Byte;
7147 begin
7148   result := false;
7149
7150   // reading first two bytes to test file and set cursor back to begin
7151   StreamPos := aStream.Position;
7152   aStream.Read(Temp[0], 2);
7153   aStream.Position := StreamPos;
7154
7155   // if Bitmap then read file.
7156   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7157     bmp := TBitmap.Create;
7158     try
7159       jpg := TJPEGImage.Create;
7160       try
7161         jpg.LoadFromStream(aStream);
7162         bmp.Assign(jpg);
7163         result := AssignFromBitmap(bmp);
7164       finally
7165         jpg.Free;
7166       end;
7167     finally
7168       bmp.Free;
7169     end;
7170   end;
7171 end;
7172 {$IFEND}
7173 {$ENDIF}
7174
7175 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7176 {$IF DEFINED(GLB_LAZ_JPEG)}
7177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7178 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7179 var
7180   jpeg: TJPEGImage;
7181   intf: TLazIntfImage;
7182   raw: TRawImage;
7183 begin
7184   jpeg := TJPEGImage.Create;
7185   intf := TLazIntfImage.Create(0, 0);
7186   try
7187     if not AssignToLazIntfImage(intf) then
7188       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7189     intf.GetRawImage(raw);
7190     jpeg.LoadFromRawImage(raw, false);
7191     jpeg.SaveToStream(aStream);
7192   finally
7193     intf.Free;
7194     jpeg.Free;
7195   end;
7196 end;
7197
7198 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7200 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7201 var
7202   jpeg: jpeg_compress_struct;
7203   jpeg_err: jpeg_error_mgr;
7204   Row: Integer;
7205   pTemp, pTemp2: pByte;
7206
7207   procedure CopyRow(pDest, pSource: pByte);
7208   var
7209     X: Integer;
7210   begin
7211     for X := 0 to Width - 1 do begin
7212       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7213       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7214       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7215       Inc(pDest, 3);
7216       Inc(pSource, 3);
7217     end;
7218   end;
7219
7220 begin
7221   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7222     raise EglBitmapUnsupportedFormat.Create(Format);
7223
7224   if not init_libJPEG then
7225     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7226
7227   try
7228     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7229     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7230
7231     // error managment
7232     jpeg.err := jpeg_std_error(@jpeg_err);
7233     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7234     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7235
7236     // compression struct
7237     jpeg_create_compress(@jpeg);
7238
7239     // allocation space for streaming methods
7240     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7241
7242     // seeting up custom functions
7243     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7244       pub.init_destination    := glBitmap_libJPEG_init_destination;
7245       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7246       pub.term_destination    := glBitmap_libJPEG_term_destination;
7247
7248       pub.next_output_byte  := @DestBuffer[1];
7249       pub.free_in_buffer    := Length(DestBuffer);
7250
7251       DestStream := aStream;
7252     end;
7253
7254     // very important state
7255     jpeg.global_state := CSTATE_START;
7256     jpeg.image_width  := Width;
7257     jpeg.image_height := Height;
7258     case Format of
7259       tfAlpha8ub1, tfLuminance8ub1: begin
7260         jpeg.input_components := 1;
7261         jpeg.in_color_space   := JCS_GRAYSCALE;
7262       end;
7263       tfRGB8ub3, tfBGR8ub3: begin
7264         jpeg.input_components := 3;
7265         jpeg.in_color_space   := JCS_RGB;
7266       end;
7267     end;
7268
7269     jpeg_set_defaults(@jpeg);
7270     jpeg_set_quality(@jpeg, 95, true);
7271     jpeg_start_compress(@jpeg, true);
7272     pTemp := Data;
7273
7274     if Format = tfBGR8ub3 then
7275       GetMem(pTemp2, fRowSize)
7276     else
7277       pTemp2 := pTemp;
7278
7279     try
7280       for Row := 0 to jpeg.image_height -1 do begin
7281         // prepare row
7282         if Format = tfBGR8ub3 then
7283           CopyRow(pTemp2, pTemp)
7284         else
7285           pTemp2 := pTemp;
7286
7287         // write row
7288         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7289         inc(pTemp, fRowSize);
7290       end;
7291     finally
7292       // free memory
7293       if Format = tfBGR8ub3 then
7294         FreeMem(pTemp2);
7295     end;
7296     jpeg_finish_compress(@jpeg);
7297     jpeg_destroy_compress(@jpeg);
7298   finally
7299     quit_libJPEG;
7300   end;
7301 end;
7302
7303 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7305 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7306 var
7307   Bmp: TBitmap;
7308   Jpg: TJPEGImage;
7309 begin
7310   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7311     raise EglBitmapUnsupportedFormat.Create(Format);
7312
7313   Bmp := TBitmap.Create;
7314   try
7315     Jpg := TJPEGImage.Create;
7316     try
7317       AssignToBitmap(Bmp);
7318       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7319         Jpg.Grayscale   := true;
7320         Jpg.PixelFormat := jf8Bit;
7321       end;
7322       Jpg.Assign(Bmp);
7323       Jpg.SaveToStream(aStream);
7324     finally
7325       FreeAndNil(Jpg);
7326     end;
7327   finally
7328     FreeAndNil(Bmp);
7329   end;
7330 end;
7331 {$IFEND}
7332 {$ENDIF}
7333
7334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7335 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7337 const
7338   BMP_MAGIC          = $4D42;
7339
7340   BMP_COMP_RGB       = 0;
7341   BMP_COMP_RLE8      = 1;
7342   BMP_COMP_RLE4      = 2;
7343   BMP_COMP_BITFIELDS = 3;
7344
7345 type
7346   TBMPHeader = packed record
7347     bfType: Word;
7348     bfSize: Cardinal;
7349     bfReserved1: Word;
7350     bfReserved2: Word;
7351     bfOffBits: Cardinal;
7352   end;
7353
7354   TBMPInfo = packed record
7355     biSize: Cardinal;
7356     biWidth: Longint;
7357     biHeight: Longint;
7358     biPlanes: Word;
7359     biBitCount: Word;
7360     biCompression: Cardinal;
7361     biSizeImage: Cardinal;
7362     biXPelsPerMeter: Longint;
7363     biYPelsPerMeter: Longint;
7364     biClrUsed: Cardinal;
7365     biClrImportant: Cardinal;
7366   end;
7367
7368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7369 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7370
7371   //////////////////////////////////////////////////////////////////////////////////////////////////
7372   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapMask): TglBitmapFormat;
7373   begin
7374     result := tfEmpty;
7375     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7376     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7377
7378     //Read Compression
7379     case aInfo.biCompression of
7380       BMP_COMP_RLE4,
7381       BMP_COMP_RLE8: begin
7382         raise EglBitmap.Create('RLE compression is not supported');
7383       end;
7384       BMP_COMP_BITFIELDS: begin
7385         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7386           aStream.Read(aMask.r, SizeOf(aMask.r));
7387           aStream.Read(aMask.g, SizeOf(aMask.g));
7388           aStream.Read(aMask.b, SizeOf(aMask.b));
7389           aStream.Read(aMask.a, SizeOf(aMask.a));
7390         end else
7391           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7392       end;
7393     end;
7394
7395     //get suitable format
7396     case aInfo.biBitCount of
7397        8: result := tfLuminance8ub1;
7398       16: result := tfX1RGB5us1;
7399       24: result := tfBGR8ub3;
7400       32: result := tfXRGB8ui1;
7401     end;
7402   end;
7403
7404   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7405   var
7406     i, c: Integer;
7407     ColorTable: TbmpColorTable;
7408   begin
7409     result := nil;
7410     if (aInfo.biBitCount >= 16) then
7411       exit;
7412     aFormat := tfLuminance8ub1;
7413     c := aInfo.biClrUsed;
7414     if (c = 0) then
7415       c := 1 shl aInfo.biBitCount;
7416     SetLength(ColorTable, c);
7417     for i := 0 to c-1 do begin
7418       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7419       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7420         aFormat := tfRGB8ub3;
7421     end;
7422
7423     result := TbmpColorTableFormat.Create;
7424     result.PixelSize  := aInfo.biBitCount / 8;
7425     result.ColorTable := ColorTable;
7426     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
7427   end;
7428
7429   //////////////////////////////////////////////////////////////////////////////////////////////////
7430   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapMask; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7431   var
7432     FormatDesc: TFormatDescriptor;
7433   begin
7434     result := nil;
7435     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7436       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7437       if (FormatDesc.Format = tfEmpty) then
7438         exit;
7439       aFormat := FormatDesc.Format;
7440       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7441         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7442       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7443         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7444
7445       result := TbmpBitfieldFormat.Create;
7446       result.PixelSize := aInfo.biBitCount / 8;
7447       result.RedMask   := aMask.r;
7448       result.GreenMask := aMask.g;
7449       result.BlueMask  := aMask.b;
7450       result.AlphaMask := aMask.a;
7451     end;
7452   end;
7453
7454 var
7455   //simple types
7456   StartPos: Int64;
7457   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7458   PaddingBuff: Cardinal;
7459   LineBuf, ImageData, TmpData: PByte;
7460   SourceMD, DestMD: Pointer;
7461   BmpFormat: TglBitmapFormat;
7462
7463   //records
7464   Mask: TglBitmapMask;
7465   Header: TBMPHeader;
7466   Info: TBMPInfo;
7467
7468   //classes
7469   SpecialFormat: TFormatDescriptor;
7470   FormatDesc: TFormatDescriptor;
7471
7472   //////////////////////////////////////////////////////////////////////////////////////////////////
7473   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7474   var
7475     i: Integer;
7476     Pixel: TglBitmapPixelData;
7477   begin
7478     aStream.Read(aLineBuf^, rbLineSize);
7479     SpecialFormat.PreparePixel(Pixel);
7480     for i := 0 to Info.biWidth-1 do begin
7481       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7482       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7483       FormatDesc.Map(Pixel, aData, DestMD);
7484     end;
7485   end;
7486
7487 begin
7488   result        := false;
7489   BmpFormat     := tfEmpty;
7490   SpecialFormat := nil;
7491   LineBuf       := nil;
7492   SourceMD      := nil;
7493   DestMD        := nil;
7494
7495   // Header
7496   StartPos := aStream.Position;
7497   aStream.Read(Header{%H-}, SizeOf(Header));
7498
7499   if Header.bfType = BMP_MAGIC then begin
7500     try try
7501       BmpFormat        := ReadInfo(Info, Mask);
7502       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7503       if not Assigned(SpecialFormat) then
7504         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7505       aStream.Position := StartPos + Header.bfOffBits;
7506
7507       if (BmpFormat <> tfEmpty) then begin
7508         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7509         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7510         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
7511         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7512
7513         //get Memory
7514         DestMD    := FormatDesc.CreateMappingData;
7515         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7516         GetMem(ImageData, ImageSize);
7517         if Assigned(SpecialFormat) then begin
7518           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7519           SourceMD := SpecialFormat.CreateMappingData;
7520         end;
7521
7522         //read Data
7523         try try
7524           FillChar(ImageData^, ImageSize, $FF);
7525           TmpData := ImageData;
7526           if (Info.biHeight > 0) then
7527             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7528           for i := 0 to Abs(Info.biHeight)-1 do begin
7529             if Assigned(SpecialFormat) then
7530               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7531             else
7532               aStream.Read(TmpData^, wbLineSize);   //else only read data
7533             if (Info.biHeight > 0) then
7534               dec(TmpData, wbLineSize)
7535             else
7536               inc(TmpData, wbLineSize);
7537             aStream.Read(PaddingBuff{%H-}, Padding);
7538           end;
7539           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7540           result := true;
7541         finally
7542           if Assigned(LineBuf) then
7543             FreeMem(LineBuf);
7544           if Assigned(SourceMD) then
7545             SpecialFormat.FreeMappingData(SourceMD);
7546           FormatDesc.FreeMappingData(DestMD);
7547         end;
7548         except
7549           if Assigned(ImageData) then
7550             FreeMem(ImageData);
7551           raise;
7552         end;
7553       end else
7554         raise EglBitmap.Create('LoadBMP - No suitable format found');
7555     except
7556       aStream.Position := StartPos;
7557       raise;
7558     end;
7559     finally
7560       FreeAndNil(SpecialFormat);
7561     end;
7562   end
7563     else aStream.Position := StartPos;
7564 end;
7565
7566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7567 procedure TglBitmap.SaveBMP(const aStream: TStream);
7568 var
7569   Header: TBMPHeader;
7570   Info: TBMPInfo;
7571   Converter: TFormatDescriptor;
7572   FormatDesc: TFormatDescriptor;
7573   SourceFD, DestFD: Pointer;
7574   pData, srcData, dstData, ConvertBuffer: pByte;
7575
7576   Pixel: TglBitmapPixelData;
7577   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7578   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7579
7580   PaddingBuff: Cardinal;
7581
7582   function GetLineWidth : Integer;
7583   begin
7584     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7585   end;
7586
7587 begin
7588   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7589     raise EglBitmapUnsupportedFormat.Create(Format);
7590
7591   Converter  := nil;
7592   FormatDesc := TFormatDescriptor.Get(Format);
7593   ImageSize  := FormatDesc.GetSize(Dimension);
7594
7595   FillChar(Header{%H-}, SizeOf(Header), 0);
7596   Header.bfType      := BMP_MAGIC;
7597   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7598   Header.bfReserved1 := 0;
7599   Header.bfReserved2 := 0;
7600   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7601
7602   FillChar(Info{%H-}, SizeOf(Info), 0);
7603   Info.biSize        := SizeOf(Info);
7604   Info.biWidth       := Width;
7605   Info.biHeight      := Height;
7606   Info.biPlanes      := 1;
7607   Info.biCompression := BMP_COMP_RGB;
7608   Info.biSizeImage   := ImageSize;
7609
7610   try
7611     case Format of
7612       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7613       begin
7614         Info.biBitCount  :=  8;
7615         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7616         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7617         Converter := TbmpColorTableFormat.Create;
7618         with (Converter as TbmpColorTableFormat) do begin
7619           PixelSize := 1;
7620           Format    := fFormat;
7621           Range     := FormatDesc.Range;
7622           Shift     := FormatDesc.Shift;
7623           CreateColorTable;
7624         end;
7625       end;
7626
7627       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7628       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7629       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7630       begin
7631         Info.biBitCount    := 16;
7632         Info.biCompression := BMP_COMP_BITFIELDS;
7633       end;
7634
7635       tfBGR8ub3, tfRGB8ub3:
7636       begin
7637         Info.biBitCount := 24;
7638         if (Format = tfRGB8ub3) then
7639           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7640       end;
7641
7642       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7643       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7644       begin
7645         Info.biBitCount    := 32;
7646         Info.biCompression := BMP_COMP_BITFIELDS;
7647       end;
7648     else
7649       raise EglBitmapUnsupportedFormat.Create(Format);
7650     end;
7651     Info.biXPelsPerMeter := 2835;
7652     Info.biYPelsPerMeter := 2835;
7653
7654     // prepare bitmasks
7655     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7656       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7657       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7658
7659       RedMask    := FormatDesc.RedMask;
7660       GreenMask  := FormatDesc.GreenMask;
7661       BlueMask   := FormatDesc.BlueMask;
7662       AlphaMask  := FormatDesc.AlphaMask;
7663     end;
7664
7665     // headers
7666     aStream.Write(Header, SizeOf(Header));
7667     aStream.Write(Info, SizeOf(Info));
7668
7669     // colortable
7670     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7671       with (Converter as TbmpColorTableFormat) do
7672         aStream.Write(ColorTable[0].b,
7673           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7674
7675     // bitmasks
7676     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7677       aStream.Write(RedMask,   SizeOf(Cardinal));
7678       aStream.Write(GreenMask, SizeOf(Cardinal));
7679       aStream.Write(BlueMask,  SizeOf(Cardinal));
7680       aStream.Write(AlphaMask, SizeOf(Cardinal));
7681     end;
7682
7683     // image data
7684     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7685     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7686     Padding     := GetLineWidth - wbLineSize;
7687     PaddingBuff := 0;
7688
7689     pData := Data;
7690     inc(pData, (Height-1) * rbLineSize);
7691
7692     // prepare row buffer. But only for RGB because RGBA supports color masks
7693     // so it's possible to change color within the image.
7694     if Assigned(Converter) then begin
7695       FormatDesc.PreparePixel(Pixel);
7696       GetMem(ConvertBuffer, wbLineSize);
7697       SourceFD := FormatDesc.CreateMappingData;
7698       DestFD   := Converter.CreateMappingData;
7699     end else
7700       ConvertBuffer := nil;
7701
7702     try
7703       for LineIdx := 0 to Height - 1 do begin
7704         // preparing row
7705         if Assigned(Converter) then begin
7706           srcData := pData;
7707           dstData := ConvertBuffer;
7708           for PixelIdx := 0 to Info.biWidth-1 do begin
7709             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7710             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7711             Converter.Map(Pixel, dstData, DestFD);
7712           end;
7713           aStream.Write(ConvertBuffer^, wbLineSize);
7714         end else begin
7715           aStream.Write(pData^, rbLineSize);
7716         end;
7717         dec(pData, rbLineSize);
7718         if (Padding > 0) then
7719           aStream.Write(PaddingBuff, Padding);
7720       end;
7721     finally
7722       // destroy row buffer
7723       if Assigned(ConvertBuffer) then begin
7724         FormatDesc.FreeMappingData(SourceFD);
7725         Converter.FreeMappingData(DestFD);
7726         FreeMem(ConvertBuffer);
7727       end;
7728     end;
7729   finally
7730     if Assigned(Converter) then
7731       Converter.Free;
7732   end;
7733 end;
7734
7735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7736 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7738 type
7739   TTGAHeader = packed record
7740     ImageID: Byte;
7741     ColorMapType: Byte;
7742     ImageType: Byte;
7743     //ColorMapSpec: Array[0..4] of Byte;
7744     ColorMapStart: Word;
7745     ColorMapLength: Word;
7746     ColorMapEntrySize: Byte;
7747     OrigX: Word;
7748     OrigY: Word;
7749     Width: Word;
7750     Height: Word;
7751     Bpp: Byte;
7752     ImageDesc: Byte;
7753   end;
7754
7755 const
7756   TGA_UNCOMPRESSED_RGB  =  2;
7757   TGA_UNCOMPRESSED_GRAY =  3;
7758   TGA_COMPRESSED_RGB    = 10;
7759   TGA_COMPRESSED_GRAY   = 11;
7760
7761   TGA_NONE_COLOR_TABLE  = 0;
7762
7763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7764 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7765 var
7766   Header: TTGAHeader;
7767   ImageData: System.PByte;
7768   StartPosition: Int64;
7769   PixelSize, LineSize: Integer;
7770   tgaFormat: TglBitmapFormat;
7771   FormatDesc: TFormatDescriptor;
7772   Counter: packed record
7773     X, Y: packed record
7774       low, high, dir: Integer;
7775     end;
7776   end;
7777
7778 const
7779   CACHE_SIZE = $4000;
7780
7781   ////////////////////////////////////////////////////////////////////////////////////////
7782   procedure ReadUncompressed;
7783   var
7784     i, j: Integer;
7785     buf, tmp1, tmp2: System.PByte;
7786   begin
7787     buf := nil;
7788     if (Counter.X.dir < 0) then
7789       GetMem(buf, LineSize);
7790     try
7791       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7792         tmp1 := ImageData;
7793         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7794         if (Counter.X.dir < 0) then begin               //flip X
7795           aStream.Read(buf^, LineSize);
7796           tmp2 := buf;
7797           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7798           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7799             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7800               tmp1^ := tmp2^;
7801               inc(tmp1);
7802               inc(tmp2);
7803             end;
7804             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7805           end;
7806         end else
7807           aStream.Read(tmp1^, LineSize);
7808         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7809       end;
7810     finally
7811       if Assigned(buf) then
7812         FreeMem(buf);
7813     end;
7814   end;
7815
7816   ////////////////////////////////////////////////////////////////////////////////////////
7817   procedure ReadCompressed;
7818
7819     /////////////////////////////////////////////////////////////////
7820     var
7821       TmpData: System.PByte;
7822       LinePixelsRead: Integer;
7823     procedure CheckLine;
7824     begin
7825       if (LinePixelsRead >= Header.Width) then begin
7826         LinePixelsRead := 0;
7827         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7828         TmpData := ImageData;
7829         inc(TmpData, Counter.Y.low * LineSize);           //set line
7830         if (Counter.X.dir < 0) then                       //if x flipped then
7831           inc(TmpData, LineSize - PixelSize);             //set last pixel
7832       end;
7833     end;
7834
7835     /////////////////////////////////////////////////////////////////
7836     var
7837       Cache: PByte;
7838       CacheSize, CachePos: Integer;
7839     procedure CachedRead(out Buffer; Count: Integer);
7840     var
7841       BytesRead: Integer;
7842     begin
7843       if (CachePos + Count > CacheSize) then begin
7844         //if buffer overflow save non read bytes
7845         BytesRead := 0;
7846         if (CacheSize - CachePos > 0) then begin
7847           BytesRead := CacheSize - CachePos;
7848           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7849           inc(CachePos, BytesRead);
7850         end;
7851
7852         //load cache from file
7853         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7854         aStream.Read(Cache^, CacheSize);
7855         CachePos := 0;
7856
7857         //read rest of requested bytes
7858         if (Count - BytesRead > 0) then begin
7859           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7860           inc(CachePos, Count - BytesRead);
7861         end;
7862       end else begin
7863         //if no buffer overflow just read the data
7864         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7865         inc(CachePos, Count);
7866       end;
7867     end;
7868
7869     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7870     begin
7871       case PixelSize of
7872         1: begin
7873           aBuffer^ := aData^;
7874           inc(aBuffer, Counter.X.dir);
7875         end;
7876         2: begin
7877           PWord(aBuffer)^ := PWord(aData)^;
7878           inc(aBuffer, 2 * Counter.X.dir);
7879         end;
7880         3: begin
7881           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7882           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7883           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7884           inc(aBuffer, 3 * Counter.X.dir);
7885         end;
7886         4: begin
7887           PCardinal(aBuffer)^ := PCardinal(aData)^;
7888           inc(aBuffer, 4 * Counter.X.dir);
7889         end;
7890       end;
7891     end;
7892
7893   var
7894     TotalPixelsToRead, TotalPixelsRead: Integer;
7895     Temp: Byte;
7896     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7897     PixelRepeat: Boolean;
7898     PixelsToRead, PixelCount: Integer;
7899   begin
7900     CacheSize := 0;
7901     CachePos  := 0;
7902
7903     TotalPixelsToRead := Header.Width * Header.Height;
7904     TotalPixelsRead   := 0;
7905     LinePixelsRead    := 0;
7906
7907     GetMem(Cache, CACHE_SIZE);
7908     try
7909       TmpData := ImageData;
7910       inc(TmpData, Counter.Y.low * LineSize);           //set line
7911       if (Counter.X.dir < 0) then                       //if x flipped then
7912         inc(TmpData, LineSize - PixelSize);             //set last pixel
7913
7914       repeat
7915         //read CommandByte
7916         CachedRead(Temp, 1);
7917         PixelRepeat  := (Temp and $80) > 0;
7918         PixelsToRead := (Temp and $7F) + 1;
7919         inc(TotalPixelsRead, PixelsToRead);
7920
7921         if PixelRepeat then
7922           CachedRead(buf[0], PixelSize);
7923         while (PixelsToRead > 0) do begin
7924           CheckLine;
7925           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7926           while (PixelCount > 0) do begin
7927             if not PixelRepeat then
7928               CachedRead(buf[0], PixelSize);
7929             PixelToBuffer(@buf[0], TmpData);
7930             inc(LinePixelsRead);
7931             dec(PixelsToRead);
7932             dec(PixelCount);
7933           end;
7934         end;
7935       until (TotalPixelsRead >= TotalPixelsToRead);
7936     finally
7937       FreeMem(Cache);
7938     end;
7939   end;
7940
7941   function IsGrayFormat: Boolean;
7942   begin
7943     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7944   end;
7945
7946 begin
7947   result := false;
7948
7949   // reading header to test file and set cursor back to begin
7950   StartPosition := aStream.Position;
7951   aStream.Read(Header{%H-}, SizeOf(Header));
7952
7953   // no colormapped files
7954   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7955     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7956   begin
7957     try
7958       if Header.ImageID <> 0 then       // skip image ID
7959         aStream.Position := aStream.Position + Header.ImageID;
7960
7961       tgaFormat := tfEmpty;
7962       case Header.Bpp of
7963          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7964                0: tgaFormat := tfLuminance8ub1;
7965                8: tgaFormat := tfAlpha8ub1;
7966             end;
7967
7968         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7969                0: tgaFormat := tfLuminance16us1;
7970                8: tgaFormat := tfLuminance8Alpha8ub2;
7971             end else case (Header.ImageDesc and $F) of
7972                0: tgaFormat := tfX1RGB5us1;
7973                1: tgaFormat := tfA1RGB5us1;
7974                4: tgaFormat := tfARGB4us1;
7975             end;
7976
7977         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7978                0: tgaFormat := tfBGR8ub3;
7979             end;
7980
7981         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7982                0: tgaFormat := tfDepth32ui1;
7983             end else case (Header.ImageDesc and $F) of
7984                0: tgaFormat := tfX2RGB10ui1;
7985                2: tgaFormat := tfA2RGB10ui1;
7986                8: tgaFormat := tfARGB8ui1;
7987             end;
7988       end;
7989
7990       if (tgaFormat = tfEmpty) then
7991         raise EglBitmap.Create('LoadTga - unsupported format');
7992
7993       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7994       PixelSize  := FormatDesc.GetSize(1, 1);
7995       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7996
7997       GetMem(ImageData, LineSize * Header.Height);
7998       try
7999         //column direction
8000         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
8001           Counter.X.low  := Header.Height-1;;
8002           Counter.X.high := 0;
8003           Counter.X.dir  := -1;
8004         end else begin
8005           Counter.X.low  := 0;
8006           Counter.X.high := Header.Height-1;
8007           Counter.X.dir  := 1;
8008         end;
8009
8010         // Row direction
8011         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
8012           Counter.Y.low  := 0;
8013           Counter.Y.high := Header.Height-1;
8014           Counter.Y.dir  := 1;
8015         end else begin
8016           Counter.Y.low  := Header.Height-1;;
8017           Counter.Y.high := 0;
8018           Counter.Y.dir  := -1;
8019         end;
8020
8021         // Read Image
8022         case Header.ImageType of
8023           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
8024             ReadUncompressed;
8025           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
8026             ReadCompressed;
8027         end;
8028
8029         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
8030         result := true;
8031       except
8032         if Assigned(ImageData) then
8033           FreeMem(ImageData);
8034         raise;
8035       end;
8036     finally
8037       aStream.Position := StartPosition;
8038     end;
8039   end
8040     else aStream.Position := StartPosition;
8041 end;
8042
8043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8044 procedure TglBitmap.SaveTGA(const aStream: TStream);
8045 var
8046   Header: TTGAHeader;
8047   Size: Integer;
8048   FormatDesc: TFormatDescriptor;
8049 begin
8050   if not (ftTGA in FormatGetSupportedFiles(Format)) then
8051     raise EglBitmapUnsupportedFormat.Create(Format);
8052
8053   //prepare header
8054   FormatDesc := TFormatDescriptor.Get(Format);
8055   FillChar(Header{%H-}, SizeOf(Header), 0);
8056   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
8057   Header.Bpp       := Trunc(8 * FormatDesc.PixelSize);
8058   Header.Width     := Width;
8059   Header.Height    := Height;
8060   Header.ImageDesc := Header.ImageDesc or $20; //flip y
8061   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
8062     Header.ImageType := TGA_UNCOMPRESSED_GRAY
8063   else
8064     Header.ImageType := TGA_UNCOMPRESSED_RGB;
8065   aStream.Write(Header, SizeOf(Header));
8066
8067   // write Data
8068   Size := FormatDesc.GetSize(Dimension);
8069   aStream.Write(Data^, Size);
8070 end;
8071
8072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8075 const
8076   DDS_MAGIC: Cardinal         = $20534444;
8077
8078   // DDS_header.dwFlags
8079   DDSD_CAPS                   = $00000001;
8080   DDSD_HEIGHT                 = $00000002;
8081   DDSD_WIDTH                  = $00000004;
8082   DDSD_PIXELFORMAT            = $00001000;
8083
8084   // DDS_header.sPixelFormat.dwFlags
8085   DDPF_ALPHAPIXELS            = $00000001;
8086   DDPF_ALPHA                  = $00000002;
8087   DDPF_FOURCC                 = $00000004;
8088   DDPF_RGB                    = $00000040;
8089   DDPF_LUMINANCE              = $00020000;
8090
8091   // DDS_header.sCaps.dwCaps1
8092   DDSCAPS_TEXTURE             = $00001000;
8093
8094   // DDS_header.sCaps.dwCaps2
8095   DDSCAPS2_CUBEMAP            = $00000200;
8096
8097   D3DFMT_DXT1                 = $31545844;
8098   D3DFMT_DXT3                 = $33545844;
8099   D3DFMT_DXT5                 = $35545844;
8100
8101 type
8102   TDDSPixelFormat = packed record
8103     dwSize: Cardinal;
8104     dwFlags: Cardinal;
8105     dwFourCC: Cardinal;
8106     dwRGBBitCount: Cardinal;
8107     dwRBitMask: Cardinal;
8108     dwGBitMask: Cardinal;
8109     dwBBitMask: Cardinal;
8110     dwABitMask: Cardinal;
8111   end;
8112
8113   TDDSCaps = packed record
8114     dwCaps1: Cardinal;
8115     dwCaps2: Cardinal;
8116     dwDDSX: Cardinal;
8117     dwReserved: Cardinal;
8118   end;
8119
8120   TDDSHeader = packed record
8121     dwSize: Cardinal;
8122     dwFlags: Cardinal;
8123     dwHeight: Cardinal;
8124     dwWidth: Cardinal;
8125     dwPitchOrLinearSize: Cardinal;
8126     dwDepth: Cardinal;
8127     dwMipMapCount: Cardinal;
8128     dwReserved: array[0..10] of Cardinal;
8129     PixelFormat: TDDSPixelFormat;
8130     Caps: TDDSCaps;
8131     dwReserved2: Cardinal;
8132   end;
8133
8134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8135 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8136 var
8137   Header: TDDSHeader;
8138   Converter: TbmpBitfieldFormat;
8139
8140   function GetDDSFormat: TglBitmapFormat;
8141   var
8142     fd: TFormatDescriptor;
8143     i: Integer;
8144     Mask: TglBitmapMask;
8145     Range: TglBitmapColorRec;
8146     match: Boolean;
8147   begin
8148     result := tfEmpty;
8149     with Header.PixelFormat do begin
8150       // Compresses
8151       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8152         case Header.PixelFormat.dwFourCC of
8153           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8154           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8155           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8156         end;
8157       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
8158         // prepare masks
8159         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8160           Mask.r := dwRBitMask;
8161           Mask.g := dwGBitMask;
8162           Mask.b := dwBBitMask;
8163         end else begin
8164           Mask.r := dwRBitMask;
8165           Mask.g := dwRBitMask;
8166           Mask.b := dwRBitMask;
8167         end;
8168         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
8169           Mask.a := dwABitMask
8170         else
8171           Mask.a := 0;;
8172
8173         //find matching format
8174         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
8175         result := fd.Format;
8176         if (result <> tfEmpty) then
8177           exit;
8178
8179         //find format with same Range
8180         for i := 0 to 3 do
8181           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
8182         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8183           fd := TFormatDescriptor.Get(result);
8184           match := true;
8185           for i := 0 to 3 do
8186             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8187               match := false;
8188               break;
8189             end;
8190           if match then
8191             break;
8192         end;
8193
8194         //no format with same range found -> use default
8195         if (result = tfEmpty) then begin
8196           if (dwABitMask > 0) then
8197             result := tfRGBA8ui1
8198           else
8199             result := tfRGB8ub3;
8200         end;
8201
8202         Converter := TbmpBitfieldFormat.Create;
8203         Converter.RedMask   := dwRBitMask;
8204         Converter.GreenMask := dwGBitMask;
8205         Converter.BlueMask  := dwBBitMask;
8206         Converter.AlphaMask := dwABitMask;
8207         Converter.PixelSize := dwRGBBitCount / 8;
8208       end;
8209     end;
8210   end;
8211
8212 var
8213   StreamPos: Int64;
8214   x, y, LineSize, RowSize, Magic: Cardinal;
8215   NewImage, TmpData, RowData, SrcData: System.PByte;
8216   SourceMD, DestMD: Pointer;
8217   Pixel: TglBitmapPixelData;
8218   ddsFormat: TglBitmapFormat;
8219   FormatDesc: TFormatDescriptor;
8220
8221 begin
8222   result    := false;
8223   Converter := nil;
8224   StreamPos := aStream.Position;
8225
8226   // Magic
8227   aStream.Read(Magic{%H-}, sizeof(Magic));
8228   if (Magic <> DDS_MAGIC) then begin
8229     aStream.Position := StreamPos;
8230     exit;
8231   end;
8232
8233   //Header
8234   aStream.Read(Header{%H-}, sizeof(Header));
8235   if (Header.dwSize <> SizeOf(Header)) or
8236      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8237         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8238   begin
8239     aStream.Position := StreamPos;
8240     exit;
8241   end;
8242
8243   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8244     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8245
8246   ddsFormat := GetDDSFormat;
8247   try
8248     if (ddsFormat = tfEmpty) then
8249       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8250
8251     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8252     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
8253     GetMem(NewImage, Header.dwHeight * LineSize);
8254     try
8255       TmpData := NewImage;
8256
8257       //Converter needed
8258       if Assigned(Converter) then begin
8259         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8260         GetMem(RowData, RowSize);
8261         SourceMD := Converter.CreateMappingData;
8262         DestMD   := FormatDesc.CreateMappingData;
8263         try
8264           for y := 0 to Header.dwHeight-1 do begin
8265             TmpData := NewImage;
8266             inc(TmpData, y * LineSize);
8267             SrcData := RowData;
8268             aStream.Read(SrcData^, RowSize);
8269             for x := 0 to Header.dwWidth-1 do begin
8270               Converter.Unmap(SrcData, Pixel, SourceMD);
8271               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8272               FormatDesc.Map(Pixel, TmpData, DestMD);
8273             end;
8274           end;
8275         finally
8276           Converter.FreeMappingData(SourceMD);
8277           FormatDesc.FreeMappingData(DestMD);
8278           FreeMem(RowData);
8279         end;
8280       end else
8281
8282       // Compressed
8283       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8284         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8285         for Y := 0 to Header.dwHeight-1 do begin
8286           aStream.Read(TmpData^, RowSize);
8287           Inc(TmpData, LineSize);
8288         end;
8289       end else
8290
8291       // Uncompressed
8292       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8293         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8294         for Y := 0 to Header.dwHeight-1 do begin
8295           aStream.Read(TmpData^, RowSize);
8296           Inc(TmpData, LineSize);
8297         end;
8298       end else
8299         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8300
8301       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8302       result := true;
8303     except
8304       if Assigned(NewImage) then
8305         FreeMem(NewImage);
8306       raise;
8307     end;
8308   finally
8309     FreeAndNil(Converter);
8310   end;
8311 end;
8312
8313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8314 procedure TglBitmap.SaveDDS(const aStream: TStream);
8315 var
8316   Header: TDDSHeader;
8317   FormatDesc: TFormatDescriptor;
8318 begin
8319   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8320     raise EglBitmapUnsupportedFormat.Create(Format);
8321
8322   FormatDesc := TFormatDescriptor.Get(Format);
8323
8324   // Generell
8325   FillChar(Header{%H-}, SizeOf(Header), 0);
8326   Header.dwSize  := SizeOf(Header);
8327   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8328
8329   Header.dwWidth  := Max(1, Width);
8330   Header.dwHeight := Max(1, Height);
8331
8332   // Caps
8333   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8334
8335   // Pixelformat
8336   Header.PixelFormat.dwSize := sizeof(Header);
8337   if (FormatDesc.IsCompressed) then begin
8338     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8339     case Format of
8340       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8341       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8342       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8343     end;
8344   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8345     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8346     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8347     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8348   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
8349     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8350     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8351     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8352     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8353   end else begin
8354     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8355     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8356     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8357     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
8358     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
8359     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8360   end;
8361
8362   if (FormatDesc.HasAlpha) then
8363     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8364
8365   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8366   aStream.Write(Header, SizeOf(Header));
8367   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8368 end;
8369
8370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8371 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8373 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8374   const aWidth: Integer; const aHeight: Integer);
8375 var
8376   pTemp: pByte;
8377   Size: Integer;
8378 begin
8379   if (aHeight > 1) then begin
8380     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8381     GetMem(pTemp, Size);
8382     try
8383       Move(aData^, pTemp^, Size);
8384       FreeMem(aData);
8385       aData := nil;
8386     except
8387       FreeMem(pTemp);
8388       raise;
8389     end;
8390   end else
8391     pTemp := aData;
8392   inherited SetDataPointer(pTemp, aFormat, aWidth);
8393 end;
8394
8395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8396 function TglBitmap1D.FlipHorz: Boolean;
8397 var
8398   Col: Integer;
8399   pTempDest, pDest, pSource: PByte;
8400 begin
8401   result := inherited FlipHorz;
8402   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8403     pSource := Data;
8404     GetMem(pDest, fRowSize);
8405     try
8406       pTempDest := pDest;
8407       Inc(pTempDest, fRowSize);
8408       for Col := 0 to Width-1 do begin
8409         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8410         Move(pSource^, pTempDest^, fPixelSize);
8411         Inc(pSource, fPixelSize);
8412       end;
8413       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8414       result := true;
8415     except
8416       if Assigned(pDest) then
8417         FreeMem(pDest);
8418       raise;
8419     end;
8420   end;
8421 end;
8422
8423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8424 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8425 var
8426   FormatDesc: TFormatDescriptor;
8427 begin
8428   // Upload data
8429   FormatDesc := TFormatDescriptor.Get(Format);
8430   if FormatDesc.IsCompressed then begin
8431     if not Assigned(glCompressedTexImage1D) then
8432       raise EglBitmap.Create('compressed formats not supported by video adapter');
8433     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8434   end else if aBuildWithGlu then
8435     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8436   else
8437     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8438
8439   // Free Data
8440   if (FreeDataAfterGenTexture) then
8441     FreeData;
8442 end;
8443
8444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8445 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8446 var
8447   BuildWithGlu, TexRec: Boolean;
8448   TexSize: Integer;
8449 begin
8450   if Assigned(Data) then begin
8451     // Check Texture Size
8452     if (aTestTextureSize) then begin
8453       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8454
8455       if (Width > TexSize) then
8456         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8457
8458       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8459                 (Target = GL_TEXTURE_RECTANGLE);
8460       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8461         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8462     end;
8463
8464     CreateId;
8465     SetupParameters(BuildWithGlu);
8466     UploadData(BuildWithGlu);
8467     glAreTexturesResident(1, @fID, @fIsResident);
8468   end;
8469 end;
8470
8471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8472 procedure TglBitmap1D.AfterConstruction;
8473 begin
8474   inherited;
8475   Target := GL_TEXTURE_1D;
8476 end;
8477
8478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8479 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8481 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8482 begin
8483   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8484     result := fLines[aIndex]
8485   else
8486     result := nil;
8487 end;
8488
8489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8490 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8491   const aWidth: Integer; const aHeight: Integer);
8492 var
8493   Idx, LineWidth: Integer;
8494 begin
8495   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8496
8497   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8498     // Assigning Data
8499     if Assigned(Data) then begin
8500       SetLength(fLines, GetHeight);
8501       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
8502
8503       for Idx := 0 to GetHeight-1 do begin
8504         fLines[Idx] := Data;
8505         Inc(fLines[Idx], Idx * LineWidth);
8506       end;
8507     end
8508       else SetLength(fLines, 0);
8509   end else begin
8510     SetLength(fLines, 0);
8511   end;
8512 end;
8513
8514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8515 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8516 var
8517   FormatDesc: TFormatDescriptor;
8518 begin
8519   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8520
8521   FormatDesc := TFormatDescriptor.Get(Format);
8522   if FormatDesc.IsCompressed then begin
8523     if not Assigned(glCompressedTexImage2D) then
8524       raise EglBitmap.Create('compressed formats not supported by video adapter');
8525     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8526   end else if aBuildWithGlu then begin
8527     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8528       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8529   end else begin
8530     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8531       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8532   end;
8533
8534   // Freigeben
8535   if (FreeDataAfterGenTexture) then
8536     FreeData;
8537 end;
8538
8539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8540 procedure TglBitmap2D.AfterConstruction;
8541 begin
8542   inherited;
8543   Target := GL_TEXTURE_2D;
8544 end;
8545
8546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8547 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8548 var
8549   Temp: pByte;
8550   Size, w, h: Integer;
8551   FormatDesc: TFormatDescriptor;
8552 begin
8553   FormatDesc := TFormatDescriptor.Get(aFormat);
8554   if FormatDesc.IsCompressed then
8555     raise EglBitmapUnsupportedFormat.Create(aFormat);
8556
8557   w    := aRight  - aLeft;
8558   h    := aBottom - aTop;
8559   Size := FormatDesc.GetSize(w, h);
8560   GetMem(Temp, Size);
8561   try
8562     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8563     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8564     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8565     FlipVert;
8566   except
8567     if Assigned(Temp) then
8568       FreeMem(Temp);
8569     raise;
8570   end;
8571 end;
8572
8573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8574 procedure TglBitmap2D.GetDataFromTexture;
8575 var
8576   Temp: PByte;
8577   TempWidth, TempHeight: Integer;
8578   TempIntFormat: GLint;
8579   IntFormat: TglBitmapFormat;
8580   FormatDesc: TFormatDescriptor;
8581 begin
8582   Bind;
8583
8584   // Request Data
8585   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8586   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8587   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8588
8589   IntFormat  := tfEmpty;
8590   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8591   IntFormat  := FormatDesc.Format;
8592
8593   // Getting data from OpenGL
8594   FormatDesc := TFormatDescriptor.Get(IntFormat);
8595   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8596   try
8597     if FormatDesc.IsCompressed then begin
8598       if not Assigned(glGetCompressedTexImage) then
8599         raise EglBitmap.Create('compressed formats not supported by video adapter');
8600       glGetCompressedTexImage(Target, 0, Temp)
8601     end else
8602       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8603     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8604   except
8605     if Assigned(Temp) then
8606       FreeMem(Temp);
8607     raise;
8608   end;
8609 end;
8610
8611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8612 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8613 var
8614   BuildWithGlu, PotTex, TexRec: Boolean;
8615   TexSize: Integer;
8616 begin
8617   if Assigned(Data) then begin
8618     // Check Texture Size
8619     if (aTestTextureSize) then begin
8620       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8621
8622       if ((Height > TexSize) or (Width > TexSize)) then
8623         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8624
8625       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8626       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8627       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8628         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8629     end;
8630
8631     CreateId;
8632     SetupParameters(BuildWithGlu);
8633     UploadData(Target, BuildWithGlu);
8634     glAreTexturesResident(1, @fID, @fIsResident);
8635   end;
8636 end;
8637
8638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8639 function TglBitmap2D.FlipHorz: Boolean;
8640 var
8641   Col, Row: Integer;
8642   TempDestData, DestData, SourceData: PByte;
8643   ImgSize: Integer;
8644 begin
8645   result := inherited FlipHorz;
8646   if Assigned(Data) then begin
8647     SourceData := Data;
8648     ImgSize := Height * fRowSize;
8649     GetMem(DestData, ImgSize);
8650     try
8651       TempDestData := DestData;
8652       Dec(TempDestData, fRowSize + fPixelSize);
8653       for Row := 0 to Height -1 do begin
8654         Inc(TempDestData, fRowSize * 2);
8655         for Col := 0 to Width -1 do begin
8656           Move(SourceData^, TempDestData^, fPixelSize);
8657           Inc(SourceData, fPixelSize);
8658           Dec(TempDestData, fPixelSize);
8659         end;
8660       end;
8661       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8662       result := true;
8663     except
8664       if Assigned(DestData) then
8665         FreeMem(DestData);
8666       raise;
8667     end;
8668   end;
8669 end;
8670
8671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8672 function TglBitmap2D.FlipVert: Boolean;
8673 var
8674   Row: Integer;
8675   TempDestData, DestData, SourceData: PByte;
8676 begin
8677   result := inherited FlipVert;
8678   if Assigned(Data) then begin
8679     SourceData := Data;
8680     GetMem(DestData, Height * fRowSize);
8681     try
8682       TempDestData := DestData;
8683       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8684       for Row := 0 to Height -1 do begin
8685         Move(SourceData^, TempDestData^, fRowSize);
8686         Dec(TempDestData, fRowSize);
8687         Inc(SourceData, fRowSize);
8688       end;
8689       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8690       result := true;
8691     except
8692       if Assigned(DestData) then
8693         FreeMem(DestData);
8694       raise;
8695     end;
8696   end;
8697 end;
8698
8699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8700 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8702 type
8703   TMatrixItem = record
8704     X, Y: Integer;
8705     W: Single;
8706   end;
8707
8708   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8709   TglBitmapToNormalMapRec = Record
8710     Scale: Single;
8711     Heights: array of Single;
8712     MatrixU : array of TMatrixItem;
8713     MatrixV : array of TMatrixItem;
8714   end;
8715
8716 const
8717   ONE_OVER_255 = 1 / 255;
8718
8719   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8720 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8721 var
8722   Val: Single;
8723 begin
8724   with FuncRec do begin
8725     Val :=
8726       Source.Data.r * LUMINANCE_WEIGHT_R +
8727       Source.Data.g * LUMINANCE_WEIGHT_G +
8728       Source.Data.b * LUMINANCE_WEIGHT_B;
8729     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8730   end;
8731 end;
8732
8733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8734 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8735 begin
8736   with FuncRec do
8737     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8738 end;
8739
8740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8741 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8742 type
8743   TVec = Array[0..2] of Single;
8744 var
8745   Idx: Integer;
8746   du, dv: Double;
8747   Len: Single;
8748   Vec: TVec;
8749
8750   function GetHeight(X, Y: Integer): Single;
8751   begin
8752     with FuncRec do begin
8753       X := Max(0, Min(Size.X -1, X));
8754       Y := Max(0, Min(Size.Y -1, Y));
8755       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8756     end;
8757   end;
8758
8759 begin
8760   with FuncRec do begin
8761     with PglBitmapToNormalMapRec(Args)^ do begin
8762       du := 0;
8763       for Idx := Low(MatrixU) to High(MatrixU) do
8764         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8765
8766       dv := 0;
8767       for Idx := Low(MatrixU) to High(MatrixU) do
8768         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8769
8770       Vec[0] := -du * Scale;
8771       Vec[1] := -dv * Scale;
8772       Vec[2] := 1;
8773     end;
8774
8775     // Normalize
8776     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8777     if Len <> 0 then begin
8778       Vec[0] := Vec[0] * Len;
8779       Vec[1] := Vec[1] * Len;
8780       Vec[2] := Vec[2] * Len;
8781     end;
8782
8783     // Farbe zuweisem
8784     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8785     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8786     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8787   end;
8788 end;
8789
8790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8791 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8792 var
8793   Rec: TglBitmapToNormalMapRec;
8794
8795   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8796   begin
8797     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8798       Matrix[Index].X := X;
8799       Matrix[Index].Y := Y;
8800       Matrix[Index].W := W;
8801     end;
8802   end;
8803
8804 begin
8805   if TFormatDescriptor.Get(Format).IsCompressed then
8806     raise EglBitmapUnsupportedFormat.Create(Format);
8807
8808   if aScale > 100 then
8809     Rec.Scale := 100
8810   else if aScale < -100 then
8811     Rec.Scale := -100
8812   else
8813     Rec.Scale := aScale;
8814
8815   SetLength(Rec.Heights, Width * Height);
8816   try
8817     case aFunc of
8818       nm4Samples: begin
8819         SetLength(Rec.MatrixU, 2);
8820         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8821         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8822
8823         SetLength(Rec.MatrixV, 2);
8824         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8825         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8826       end;
8827
8828       nmSobel: begin
8829         SetLength(Rec.MatrixU, 6);
8830         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8831         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8832         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8833         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8834         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8835         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8836
8837         SetLength(Rec.MatrixV, 6);
8838         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8839         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8840         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8841         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8842         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8843         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8844       end;
8845
8846       nm3x3: begin
8847         SetLength(Rec.MatrixU, 6);
8848         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8849         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8850         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8851         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8852         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8853         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8854
8855         SetLength(Rec.MatrixV, 6);
8856         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8857         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8858         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8859         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8860         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8861         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8862       end;
8863
8864       nm5x5: begin
8865         SetLength(Rec.MatrixU, 20);
8866         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8867         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8868         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8869         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8870         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8871         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8872         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8873         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8874         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8875         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8876         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8877         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8878         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8879         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8880         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8881         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8882         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8883         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8884         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8885         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8886
8887         SetLength(Rec.MatrixV, 20);
8888         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8889         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8890         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8891         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8892         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8893         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8894         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8895         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8896         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8897         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8898         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8899         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8900         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8901         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8902         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8903         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8904         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8905         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8906         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8907         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8908       end;
8909     end;
8910
8911     // Daten Sammeln
8912     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8913       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8914     else
8915       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8916     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8917   finally
8918     SetLength(Rec.Heights, 0);
8919   end;
8920 end;
8921
8922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8923 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8925 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8926 begin
8927   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8928 end;
8929
8930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8931 procedure TglBitmapCubeMap.AfterConstruction;
8932 begin
8933   inherited;
8934
8935   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8936     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8937
8938   SetWrap;
8939   Target   := GL_TEXTURE_CUBE_MAP;
8940   fGenMode := GL_REFLECTION_MAP;
8941 end;
8942
8943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8944 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8945 var
8946   BuildWithGlu: Boolean;
8947   TexSize: Integer;
8948 begin
8949   if (aTestTextureSize) then begin
8950     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8951
8952     if (Height > TexSize) or (Width > TexSize) then
8953       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8954
8955     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8956       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8957   end;
8958
8959   if (ID = 0) then
8960     CreateID;
8961   SetupParameters(BuildWithGlu);
8962   UploadData(aCubeTarget, BuildWithGlu);
8963 end;
8964
8965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8966 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8967 begin
8968   inherited Bind (aEnableTextureUnit);
8969   if aEnableTexCoordsGen then begin
8970     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8971     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8972     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8973     glEnable(GL_TEXTURE_GEN_S);
8974     glEnable(GL_TEXTURE_GEN_T);
8975     glEnable(GL_TEXTURE_GEN_R);
8976   end;
8977 end;
8978
8979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8980 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8981 begin
8982   inherited Unbind(aDisableTextureUnit);
8983   if aDisableTexCoordsGen then begin
8984     glDisable(GL_TEXTURE_GEN_S);
8985     glDisable(GL_TEXTURE_GEN_T);
8986     glDisable(GL_TEXTURE_GEN_R);
8987   end;
8988 end;
8989
8990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8991 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8993 type
8994   TVec = Array[0..2] of Single;
8995   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8996
8997   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8998   TglBitmapNormalMapRec = record
8999     HalfSize : Integer;
9000     Func: TglBitmapNormalMapGetVectorFunc;
9001   end;
9002
9003   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9004 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9005 begin
9006   aVec[0] := aHalfSize;
9007   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9008   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
9009 end;
9010
9011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9012 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9013 begin
9014   aVec[0] := - aHalfSize;
9015   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9016   aVec[2] := aPosition.X + 0.5 - aHalfSize;
9017 end;
9018
9019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9020 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9021 begin
9022   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9023   aVec[1] := aHalfSize;
9024   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
9025 end;
9026
9027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9028 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9029 begin
9030   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9031   aVec[1] := - aHalfSize;
9032   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
9033 end;
9034
9035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9036 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9037 begin
9038   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9039   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9040   aVec[2] := aHalfSize;
9041 end;
9042
9043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9044 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9045 begin
9046   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
9047   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9048   aVec[2] := - aHalfSize;
9049 end;
9050
9051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9052 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
9053 var
9054   i: Integer;
9055   Vec: TVec;
9056   Len: Single;
9057 begin
9058   with FuncRec do begin
9059     with PglBitmapNormalMapRec(Args)^ do begin
9060       Func(Vec, Position, HalfSize);
9061
9062       // Normalize
9063       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9064       if Len <> 0 then begin
9065         Vec[0] := Vec[0] * Len;
9066         Vec[1] := Vec[1] * Len;
9067         Vec[2] := Vec[2] * Len;
9068       end;
9069
9070       // Scale Vector and AddVectro
9071       Vec[0] := Vec[0] * 0.5 + 0.5;
9072       Vec[1] := Vec[1] * 0.5 + 0.5;
9073       Vec[2] := Vec[2] * 0.5 + 0.5;
9074     end;
9075
9076     // Set Color
9077     for i := 0 to 2 do
9078       Dest.Data.arr[i] := Round(Vec[i] * 255);
9079   end;
9080 end;
9081
9082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9083 procedure TglBitmapNormalMap.AfterConstruction;
9084 begin
9085   inherited;
9086   fGenMode := GL_NORMAL_MAP;
9087 end;
9088
9089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9090 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9091 var
9092   Rec: TglBitmapNormalMapRec;
9093   SizeRec: TglBitmapPixelPosition;
9094 begin
9095   Rec.HalfSize := aSize div 2;
9096   FreeDataAfterGenTexture := false;
9097
9098   SizeRec.Fields := [ffX, ffY];
9099   SizeRec.X := aSize;
9100   SizeRec.Y := aSize;
9101
9102   // Positive X
9103   Rec.Func := glBitmapNormalMapPosX;
9104   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9105   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9106
9107   // Negative X
9108   Rec.Func := glBitmapNormalMapNegX;
9109   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9110   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9111
9112   // Positive Y
9113   Rec.Func := glBitmapNormalMapPosY;
9114   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9115   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9116
9117   // Negative Y
9118   Rec.Func := glBitmapNormalMapNegY;
9119   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9120   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9121
9122   // Positive Z
9123   Rec.Func := glBitmapNormalMapPosZ;
9124   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9125   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9126
9127   // Negative Z
9128   Rec.Func := glBitmapNormalMapNegZ;
9129   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9130   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9131 end;
9132
9133
9134 initialization
9135   glBitmapSetDefaultFormat (tfEmpty);
9136   glBitmapSetDefaultMipmap (mmMipmap);
9137   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9138   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9139   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9140
9141   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9142   glBitmapSetDefaultDeleteTextureOnFree    (true);
9143
9144   TFormatDescriptor.Init;
9145
9146 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9147   OpenGLInitialized := false;
9148   InitOpenGLCS := TCriticalSection.Create;
9149 {$ENDIF}
9150
9151 finalization
9152   TFormatDescriptor.Finalize;
9153
9154 {$IFDEF GLB_NATIVE_OGL}
9155   if Assigned(GL_LibHandle) then
9156     glbFreeLibrary(GL_LibHandle);
9157
9158 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9159   if Assigned(GLU_LibHandle) then
9160     glbFreeLibrary(GLU_LibHandle);
9161   FreeAndNil(InitOpenGLCS);
9162 {$ENDIF}
9163 {$ENDIF}
9164
9165 end.