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   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     tfAlpha16,
 782
 783     tfLuminance4,
 784     tfLuminance8,
 785     tfLuminance16,
 786
 787     tfLuminance4Alpha4,
 788     tfLuminance6Alpha2,
 789     tfLuminance8Alpha8,
 790     tfLuminance12Alpha4,
 791     tfLuminance16Alpha16,
 792
 793     tfR3G3B2,
 794     tfRGBX4,
 795     tfXRGB4,
 796     tfR5G6B5,
 797     tfRGB5X1,
 798     tfX1RGB5,
 799     tfRGB8,
 800     tfRGBX8,
 801     tfXRGB8,
 802     tfRGB10X2,
 803     tfX2RGB10,
 804     tfRGB16,
 805
 806     tfRGBA4,
 807     tfARGB4,
 808     tfRGB5A1,
 809     tfA1RGB5,
 810     tfRGBA8,
 811     tfARGB8,
 812     tfRGB10A2,
 813     tfA2RGB10,
 814     tfRGBA16,
 815
 816     tfBGRX4,
 817     tfXBGR4,
 818     tfB5G6R5,
 819     tfBGR5X1,
 820     tfX1BGR5,
 821     tfBGR8,
 822     tfBGRX8,
 823     tfXBGR8,
 824     tfBGR10X2,
 825     tfX2BGR10,
 826     tfBGR16,
 827
 828     tfBGRA4,
 829     tfABGR4,
 830     tfBGR5A1,
 831     tfA1BGR5,
 832     tfBGRA8,
 833     tfABGR8,
 834     tfBGR10A2,
 835     tfA2BGR10,
 836     tfBGRA16,
 837
 838     tfDepth16,
 839     tfDepth24,
 840     tfDepth32,
 841
 842     tfS3tcDtx1RGBA,
 843     tfS3tcDtx3RGBA,
 844     tfS3tcDtx5RGBA
 845   );
 846
 847   TglBitmapFileType = (
 848      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 849      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 850      ftDDS,
 851      ftTGA,
 852      ftBMP);
 853    TglBitmapFileTypes = set of TglBitmapFileType;
 854
 855    TglBitmapMipMap = (
 856      mmNone,
 857      mmMipmap,
 858      mmMipmapGlu);
 859
 860    TglBitmapNormalMapFunc = (
 861      nm4Samples,
 862      nmSobel,
 863      nm3x3,
 864      nm5x5);
 865
 866  ////////////////////////////////////////////////////////////////////////////////////////////////////
 867    EglBitmap                  = class(Exception);
 868    EglBitmapNotSupported      = class(Exception);
 869    EglBitmapSizeToLarge       = class(EglBitmap);
 870    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 871    EglBitmapUnsupportedFormat = class(EglBitmap)
 872    public
 873      constructor Create(const aFormat: TglBitmapFormat); overload;
 874      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 875    end;
 876
 877 ////////////////////////////////////////////////////////////////////////////////////////////////////
 878   TglBitmapColorRec = packed record
 879   case Integer of
 880     0: (r, g, b, a: Cardinal);
 881     1: (arr: array[0..3] of Cardinal);
 882   end;
 883
 884   TglBitmapPixelData = packed record
 885     Data, Range: TglBitmapColorRec;
 886     Format: TglBitmapFormat;
 887   end;
 888   PglBitmapPixelData = ^TglBitmapPixelData;
 889
 890 ////////////////////////////////////////////////////////////////////////////////////////////////////
 891   TglBitmapPixelPositionFields = set of (ffX, ffY);
 892   TglBitmapPixelPosition = record
 893     Fields : TglBitmapPixelPositionFields;
 894     X : Word;
 895     Y : Word;
 896   end;
 897
 898   TglBitmapFormatDescriptor = class(TObject)
 899   protected
 900     function GetIsCompressed: Boolean; virtual; abstract;
 901     function GetHasRed:       Boolean; virtual; abstract;
 902     function GetHasGreen:     Boolean; virtual; abstract;
 903     function GetHasBlue:      Boolean; virtual; abstract;
 904     function GetHasAlpha:     Boolean; virtual; abstract;
 905
 906     function GetRGBInverted:  TglBitmapFormat; virtual; abstract;
 907     function GetWithAlpha:    TglBitmapFormat; virtual; abstract;
 908     function GetWithoutAlpha: TglBitmapFormat; virtual; abstract;
 909     function GetOpenGLFormat: TglBitmapFormat; virtual; abstract;
 910     function GetUncompressed: TglBitmapFormat; virtual; abstract;
 911
 912     function GetglDataFormat:     GLenum;  virtual; abstract;
 913     function GetglFormat:         GLenum;  virtual; abstract;
 914     function GetglInternalFormat: GLenum;  virtual; abstract;
 915   public
 916     property IsCompressed: Boolean read GetIsCompressed;
 917     property HasRed:       Boolean read GetHasRed;
 918     property HasGreen:     Boolean read GetHasGreen;
 919     property HasBlue:      Boolean read GetHasBlue;
 920     property HasAlpha:     Boolean read GetHasAlpha;
 921
 922     property RGBInverted:  TglBitmapFormat read GetRGBInverted;
 923     property WithAlpha:    TglBitmapFormat read GetWithAlpha;
 924     property WithoutAlpha: TglBitmapFormat read GetWithoutAlpha;
 925     property OpenGLFormat: TglBitmapFormat read GetOpenGLFormat;
 926     property Uncompressed: TglBitmapFormat read GetUncompressed;
 927
 928     property glFormat:         GLenum  read GetglFormat;
 929     property glInternalFormat: GLenum  read GetglInternalFormat;
 930     property glDataFormat:     GLenum  read GetglDataFormat;
 931   public
 932     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 933   end;
 934
 935 ////////////////////////////////////////////////////////////////////////////////////////////////////
 936   TglBitmap = class;
 937   TglBitmapFunctionRec = record
 938     Sender:   TglBitmap;
 939     Size:     TglBitmapPixelPosition;
 940     Position: TglBitmapPixelPosition;
 941     Source:   TglBitmapPixelData;
 942     Dest:     TglBitmapPixelData;
 943     Args:     Pointer;
 944   end;
 945   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 946
 947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 948   TglBitmap = class
 949   private
 950     function GetFormatDesc: TglBitmapFormatDescriptor;
 951   protected
 952     fID: GLuint;
 953     fTarget: GLuint;
 954     fAnisotropic: Integer;
 955     fDeleteTextureOnFree: Boolean;
 956     fFreeDataOnDestroy: Boolean;
 957     fFreeDataAfterGenTexture: Boolean;
 958     fData: PByte;
 959     fIsResident: GLboolean;
 960     fBorderColor: array[0..3] of Single;
 961
 962     fDimension: TglBitmapPixelPosition;
 963     fMipMap: TglBitmapMipMap;
 964     fFormat: TglBitmapFormat;
 965
 966     // Mapping
 967     fPixelSize: Integer;
 968     fRowSize: Integer;
 969
 970     // Filtering
 971     fFilterMin: GLenum;
 972     fFilterMag: GLenum;
 973
 974     // TexturWarp
 975     fWrapS: GLenum;
 976     fWrapT: GLenum;
 977     fWrapR: GLenum;
 978
 979     //Swizzle
 980     fSwizzle: array[0..3] of GLenum;
 981
 982     // CustomData
 983     fFilename: String;
 984     fCustomName: String;
 985     fCustomNameW: WideString;
 986     fCustomData: Pointer;
 987
 988     //Getter
 989     function GetWidth:  Integer; virtual;
 990     function GetHeight: Integer; virtual;
 991
 992     function GetFileWidth:  Integer; virtual;
 993     function GetFileHeight: Integer; virtual;
 994
 995     //Setter
 996     procedure SetCustomData(const aValue: Pointer);
 997     procedure SetCustomName(const aValue: String);
 998     procedure SetCustomNameW(const aValue: WideString);
 999     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1000     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1001     procedure SetFormat(const aValue: TglBitmapFormat);
1002     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1003     procedure SetID(const aValue: Cardinal);
1004     procedure SetMipMap(const aValue: TglBitmapMipMap);
1005     procedure SetTarget(const aValue: Cardinal);
1006     procedure SetAnisotropic(const aValue: Integer);
1007
1008     procedure CreateID;
1009     procedure SetupParameters(out aBuildWithGlu: Boolean);
1010     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1011       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1012     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1013
1014     function FlipHorz: Boolean; virtual;
1015     function FlipVert: Boolean; virtual;
1016
1017     property Width:  Integer read GetWidth;
1018     property Height: Integer read GetHeight;
1019
1020     property FileWidth:  Integer read GetFileWidth;
1021     property FileHeight: Integer read GetFileHeight;
1022   public
1023     //Properties
1024     property ID:           Cardinal        read fID          write SetID;
1025     property Target:       Cardinal        read fTarget      write SetTarget;
1026     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1027     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1028     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1029
1030     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1031
1032     property Filename:    String     read fFilename;
1033     property CustomName:  String     read fCustomName  write SetCustomName;
1034     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1035     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1036
1037     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1038     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1039     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1040
1041     property Dimension:  TglBitmapPixelPosition  read fDimension;
1042     property Data:       PByte                   read fData;
1043     property IsResident: GLboolean               read fIsResident;
1044
1045     procedure AfterConstruction; override;
1046     procedure BeforeDestruction; override;
1047
1048     procedure PrepareResType(var aResource: String; var aResType: PChar);
1049
1050     //Load
1051     procedure LoadFromFile(const aFilename: String);
1052     procedure LoadFromStream(const aStream: TStream); virtual;
1053     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1054       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1055     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1056     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1057
1058     //Save
1059     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1060     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1061
1062     //Convert
1063     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1064     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1065       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1066   public
1067     //Alpha & Co
1068     {$IFDEF GLB_SDL}
1069     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1070     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1071     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1072     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1073       const aArgs: Pointer = nil): Boolean;
1074     {$ENDIF}
1075
1076     {$IFDEF GLB_DELPHI}
1077     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1078     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1079     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1080     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1081       const aArgs: Pointer = nil): Boolean;
1082     {$ENDIF}
1083
1084     {$IFDEF GLB_LAZARUS}
1085     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1086     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1087     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1088     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1089       const aArgs: Pointer = nil): Boolean;
1090     {$ENDIF}
1091
1092     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1093       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1094     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1095       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1096
1097     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1098     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1099     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1100     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1101
1102     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1103     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1104     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1105
1106     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1107     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1108     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1109
1110     function RemoveAlpha: Boolean; virtual;
1111   public
1112     //Common
1113     function Clone: TglBitmap;
1114     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1115     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1116     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1117     procedure FreeData;
1118
1119     //ColorFill
1120     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1121     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1122     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1123
1124     //TexParameters
1125     procedure SetFilter(const aMin, aMag: GLenum);
1126     procedure SetWrap(
1127       const S: GLenum = GL_CLAMP_TO_EDGE;
1128       const T: GLenum = GL_CLAMP_TO_EDGE;
1129       const R: GLenum = GL_CLAMP_TO_EDGE);
1130     procedure SetSwizzle(const r, g, b, a: GLenum);
1131
1132     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1133     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1134
1135     //Constructors
1136     constructor Create; overload;
1137     constructor Create(const aFileName: String); overload;
1138     constructor Create(const aStream: TStream); overload;
1139     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1140     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1141     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1142     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1143   private
1144     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1145     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1146
1147     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1148     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1149
1150     function LoadBMP(const aStream: TStream): Boolean; virtual;
1151     procedure SaveBMP(const aStream: TStream); virtual;
1152
1153     function LoadTGA(const aStream: TStream): Boolean; virtual;
1154     procedure SaveTGA(const aStream: TStream); virtual;
1155
1156     function LoadDDS(const aStream: TStream): Boolean; virtual;
1157     procedure SaveDDS(const aStream: TStream); virtual;
1158   end;
1159
1160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1161   TglBitmap1D = class(TglBitmap)
1162   protected
1163     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1164       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1165     procedure UploadData(const aBuildWithGlu: Boolean);
1166   public
1167     property Width;
1168     procedure AfterConstruction; override;
1169     function FlipHorz: Boolean; override;
1170     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1171   end;
1172
1173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1174   TglBitmap2D = class(TglBitmap)
1175   protected
1176     fLines: array of PByte;
1177     function GetScanline(const aIndex: Integer): Pointer;
1178     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1179       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1180     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1181   public
1182     property Width;
1183     property Height;
1184     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1185
1186     procedure AfterConstruction; override;
1187
1188     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1189     procedure GetDataFromTexture;
1190     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1191
1192     function FlipHorz: Boolean; override;
1193     function FlipVert: Boolean; override;
1194
1195     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1196       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1197   end;
1198
1199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1200   TglBitmapCubeMap = class(TglBitmap2D)
1201   protected
1202     fGenMode: Integer;
1203     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1204   public
1205     procedure AfterConstruction; override;
1206     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1207     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1208     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1209   end;
1210
1211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1212   TglBitmapNormalMap = class(TglBitmapCubeMap)
1213   public
1214     procedure AfterConstruction; override;
1215     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1216   end;
1217
1218 const
1219   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1220
1221 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1222 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1223 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1224 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1225 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1226 procedure glBitmapSetDefaultWrap(
1227   const S: Cardinal = GL_CLAMP_TO_EDGE;
1228   const T: Cardinal = GL_CLAMP_TO_EDGE;
1229   const R: Cardinal = GL_CLAMP_TO_EDGE);
1230
1231 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1232 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1233 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1234 function glBitmapGetDefaultFormat: TglBitmapFormat;
1235 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1236 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1237
1238 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1239 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1240 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1241
1242 var
1243   glBitmapDefaultDeleteTextureOnFree: Boolean;
1244   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1245   glBitmapDefaultFormat: TglBitmapFormat;
1246   glBitmapDefaultMipmap: TglBitmapMipMap;
1247   glBitmapDefaultFilterMin: Cardinal;
1248   glBitmapDefaultFilterMag: Cardinal;
1249   glBitmapDefaultWrapS: Cardinal;
1250   glBitmapDefaultWrapT: Cardinal;
1251   glBitmapDefaultWrapR: Cardinal;
1252   glDefaultSwizzle: array[0..3] of GLenum;
1253
1254 {$IFDEF GLB_DELPHI}
1255 function CreateGrayPalette: HPALETTE;
1256 {$ENDIF}
1257
1258 implementation
1259
1260 uses
1261   Math, syncobjs, typinfo
1262   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1263
1264 type
1265 {$IFNDEF fpc}
1266   QWord   = System.UInt64;
1267   PQWord  = ^QWord;
1268
1269   PtrInt  = Longint;
1270   PtrUInt = DWord;
1271 {$ENDIF}
1272
1273 ////////////////////////////////////////////////////////////////////////////////////////////////////
1274   TShiftRec = packed record
1275   case Integer of
1276     0: (r, g, b, a: Byte);
1277     1: (arr: array[0..3] of Byte);
1278   end;
1279
1280   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1281   private
1282     function GetRedMask: QWord;
1283     function GetGreenMask: QWord;
1284     function GetBlueMask: QWord;
1285     function GetAlphaMask: QWord;
1286   protected
1287     fFormat: TglBitmapFormat;
1288     fWithAlpha: TglBitmapFormat;
1289     fWithoutAlpha: TglBitmapFormat;
1290     fOpenGLFormat: TglBitmapFormat;
1291     fRGBInverted: TglBitmapFormat;
1292     fUncompressed: TglBitmapFormat;
1293
1294     fPixelSize: Single;
1295     fIsCompressed: Boolean;
1296
1297     fRange: TglBitmapColorRec;
1298     fShift: TShiftRec;
1299
1300     fglFormat:         GLenum;
1301     fglInternalFormat: GLenum;
1302     fglDataFormat:     GLenum;
1303
1304     function GetIsCompressed: Boolean; override;
1305     function GetHasRed: Boolean; override;
1306     function GetHasGreen: Boolean; override;
1307     function GetHasBlue: Boolean; override;
1308     function GetHasAlpha: Boolean; override;
1309
1310     function GetRGBInverted:  TglBitmapFormat; override;
1311     function GetWithAlpha:    TglBitmapFormat; override;
1312     function GetWithoutAlpha: TglBitmapFormat; override;
1313     function GetOpenGLFormat: TglBitmapFormat; override;
1314     function GetUncompressed: TglBitmapFormat; override;
1315
1316     function GetglFormat: GLenum; override;
1317     function GetglInternalFormat: GLenum; override;
1318     function GetglDataFormat: GLenum; override;
1319
1320     function GetComponents: Integer; virtual;
1321   public
1322     property Format:       TglBitmapFormat read fFormat;
1323     property Components:   Integer         read GetComponents;
1324     property PixelSize:    Single          read fPixelSize;
1325
1326     property Range: TglBitmapColorRec read fRange;
1327     property Shift: TShiftRec         read fShift;
1328
1329     property RedMask:   QWord read GetRedMask;
1330     property GreenMask: QWord read GetGreenMask;
1331     property BlueMask:  QWord read GetBlueMask;
1332     property AlphaMask: QWord read GetAlphaMask;
1333
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1336
1337     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1338     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1339
1340     function CreateMappingData: Pointer; virtual;
1341     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1342
1343     function IsEmpty:  Boolean; virtual;
1344     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1345
1346     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1347
1348     constructor Create; virtual;
1349   public
1350     class procedure Init;
1351     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1352     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1353     class procedure Clear;
1354     class procedure Finalize;
1355   end;
1356   TFormatDescriptorClass = class of TFormatDescriptor;
1357
1358   TfdEmpty = class(TFormatDescriptor);
1359
1360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1361   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1362     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1363     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1364   end;
1365
1366   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369   end;
1370
1371   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374   end;
1375
1376   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379   end;
1380
1381   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1382     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1383     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1384   end;
1385
1386   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1387     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1388     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1389   end;
1390
1391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1392   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
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   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
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   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
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   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (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   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1428     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1429     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1430   end;
1431
1432   TfdARGB_US4 = class(TfdRGB_US3) //4* unsigned short
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435   end;
1436
1437   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1438     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1439     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1440   end;
1441
1442   TfdABGR_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1443     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1444     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1445   end;
1446
1447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1448   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
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   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1459   TfdAlpha4 = class(TfdAlpha_UB1)
1460     constructor Create; override;
1461   end;
1462
1463   TfdAlpha8 = class(TfdAlpha_UB1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdAlpha16 = class(TfdAlpha_US1)
1468     constructor Create; override;
1469   end;
1470
1471   TfdLuminance4 = class(TfdLuminance_UB1)
1472     constructor Create; override;
1473   end;
1474
1475   TfdLuminance8 = class(TfdLuminance_UB1)
1476     constructor Create; override;
1477   end;
1478
1479   TfdLuminance16 = class(TfdLuminance_US1)
1480     constructor Create; override;
1481   end;
1482
1483   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1484     constructor Create; override;
1485   end;
1486
1487   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1488     constructor Create; override;
1489   end;
1490
1491   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1492     constructor Create; override;
1493   end;
1494
1495   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1496     constructor Create; override;
1497   end;
1498
1499   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1500     constructor Create; override;
1501   end;
1502
1503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1504   TfdR3G3B2 = class(TfdUniversal_UB1)
1505     constructor Create; override;
1506   end;
1507
1508   TfdRGBX4 = class(TfdUniversal_US1)
1509     constructor Create; override;
1510   end;
1511
1512   TfdXRGB4 = class(TfdUniversal_US1)
1513     constructor Create; override;
1514   end;
1515
1516   TfdR5G6B5 = class(TfdUniversal_US1)
1517     constructor Create; override;
1518   end;
1519
1520   TfdRGB5X1 = class(TfdUniversal_US1)
1521     constructor Create; override;
1522   end;
1523
1524   TfdX1RGB5 = class(TfdUniversal_US1)
1525     constructor Create; override;
1526   end;
1527
1528   TfdRGB8 = class(TfdRGB_UB3)
1529     constructor Create; override;
1530   end;
1531
1532   TfdRGBX8 = class(TfdUniversal_UI1)
1533     constructor Create; override;
1534   end;
1535
1536   TfdXRGB8 = class(TfdUniversal_UI1)
1537     constructor Create; override;
1538   end;
1539
1540   TfdRGB10X2 = class(TfdUniversal_UI1)
1541     constructor Create; override;
1542   end;
1543
1544   TfdX2RGB10 = class(TfdUniversal_UI1)
1545     constructor Create; override;
1546   end;
1547
1548   TfdRGB16 = class(TfdRGB_US3)
1549     constructor Create; override;
1550   end;
1551
1552   TfdRGBA4 = class(TfdUniversal_US1)
1553     constructor Create; override;
1554   end;
1555
1556   TfdARGB4 = class(TfdUniversal_US1)
1557     constructor Create; override;
1558   end;
1559
1560   TfdRGB5A1 = class(TfdUniversal_US1)
1561     constructor Create; override;
1562   end;
1563
1564   TfdA1RGB5 = class(TfdUniversal_US1)
1565     constructor Create; override;
1566   end;
1567
1568   TfdRGBA8 = class(TfdUniversal_UI1)
1569     constructor Create; override;
1570   end;
1571
1572   TfdARGB8 = class(TfdUniversal_UI1)
1573     constructor Create; override;
1574   end;
1575
1576   TfdRGB10A2 = class(TfdUniversal_UI1)
1577     constructor Create; override;
1578   end;
1579
1580   TfdA2RGB10 = class(TfdUniversal_UI1)
1581     constructor Create; override;
1582   end;
1583
1584   TfdRGBA16 = class(TfdUniversal_UI1)
1585     constructor Create; override;
1586   end;
1587
1588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1589   TfdBGRX4 = class(TfdUniversal_US1)
1590     constructor Create; override;
1591   end;
1592
1593   TfdXBGR4 = class(TfdUniversal_US1)
1594     constructor Create; override;
1595   end;
1596
1597   TfdB5G6R5 = class(TfdUniversal_US1)
1598     constructor Create; override;
1599   end;
1600
1601   TfdBGR5X1 = class(TfdUniversal_US1)
1602     constructor Create; override;
1603   end;
1604
1605   TfdX1BGR5 = class(TfdUniversal_US1)
1606     constructor Create; override;
1607   end;
1608
1609   TfdBGR8 = class(TfdBGR_UB3)
1610     constructor Create; override;
1611   end;
1612
1613   TfdBGRX8 = class(TfdUniversal_UI1)
1614     constructor Create; override;
1615   end;
1616
1617   TfdXBGR8 = class(TfdUniversal_UI1)
1618     constructor Create; override;
1619   end;
1620
1621   TfdBGR10X2 = class(TfdUniversal_UI1)
1622     constructor Create; override;
1623   end;
1624
1625   TfdX2BGR10 = class(TfdUniversal_UI1)
1626     constructor Create; override;
1627   end;
1628
1629   TfdBGR16 = class(TfdBGR_US3)
1630     constructor Create; override;
1631   end;
1632
1633   TfdBGRA4 = class(TfdUniversal_US1)
1634     constructor Create; override;
1635   end;
1636
1637   TfdABGR4 = class(TfdUniversal_US1)
1638     constructor Create; override;
1639   end;
1640
1641   TfdBGR5A1 = class(TfdUniversal_US1)
1642     constructor Create; override;
1643   end;
1644
1645   TfdA1BGR5 = class(TfdUniversal_US1)
1646     constructor Create; override;
1647   end;
1648
1649   TfdBGRA8 = class(TfdUniversal_UI1)
1650     constructor Create; override;
1651   end;
1652
1653   TfdABGR8 = class(TfdUniversal_UI1)
1654     constructor Create; override;
1655   end;
1656
1657   TfdBGR10A2 = class(TfdUniversal_UI1)
1658     constructor Create; override;
1659   end;
1660
1661   TfdA2BGR10 = class(TfdUniversal_UI1)
1662     constructor Create; override;
1663   end;
1664
1665   TfdBGRA16 = class(TfdBGRA_US4)
1666     constructor Create; override;
1667   end;
1668
1669   TfdDepth16 = class(TfdDepth_US1)
1670     constructor Create; override;
1671   end;
1672
1673   TfdDepth24 = class(TfdDepth_UI1)
1674     constructor Create; override;
1675   end;
1676
1677   TfdDepth32 = class(TfdDepth_UI1)
1678     constructor Create; override;
1679   end;
1680
1681   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1682     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1683     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1684     constructor Create; override;
1685   end;
1686
1687   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1688     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1689     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1690     constructor Create; override;
1691   end;
1692
1693   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1694     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1695     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1696     constructor Create; override;
1697   end;
1698
1699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1700   TbmpBitfieldFormat = class(TFormatDescriptor)
1701   private
1702     procedure SetRedMask  (const aValue: QWord);
1703     procedure SetGreenMask(const aValue: QWord);
1704     procedure SetBlueMask (const aValue: QWord);
1705     procedure SetAlphaMask(const aValue: QWord);
1706
1707     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1708   public
1709     property RedMask:   QWord read GetRedMask   write SetRedMask;
1710     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1711     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1712     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1713
1714     property PixelSize: Single read fPixelSize write fPixelSize;
1715
1716     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1717     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1718   end;
1719
1720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1721   TbmpColorTableEnty = packed record
1722     b, g, r, a: Byte;
1723   end;
1724   TbmpColorTable = array of TbmpColorTableEnty;
1725   TbmpColorTableFormat = class(TFormatDescriptor)
1726   private
1727     fColorTable: TbmpColorTable;
1728   public
1729     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1730     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1731     property Range:      TglBitmapColorRec read fRange      write fRange;
1732     property Shift:      TShiftRec         read fShift      write fShift;
1733     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1734
1735     procedure CreateColorTable;
1736
1737     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1738     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1739     destructor Destroy; override;
1740   end;
1741
1742 const
1743   LUMINANCE_WEIGHT_R = 0.30;
1744   LUMINANCE_WEIGHT_G = 0.59;
1745   LUMINANCE_WEIGHT_B = 0.11;
1746
1747   ALPHA_WEIGHT_R = 0.30;
1748   ALPHA_WEIGHT_G = 0.59;
1749   ALPHA_WEIGHT_B = 0.11;
1750
1751   DEPTH_WEIGHT_R = 0.333333333;
1752   DEPTH_WEIGHT_G = 0.333333333;
1753   DEPTH_WEIGHT_B = 0.333333333;
1754
1755   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1756
1757   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1758     TfdEmpty,
1759
1760     TfdAlpha4,
1761     TfdAlpha8,
1762     TfdAlpha16,
1763
1764     TfdLuminance4,
1765     TfdLuminance8,
1766     TfdLuminance16,
1767
1768     TfdLuminance4Alpha4,
1769     TfdLuminance6Alpha2,
1770     TfdLuminance8Alpha8,
1771     TfdLuminance12Alpha4,
1772     TfdLuminance16Alpha16,
1773
1774     TfdR3G3B2,
1775     TfdRGBX4,
1776     TfdXRGB4,
1777     TfdR5G6B5,
1778     TfdRGB5X1,
1779     TfdX1RGB5,
1780     TfdRGB8,
1781     TfdRGBX8,
1782     TfdXRGB8,
1783     TfdRGB10X2,
1784     TfdX2RGB10,
1785     TfdRGB16,
1786
1787     TfdRGBA4,
1788     TfdARGB4,
1789     TfdRGB5A1,
1790     TfdA1RGB5,
1791     TfdRGBA8,
1792     TfdARGB8,
1793     TfdRGB10A2,
1794     TfdA2RGB10,
1795     TfdRGBA16,
1796
1797     TfdBGRX4,
1798     TfdXBGR4,
1799     TfdB5G6R5,
1800     TfdBGR5X1,
1801     TfdX1BGR5,
1802     TfdBGR8,
1803     TfdBGRX8,
1804     TfdXBGR8,
1805     TfdBGR10X2,
1806     TfdX2BGR10,
1807     TfdBGR16,
1808
1809     TfdBGRA4,
1810     TfdABGR4,
1811     TfdBGR5A1,
1812     TfdA1BGR5,
1813     TfdBGRA8,
1814     TfdABGR8,
1815     TfdBGR10A2,
1816     TfdA2BGR10,
1817     TfdBGRA16,
1818
1819     TfdDepth16,
1820     TfdDepth24,
1821     TfdDepth32,
1822
1823     TfdS3tcDtx1RGBA,
1824     TfdS3tcDtx3RGBA,
1825     TfdS3tcDtx5RGBA
1826   );
1827
1828 var
1829   FormatDescriptorCS: TCriticalSection;
1830   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1831
1832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1833 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1834 begin
1835   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1836 end;
1837
1838 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1840 begin
1841   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1842 end;
1843
1844 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1846 begin
1847   result.Fields := [];
1848
1849   if X >= 0 then
1850     result.Fields := result.Fields + [ffX];
1851   if Y >= 0 then
1852     result.Fields := result.Fields + [ffY];
1853
1854   result.X := Max(0, X);
1855   result.Y := Max(0, Y);
1856 end;
1857
1858 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1859 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1860 begin
1861   result.r := r;
1862   result.g := g;
1863   result.b := b;
1864   result.a := a;
1865 end;
1866
1867 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1868 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1869 var
1870   i: Integer;
1871 begin
1872   result := false;
1873   for i := 0 to high(r1.arr) do
1874     if (r1.arr[i] <> r2.arr[i]) then
1875       exit;
1876   result := true;
1877 end;
1878
1879 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1880 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1881 begin
1882   result.r := r;
1883   result.g := g;
1884   result.b := b;
1885   result.a := a;
1886 end;
1887
1888 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1889 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1890 begin
1891   result := [];
1892
1893   if (aFormat in [
1894         //4 bbp
1895         tfLuminance4,
1896
1897         //8bpp
1898         tfR3G3B2, tfLuminance8,
1899
1900         //16bpp
1901         tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
1902         tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
1903
1904         //24bpp
1905         tfBGR8, tfRGB8,
1906
1907         //32bpp
1908         tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
1909         tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8]) then
1910     result := result + [ftBMP];
1911
1912   if (aFormat in [
1913         //8 bpp
1914         tfLuminance8, tfAlpha8,
1915
1916         //16 bpp
1917         tfLuminance16, tfLuminance8Alpha8,
1918         tfRGB5X1, tfX1RGB5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
1919         tfBGR5X1, tfX1BGR5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
1920
1921         //24 bpp
1922         tfRGB8, tfBGR8,
1923
1924         //32 bpp
1925         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1926     result := result + [ftTGA];
1927
1928   if (aFormat in [
1929         //8 bpp
1930         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1931         tfR3G3B2,
1932
1933         //16 bpp
1934         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1935         tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5,
1936         tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5,
1937
1938         //24 bpp
1939         tfRGB8, tfBGR8,
1940
1941         //32 bbp
1942         tfLuminance16Alpha16,
1943         tfRGBA8, tfRGB10A2,
1944         tfBGRA8, tfBGR10A2,
1945
1946         //compressed
1947         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1948     result := result + [ftDDS];
1949
1950   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1951   if aFormat in [
1952       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1953       tfRGB8, tfRGBA8,
1954       tfBGR8, tfBGRA8] then
1955     result := result + [ftPNG];
1956   {$ENDIF}
1957
1958   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1959   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1960     result := result + [ftJPEG];
1961   {$ENDIF}
1962 end;
1963
1964 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1965 function IsPowerOfTwo(aNumber: Integer): Boolean;
1966 begin
1967   while (aNumber and 1) = 0 do
1968     aNumber := aNumber shr 1;
1969   result := aNumber = 1;
1970 end;
1971
1972 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1973 function GetTopMostBit(aBitSet: QWord): Integer;
1974 begin
1975   result := 0;
1976   while aBitSet > 0 do begin
1977     inc(result);
1978     aBitSet := aBitSet shr 1;
1979   end;
1980 end;
1981
1982 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1983 function CountSetBits(aBitSet: QWord): Integer;
1984 begin
1985   result := 0;
1986   while aBitSet > 0 do begin
1987     if (aBitSet and 1) = 1 then
1988       inc(result);
1989     aBitSet := aBitSet shr 1;
1990   end;
1991 end;
1992
1993 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1994 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1995 begin
1996   result := Trunc(
1997     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1998     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1999     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2000 end;
2001
2002 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2003 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2004 begin
2005   result := Trunc(
2006     DEPTH_WEIGHT_R * aPixel.Data.r +
2007     DEPTH_WEIGHT_G * aPixel.Data.g +
2008     DEPTH_WEIGHT_B * aPixel.Data.b);
2009 end;
2010
2011 {$IFDEF GLB_NATIVE_OGL}
2012 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2013 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2014 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2015 var
2016   GL_LibHandle: Pointer = nil;
2017
2018 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2019 begin
2020   if not Assigned(aLibHandle) then
2021     aLibHandle := GL_LibHandle;
2022
2023 {$IF DEFINED(GLB_WIN)}
2024   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2025   if Assigned(result) then
2026     exit;
2027
2028   if Assigned(wglGetProcAddress) then
2029     result := wglGetProcAddress(aProcName);
2030 {$ELSEIF DEFINED(GLB_LINUX)}
2031   if Assigned(glXGetProcAddress) then begin
2032     result := glXGetProcAddress(aProcName);
2033     if Assigned(result) then
2034       exit;
2035   end;
2036
2037   if Assigned(glXGetProcAddressARB) then begin
2038     result := glXGetProcAddressARB(aProcName);
2039     if Assigned(result) then
2040       exit;
2041   end;
2042
2043   result := dlsym(aLibHandle, aProcName);
2044 {$IFEND}
2045   if not Assigned(result) and aRaiseOnErr then
2046     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2047 end;
2048
2049 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2050 var
2051   GLU_LibHandle: Pointer = nil;
2052   OpenGLInitialized: Boolean;
2053   InitOpenGLCS: TCriticalSection;
2054
2055 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 procedure glbInitOpenGL;
2057
2058   ////////////////////////////////////////////////////////////////////////////////
2059   function glbLoadLibrary(const aName: PChar): Pointer;
2060   begin
2061     {$IF DEFINED(GLB_WIN)}
2062     result := {%H-}Pointer(LoadLibrary(aName));
2063     {$ELSEIF DEFINED(GLB_LINUX)}
2064     result := dlopen(Name, RTLD_LAZY);
2065     {$ELSE}
2066     result := nil;
2067     {$IFEND}
2068   end;
2069
2070   ////////////////////////////////////////////////////////////////////////////////
2071   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2072   begin
2073     result := false;
2074     if not Assigned(aLibHandle) then
2075       exit;
2076
2077     {$IF DEFINED(GLB_WIN)}
2078     Result := FreeLibrary({%H-}HINST(aLibHandle));
2079     {$ELSEIF DEFINED(GLB_LINUX)}
2080     Result := dlclose(aLibHandle) = 0;
2081     {$IFEND}
2082   end;
2083
2084 begin
2085   if Assigned(GL_LibHandle) then
2086     glbFreeLibrary(GL_LibHandle);
2087
2088   if Assigned(GLU_LibHandle) then
2089     glbFreeLibrary(GLU_LibHandle);
2090
2091   GL_LibHandle := glbLoadLibrary(libopengl);
2092   if not Assigned(GL_LibHandle) then
2093     raise EglBitmap.Create('unable to load library: ' + libopengl);
2094
2095   GLU_LibHandle := glbLoadLibrary(libglu);
2096   if not Assigned(GLU_LibHandle) then
2097     raise EglBitmap.Create('unable to load library: ' + libglu);
2098
2099 {$IF DEFINED(GLB_WIN)}
2100   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2101 {$ELSEIF DEFINED(GLB_LINUX)}
2102   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2103   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2104 {$IFEND}
2105
2106   glEnable := glbGetProcAddress('glEnable');
2107   glDisable := glbGetProcAddress('glDisable');
2108   glGetString := glbGetProcAddress('glGetString');
2109   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2110   glTexParameteri := glbGetProcAddress('glTexParameteri');
2111   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2112   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2113   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2114   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2115   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2116   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2117   glTexGeni := glbGetProcAddress('glTexGeni');
2118   glGenTextures := glbGetProcAddress('glGenTextures');
2119   glBindTexture := glbGetProcAddress('glBindTexture');
2120   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2121   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2122   glReadPixels := glbGetProcAddress('glReadPixels');
2123   glPixelStorei := glbGetProcAddress('glPixelStorei');
2124   glTexImage1D := glbGetProcAddress('glTexImage1D');
2125   glTexImage2D := glbGetProcAddress('glTexImage2D');
2126   glGetTexImage := glbGetProcAddress('glGetTexImage');
2127
2128   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2129   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2130 end;
2131 {$ENDIF}
2132
2133 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2134 procedure glbReadOpenGLExtensions;
2135 var
2136   Buffer: AnsiString;
2137   MajorVersion, MinorVersion: Integer;
2138
2139   ///////////////////////////////////////////////////////////////////////////////////////////
2140   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2141   var
2142     Separator: Integer;
2143   begin
2144     aMinor := 0;
2145     aMajor := 0;
2146
2147     Separator := Pos(AnsiString('.'), aBuffer);
2148     if (Separator > 1) and (Separator < Length(aBuffer)) and
2149        (aBuffer[Separator - 1] in ['0'..'9']) and
2150        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2151
2152       Dec(Separator);
2153       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2154         Dec(Separator);
2155
2156       Delete(aBuffer, 1, Separator);
2157       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2158
2159       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2160         Inc(Separator);
2161
2162       Delete(aBuffer, Separator, 255);
2163       Separator := Pos(AnsiString('.'), aBuffer);
2164
2165       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2166       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2167     end;
2168   end;
2169
2170   ///////////////////////////////////////////////////////////////////////////////////////////
2171   function CheckExtension(const Extension: AnsiString): Boolean;
2172   var
2173     ExtPos: Integer;
2174   begin
2175     ExtPos := Pos(Extension, Buffer);
2176     result := ExtPos > 0;
2177     if result then
2178       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2179   end;
2180
2181   ///////////////////////////////////////////////////////////////////////////////////////////
2182   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2183   begin
2184     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2185   end;
2186
2187 begin
2188 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2189   InitOpenGLCS.Enter;
2190   try
2191     if not OpenGLInitialized then begin
2192       glbInitOpenGL;
2193       OpenGLInitialized := true;
2194     end;
2195   finally
2196     InitOpenGLCS.Leave;
2197   end;
2198 {$ENDIF}
2199
2200   // Version
2201   Buffer := glGetString(GL_VERSION);
2202   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2203
2204   GL_VERSION_1_2 := CheckVersion(1, 2);
2205   GL_VERSION_1_3 := CheckVersion(1, 3);
2206   GL_VERSION_1_4 := CheckVersion(1, 4);
2207   GL_VERSION_2_0 := CheckVersion(2, 0);
2208   GL_VERSION_3_3 := CheckVersion(3, 3);
2209
2210   // Extensions
2211   Buffer := glGetString(GL_EXTENSIONS);
2212   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2213   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2214   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2215   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2216   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2217   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2218   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2219   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2220   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2221   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2222   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2223   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2224   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2225   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2226
2227   if GL_VERSION_1_3 then begin
2228     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2229     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2230     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2231   end else begin
2232     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2233     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2234     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2235   end;
2236 end;
2237 {$ENDIF}
2238
2239 {$IFDEF GLB_SDL_IMAGE}
2240 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2242 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2244 begin
2245   result := TStream(context^.unknown.data1).Seek(offset, whence);
2246 end;
2247
2248 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2249 begin
2250   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2251 end;
2252
2253 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2254 begin
2255   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2256 end;
2257
2258 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2259 begin
2260   result := 0;
2261 end;
2262
2263 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2264 begin
2265   result := SDL_AllocRW;
2266
2267   if result = nil then
2268     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2269
2270   result^.seek := glBitmapRWseek;
2271   result^.read := glBitmapRWread;
2272   result^.write := glBitmapRWwrite;
2273   result^.close := glBitmapRWclose;
2274   result^.unknown.data1 := Stream;
2275 end;
2276 {$ENDIF}
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2280 begin
2281   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2286 begin
2287   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2292 begin
2293   glBitmapDefaultMipmap := aValue;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2298 begin
2299   glBitmapDefaultFormat := aFormat;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2304 begin
2305   glBitmapDefaultFilterMin := aMin;
2306   glBitmapDefaultFilterMag := aMag;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2311 begin
2312   glBitmapDefaultWrapS := S;
2313   glBitmapDefaultWrapT := T;
2314   glBitmapDefaultWrapR := R;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2319 begin
2320   glDefaultSwizzle[0] := r;
2321   glDefaultSwizzle[1] := g;
2322   glDefaultSwizzle[2] := b;
2323   glDefaultSwizzle[3] := a;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2328 begin
2329   result := glBitmapDefaultDeleteTextureOnFree;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2334 begin
2335   result := glBitmapDefaultFreeDataAfterGenTextures;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2340 begin
2341   result := glBitmapDefaultMipmap;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function glBitmapGetDefaultFormat: TglBitmapFormat;
2346 begin
2347   result := glBitmapDefaultFormat;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2352 begin
2353   aMin := glBitmapDefaultFilterMin;
2354   aMag := glBitmapDefaultFilterMag;
2355 end;
2356
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2359 begin
2360   S := glBitmapDefaultWrapS;
2361   T := glBitmapDefaultWrapT;
2362   R := glBitmapDefaultWrapR;
2363 end;
2364
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2367 begin
2368   r := glDefaultSwizzle[0];
2369   g := glDefaultSwizzle[1];
2370   b := glDefaultSwizzle[2];
2371   a := glDefaultSwizzle[3];
2372 end;
2373
2374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2375 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetRedMask: QWord;
2378 begin
2379   result := fRange.r shl fShift.r;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetGreenMask: QWord;
2384 begin
2385   result := fRange.g shl fShift.g;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetBlueMask: QWord;
2390 begin
2391   result := fRange.b shl fShift.b;
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.GetAlphaMask: QWord;
2396 begin
2397   result := fRange.a shl fShift.a;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 function TFormatDescriptor.GetIsCompressed: Boolean;
2402 begin
2403   result := fIsCompressed;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function TFormatDescriptor.GetHasRed: Boolean;
2408 begin
2409   result := (fRange.r > 0);
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 function TFormatDescriptor.GetHasGreen: Boolean;
2414 begin
2415   result := (fRange.g > 0);
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function TFormatDescriptor.GetHasBlue: Boolean;
2420 begin
2421   result := (fRange.b > 0);
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 function TFormatDescriptor.GetHasAlpha: Boolean;
2426 begin
2427   result := (fRange.a > 0);
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
2432 begin
2433   result := fRGBInverted;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
2438 begin
2439   result := fWithAlpha;
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
2444 begin
2445   result := fWithoutAlpha;
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
2450 begin
2451   result := fOpenGLFormat;
2452 end;
2453
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
2456 begin
2457   result := fUncompressed;
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 function TFormatDescriptor.GetglFormat: GLenum;
2462 begin
2463   result := fglFormat;
2464 end;
2465
2466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2467 function TFormatDescriptor.GetglInternalFormat: GLenum;
2468 begin
2469   result := fglInternalFormat;
2470 end;
2471
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 function TFormatDescriptor.GetglDataFormat: GLenum;
2474 begin
2475   result := fglDataFormat;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 function TFormatDescriptor.GetComponents: Integer;
2480 var
2481   i: Integer;
2482 begin
2483   result := 0;
2484   for i := 0 to 3 do
2485     if (fRange.arr[i] > 0) then
2486       inc(result);
2487 end;
2488
2489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2491 var
2492   w, h: Integer;
2493 begin
2494   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2495     w := Max(1, aSize.X);
2496     h := Max(1, aSize.Y);
2497     result := GetSize(w, h);
2498   end else
2499     result := 0;
2500 end;
2501
2502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2503 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2504 begin
2505   result := 0;
2506   if (aWidth <= 0) or (aHeight <= 0) then
2507     exit;
2508   result := Ceil(aWidth * aHeight * fPixelSize);
2509 end;
2510
2511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 function TFormatDescriptor.CreateMappingData: Pointer;
2513 begin
2514   result := nil;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2519 begin
2520   //DUMMY
2521 end;
2522
2523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 function TFormatDescriptor.IsEmpty: Boolean;
2525 begin
2526   result := (fFormat = tfEmpty);
2527 end;
2528
2529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2531 begin
2532   result := false;
2533   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2534     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2535   if (aRedMask   <> RedMask) then
2536     exit;
2537   if (aGreenMask <> GreenMask) then
2538     exit;
2539   if (aBlueMask  <> BlueMask) then
2540     exit;
2541   if (aAlphaMask <> AlphaMask) then
2542     exit;
2543   result := true;
2544 end;
2545
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2548 begin
2549   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2550   aPixel.Data   := fRange;
2551   aPixel.Range  := fRange;
2552   aPixel.Format := fFormat;
2553 end;
2554
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 constructor TFormatDescriptor.Create;
2557 begin
2558   inherited Create;
2559
2560   fFormat       := tfEmpty;
2561   fWithAlpha    := tfEmpty;
2562   fWithoutAlpha := tfEmpty;
2563   fOpenGLFormat := tfEmpty;
2564   fRGBInverted  := tfEmpty;
2565   fUncompressed := tfEmpty;
2566
2567   fPixelSize    := 0.0;
2568   fIsCompressed := false;
2569
2570   fglFormat         := 0;
2571   fglInternalFormat := 0;
2572   fglDataFormat     := 0;
2573
2574   FillChar(fRange, 0, SizeOf(fRange));
2575   FillChar(fShift, 0, SizeOf(fShift));
2576 end;
2577
2578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2581 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2582 begin
2583   aData^ := aPixel.Data.a;
2584   inc(aData);
2585 end;
2586
2587 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2588 begin
2589   aPixel.Data.r := 0;
2590   aPixel.Data.g := 0;
2591   aPixel.Data.b := 0;
2592   aPixel.Data.a := aData^;
2593   inc(aData);
2594 end;
2595
2596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2597 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2600 begin
2601   aData^ := LuminanceWeight(aPixel);
2602   inc(aData);
2603 end;
2604
2605 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2606 begin
2607   aPixel.Data.r := aData^;
2608   aPixel.Data.g := aData^;
2609   aPixel.Data.b := aData^;
2610   aPixel.Data.a := 0;
2611   inc(aData);
2612 end;
2613
2614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2617 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2618 var
2619   i: Integer;
2620 begin
2621   aData^ := 0;
2622   for i := 0 to 3 do
2623     if (fRange.arr[i] > 0) then
2624       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2625   inc(aData);
2626 end;
2627
2628 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2629 var
2630   i: Integer;
2631 begin
2632   for i := 0 to 3 do
2633     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2634   inc(aData);
2635 end;
2636
2637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2638 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2641 begin
2642   inherited Map(aPixel, aData, aMapData);
2643   aData^ := aPixel.Data.a;
2644   inc(aData);
2645 end;
2646
2647 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2648 begin
2649   inherited Unmap(aData, aPixel, aMapData);
2650   aPixel.Data.a := aData^;
2651   inc(aData);
2652 end;
2653
2654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2655 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2657 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2658 begin
2659   aData^ := aPixel.Data.b;
2660   inc(aData);
2661   aData^ := aPixel.Data.g;
2662   inc(aData);
2663   aData^ := aPixel.Data.r;
2664   inc(aData);
2665 end;
2666
2667 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2668 begin
2669   aPixel.Data.b := aData^;
2670   inc(aData);
2671   aPixel.Data.g := aData^;
2672   inc(aData);
2673   aPixel.Data.r := aData^;
2674   inc(aData);
2675   aPixel.Data.a := 0;
2676 end;
2677
2678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2682 begin
2683   aData^ := aPixel.Data.r;
2684   inc(aData);
2685   aData^ := aPixel.Data.g;
2686   inc(aData);
2687   aData^ := aPixel.Data.b;
2688   inc(aData);
2689 end;
2690
2691 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2692 begin
2693   aPixel.Data.r := aData^;
2694   inc(aData);
2695   aPixel.Data.g := aData^;
2696   inc(aData);
2697   aPixel.Data.b := aData^;
2698   inc(aData);
2699   aPixel.Data.a := 0;
2700 end;
2701
2702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2703 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2706 begin
2707   PWord(aData)^ := aPixel.Data.a;
2708   inc(aData, 2);
2709 end;
2710
2711 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2712 begin
2713   aPixel.Data.r := 0;
2714   aPixel.Data.g := 0;
2715   aPixel.Data.b := 0;
2716   aPixel.Data.a := PWord(aData)^;
2717   inc(aData, 2);
2718 end;
2719
2720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2721 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2723 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2724 begin
2725   PWord(aData)^ := LuminanceWeight(aPixel);
2726   inc(aData, 2);
2727 end;
2728
2729 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2730 begin
2731   aPixel.Data.r := PWord(aData)^;
2732   aPixel.Data.g := PWord(aData)^;
2733   aPixel.Data.b := PWord(aData)^;
2734   aPixel.Data.a := 0;
2735   inc(aData, 2);
2736 end;
2737
2738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2739 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2742 var
2743   i: Integer;
2744 begin
2745   PWord(aData)^ := 0;
2746   for i := 0 to 3 do
2747     if (fRange.arr[i] > 0) then
2748       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2749   inc(aData, 2);
2750 end;
2751
2752 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2753 var
2754   i: Integer;
2755 begin
2756   for i := 0 to 3 do
2757     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2758   inc(aData, 2);
2759 end;
2760
2761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2764 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2765 begin
2766   PWord(aData)^ := DepthWeight(aPixel);
2767   inc(aData, 2);
2768 end;
2769
2770 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2771 begin
2772   aPixel.Data.r := PWord(aData)^;
2773   aPixel.Data.g := PWord(aData)^;
2774   aPixel.Data.b := PWord(aData)^;
2775   aPixel.Data.a := PWord(aData)^;;
2776   inc(aData, 2);
2777 end;
2778
2779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2780 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2782 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2783 begin
2784   inherited Map(aPixel, aData, aMapData);
2785   PWord(aData)^ := aPixel.Data.a;
2786   inc(aData, 2);
2787 end;
2788
2789 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2790 begin
2791   inherited Unmap(aData, aPixel, aMapData);
2792   aPixel.Data.a := PWord(aData)^;
2793   inc(aData, 2);
2794 end;
2795
2796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2800 begin
2801   PWord(aData)^ := aPixel.Data.b;
2802   inc(aData, 2);
2803   PWord(aData)^ := aPixel.Data.g;
2804   inc(aData, 2);
2805   PWord(aData)^ := aPixel.Data.r;
2806   inc(aData, 2);
2807 end;
2808
2809 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2810 begin
2811   aPixel.Data.b := PWord(aData)^;
2812   inc(aData, 2);
2813   aPixel.Data.g := PWord(aData)^;
2814   inc(aData, 2);
2815   aPixel.Data.r := PWord(aData)^;
2816   inc(aData, 2);
2817   aPixel.Data.a := 0;
2818 end;
2819
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2823 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2824 begin
2825   PWord(aData)^ := aPixel.Data.r;
2826   inc(aData, 2);
2827   PWord(aData)^ := aPixel.Data.g;
2828   inc(aData, 2);
2829   PWord(aData)^ := aPixel.Data.b;
2830   inc(aData, 2);
2831 end;
2832
2833 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2834 begin
2835   aPixel.Data.r := PWord(aData)^;
2836   inc(aData, 2);
2837   aPixel.Data.g := PWord(aData)^;
2838   inc(aData, 2);
2839   aPixel.Data.b := PWord(aData)^;
2840   inc(aData, 2);
2841   aPixel.Data.a := 0;
2842 end;
2843
2844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2845 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2848 begin
2849   PWord(aData)^ := aPixel.Data.a;
2850   inc(aData, 2);
2851   inherited Map(aPixel, aData, aMapData);
2852 end;
2853
2854 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2855 begin
2856   aPixel.Data.a := PWord(aData)^;
2857   inc(aData, 2);
2858   inherited Unmap(aData, aPixel, aMapData);
2859 end;
2860
2861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2862 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2863 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2864 procedure TfdARGB_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2865 begin
2866   inherited Map(aPixel, aData, aMapData);
2867   PWord(aData)^ := aPixel.Data.a;
2868   inc(aData, 2);
2869 end;
2870
2871 procedure TfdARGB_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2872 begin
2873   inherited Unmap(aData, aPixel, aMapData);
2874   aPixel.Data.a := PWord(aData)^;
2875   inc(aData, 2);
2876 end;
2877
2878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2879 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2882 begin
2883   PWord(aData)^ := aPixel.Data.a;
2884   inc(aData, 2);
2885   inherited Map(aPixel, aData, aMapData);
2886 end;
2887
2888 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2889 begin
2890   aPixel.Data.a := PWord(aData)^;
2891   inc(aData, 2);
2892   inherited Unmap(aData, aPixel, aMapData);
2893 end;
2894
2895 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2896 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2898 procedure TfdABGR_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2899 begin
2900   inherited Map(aPixel, aData, aMapData);
2901   PWord(aData)^ := aPixel.Data.a;
2902   inc(aData, 2);
2903 end;
2904
2905 procedure TfdABGR_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2906 begin
2907   inherited Unmap(aData, aPixel, aMapData);
2908   aPixel.Data.a := PWord(aData)^;
2909   inc(aData, 2);
2910 end;
2911
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2916 var
2917   i: Integer;
2918 begin
2919   PCardinal(aData)^ := 0;
2920   for i := 0 to 3 do
2921     if (fRange.arr[i] > 0) then
2922       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2923   inc(aData, 4);
2924 end;
2925
2926 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2927 var
2928   i: Integer;
2929 begin
2930   for i := 0 to 3 do
2931     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2932   inc(aData, 2);
2933 end;
2934
2935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2936 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2938 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2939 begin
2940   PCardinal(aData)^ := DepthWeight(aPixel);
2941   inc(aData, 4);
2942 end;
2943
2944 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2945 begin
2946   aPixel.Data.r := PCardinal(aData)^;
2947   aPixel.Data.g := PCardinal(aData)^;
2948   aPixel.Data.b := PCardinal(aData)^;
2949   aPixel.Data.a := 0;
2950   inc(aData, 4);
2951 end;
2952
2953 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2956 constructor TfdAlpha4.Create;
2957 begin
2958   inherited Create;
2959   fPixelSize        := 1.0;
2960   fFormat           := tfAlpha4;
2961   fWithAlpha        := tfAlpha4;
2962   fOpenGLFormat     := tfAlpha4;
2963   fRange.a          := $FF;
2964   fglFormat         := GL_ALPHA;
2965   fglInternalFormat := GL_ALPHA4;
2966   fglDataFormat     := GL_UNSIGNED_BYTE;
2967 end;
2968
2969 constructor TfdAlpha8.Create;
2970 begin
2971   inherited Create;
2972   fPixelSize        := 1.0;
2973   fFormat           := tfAlpha8;
2974   fWithAlpha        := tfAlpha8;
2975   fOpenGLFormat     := tfAlpha8;
2976   fRange.a          := $FF;
2977   fglFormat         := GL_ALPHA;
2978   fglInternalFormat := GL_ALPHA8;
2979   fglDataFormat     := GL_UNSIGNED_BYTE;
2980 end;
2981
2982 constructor TfdAlpha16.Create;
2983 begin
2984   inherited Create;
2985   fPixelSize        := 2.0;
2986   fFormat           := tfAlpha16;
2987   fWithAlpha        := tfAlpha16;
2988   fOpenGLFormat     := tfAlpha16;
2989   fRange.a          := $FFFF;
2990   fglFormat         := GL_ALPHA;
2991   fglInternalFormat := GL_ALPHA16;
2992   fglDataFormat     := GL_UNSIGNED_SHORT;
2993 end;
2994
2995 constructor TfdLuminance4.Create;
2996 begin
2997   inherited Create;
2998   fPixelSize        := 1.0;
2999   fFormat           := tfLuminance4;
3000   fWithAlpha        := tfLuminance4Alpha4;
3001   fWithoutAlpha     := tfLuminance4;
3002   fOpenGLFormat     := tfLuminance4;
3003   fRange.r          := $FF;
3004   fRange.g          := $FF;
3005   fRange.b          := $FF;
3006   fglFormat         := GL_LUMINANCE;
3007   fglInternalFormat := GL_LUMINANCE4;
3008   fglDataFormat     := GL_UNSIGNED_BYTE;
3009 end;
3010
3011 constructor TfdLuminance8.Create;
3012 begin
3013   inherited Create;
3014   fPixelSize        := 1.0;
3015   fFormat           := tfLuminance8;
3016   fWithAlpha        := tfLuminance8Alpha8;
3017   fWithoutAlpha     := tfLuminance8;
3018   fOpenGLFormat     := tfLuminance8;
3019   fRange.r          := $FF;
3020   fRange.g          := $FF;
3021   fRange.b          := $FF;
3022   fglFormat         := GL_LUMINANCE;
3023   fglInternalFormat := GL_LUMINANCE8;
3024   fglDataFormat     := GL_UNSIGNED_BYTE;
3025 end;
3026
3027 constructor TfdLuminance16.Create;
3028 begin
3029   inherited Create;
3030   fPixelSize        := 2.0;
3031   fFormat           := tfLuminance16;
3032   fWithAlpha        := tfLuminance16Alpha16;
3033   fWithoutAlpha     := tfLuminance16;
3034   fOpenGLFormat     := tfLuminance16;
3035   fRange.r          := $FFFF;
3036   fRange.g          := $FFFF;
3037   fRange.b          := $FFFF;
3038   fglFormat         := GL_LUMINANCE;
3039   fglInternalFormat := GL_LUMINANCE16;
3040   fglDataFormat     := GL_UNSIGNED_SHORT;
3041 end;
3042
3043 constructor TfdLuminance4Alpha4.Create;
3044 begin
3045   inherited Create;
3046   fPixelSize        := 2.0;
3047   fFormat           := tfLuminance4Alpha4;
3048   fWithAlpha        := tfLuminance4Alpha4;
3049   fWithoutAlpha     := tfLuminance4;
3050   fOpenGLFormat     := tfLuminance4Alpha4;
3051   fRange.r          := $FF;
3052   fRange.g          := $FF;
3053   fRange.b          := $FF;
3054   fRange.a          := $FF;
3055   fShift.r          := 0;
3056   fShift.g          := 0;
3057   fShift.b          := 0;
3058   fShift.a          := 8;
3059   fglFormat         := GL_LUMINANCE_ALPHA;
3060   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3061   fglDataFormat     := GL_UNSIGNED_BYTE;
3062 end;
3063
3064 constructor TfdLuminance6Alpha2.Create;
3065 begin
3066   inherited Create;
3067   fPixelSize        := 2.0;
3068   fFormat           := tfLuminance6Alpha2;
3069   fWithAlpha        := tfLuminance6Alpha2;
3070   fWithoutAlpha     := tfLuminance8;
3071   fOpenGLFormat     := tfLuminance6Alpha2;
3072   fRange.r          := $FF;
3073   fRange.g          := $FF;
3074   fRange.b          := $FF;
3075   fRange.a          := $FF;
3076   fShift.r          := 0;
3077   fShift.g          := 0;
3078   fShift.b          := 0;
3079   fShift.a          := 8;
3080   fglFormat         := GL_LUMINANCE_ALPHA;
3081   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3082   fglDataFormat     := GL_UNSIGNED_BYTE;
3083 end;
3084
3085 constructor TfdLuminance8Alpha8.Create;
3086 begin
3087   inherited Create;
3088   fPixelSize        := 2.0;
3089   fFormat           := tfLuminance8Alpha8;
3090   fWithAlpha        := tfLuminance8Alpha8;
3091   fWithoutAlpha     := tfLuminance8;
3092   fOpenGLFormat     := tfLuminance8Alpha8;
3093   fRange.r          := $FF;
3094   fRange.g          := $FF;
3095   fRange.b          := $FF;
3096   fRange.a          := $FF;
3097   fShift.r          := 0;
3098   fShift.g          := 0;
3099   fShift.b          := 0;
3100   fShift.a          := 8;
3101   fglFormat         := GL_LUMINANCE_ALPHA;
3102   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3103   fglDataFormat     := GL_UNSIGNED_BYTE;
3104 end;
3105
3106 constructor TfdLuminance12Alpha4.Create;
3107 begin
3108   inherited Create;
3109   fPixelSize        := 4.0;
3110   fFormat           := tfLuminance12Alpha4;
3111   fWithAlpha        := tfLuminance12Alpha4;
3112   fWithoutAlpha     := tfLuminance16;
3113   fOpenGLFormat     := tfLuminance12Alpha4;
3114   fRange.r          := $FFFF;
3115   fRange.g          := $FFFF;
3116   fRange.b          := $FFFF;
3117   fRange.a          := $FFFF;
3118   fShift.r          := 0;
3119   fShift.g          := 0;
3120   fShift.b          := 0;
3121   fShift.a          := 16;
3122   fglFormat         := GL_LUMINANCE_ALPHA;
3123   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3124   fglDataFormat     := GL_UNSIGNED_SHORT;
3125 end;
3126
3127 constructor TfdLuminance16Alpha16.Create;
3128 begin
3129   inherited Create;
3130   fPixelSize        := 4.0;
3131   fFormat           := tfLuminance16Alpha16;
3132   fWithAlpha        := tfLuminance16Alpha16;
3133   fWithoutAlpha     := tfLuminance16;
3134   fOpenGLFormat     := tfLuminance16Alpha16;
3135   fRange.r          := $FFFF;
3136   fRange.g          := $FFFF;
3137   fRange.b          := $FFFF;
3138   fRange.a          := $FFFF;
3139   fShift.r          := 0;
3140   fShift.g          := 0;
3141   fShift.b          := 0;
3142   fShift.a          := 16;
3143   fglFormat         := GL_LUMINANCE_ALPHA;
3144   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3145   fglDataFormat     := GL_UNSIGNED_SHORT;
3146 end;
3147
3148 constructor TfdR3G3B2.Create;
3149 begin
3150   inherited Create;
3151   fPixelSize        := 1.0;
3152   fFormat           := tfR3G3B2;
3153   fWithAlpha        := tfRGBA4;
3154   fWithoutAlpha     := tfR3G3B2;
3155   fOpenGLFormat     := tfR3G3B2;
3156   fRGBInverted      := tfEmpty;
3157   fRange.r          := $07;
3158   fRange.g          := $07;
3159   fRange.b          := $04;
3160   fShift.r          := 5;
3161   fShift.g          := 2;
3162   fShift.b          := 0;
3163   fglFormat         := GL_RGB;
3164   fglInternalFormat := GL_R3_G3_B2;
3165   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3166 end;
3167
3168 constructor TfdRGBX4.Create;
3169 begin
3170   inherited Create;
3171   fPixelSize        := 2.0;
3172   fFormat           := tfRGBX4;
3173   fWithAlpha        := tfRGBA4;
3174   fWithoutAlpha     := tfRGBX4;
3175   fOpenGLFormat     := tfRGBX4;
3176   fRGBInverted      := tfBGRX4;
3177   fRange.r          := $0F;
3178   fRange.g          := $0F;
3179   fRange.b          := $0F;
3180   fRange.a          := $00;
3181   fShift.r          := 12;
3182   fShift.g          :=  8;
3183   fShift.b          :=  4;
3184   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3185   fglInternalFormat := GL_RGB4;
3186   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3187 end;
3188
3189 constructor TfdXRGB4.Create;
3190 begin
3191   inherited Create;
3192   fPixelSize        := 2.0;
3193   fFormat           := tfXRGB4;
3194   fWithAlpha        := tfARGB4;
3195   fWithoutAlpha     := tfXRGB4;
3196   fOpenGLFormat     := tfXRGB4;
3197   fRGBInverted      := tfXBGR4;
3198   fRange.r          := $0F;
3199   fRange.g          := $0F;
3200   fRange.b          := $0F;
3201   fShift.r          := 8;
3202   fShift.g          := 4;
3203   fShift.b          := 0;
3204   fglFormat         := GL_BGRA;
3205   fglInternalFormat := GL_RGB4;
3206   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3207 end;
3208
3209 constructor TfdR5G6B5.Create;
3210 begin
3211   inherited Create;
3212   fPixelSize        := 2.0;
3213   fFormat           := tfR5G6B5;
3214   fWithAlpha        := tfRGB5A1;
3215   fWithoutAlpha     := tfR5G6B5;
3216   fOpenGLFormat     := tfR5G6B5;
3217   fRGBInverted      := tfB5G6R5;
3218   fRange.r          := $1F;
3219   fRange.g          := $3F;
3220   fRange.b          := $1F;
3221   fShift.r          := 11;
3222   fShift.g          := 5;
3223   fShift.b          := 0;
3224   fglFormat         := GL_RGB;
3225   fglInternalFormat := GL_RGB565;
3226   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3227 end;
3228
3229 constructor TfdRGB5X1.Create;
3230 begin
3231   inherited Create;
3232   fPixelSize        := 2.0;
3233   fFormat           := tfRGB5X1;
3234   fWithAlpha        := tfRGB5A1;
3235   fWithoutAlpha     := tfRGB5X1;
3236   fOpenGLFormat     := tfRGB5X1;
3237   fRGBInverted      := tfBGR5X1;
3238   fRange.r          := $1F;
3239   fRange.g          := $1F;
3240   fRange.b          := $1F;
3241   fShift.r          := 11;
3242   fShift.g          :=  6;
3243   fShift.b          :=  1;
3244   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3245   fglInternalFormat := GL_RGB5;
3246   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3247 end;
3248
3249 constructor TfdX1RGB5.Create;
3250 begin
3251   inherited Create;
3252   fPixelSize        := 2.0;
3253   fFormat           := tfX1RGB5;
3254   fWithAlpha        := tfA1RGB5;
3255   fWithoutAlpha     := tfX1RGB5;
3256   fOpenGLFormat     := tfX1RGB5;
3257   fRGBInverted      := tfX1BGR5;
3258   fRange.r          := $1F;
3259   fRange.g          := $1F;
3260   fRange.b          := $1F;
3261   fShift.r          := 10;
3262   fShift.g          :=  5;
3263   fShift.b          :=  0;
3264   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3265   fglInternalFormat := GL_RGB5;
3266   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3267 end;
3268
3269 constructor TfdRGB8.Create;
3270 begin
3271   inherited Create;
3272   fPixelSize        := 3.0;
3273   fFormat           := tfRGB8;
3274   fWithAlpha        := tfRGBA8;
3275   fWithoutAlpha     := tfRGB8;
3276   fOpenGLFormat     := tfRGB8;
3277   fRGBInverted      := tfBGR8;
3278   fRange.r          := $FF;
3279   fRange.g          := $FF;
3280   fRange.b          := $FF;
3281   fShift.r          := 16;
3282   fShift.g          :=  8;
3283   fShift.b          :=  0;
3284   fglFormat         := GL_BGR;    // reverse byte order to match little endianess
3285   fglInternalFormat := GL_RGB8;   // as if u interpret the 3 bytes as unsigned integer
3286   fglDataFormat     := GL_UNSIGNED_BYTE;
3287 end;
3288
3289 constructor TfdRGBX8.Create;
3290 begin
3291   inherited Create;
3292   fPixelSize        := 4.0;
3293   fFormat           := tfRGBX8;
3294   fWithAlpha        := tfRGBA8;
3295   fWithoutAlpha     := tfRGBX8;
3296   fOpenGLFormat     := tfRGB8;
3297   fRGBInverted      := tfBGRX8;
3298   fRange.r          := $FF;
3299   fRange.g          := $FF;
3300   fRange.b          := $FF;
3301   fShift.r          := 24;
3302   fShift.g          := 16;
3303   fShift.b          := 8;
3304   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3305   fglInternalFormat := GL_RGB8;
3306   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3307 end;
3308
3309 constructor TfdXRGB8.Create;
3310 begin
3311   inherited Create;
3312   fPixelSize        := 4.0;
3313   fFormat           := tfXRGB8;
3314   fWithAlpha        := tfXRGB8;
3315   fWithoutAlpha     := tfXRGB8;
3316   fOpenGLFormat     := tfRGB8;
3317   fRGBInverted      := tfXBGR8;
3318   fRange.r          := $FF;
3319   fRange.g          := $FF;
3320   fRange.b          := $FF;
3321   fShift.r          := 16;
3322   fShift.g          :=  8;
3323   fShift.b          :=  0;
3324   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3325   fglInternalFormat := GL_RGB8;
3326   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3327 end;
3328
3329 constructor TfdRGB10X2.Create;
3330 begin
3331   inherited Create;
3332   fPixelSize        := 3.0;
3333   fFormat           := tfRGB10X2;
3334   fWithAlpha        := tfRGB10A2;
3335   fWithoutAlpha     := tfRGB10X2;
3336   fOpenGLFormat     := tfRGB10X2;
3337   fRGBInverted      := tfBGR10X2;
3338   fRange.r          := $03FF;
3339   fRange.g          := $03FF;
3340   fRange.b          := $03FF;
3341   fShift.r          := 22;
3342   fShift.g          := 12;
3343   fShift.b          :=  2;
3344   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3345   fglInternalFormat := GL_RGB10;
3346   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3347 end;
3348
3349 constructor TfdX2RGB10.Create;
3350 begin
3351   inherited Create;
3352   fPixelSize        := 3.0;
3353   fFormat           := tfX2RGB10;
3354   fWithAlpha        := tfA2RGB10;
3355   fWithoutAlpha     := tfX2RGB10;
3356   fOpenGLFormat     := tfX2RGB10;
3357   fRGBInverted      := tfX2BGR10;
3358   fRange.r          := $03FF;
3359   fRange.g          := $03FF;
3360   fRange.b          := $03FF;
3361   fShift.r          := 20;
3362   fShift.g          := 10;
3363   fShift.b          :=  0;
3364   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3365   fglInternalFormat := GL_RGB10;
3366   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3367 end;
3368
3369 constructor TfdRGB16.Create;
3370 begin
3371   inherited Create;
3372   fPixelSize        := 6.0;
3373   fFormat           := tfRGB16;
3374   fWithAlpha        := tfRGBA16;
3375   fWithoutAlpha     := tfRGB16;
3376   fOpenGLFormat     := tfRGB16;
3377   fRGBInverted      := tfBGR16;
3378   fRange.r          := $FFFF;
3379   fRange.g          := $FFFF;
3380   fRange.b          := $FFFF;
3381   fShift.r          := 32;
3382   fShift.g          := 16;
3383   fShift.b          :=  0;
3384   fglFormat         := GL_BGR;     // reverse byte order to match little endianess
3385   fglInternalFormat := GL_RGB16;   // as if u interpret the 3 bytes as unsigned integer
3386   fglDataFormat     := GL_UNSIGNED_SHORT;
3387 end;
3388
3389 constructor TfdRGBA4.Create;
3390 begin
3391   inherited Create;
3392   fPixelSize        := 2.0;
3393   fFormat           := tfRGBA4;
3394   fWithAlpha        := tfRGBA4;
3395   fWithoutAlpha     := tfRGBX4;
3396   fOpenGLFormat     := tfRGBA4;
3397   fRGBInverted      := tfBGRA4;
3398   fRange.r          := $0F;
3399   fRange.g          := $0F;
3400   fRange.b          := $0F;
3401   fRange.a          := $0F;
3402   fShift.r          := 12;
3403   fShift.g          :=  8;
3404   fShift.b          :=  4;
3405   fShift.a          :=  0;
3406   fglFormat         := GL_RGBA;
3407   fglInternalFormat := GL_RGBA4;
3408   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3409 end;
3410
3411 constructor TfdARGB4.Create;
3412 begin
3413   inherited Create;
3414   fPixelSize        := 2.0;
3415   fFormat           := tfARGB4;
3416   fWithAlpha        := tfARGB4;
3417   fWithoutAlpha     := tfXRGB4;
3418   fOpenGLFormat     := tfARGB4;
3419   fRGBInverted      := tfABGR4;
3420   fRange.r          := $0F;
3421   fRange.g          := $0F;
3422   fRange.b          := $0F;
3423   fRange.a          := $0F;
3424   fShift.r          :=  8;
3425   fShift.g          :=  4;
3426   fShift.b          :=  0;
3427   fShift.a          := 12;
3428   fglFormat         := GL_BGRA;
3429   fglInternalFormat := GL_RGBA4;
3430   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3431 end;
3432
3433 constructor TfdRGB5A1.Create;
3434 begin
3435   inherited Create;
3436   fPixelSize        := 2.0;
3437   fFormat           := tfRGB5A1;
3438   fWithAlpha        := tfRGB5A1;
3439   fWithoutAlpha     := tfRGB5X1;
3440   fOpenGLFormat     := tfRGB5A1;
3441   fRGBInverted      := tfBGR5A1;
3442   fRange.r          := $1F;
3443   fRange.g          := $1F;
3444   fRange.b          := $1F;
3445   fRange.a          := $01;
3446   fShift.r          := 11;
3447   fShift.g          :=  6;
3448   fShift.b          :=  1;
3449   fShift.a          :=  0;
3450   fglFormat         := GL_RGBA;
3451   fglInternalFormat := GL_RGB5_A1;
3452   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3453 end;
3454
3455 constructor TfdA1RGB5.Create;
3456 begin
3457   inherited Create;
3458   fPixelSize        := 2.0;
3459   fFormat           := tfA1RGB5;
3460   fWithAlpha        := tfA1RGB5;
3461   fWithoutAlpha     := tfX1RGB5;
3462   fOpenGLFormat     := tfA1RGB5;
3463   fRGBInverted      := tfA1BGR5;
3464   fRange.r          := $1F;
3465   fRange.g          := $1F;
3466   fRange.b          := $1F;
3467   fRange.a          := $01;
3468   fShift.r          := 10;
3469   fShift.g          :=  5;
3470   fShift.b          :=  0;
3471   fShift.a          := 15;
3472   fglFormat         := GL_BGRA;
3473   fglInternalFormat := GL_RGB5_A1;
3474   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3475 end;
3476
3477 constructor TfdRGBA8.Create;
3478 begin
3479   inherited Create;
3480   fPixelSize        := 4.0;
3481   fFormat           := tfRGBA8;
3482   fWithAlpha        := tfRGBA8;
3483   fWithoutAlpha     := tfRGB8;
3484   fOpenGLFormat     := tfRGBA8;
3485   fRGBInverted      := tfBGRA8;
3486   fRange.r          := $FF;
3487   fRange.g          := $FF;
3488   fRange.b          := $FF;
3489   fRange.a          := $FF;
3490   fShift.r          := 24;
3491   fShift.g          := 16;
3492   fShift.b          :=  8;
3493   fShift.a          :=  0;
3494   fglFormat         := GL_RGBA;
3495   fglInternalFormat := GL_RGBA8;
3496   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3497 end;
3498
3499 constructor TfdARGB8.Create;
3500 begin
3501   inherited Create;
3502   fPixelSize        := 4.0;
3503   fFormat           := tfARGB8;
3504   fWithAlpha        := tfARGB8;
3505   fWithoutAlpha     := tfRGB8;
3506   fOpenGLFormat     := tfARGB8;
3507   fRGBInverted      := tfABGR8;
3508   fRange.r          := $FF;
3509   fRange.g          := $FF;
3510   fRange.b          := $FF;
3511   fRange.a          := $FF;
3512   fShift.r          := 16;
3513   fShift.g          :=  8;
3514   fShift.b          :=  0;
3515   fShift.a          := 24;
3516   fglFormat         := GL_BGRA;
3517   fglInternalFormat := GL_RGBA8;
3518   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3519 end;
3520
3521 constructor TfdRGB10A2.Create;
3522 begin
3523   inherited Create;
3524   fPixelSize        := 3.0;
3525   fFormat           := tfRGB10A2;
3526   fWithAlpha        := tfRGB10A2;
3527   fWithoutAlpha     := tfRGB10X2;
3528   fOpenGLFormat     := tfRGB10A2;
3529   fRGBInverted      := tfBGR10A2;
3530   fRange.r          := $03FF;
3531   fRange.g          := $03FF;
3532   fRange.b          := $03FF;
3533   fRange.a          := $0003;
3534   fShift.r          := 22;
3535   fShift.g          := 12;
3536   fShift.b          :=  2;
3537   fShift.a          :=  0;
3538   fglFormat         := GL_RGBA;
3539   fglInternalFormat := GL_RGB10_A2;
3540   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3541 end;
3542
3543 constructor TfdA2RGB10.Create;
3544 begin
3545   inherited Create;
3546   fPixelSize        := 3.0;
3547   fFormat           := tfA2RGB10;
3548   fWithAlpha        := tfA2RGB10;
3549   fWithoutAlpha     := tfX2RGB10;
3550   fOpenGLFormat     := tfA2RGB10;
3551   fRGBInverted      := tfA2BGR10;
3552   fRange.r          := $03FF;
3553   fRange.g          := $03FF;
3554   fRange.b          := $03FF;
3555   fRange.a          := $0003;
3556   fShift.r          := 20;
3557   fShift.g          := 10;
3558   fShift.b          :=  0;
3559   fShift.a          := 30;
3560   fglFormat         := GL_BGRA;
3561   fglInternalFormat := GL_RGB10_A2;
3562   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3563 end;
3564
3565 constructor TfdRGBA16.Create;
3566 begin
3567   inherited Create;
3568   fPixelSize        := 8.0;
3569   fFormat           := tfRGBA16;
3570   fWithAlpha        := tfRGBA16;
3571   fWithoutAlpha     := tfRGB16;
3572   fOpenGLFormat     := tfRGBA16;
3573   fRGBInverted      := tfBGRA16;
3574   fRange.r          := $FFFF;
3575   fRange.g          := $FFFF;
3576   fRange.b          := $FFFF;
3577   fRange.a          := $FFFF;
3578   fShift.r          := 48;
3579   fShift.g          := 32;
3580   fShift.b          := 16;
3581   fShift.a          :=  0;
3582   fglFormat         := GL_BGRA;     // reverse byte order to match little endianess
3583   fglInternalFormat := GL_RGBA16;   // as if u interpret the 3 bytes as unsigned integer
3584   fglDataFormat     := GL_UNSIGNED_SHORT;
3585 end;
3586
3587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3590 constructor TfdBGRX4.Create;
3591 begin
3592   inherited Create;
3593   fPixelSize        := 2.0;
3594   fFormat           := tfBGRX4;
3595   fWithAlpha        := tfBGRA4;
3596   fWithoutAlpha     := tfBGRX4;
3597   fOpenGLFormat     := tfBGRX4;
3598   fRGBInverted      := tfRGBX4;
3599   fRange.r          := $0F;
3600   fRange.g          := $0F;
3601   fRange.b          := $0F;
3602   fShift.r          :=  4;
3603   fShift.g          :=  8;
3604   fShift.b          := 12;
3605   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3606   fglInternalFormat := GL_RGB4;
3607   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3608 end;
3609
3610 constructor TfdXBGR4.Create;
3611 begin
3612   inherited Create;
3613   fPixelSize        := 2.0;
3614   fFormat           := tfXBGR4;
3615   fWithAlpha        := tfABGR4;
3616   fWithoutAlpha     := tfXBGR4;
3617   fOpenGLFormat     := tfXBGR4;
3618   fRGBInverted      := tfXRGB4;
3619   fRange.r          := $0F;
3620   fRange.g          := $0F;
3621   fRange.b          := $0F;
3622   fRange.a          := $0F;
3623   fShift.r          := 0;
3624   fShift.g          := 4;
3625   fShift.b          := 8;
3626   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3627   fglInternalFormat := GL_RGB4;
3628   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3629 end;
3630
3631 constructor TfdB5G6R5.Create;
3632 begin
3633   inherited Create;
3634   fPixelSize        := 2.0;
3635   fFormat           := tfB5G6R5;
3636   fWithAlpha        := tfBGR5A1;
3637   fWithoutAlpha     := tfB5G6R5;
3638   fOpenGLFormat     := tfB5G6R5;
3639   fRGBInverted      := tfR5G6B5;
3640   fRange.r          := $1F;
3641   fRange.g          := $3F;
3642   fRange.b          := $1F;
3643   fShift.r          :=  0;
3644   fShift.g          :=  5;
3645   fShift.b          := 11;
3646   fglFormat         := GL_RGB;
3647   fglInternalFormat := GL_RGB565;
3648   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3649 end;
3650
3651 constructor TfdBGR5X1.Create;
3652 begin
3653   inherited Create;
3654   fPixelSize        := 2.0;
3655   fFormat           := tfBGR5X1;
3656   fWithAlpha        := tfBGR5A1;
3657   fWithoutAlpha     := tfBGR5X1;
3658   fOpenGLFormat     := tfBGR5X1;
3659   fRGBInverted      := tfRGB5X1;
3660   fRange.r          := $1F;
3661   fRange.g          := $1F;
3662   fRange.b          := $1F;
3663   fShift.r          :=  1;
3664   fShift.g          :=  6;
3665   fShift.b          := 11;
3666   fglFormat         := GL_BGRA;
3667   fglInternalFormat := GL_RGB5;
3668   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3669 end;
3670
3671 constructor TfdX1BGR5.Create;
3672 begin
3673   inherited Create;
3674   fPixelSize        := 2.0;
3675   fFormat           := tfX1BGR5;
3676   fWithAlpha        := tfA1BGR5;
3677   fWithoutAlpha     := tfX1BGR5;
3678   fOpenGLFormat     := tfX1BGR5;
3679   fRGBInverted      := tfX1RGB5;
3680   fRange.r          := $1F;
3681   fRange.g          := $1F;
3682   fRange.b          := $1F;
3683   fShift.r          :=  0;
3684   fShift.g          :=  5;
3685   fShift.b          := 10;
3686   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3687   fglInternalFormat := GL_RGB5;
3688   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3689 end;
3690
3691 constructor TfdBGR8.Create;
3692 begin
3693   inherited Create;
3694   fPixelSize        := 3.0;
3695   fFormat           := tfBGR8;
3696   fWithAlpha        := tfBGRA8;
3697   fWithoutAlpha     := tfBGR8;
3698   fOpenGLFormat     := tfBGR8;
3699   fRGBInverted      := tfRGB8;
3700   fRange.r          := $FF;
3701   fRange.g          := $FF;
3702   fRange.b          := $FF;
3703   fShift.r          :=  0;
3704   fShift.g          :=  8;
3705   fShift.b          := 16;
3706   fglFormat         := GL_RGB;      // reverse byte order to match little endianess
3707   fglInternalFormat := GL_RGB8;     // as if u interpret the 3 bytes as unsigned integer
3708   fglDataFormat     := GL_UNSIGNED_BYTE;
3709 end;
3710
3711 constructor TfdBGRX8.Create;
3712 begin
3713   inherited Create;
3714   fPixelSize        := 4.0;
3715   fFormat           := tfBGRX8;
3716   fWithAlpha        := tfBGRA8;
3717   fWithoutAlpha     := tfBGRX8;
3718   fOpenGLFormat     := tfBGRX8;
3719   fRGBInverted      := tfRGBX8;
3720   fRange.r          := $FF;
3721   fRange.g          := $FF;
3722   fRange.b          := $FF;
3723   fShift.r          :=  8;
3724   fShift.g          := 16;
3725   fShift.b          := 24;
3726   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3727   fglInternalFormat := GL_RGB8;
3728   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3729 end;
3730
3731 constructor TfdXBGR8.Create;
3732 begin
3733   inherited Create;
3734   fPixelSize        := 4.0;
3735   fFormat           := tfXBGR8;
3736   fWithAlpha        := tfABGR8;
3737   fWithoutAlpha     := tfXBGR8;
3738   fOpenGLFormat     := tfXBGR8;
3739   fRGBInverted      := tfXRGB8;
3740   fRange.r          := $FF;
3741   fRange.g          := $FF;
3742   fRange.b          := $FF;
3743   fShift.r          :=  0;
3744   fShift.g          :=  8;
3745   fShift.b          := 16;
3746   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3747   fglInternalFormat := GL_RGB8;
3748   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3749 end;
3750
3751 constructor TfdBGR10X2.Create;
3752 begin
3753   inherited Create;
3754   fPixelSize        := 3.0;
3755   fFormat           := tfBGR10X2;
3756   fWithAlpha        := tfBGR10A2;
3757   fWithoutAlpha     := tfBGR10X2;
3758   fOpenGLFormat     := tfBGR10X2;
3759   fRGBInverted      := tfRGB10X2;
3760   fRange.r          := $03FF;
3761   fRange.g          := $03FF;
3762   fRange.b          := $03FF;
3763   fShift.r          :=  2;
3764   fShift.g          := 12;
3765   fShift.b          := 22;
3766   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3767   fglInternalFormat := GL_RGB10;
3768   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3769 end;
3770
3771 constructor TfdX2BGR10.Create;
3772 begin
3773   inherited Create;
3774   fPixelSize        := 3.0;
3775   fFormat           := tfX2BGR10;
3776   fWithAlpha        := tfA2BGR10;
3777   fWithoutAlpha     := tfX2BGR10;
3778   fOpenGLFormat     := tfX2BGR10;
3779   fRGBInverted      := tfX2RGB10;
3780   fRange.r          := $03FF;
3781   fRange.g          := $03FF;
3782   fRange.b          := $03FF;
3783   fShift.r          :=  0;
3784   fShift.g          := 10;
3785   fShift.b          := 20;
3786   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3787   fglInternalFormat := GL_RGB10;
3788   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3789 end;
3790
3791 constructor TfdBGR16.Create;
3792 begin
3793   inherited Create;
3794   fPixelSize        := 6.0;
3795   fFormat           := tfBGR16;
3796   fWithAlpha        := tfBGRA16;
3797   fWithoutAlpha     := tfBGR16;
3798   fOpenGLFormat     := tfBGR16;
3799   fRGBInverted      := tfRGB16;
3800   fRange.r          := $FFFF;
3801   fRange.g          := $FFFF;
3802   fRange.b          := $FFFF;
3803   fShift.r          :=  0;
3804   fShift.g          := 16;
3805   fShift.b          := 32;
3806   fglFormat         := GL_RGB;      // reverse byte order to match little endianess
3807   fglInternalFormat := GL_RGB16;    // as if u interpret the 3 bytes as unsigned integer
3808   fglDataFormat     := GL_UNSIGNED_SHORT;
3809 end;
3810
3811 constructor TfdBGRA4.Create;
3812 begin
3813   inherited Create;
3814   fPixelSize        := 2.0;
3815   fFormat           := tfBGRA4;
3816   fWithAlpha        := tfBGRA4;
3817   fWithoutAlpha     := tfBGRX4;
3818   fOpenGLFormat     := tfBGRA4;
3819   fRGBInverted      := tfRGBA4;
3820   fRange.r          := $0F;
3821   fRange.g          := $0F;
3822   fRange.b          := $0F;
3823   fRange.a          := $0F;
3824   fShift.r          :=  4;
3825   fShift.g          :=  8;
3826   fShift.b          := 12;
3827   fShift.a          :=  0;
3828   fglFormat         := GL_BGRA;
3829   fglInternalFormat := GL_RGBA4;
3830   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3831 end;
3832
3833 constructor TfdABGR4.Create;
3834 begin
3835   inherited Create;
3836   fPixelSize        := 2.0;
3837   fFormat           := tfABGR4;
3838   fWithAlpha        := tfABGR4;
3839   fWithoutAlpha     := tfXBGR4;
3840   fOpenGLFormat     := tfABGR4;
3841   fRGBInverted      := tfARGB4;
3842   fRange.r          := $0F;
3843   fRange.g          := $0F;
3844   fRange.b          := $0F;
3845   fRange.a          := $0F;
3846   fShift.r          :=  0;
3847   fShift.g          :=  4;
3848   fShift.b          :=  8;
3849   fShift.a          := 12;
3850   fglFormat         := GL_RGBA;
3851   fglInternalFormat := GL_RGBA4;
3852   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3853 end;
3854
3855 constructor TfdBGR5A1.Create;
3856 begin
3857   inherited Create;
3858   fPixelSize        := 2.0;
3859   fFormat           := tfBGR5A1;
3860   fWithAlpha        := tfBGR5A1;
3861   fWithoutAlpha     := tfBGR5X1;
3862   fOpenGLFormat     := tfBGR5A1;
3863   fRGBInverted      := tfRGB5A1;
3864   fRange.r          := $1F;
3865   fRange.g          := $1F;
3866   fRange.b          := $1F;
3867   fRange.a          := $01;
3868   fShift.r          :=  1;
3869   fShift.g          :=  6;
3870   fShift.b          := 11;
3871   fShift.a          :=  0;
3872   fglFormat         := GL_BGRA;
3873   fglInternalFormat := GL_RGB5_A1;
3874   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3875 end;
3876
3877 constructor TfdA1BGR5.Create;
3878 begin
3879   inherited Create;
3880   fPixelSize        := 2.0;
3881   fFormat           := tfA1BGR5;
3882   fWithAlpha        := tfA1BGR5;
3883   fWithoutAlpha     := tfX1BGR5;
3884   fOpenGLFormat     := tfA1BGR5;
3885   fRGBInverted      := tfA1RGB5;
3886   fRange.r          := $1F;
3887   fRange.g          := $1F;
3888   fRange.b          := $1F;
3889   fRange.a          := $01;
3890   fShift.r          :=  0;
3891   fShift.g          :=  5;
3892   fShift.b          := 10;
3893   fShift.a          := 15;
3894   fglFormat         := GL_RGBA;
3895   fglInternalFormat := GL_RGB5_A1;
3896   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3897 end;
3898
3899 constructor TfdBGRA8.Create;
3900 begin
3901   inherited Create;
3902   fPixelSize        := 4.0;
3903   fFormat           := tfBGRA8;
3904   fWithAlpha        := tfBGRA8;
3905   fWithoutAlpha     := tfBGR8;
3906   fOpenGLFormat     := tfBGRA8;
3907   fRGBInverted      := tfRGBA8;
3908   fRange.r          := $FF;
3909   fRange.g          := $FF;
3910   fRange.b          := $FF;
3911   fRange.a          := $FF;
3912   fShift.r          :=  8;
3913   fShift.g          := 16;
3914   fShift.b          := 24;
3915   fShift.a          :=  0;
3916   fglFormat         := GL_BGRA;
3917   fglInternalFormat := GL_RGBA8;
3918   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3919 end;
3920
3921 constructor TfdABGR8.Create;
3922 begin
3923   inherited Create;
3924   fPixelSize        := 4.0;
3925   fFormat           := tfABGR8;
3926   fWithAlpha        := tfABGR8;
3927   fWithoutAlpha     := tfBGR8;
3928   fOpenGLFormat     := tfABGR8;
3929   fRGBInverted      := tfARGB8;
3930   fRange.r          := $FF;
3931   fRange.g          := $FF;
3932   fRange.b          := $FF;
3933   fRange.a          := $FF;
3934   fShift.r          :=  0;
3935   fShift.g          :=  8;
3936   fShift.b          := 16;
3937   fShift.a          := 24;
3938   fglFormat         := GL_RGBA;
3939   fglInternalFormat := GL_RGBA8;
3940   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3941 end;
3942
3943 constructor TfdBGR10A2.Create;
3944 begin
3945   inherited Create;
3946   fPixelSize        := 3.0;
3947   fFormat           := tfBGR10A2;
3948   fWithAlpha        := tfBGR10A2;
3949   fWithoutAlpha     := tfBGR10X2;
3950   fOpenGLFormat     := tfBGR10A2;
3951   fRGBInverted      := tfRGB10A2;
3952   fRange.r          := $03FF;
3953   fRange.g          := $03FF;
3954   fRange.b          := $03FF;
3955   fRange.a          := $0003;
3956   fShift.r          :=  2;
3957   fShift.g          := 12;
3958   fShift.b          := 22;
3959   fShift.a          :=  0;
3960   fglFormat         := GL_BGRA;
3961   fglInternalFormat := GL_RGB10_A2;
3962   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3963 end;
3964
3965 constructor TfdA2BGR10.Create;
3966 begin
3967   inherited Create;
3968   fPixelSize        := 3.0;
3969   fFormat           := tfA2BGR10;
3970   fWithAlpha        := tfA2BGR10;
3971   fWithoutAlpha     := tfX2BGR10;
3972   fOpenGLFormat     := tfA2BGR10;
3973   fRGBInverted      := tfA2RGB10;
3974   fRange.r          := $03FF;
3975   fRange.g          := $03FF;
3976   fRange.b          := $03FF;
3977   fRange.a          := $0003;
3978   fShift.r          :=  0;
3979   fShift.g          := 10;
3980   fShift.b          := 20;
3981   fShift.a          := 30;
3982   fglFormat         := GL_RGBA;
3983   fglInternalFormat := GL_RGB10_A2;
3984   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3985 end;
3986
3987 constructor TfdBGRA16.Create;
3988 begin
3989   inherited Create;
3990   fPixelSize        := 8.0;
3991   fFormat           := tfBGRA16;
3992   fWithAlpha        := tfBGRA16;
3993   fWithoutAlpha     := tfBGR16;
3994   fOpenGLFormat     := tfBGRA16;
3995   fRGBInverted      := tfRGBA16;
3996   fRange.r          := $FFFF;
3997   fRange.g          := $FFFF;
3998   fRange.b          := $FFFF;
3999   fRange.a          := $FFFF;
4000   fShift.r          := 16;
4001   fShift.g          := 32;
4002   fShift.b          := 48;
4003   fShift.a          :=  0;
4004   fglFormat         := GL_RGBA;      // reverse byte order to match little endianess
4005   fglInternalFormat := GL_RGBA16;    // as if u interpret the 3 bytes as unsigned integer
4006   fglDataFormat     := GL_UNSIGNED_SHORT;
4007 end;
4008
4009 constructor TfdDepth16.Create;
4010 begin
4011   inherited Create;
4012   fPixelSize        := 2.0;
4013   fFormat           := tfDepth16;
4014   fWithoutAlpha     := tfDepth16;
4015   fOpenGLFormat     := tfDepth16;
4016   fRange.r          := $FFFF;
4017   fRange.g          := $FFFF;
4018   fRange.b          := $FFFF;
4019   fRange.a          := $FFFF;
4020   fglFormat         := GL_DEPTH_COMPONENT;
4021   fglInternalFormat := GL_DEPTH_COMPONENT16;
4022   fglDataFormat     := GL_UNSIGNED_SHORT;
4023 end;
4024
4025 constructor TfdDepth24.Create;
4026 begin
4027   inherited Create;
4028   fPixelSize        := 3.0;
4029   fFormat           := tfDepth24;
4030   fWithoutAlpha     := tfDepth24;
4031   fOpenGLFormat     := tfDepth24;
4032   fRange.r          := $FFFFFF;
4033   fRange.g          := $FFFFFF;
4034   fRange.b          := $FFFFFF;
4035   fRange.a          := $FFFFFF;
4036   fglFormat         := GL_DEPTH_COMPONENT;
4037   fglInternalFormat := GL_DEPTH_COMPONENT24;
4038   fglDataFormat     := GL_UNSIGNED_INT;
4039 end;
4040
4041 constructor TfdDepth32.Create;
4042 begin
4043   inherited Create;
4044   fPixelSize        := 4.0;
4045   fFormat           := tfDepth32;
4046   fWithoutAlpha     := tfDepth32;
4047   fOpenGLFormat     := tfDepth32;
4048   fRange.r          := $FFFFFFFF;
4049   fRange.g          := $FFFFFFFF;
4050   fRange.b          := $FFFFFFFF;
4051   fRange.a          := $FFFFFFFF;
4052   fglFormat         := GL_DEPTH_COMPONENT;
4053   fglInternalFormat := GL_DEPTH_COMPONENT32;
4054   fglDataFormat     := GL_UNSIGNED_INT;
4055 end;
4056
4057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4058 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4060 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4061 begin
4062   raise EglBitmap.Create('mapping for compressed formats is not supported');
4063 end;
4064
4065 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4066 begin
4067   raise EglBitmap.Create('mapping for compressed formats is not supported');
4068 end;
4069
4070 constructor TfdS3tcDtx1RGBA.Create;
4071 begin
4072   inherited Create;
4073   fFormat           := tfS3tcDtx1RGBA;
4074   fWithAlpha        := tfS3tcDtx1RGBA;
4075   fOpenGLFormat     := tfS3tcDtx1RGBA;
4076   fUncompressed     := tfRGB5A1;
4077   fPixelSize        := 0.5;
4078   fIsCompressed     := true;
4079   fglFormat         := GL_COMPRESSED_RGBA;
4080   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4081   fglDataFormat     := GL_UNSIGNED_BYTE;
4082 end;
4083
4084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4085 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4087 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4088 begin
4089   raise EglBitmap.Create('mapping for compressed formats is not supported');
4090 end;
4091
4092 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4093 begin
4094   raise EglBitmap.Create('mapping for compressed formats is not supported');
4095 end;
4096
4097 constructor TfdS3tcDtx3RGBA.Create;
4098 begin
4099   inherited Create;
4100   fFormat           := tfS3tcDtx3RGBA;
4101   fWithAlpha        := tfS3tcDtx3RGBA;
4102   fOpenGLFormat     := tfS3tcDtx3RGBA;
4103   fUncompressed     := tfRGBA8;
4104   fPixelSize        := 1.0;
4105   fIsCompressed     := true;
4106   fglFormat         := GL_COMPRESSED_RGBA;
4107   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4108   fglDataFormat     := GL_UNSIGNED_BYTE;
4109 end;
4110
4111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4112 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4114 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4115 begin
4116   raise EglBitmap.Create('mapping for compressed formats is not supported');
4117 end;
4118
4119 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4120 begin
4121   raise EglBitmap.Create('mapping for compressed formats is not supported');
4122 end;
4123
4124 constructor TfdS3tcDtx5RGBA.Create;
4125 begin
4126   inherited Create;
4127   fFormat           := tfS3tcDtx3RGBA;
4128   fWithAlpha        := tfS3tcDtx3RGBA;
4129   fOpenGLFormat     := tfS3tcDtx3RGBA;
4130   fUncompressed     := tfRGBA8;
4131   fPixelSize        := 1.0;
4132   fIsCompressed     := true;
4133   fglFormat         := GL_COMPRESSED_RGBA;
4134   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4135   fglDataFormat     := GL_UNSIGNED_BYTE;
4136 end;
4137
4138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4139 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4141 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4142 var
4143   f: TglBitmapFormat;
4144 begin
4145   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4146     result := TFormatDescriptor.Get(f);
4147     if (result.glInternalFormat = aInternalFormat) then
4148       exit;
4149   end;
4150   result := TFormatDescriptor.Get(tfEmpty);
4151 end;
4152
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 class procedure TFormatDescriptor.Init;
4157 begin
4158   if not Assigned(FormatDescriptorCS) then
4159     FormatDescriptorCS := TCriticalSection.Create;
4160 end;
4161
4162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4163 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4164 begin
4165   FormatDescriptorCS.Enter;
4166   try
4167     result := FormatDescriptors[aFormat];
4168     if not Assigned(result) then begin
4169       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4170       FormatDescriptors[aFormat] := result;
4171     end;
4172   finally
4173     FormatDescriptorCS.Leave;
4174   end;
4175 end;
4176
4177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4178 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4179 begin
4180   result := Get(Get(aFormat).WithAlpha);
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 class procedure TFormatDescriptor.Clear;
4185 var
4186   f: TglBitmapFormat;
4187 begin
4188   FormatDescriptorCS.Enter;
4189   try
4190     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4191       FreeAndNil(FormatDescriptors[f]);
4192   finally
4193     FormatDescriptorCS.Leave;
4194   end;
4195 end;
4196
4197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4198 class procedure TFormatDescriptor.Finalize;
4199 begin
4200   Clear;
4201   FreeAndNil(FormatDescriptorCS);
4202 end;
4203
4204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4205 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4207 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
4208 begin
4209   Update(aValue, fRange.r, fShift.r);
4210 end;
4211
4212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4213 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
4214 begin
4215   Update(aValue, fRange.g, fShift.g);
4216 end;
4217
4218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4219 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
4220 begin
4221   Update(aValue, fRange.b, fShift.b);
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
4226 begin
4227   Update(aValue, fRange.a, fShift.a);
4228 end;
4229
4230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4231 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
4232   aShift: Byte);
4233 begin
4234   aShift := 0;
4235   aRange := 0;
4236   if (aMask = 0) then
4237     exit;
4238   while (aMask > 0) and ((aMask and 1) = 0) do begin
4239     inc(aShift);
4240     aMask := aMask shr 1;
4241   end;
4242   aRange := 1;
4243   while (aMask > 0) do begin
4244     aRange := aRange shl 1;
4245     aMask  := aMask  shr 1;
4246   end;
4247   dec(aRange);
4248
4249   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
4250 end;
4251
4252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4253 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4254 var
4255   data: QWord;
4256   s: Integer;
4257 begin
4258   data :=
4259     ((aPixel.Data.r and fRange.r) shl fShift.r) or
4260     ((aPixel.Data.g and fRange.g) shl fShift.g) or
4261     ((aPixel.Data.b and fRange.b) shl fShift.b) or
4262     ((aPixel.Data.a and fRange.a) shl fShift.a);
4263   s := Round(fPixelSize);
4264   case s of
4265     1:           aData^  := data;
4266     2:     PWord(aData)^ := data;
4267     4: PCardinal(aData)^ := data;
4268     8:    PQWord(aData)^ := data;
4269   else
4270     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4271   end;
4272   inc(aData, s);
4273 end;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4277 var
4278   data: QWord;
4279   s, i: Integer;
4280 begin
4281   s := Round(fPixelSize);
4282   case s of
4283     1: data :=           aData^;
4284     2: data :=     PWord(aData)^;
4285     4: data := PCardinal(aData)^;
4286     8: data :=    PQWord(aData)^;
4287   else
4288     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4289   end;
4290   for i := 0 to 3 do
4291     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
4292   inc(aData, s);
4293 end;
4294
4295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4296 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4298 procedure TbmpColorTableFormat.CreateColorTable;
4299 var
4300   i: Integer;
4301 begin
4302   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
4303     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
4304
4305   if (Format = tfLuminance4) then
4306     SetLength(fColorTable, 16)
4307   else
4308     SetLength(fColorTable, 256);
4309
4310   case Format of
4311     tfLuminance4: begin
4312       for i := 0 to High(fColorTable) do begin
4313         fColorTable[i].r := 16 * i;
4314         fColorTable[i].g := 16 * i;
4315         fColorTable[i].b := 16 * i;
4316         fColorTable[i].a := 0;
4317       end;
4318     end;
4319
4320     tfLuminance8: begin
4321       for i := 0 to High(fColorTable) do begin
4322         fColorTable[i].r := i;
4323         fColorTable[i].g := i;
4324         fColorTable[i].b := i;
4325         fColorTable[i].a := 0;
4326       end;
4327     end;
4328
4329     tfR3G3B2: begin
4330       for i := 0 to High(fColorTable) do begin
4331         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4332         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4333         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4334         fColorTable[i].a := 0;
4335       end;
4336     end;
4337   end;
4338 end;
4339
4340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4341 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4342 var
4343   d: Byte;
4344 begin
4345   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
4346     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
4347
4348   case Format of
4349     tfLuminance4: begin
4350       if (aMapData = nil) then
4351         aData^ := 0;
4352       d := LuminanceWeight(aPixel) and Range.r;
4353       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
4354       inc(PByte(aMapData), 4);
4355       if ({%H-}PtrUInt(aMapData) >= 8) then begin
4356         inc(aData);
4357         aMapData := nil;
4358       end;
4359     end;
4360
4361     tfLuminance8: begin
4362       aData^ := LuminanceWeight(aPixel) and Range.r;
4363       inc(aData);
4364     end;
4365
4366     tfR3G3B2: begin
4367       aData^ := Round(
4368         ((aPixel.Data.r and Range.r) shl Shift.r) or
4369         ((aPixel.Data.g and Range.g) shl Shift.g) or
4370         ((aPixel.Data.b and Range.b) shl Shift.b));
4371       inc(aData);
4372     end;
4373   end;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4378 var
4379   idx: QWord;
4380   s: Integer;
4381   bits: Byte;
4382   f: Single;
4383 begin
4384   s    := Trunc(fPixelSize);
4385   f    := fPixelSize - s;
4386   bits := Round(8 * f);
4387   case s of
4388     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
4389     1: idx :=           aData^;
4390     2: idx :=     PWord(aData)^;
4391     4: idx := PCardinal(aData)^;
4392     8: idx :=    PQWord(aData)^;
4393   else
4394     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
4395   end;
4396   if (idx >= Length(fColorTable)) then
4397     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
4398   with fColorTable[idx] do begin
4399     aPixel.Data.r := r;
4400     aPixel.Data.g := g;
4401     aPixel.Data.b := b;
4402     aPixel.Data.a := a;
4403   end;
4404   inc(PByte(aMapData), bits);
4405   if ({%H-}PtrUInt(aMapData) >= 8) then begin
4406     inc(aData, 1);
4407     dec(PByte(aMapData), 8);
4408   end;
4409   inc(aData, s);
4410 end;
4411
4412 destructor TbmpColorTableFormat.Destroy;
4413 begin
4414   SetLength(fColorTable, 0);
4415   inherited Destroy;
4416 end;
4417
4418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4421 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4422 var
4423   i: Integer;
4424 begin
4425   for i := 0 to 3 do begin
4426     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4427       if (aSourceFD.Range.arr[i] > 0) then
4428         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4429       else
4430         aPixel.Data.arr[i] := 0;
4431     end;
4432   end;
4433 end;
4434
4435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4436 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4437 begin
4438   with aFuncRec do begin
4439     if (Source.Range.r   > 0) then
4440       Dest.Data.r := Source.Data.r;
4441     if (Source.Range.g > 0) then
4442       Dest.Data.g := Source.Data.g;
4443     if (Source.Range.b  > 0) then
4444       Dest.Data.b := Source.Data.b;
4445     if (Source.Range.a > 0) then
4446       Dest.Data.a := Source.Data.a;
4447   end;
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4452 var
4453   i: Integer;
4454 begin
4455   with aFuncRec do begin
4456     for i := 0 to 3 do
4457       if (Source.Range.arr[i] > 0) then
4458         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4459   end;
4460 end;
4461
4462 type
4463   TShiftData = packed record
4464     case Integer of
4465       0: (r, g, b, a: SmallInt);
4466       1: (arr: array[0..3] of SmallInt);
4467   end;
4468   PShiftData = ^TShiftData;
4469
4470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4471 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4472 var
4473   i: Integer;
4474 begin
4475   with aFuncRec do
4476     for i := 0 to 3 do
4477       if (Source.Range.arr[i] > 0) then
4478         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4479 end;
4480
4481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4482 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4483 begin
4484   with aFuncRec do begin
4485     Dest.Data := Source.Data;
4486     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4487       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4488       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4489       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4490     end;
4491     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4492       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4493     end;
4494   end;
4495 end;
4496
4497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4498 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4499 var
4500   i: Integer;
4501 begin
4502   with aFuncRec do begin
4503     for i := 0 to 3 do
4504       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4505   end;
4506 end;
4507
4508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4509 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4510 var
4511   Temp: Single;
4512 begin
4513   with FuncRec do begin
4514     if (FuncRec.Args = nil) then begin //source has no alpha
4515       Temp :=
4516         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4517         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4518         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4519       Dest.Data.a := Round(Dest.Range.a * Temp);
4520     end else
4521       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4522   end;
4523 end;
4524
4525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4526 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4527 type
4528   PglBitmapPixelData = ^TglBitmapPixelData;
4529 begin
4530   with FuncRec do begin
4531     Dest.Data.r := Source.Data.r;
4532     Dest.Data.g := Source.Data.g;
4533     Dest.Data.b := Source.Data.b;
4534
4535     with PglBitmapPixelData(Args)^ do
4536       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4537           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4538           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4539         Dest.Data.a := 0
4540       else
4541         Dest.Data.a := Dest.Range.a;
4542   end;
4543 end;
4544
4545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4546 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4547 begin
4548   with FuncRec do begin
4549     Dest.Data.r := Source.Data.r;
4550     Dest.Data.g := Source.Data.g;
4551     Dest.Data.b := Source.Data.b;
4552     Dest.Data.a := PCardinal(Args)^;
4553   end;
4554 end;
4555
4556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4557 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4558 type
4559   PRGBPix = ^TRGBPix;
4560   TRGBPix = array [0..2] of byte;
4561 var
4562   Temp: Byte;
4563 begin
4564   while aWidth > 0 do begin
4565     Temp := PRGBPix(aData)^[0];
4566     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4567     PRGBPix(aData)^[2] := Temp;
4568
4569     if aHasAlpha then
4570       Inc(aData, 4)
4571     else
4572       Inc(aData, 3);
4573     dec(aWidth);
4574   end;
4575 end;
4576
4577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4578 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4580 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4581 begin
4582   result := TFormatDescriptor.Get(Format);
4583 end;
4584
4585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4586 function TglBitmap.GetWidth: Integer;
4587 begin
4588   if (ffX in fDimension.Fields) then
4589     result := fDimension.X
4590   else
4591     result := -1;
4592 end;
4593
4594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4595 function TglBitmap.GetHeight: Integer;
4596 begin
4597   if (ffY in fDimension.Fields) then
4598     result := fDimension.Y
4599   else
4600     result := -1;
4601 end;
4602
4603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4604 function TglBitmap.GetFileWidth: Integer;
4605 begin
4606   result := Max(1, Width);
4607 end;
4608
4609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4610 function TglBitmap.GetFileHeight: Integer;
4611 begin
4612   result := Max(1, Height);
4613 end;
4614
4615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4616 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4617 begin
4618   if fCustomData = aValue then
4619     exit;
4620   fCustomData := aValue;
4621 end;
4622
4623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4624 procedure TglBitmap.SetCustomName(const aValue: String);
4625 begin
4626   if fCustomName = aValue then
4627     exit;
4628   fCustomName := aValue;
4629 end;
4630
4631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4632 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4633 begin
4634   if fCustomNameW = aValue then
4635     exit;
4636   fCustomNameW := aValue;
4637 end;
4638
4639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4640 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4641 begin
4642   if fFreeDataOnDestroy = aValue then
4643     exit;
4644   fFreeDataOnDestroy := aValue;
4645 end;
4646
4647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4648 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4649 begin
4650   if fDeleteTextureOnFree = aValue then
4651     exit;
4652   fDeleteTextureOnFree := aValue;
4653 end;
4654
4655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4656 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4657 begin
4658   if fFormat = aValue then
4659     exit;
4660   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4661     raise EglBitmapUnsupportedFormat.Create(Format);
4662   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4663 end;
4664
4665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4666 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4667 begin
4668   if fFreeDataAfterGenTexture = aValue then
4669     exit;
4670   fFreeDataAfterGenTexture := aValue;
4671 end;
4672
4673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4674 procedure TglBitmap.SetID(const aValue: Cardinal);
4675 begin
4676   if fID = aValue then
4677     exit;
4678   fID := aValue;
4679 end;
4680
4681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4682 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4683 begin
4684   if fMipMap = aValue then
4685     exit;
4686   fMipMap := aValue;
4687 end;
4688
4689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4690 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4691 begin
4692   if fTarget = aValue then
4693     exit;
4694   fTarget := aValue;
4695 end;
4696
4697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4698 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4699 var
4700   MaxAnisotropic: Integer;
4701 begin
4702   fAnisotropic := aValue;
4703   if (ID > 0) then begin
4704     if GL_EXT_texture_filter_anisotropic then begin
4705       if fAnisotropic > 0 then begin
4706         Bind(false);
4707         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4708         if aValue > MaxAnisotropic then
4709           fAnisotropic := MaxAnisotropic;
4710         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4711       end;
4712     end else begin
4713       fAnisotropic := 0;
4714     end;
4715   end;
4716 end;
4717
4718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4719 procedure TglBitmap.CreateID;
4720 begin
4721   if (ID <> 0) then
4722     glDeleteTextures(1, @fID);
4723   glGenTextures(1, @fID);
4724   Bind(false);
4725 end;
4726
4727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4728 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4729 begin
4730   // Set Up Parameters
4731   SetWrap(fWrapS, fWrapT, fWrapR);
4732   SetFilter(fFilterMin, fFilterMag);
4733   SetAnisotropic(fAnisotropic);
4734   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4735
4736   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4737     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4738
4739   // Mip Maps Generation Mode
4740   aBuildWithGlu := false;
4741   if (MipMap = mmMipmap) then begin
4742     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4743       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4744     else
4745       aBuildWithGlu := true;
4746   end else if (MipMap = mmMipmapGlu) then
4747     aBuildWithGlu := true;
4748 end;
4749
4750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4751 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4752   const aWidth: Integer; const aHeight: Integer);
4753 var
4754   s: Single;
4755 begin
4756   if (Data <> aData) then begin
4757     if (Assigned(Data)) then
4758       FreeMem(Data);
4759     fData := aData;
4760   end;
4761
4762   if not Assigned(fData) then begin
4763     fPixelSize := 0;
4764     fRowSize   := 0;
4765   end else begin
4766     FillChar(fDimension, SizeOf(fDimension), 0);
4767     if aWidth <> -1 then begin
4768       fDimension.Fields := fDimension.Fields + [ffX];
4769       fDimension.X := aWidth;
4770     end;
4771
4772     if aHeight <> -1 then begin
4773       fDimension.Fields := fDimension.Fields + [ffY];
4774       fDimension.Y := aHeight;
4775     end;
4776
4777     s := TFormatDescriptor.Get(aFormat).PixelSize;
4778     fFormat    := aFormat;
4779     fPixelSize := Ceil(s);
4780     fRowSize   := Ceil(s * aWidth);
4781   end;
4782 end;
4783
4784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4785 function TglBitmap.FlipHorz: Boolean;
4786 begin
4787   result := false;
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.FlipVert: Boolean;
4792 begin
4793   result := false;
4794 end;
4795
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4799 procedure TglBitmap.AfterConstruction;
4800 begin
4801   inherited AfterConstruction;
4802
4803   fID         := 0;
4804   fTarget     := 0;
4805   fIsResident := false;
4806
4807   fMipMap                  := glBitmapDefaultMipmap;
4808   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4809   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4810
4811   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4812   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4813   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4814 end;
4815
4816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4817 procedure TglBitmap.BeforeDestruction;
4818 var
4819   NewData: PByte;
4820 begin
4821   if fFreeDataOnDestroy then begin
4822     NewData := nil;
4823     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4824   end;
4825   if (fID > 0) and fDeleteTextureOnFree then
4826     glDeleteTextures(1, @fID);
4827   inherited BeforeDestruction;
4828 end;
4829
4830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4831 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4832 var
4833   TempPos: Integer;
4834 begin
4835   if not Assigned(aResType) then begin
4836     TempPos   := Pos('.', aResource);
4837     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4838     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4839   end;
4840 end;
4841
4842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4843 procedure TglBitmap.LoadFromFile(const aFilename: String);
4844 var
4845   fs: TFileStream;
4846 begin
4847   if not FileExists(aFilename) then
4848     raise EglBitmap.Create('file does not exist: ' + aFilename);
4849   fFilename := aFilename;
4850   fs := TFileStream.Create(fFilename, fmOpenRead);
4851   try
4852     fs.Position := 0;
4853     LoadFromStream(fs);
4854   finally
4855     fs.Free;
4856   end;
4857 end;
4858
4859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4860 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4861 begin
4862   {$IFDEF GLB_SUPPORT_PNG_READ}
4863   if not LoadPNG(aStream) then
4864   {$ENDIF}
4865   {$IFDEF GLB_SUPPORT_JPEG_READ}
4866   if not LoadJPEG(aStream) then
4867   {$ENDIF}
4868   if not LoadDDS(aStream) then
4869   if not LoadTGA(aStream) then
4870   if not LoadBMP(aStream) then
4871     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4872 end;
4873
4874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4875 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4876   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4877 var
4878   tmpData: PByte;
4879   size: Integer;
4880 begin
4881   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4882   GetMem(tmpData, size);
4883   try
4884     FillChar(tmpData^, size, #$FF);
4885     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4886   except
4887     if Assigned(tmpData) then
4888       FreeMem(tmpData);
4889     raise;
4890   end;
4891   AddFunc(Self, aFunc, false, aFormat, aArgs);
4892 end;
4893
4894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4895 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4896 var
4897   rs: TResourceStream;
4898 begin
4899   PrepareResType(aResource, aResType);
4900   rs := TResourceStream.Create(aInstance, aResource, aResType);
4901   try
4902     LoadFromStream(rs);
4903   finally
4904     rs.Free;
4905   end;
4906 end;
4907
4908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4909 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4910 var
4911   rs: TResourceStream;
4912 begin
4913   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4914   try
4915     LoadFromStream(rs);
4916   finally
4917     rs.Free;
4918   end;
4919 end;
4920
4921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4922 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4923 var
4924   fs: TFileStream;
4925 begin
4926   fs := TFileStream.Create(aFileName, fmCreate);
4927   try
4928     fs.Position := 0;
4929     SaveToStream(fs, aFileType);
4930   finally
4931     fs.Free;
4932   end;
4933 end;
4934
4935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4936 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4937 begin
4938   case aFileType of
4939     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4940     ftPNG:  SavePNG(aStream);
4941     {$ENDIF}
4942     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4943     ftJPEG: SaveJPEG(aStream);
4944     {$ENDIF}
4945     ftDDS:  SaveDDS(aStream);
4946     ftTGA:  SaveTGA(aStream);
4947     ftBMP:  SaveBMP(aStream);
4948   end;
4949 end;
4950
4951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4952 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4953 begin
4954   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4955 end;
4956
4957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4958 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4959   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4960 var
4961   DestData, TmpData, SourceData: pByte;
4962   TempHeight, TempWidth: Integer;
4963   SourceFD, DestFD: TFormatDescriptor;
4964   SourceMD, DestMD: Pointer;
4965
4966   FuncRec: TglBitmapFunctionRec;
4967 begin
4968   Assert(Assigned(Data));
4969   Assert(Assigned(aSource));
4970   Assert(Assigned(aSource.Data));
4971
4972   result := false;
4973   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4974     SourceFD := TFormatDescriptor.Get(aSource.Format);
4975     DestFD   := TFormatDescriptor.Get(aFormat);
4976
4977     if (SourceFD.IsCompressed) then
4978       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4979     if (DestFD.IsCompressed) then
4980       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4981
4982     // inkompatible Formats so CreateTemp
4983     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4984       aCreateTemp := true;
4985
4986     // Values
4987     TempHeight := Max(1, aSource.Height);
4988     TempWidth  := Max(1, aSource.Width);
4989
4990     FuncRec.Sender := Self;
4991     FuncRec.Args   := aArgs;
4992
4993     TmpData := nil;
4994     if aCreateTemp then begin
4995       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4996       DestData := TmpData;
4997     end else
4998       DestData := Data;
4999
5000     try
5001       SourceFD.PreparePixel(FuncRec.Source);
5002       DestFD.PreparePixel  (FuncRec.Dest);
5003
5004       SourceMD := SourceFD.CreateMappingData;
5005       DestMD   := DestFD.CreateMappingData;
5006
5007       FuncRec.Size            := aSource.Dimension;
5008       FuncRec.Position.Fields := FuncRec.Size.Fields;
5009
5010       try
5011         SourceData := aSource.Data;
5012         FuncRec.Position.Y := 0;
5013         while FuncRec.Position.Y < TempHeight do begin
5014           FuncRec.Position.X := 0;
5015           while FuncRec.Position.X < TempWidth do begin
5016             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5017             aFunc(FuncRec);
5018             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5019             inc(FuncRec.Position.X);
5020           end;
5021           inc(FuncRec.Position.Y);
5022         end;
5023
5024         // Updating Image or InternalFormat
5025         if aCreateTemp then
5026           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5027         else if (aFormat <> fFormat) then
5028           Format := aFormat;
5029
5030         result := true;
5031       finally
5032         SourceFD.FreeMappingData(SourceMD);
5033         DestFD.FreeMappingData(DestMD);
5034       end;
5035     except
5036       if aCreateTemp and Assigned(TmpData) then
5037         FreeMem(TmpData);
5038       raise;
5039     end;
5040   end;
5041 end;
5042
5043 {$IFDEF GLB_SDL}
5044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5045 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5046 var
5047   Row, RowSize: Integer;
5048   SourceData, TmpData: PByte;
5049   TempDepth: Integer;
5050   FormatDesc: TFormatDescriptor;
5051
5052   function GetRowPointer(Row: Integer): pByte;
5053   begin
5054     result := aSurface.pixels;
5055     Inc(result, Row * RowSize);
5056   end;
5057
5058 begin
5059   result := false;
5060
5061   FormatDesc := TFormatDescriptor.Get(Format);
5062   if FormatDesc.IsCompressed then
5063     raise EglBitmapUnsupportedFormat.Create(Format);
5064
5065   if Assigned(Data) then begin
5066     case Trunc(FormatDesc.PixelSize) of
5067       1: TempDepth :=  8;
5068       2: TempDepth := 16;
5069       3: TempDepth := 24;
5070       4: TempDepth := 32;
5071     else
5072       raise EglBitmapUnsupportedFormat.Create(Format);
5073     end;
5074
5075     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5076       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5077     SourceData := Data;
5078     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5079
5080     for Row := 0 to FileHeight-1 do begin
5081       TmpData := GetRowPointer(Row);
5082       if Assigned(TmpData) then begin
5083         Move(SourceData^, TmpData^, RowSize);
5084         inc(SourceData, RowSize);
5085       end;
5086     end;
5087     result := true;
5088   end;
5089 end;
5090
5091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5092 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5093 var
5094   pSource, pData, pTempData: PByte;
5095   Row, RowSize, TempWidth, TempHeight: Integer;
5096   IntFormat: TglBitmapFormat;
5097   FormatDesc: TFormatDescriptor;
5098
5099   function GetRowPointer(Row: Integer): pByte;
5100   begin
5101     result := aSurface^.pixels;
5102     Inc(result, Row * RowSize);
5103   end;
5104
5105 begin
5106   result := false;
5107   if (Assigned(aSurface)) then begin
5108     with aSurface^.format^ do begin
5109       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
5110         FormatDesc := TFormatDescriptor.Get(IntFormat);
5111         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
5112           break;
5113       end;
5114       if (IntFormat = tfEmpty) then
5115         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
5116     end;
5117
5118     TempWidth  := aSurface^.w;
5119     TempHeight := aSurface^.h;
5120     RowSize := FormatDesc.GetSize(TempWidth, 1);
5121     GetMem(pData, TempHeight * RowSize);
5122     try
5123       pTempData := pData;
5124       for Row := 0 to TempHeight -1 do begin
5125         pSource := GetRowPointer(Row);
5126         if (Assigned(pSource)) then begin
5127           Move(pSource^, pTempData^, RowSize);
5128           Inc(pTempData, RowSize);
5129         end;
5130       end;
5131       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5132       result := true;
5133     except
5134       if Assigned(pData) then
5135         FreeMem(pData);
5136       raise;
5137     end;
5138   end;
5139 end;
5140
5141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5142 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5143 var
5144   Row, Col, AlphaInterleave: Integer;
5145   pSource, pDest: PByte;
5146
5147   function GetRowPointer(Row: Integer): pByte;
5148   begin
5149     result := aSurface.pixels;
5150     Inc(result, Row * Width);
5151   end;
5152
5153 begin
5154   result := false;
5155   if Assigned(Data) then begin
5156     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
5157       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5158
5159       AlphaInterleave := 0;
5160       case Format of
5161         tfLuminance8Alpha8:
5162           AlphaInterleave := 1;
5163         tfBGRA8, tfRGBA8:
5164           AlphaInterleave := 3;
5165       end;
5166
5167       pSource := Data;
5168       for Row := 0 to Height -1 do begin
5169         pDest := GetRowPointer(Row);
5170         if Assigned(pDest) then begin
5171           for Col := 0 to Width -1 do begin
5172             Inc(pSource, AlphaInterleave);
5173             pDest^ := pSource^;
5174             Inc(pDest);
5175             Inc(pSource);
5176           end;
5177         end;
5178       end;
5179       result := true;
5180     end;
5181   end;
5182 end;
5183
5184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5185 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5186 var
5187   bmp: TglBitmap2D;
5188 begin
5189   bmp := TglBitmap2D.Create;
5190   try
5191     bmp.AssignFromSurface(aSurface);
5192     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5193   finally
5194     bmp.Free;
5195   end;
5196 end;
5197 {$ENDIF}
5198
5199 {$IFDEF GLB_DELPHI}
5200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5201 function CreateGrayPalette: HPALETTE;
5202 var
5203   Idx: Integer;
5204   Pal: PLogPalette;
5205 begin
5206   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5207
5208   Pal.palVersion := $300;
5209   Pal.palNumEntries := 256;
5210
5211   for Idx := 0 to Pal.palNumEntries - 1 do begin
5212     Pal.palPalEntry[Idx].peRed   := Idx;
5213     Pal.palPalEntry[Idx].peGreen := Idx;
5214     Pal.palPalEntry[Idx].peBlue  := Idx;
5215     Pal.palPalEntry[Idx].peFlags := 0;
5216   end;
5217   Result := CreatePalette(Pal^);
5218   FreeMem(Pal);
5219 end;
5220
5221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5222 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5223 var
5224   Row: Integer;
5225   pSource, pData: PByte;
5226 begin
5227   result := false;
5228   if Assigned(Data) then begin
5229     if Assigned(aBitmap) then begin
5230       aBitmap.Width  := Width;
5231       aBitmap.Height := Height;
5232
5233       case Format of
5234         tfAlpha8, tfLuminance8: begin
5235           aBitmap.PixelFormat := pf8bit;
5236           aBitmap.Palette     := CreateGrayPalette;
5237         end;
5238         tfRGB5A1:
5239           aBitmap.PixelFormat := pf15bit;
5240         tfR5G6B5:
5241           aBitmap.PixelFormat := pf16bit;
5242         tfRGB8, tfBGR8:
5243           aBitmap.PixelFormat := pf24bit;
5244         tfRGBA8, tfBGRA8:
5245           aBitmap.PixelFormat := pf32bit;
5246       else
5247         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5248       end;
5249
5250       pSource := Data;
5251       for Row := 0 to FileHeight -1 do begin
5252         pData := aBitmap.Scanline[Row];
5253         Move(pSource^, pData^, fRowSize);
5254         Inc(pSource, fRowSize);
5255         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
5256           SwapRGB(pData, FileWidth, Format = tfRGBA8);
5257       end;
5258       result := true;
5259     end;
5260   end;
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5265 var
5266   pSource, pData, pTempData: PByte;
5267   Row, RowSize, TempWidth, TempHeight: Integer;
5268   IntFormat: TglBitmapFormat;
5269 begin
5270   result := false;
5271
5272   if (Assigned(aBitmap)) then begin
5273     case aBitmap.PixelFormat of
5274       pf8bit:
5275         IntFormat := tfLuminance8;
5276       pf15bit:
5277         IntFormat := tfRGB5A1;
5278       pf16bit:
5279         IntFormat := tfR5G6B5;
5280       pf24bit:
5281         IntFormat := tfBGR8;
5282       pf32bit:
5283         IntFormat := tfBGRA8;
5284     else
5285       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5286     end;
5287
5288     TempWidth  := aBitmap.Width;
5289     TempHeight := aBitmap.Height;
5290     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5291     GetMem(pData, TempHeight * RowSize);
5292     try
5293       pTempData := pData;
5294       for Row := 0 to TempHeight -1 do begin
5295         pSource := aBitmap.Scanline[Row];
5296         if (Assigned(pSource)) then begin
5297           Move(pSource^, pTempData^, RowSize);
5298           Inc(pTempData, RowSize);
5299         end;
5300       end;
5301       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5302       result := true;
5303     except
5304       if Assigned(pData) then
5305         FreeMem(pData);
5306       raise;
5307     end;
5308   end;
5309 end;
5310
5311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5312 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5313 var
5314   Row, Col, AlphaInterleave: Integer;
5315   pSource, pDest: PByte;
5316 begin
5317   result := false;
5318
5319   if Assigned(Data) then begin
5320     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
5321       if Assigned(aBitmap) then begin
5322         aBitmap.PixelFormat := pf8bit;
5323         aBitmap.Palette     := CreateGrayPalette;
5324         aBitmap.Width       := Width;
5325         aBitmap.Height      := Height;
5326
5327         case Format of
5328           tfLuminance8Alpha8:
5329             AlphaInterleave := 1;
5330           tfRGBA8, tfBGRA8:
5331             AlphaInterleave := 3;
5332           else
5333             AlphaInterleave := 0;
5334         end;
5335
5336         // Copy Data
5337         pSource := Data;
5338
5339         for Row := 0 to Height -1 do begin
5340           pDest := aBitmap.Scanline[Row];
5341           if Assigned(pDest) then begin
5342             for Col := 0 to Width -1 do begin
5343               Inc(pSource, AlphaInterleave);
5344               pDest^ := pSource^;
5345               Inc(pDest);
5346               Inc(pSource);
5347             end;
5348           end;
5349         end;
5350         result := true;
5351       end;
5352     end;
5353   end;
5354 end;
5355
5356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5357 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5358 var
5359   tex: TglBitmap2D;
5360 begin
5361   tex := TglBitmap2D.Create;
5362   try
5363     tex.AssignFromBitmap(ABitmap);
5364     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5365   finally
5366     tex.Free;
5367   end;
5368 end;
5369 {$ENDIF}
5370
5371 {$IFDEF GLB_LAZARUS}
5372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5373 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5374 var
5375   rid: TRawImageDescription;
5376   FormatDesc: TFormatDescriptor;
5377 begin
5378   result := false;
5379   if not Assigned(aImage) or (Format = tfEmpty) then
5380     exit;
5381   FormatDesc := TFormatDescriptor.Get(Format);
5382   if FormatDesc.IsCompressed then
5383     exit;
5384
5385   FillChar(rid{%H-}, SizeOf(rid), 0);
5386   if (Format in [
5387        tfAlpha4, tfAlpha8, tfAlpha16,
5388        tfLuminance4, tfLuminance8, tfLuminance16,
5389        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16]) then
5390     rid.Format := ricfGray
5391   else
5392     rid.Format := ricfRGBA;
5393
5394   rid.Width        := Width;
5395   rid.Height       := Height;
5396   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
5397   rid.BitOrder     := riboBitsInOrder;
5398   rid.ByteOrder    := riboLSBFirst;
5399   rid.LineOrder    := riloTopToBottom;
5400   rid.LineEnd      := rileTight;
5401   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
5402   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5403   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5404   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5405   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5406   rid.RedShift     := FormatDesc.Shift.r;
5407   rid.GreenShift   := FormatDesc.Shift.g;
5408   rid.BlueShift    := FormatDesc.Shift.b;
5409   rid.AlphaShift   := FormatDesc.Shift.a;
5410
5411   rid.MaskBitsPerPixel  := 0;
5412   rid.PaletteColorCount := 0;
5413
5414   aImage.DataDescription := rid;
5415   aImage.CreateData;
5416
5417   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5418
5419   result := true;
5420 end;
5421
5422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5423 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5424 var
5425   f: TglBitmapFormat;
5426   FormatDesc: TFormatDescriptor;
5427   ImageData: PByte;
5428   ImageSize: Integer;
5429   CanCopy: Boolean;
5430
5431   procedure CopyConvert;
5432   var
5433     bfFormat: TbmpBitfieldFormat;
5434     pSourceLine, pDestLine: PByte;
5435     pSourceMD, pDestMD: Pointer;
5436     x, y: Integer;
5437     pixel: TglBitmapPixelData;
5438   begin
5439     bfFormat  := TbmpBitfieldFormat.Create;
5440     with aImage.DataDescription do begin
5441       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5442       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5443       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5444       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5445       bfFormat.PixelSize := BitsPerPixel / 8;
5446     end;
5447     pSourceMD := bfFormat.CreateMappingData;
5448     pDestMD   := FormatDesc.CreateMappingData;
5449     try
5450       for y := 0 to aImage.Height-1 do begin
5451         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5452         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5453         for x := 0 to aImage.Width-1 do begin
5454           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5455           FormatDesc.Map(pixel, pDestLine, pDestMD);
5456         end;
5457       end;
5458     finally
5459       FormatDesc.FreeMappingData(pDestMD);
5460       bfFormat.FreeMappingData(pSourceMD);
5461       bfFormat.Free;
5462     end;
5463   end;
5464
5465 begin
5466   result := false;
5467   if not Assigned(aImage) then
5468     exit;
5469   for f := High(f) downto Low(f) do begin
5470     FormatDesc := TFormatDescriptor.Get(f);
5471     with aImage.DataDescription do
5472       if FormatDesc.MaskMatch(
5473         (QWord(1 shl RedPrec  )-1) shl RedShift,
5474         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5475         (QWord(1 shl BluePrec )-1) shl BlueShift,
5476         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5477         break;
5478   end;
5479
5480   if (f = tfEmpty) then
5481     exit;
5482
5483   CanCopy :=
5484     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5485     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5486
5487   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5488   ImageData := GetMem(ImageSize);
5489   try
5490     if CanCopy then
5491       Move(aImage.PixelData^, ImageData^, ImageSize)
5492     else
5493       CopyConvert;
5494     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5495   except
5496     if Assigned(ImageData) then
5497       FreeMem(ImageData);
5498     raise;
5499   end;
5500
5501   result := true;
5502 end;
5503
5504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5505 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5506 var
5507   rid: TRawImageDescription;
5508   FormatDesc: TFormatDescriptor;
5509   Pixel: TglBitmapPixelData;
5510   x, y: Integer;
5511   srcMD: Pointer;
5512   src, dst: PByte;
5513 begin
5514   result := false;
5515   if not Assigned(aImage) or (Format = tfEmpty) then
5516     exit;
5517   FormatDesc := TFormatDescriptor.Get(Format);
5518   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5519     exit;
5520
5521   FillChar(rid{%H-}, SizeOf(rid), 0);
5522   rid.Format       := ricfGray;
5523   rid.Width        := Width;
5524   rid.Height       := Height;
5525   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5526   rid.BitOrder     := riboBitsInOrder;
5527   rid.ByteOrder    := riboLSBFirst;
5528   rid.LineOrder    := riloTopToBottom;
5529   rid.LineEnd      := rileTight;
5530   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5531   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5532   rid.GreenPrec    := 0;
5533   rid.BluePrec     := 0;
5534   rid.AlphaPrec    := 0;
5535   rid.RedShift     := 0;
5536   rid.GreenShift   := 0;
5537   rid.BlueShift    := 0;
5538   rid.AlphaShift   := 0;
5539
5540   rid.MaskBitsPerPixel  := 0;
5541   rid.PaletteColorCount := 0;
5542
5543   aImage.DataDescription := rid;
5544   aImage.CreateData;
5545
5546   srcMD := FormatDesc.CreateMappingData;
5547   try
5548     FormatDesc.PreparePixel(Pixel);
5549     src := Data;
5550     dst := aImage.PixelData;
5551     for y := 0 to Height-1 do
5552       for x := 0 to Width-1 do begin
5553         FormatDesc.Unmap(src, Pixel, srcMD);
5554         case rid.BitsPerPixel of
5555            8: begin
5556             dst^ := Pixel.Data.a;
5557             inc(dst);
5558           end;
5559           16: begin
5560             PWord(dst)^ := Pixel.Data.a;
5561             inc(dst, 2);
5562           end;
5563           24: begin
5564             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5565             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5566             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5567             inc(dst, 3);
5568           end;
5569           32: begin
5570             PCardinal(dst)^ := Pixel.Data.a;
5571             inc(dst, 4);
5572           end;
5573         else
5574           raise EglBitmapUnsupportedFormat.Create(Format);
5575         end;
5576       end;
5577   finally
5578     FormatDesc.FreeMappingData(srcMD);
5579   end;
5580   result := true;
5581 end;
5582
5583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5584 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5585 var
5586   tex: TglBitmap2D;
5587 begin
5588   tex := TglBitmap2D.Create;
5589   try
5590     tex.AssignFromLazIntfImage(aImage);
5591     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5592   finally
5593     tex.Free;
5594   end;
5595 end;
5596 {$ENDIF}
5597
5598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5599 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5600   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5601 var
5602   rs: TResourceStream;
5603 begin
5604   PrepareResType(aResource, aResType);
5605   rs := TResourceStream.Create(aInstance, aResource, aResType);
5606   try
5607     result := AddAlphaFromStream(rs, aFunc, aArgs);
5608   finally
5609     rs.Free;
5610   end;
5611 end;
5612
5613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5614 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5615   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5616 var
5617   rs: TResourceStream;
5618 begin
5619   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5620   try
5621     result := AddAlphaFromStream(rs, aFunc, aArgs);
5622   finally
5623     rs.Free;
5624   end;
5625 end;
5626
5627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5628 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5629 begin
5630   if TFormatDescriptor.Get(Format).IsCompressed then
5631     raise EglBitmapUnsupportedFormat.Create(Format);
5632   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5633 end;
5634
5635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5636 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5637 var
5638   FS: TFileStream;
5639 begin
5640   FS := TFileStream.Create(aFileName, fmOpenRead);
5641   try
5642     result := AddAlphaFromStream(FS, aFunc, aArgs);
5643   finally
5644     FS.Free;
5645   end;
5646 end;
5647
5648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5649 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5650 var
5651   tex: TglBitmap2D;
5652 begin
5653   tex := TglBitmap2D.Create(aStream);
5654   try
5655     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5656   finally
5657     tex.Free;
5658   end;
5659 end;
5660
5661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5662 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5663 var
5664   DestData, DestData2, SourceData: pByte;
5665   TempHeight, TempWidth: Integer;
5666   SourceFD, DestFD: TFormatDescriptor;
5667   SourceMD, DestMD, DestMD2: Pointer;
5668
5669   FuncRec: TglBitmapFunctionRec;
5670 begin
5671   result := false;
5672
5673   Assert(Assigned(Data));
5674   Assert(Assigned(aBitmap));
5675   Assert(Assigned(aBitmap.Data));
5676
5677   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5678     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5679
5680     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5681     DestFD   := TFormatDescriptor.Get(Format);
5682
5683     if not Assigned(aFunc) then begin
5684       aFunc        := glBitmapAlphaFunc;
5685       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5686     end else
5687       FuncRec.Args := aArgs;
5688
5689     // Values
5690     TempHeight := aBitmap.FileHeight;
5691     TempWidth  := aBitmap.FileWidth;
5692
5693     FuncRec.Sender          := Self;
5694     FuncRec.Size            := Dimension;
5695     FuncRec.Position.Fields := FuncRec.Size.Fields;
5696
5697     DestData   := Data;
5698     DestData2  := Data;
5699     SourceData := aBitmap.Data;
5700
5701     // Mapping
5702     SourceFD.PreparePixel(FuncRec.Source);
5703     DestFD.PreparePixel  (FuncRec.Dest);
5704
5705     SourceMD := SourceFD.CreateMappingData;
5706     DestMD   := DestFD.CreateMappingData;
5707     DestMD2  := DestFD.CreateMappingData;
5708     try
5709       FuncRec.Position.Y := 0;
5710       while FuncRec.Position.Y < TempHeight do begin
5711         FuncRec.Position.X := 0;
5712         while FuncRec.Position.X < TempWidth do begin
5713           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5714           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5715           aFunc(FuncRec);
5716           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5717           inc(FuncRec.Position.X);
5718         end;
5719         inc(FuncRec.Position.Y);
5720       end;
5721     finally
5722       SourceFD.FreeMappingData(SourceMD);
5723       DestFD.FreeMappingData(DestMD);
5724       DestFD.FreeMappingData(DestMD2);
5725     end;
5726   end;
5727 end;
5728
5729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5730 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5731 begin
5732   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5733 end;
5734
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5737 var
5738   PixelData: TglBitmapPixelData;
5739 begin
5740   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5741   result := AddAlphaFromColorKeyFloat(
5742     aRed   / PixelData.Range.r,
5743     aGreen / PixelData.Range.g,
5744     aBlue  / PixelData.Range.b,
5745     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5746 end;
5747
5748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5749 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5750 var
5751   values: array[0..2] of Single;
5752   tmp: Cardinal;
5753   i: Integer;
5754   PixelData: TglBitmapPixelData;
5755 begin
5756   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5757   with PixelData do begin
5758     values[0] := aRed;
5759     values[1] := aGreen;
5760     values[2] := aBlue;
5761
5762     for i := 0 to 2 do begin
5763       tmp          := Trunc(Range.arr[i] * aDeviation);
5764       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5765       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5766     end;
5767     Data.a  := 0;
5768     Range.a := 0;
5769   end;
5770   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5771 end;
5772
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5775 begin
5776   result := AddAlphaFromValueFloat(aAlpha / $FF);
5777 end;
5778
5779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5780 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5781 var
5782   PixelData: TglBitmapPixelData;
5783 begin
5784   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5785   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5786 end;
5787
5788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5789 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5790 var
5791   PixelData: TglBitmapPixelData;
5792 begin
5793   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5794   with PixelData do
5795     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5796   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5797 end;
5798
5799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5800 function TglBitmap.RemoveAlpha: Boolean;
5801 var
5802   FormatDesc: TFormatDescriptor;
5803 begin
5804   result := false;
5805   FormatDesc := TFormatDescriptor.Get(Format);
5806   if Assigned(Data) then begin
5807     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5808       raise EglBitmapUnsupportedFormat.Create(Format);
5809     result := ConvertTo(FormatDesc.WithoutAlpha);
5810   end;
5811 end;
5812
5813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5814 function TglBitmap.Clone: TglBitmap;
5815 var
5816   Temp: TglBitmap;
5817   TempPtr: PByte;
5818   Size: Integer;
5819 begin
5820   result := nil;
5821   Temp := (ClassType.Create as TglBitmap);
5822   try
5823     // copy texture data if assigned
5824     if Assigned(Data) then begin
5825       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5826       GetMem(TempPtr, Size);
5827       try
5828         Move(Data^, TempPtr^, Size);
5829         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5830       except
5831         if Assigned(TempPtr) then
5832           FreeMem(TempPtr);
5833         raise;
5834       end;
5835     end else begin
5836       TempPtr := nil;
5837       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5838     end;
5839
5840         // copy properties
5841     Temp.fID                      := ID;
5842     Temp.fTarget                  := Target;
5843     Temp.fFormat                  := Format;
5844     Temp.fMipMap                  := MipMap;
5845     Temp.fAnisotropic             := Anisotropic;
5846     Temp.fBorderColor             := fBorderColor;
5847     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5848     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5849     Temp.fFilterMin               := fFilterMin;
5850     Temp.fFilterMag               := fFilterMag;
5851     Temp.fWrapS                   := fWrapS;
5852     Temp.fWrapT                   := fWrapT;
5853     Temp.fWrapR                   := fWrapR;
5854     Temp.fFilename                := fFilename;
5855     Temp.fCustomName              := fCustomName;
5856     Temp.fCustomNameW             := fCustomNameW;
5857     Temp.fCustomData              := fCustomData;
5858
5859     result := Temp;
5860   except
5861     FreeAndNil(Temp);
5862     raise;
5863   end;
5864 end;
5865
5866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5867 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5868 var
5869   SourceFD, DestFD: TFormatDescriptor;
5870   SourcePD, DestPD: TglBitmapPixelData;
5871   ShiftData: TShiftData;
5872
5873   function DataIsIdentical: Boolean;
5874   begin
5875     result :=
5876       (SourceFD.RedMask   = DestFD.RedMask)   and
5877       (SourceFD.GreenMask = DestFD.GreenMask) and
5878       (SourceFD.BlueMask  = DestFD.BlueMask)  and
5879       (SourceFD.AlphaMask = DestFD.AlphaMask);
5880   end;
5881
5882   function CanCopyDirect: Boolean;
5883   begin
5884     result :=
5885       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5886       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5887       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5888       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5889   end;
5890
5891   function CanShift: Boolean;
5892   begin
5893     result :=
5894       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5895       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5896       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5897       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5898   end;
5899
5900   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5901   begin
5902     result := 0;
5903     while (aSource > aDest) and (aSource > 0) do begin
5904       inc(result);
5905       aSource := aSource shr 1;
5906     end;
5907   end;
5908
5909 begin
5910   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5911     SourceFD := TFormatDescriptor.Get(Format);
5912     DestFD   := TFormatDescriptor.Get(aFormat);
5913
5914     if DataIsIdentical then begin
5915       result := true;
5916       Format := aFormat;
5917       exit;
5918     end;
5919
5920     SourceFD.PreparePixel(SourcePD);
5921     DestFD.PreparePixel  (DestPD);
5922
5923     if CanCopyDirect then
5924       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5925     else if CanShift then begin
5926       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5927       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5928       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5929       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5930       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5931     end else
5932       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5933   end else
5934     result := true;
5935 end;
5936
5937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5938 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5939 begin
5940   if aUseRGB or aUseAlpha then
5941     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5942       ((Byte(aUseAlpha) and 1) shl 1) or
5943        (Byte(aUseRGB)   and 1)      ));
5944 end;
5945
5946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5947 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5948 begin
5949   fBorderColor[0] := aRed;
5950   fBorderColor[1] := aGreen;
5951   fBorderColor[2] := aBlue;
5952   fBorderColor[3] := aAlpha;
5953   if (ID > 0) then begin
5954     Bind(false);
5955     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5956   end;
5957 end;
5958
5959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5960 procedure TglBitmap.FreeData;
5961 var
5962   TempPtr: PByte;
5963 begin
5964   TempPtr := nil;
5965   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5966 end;
5967
5968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5969 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5970   const aAlpha: Byte);
5971 begin
5972   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5973 end;
5974
5975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5976 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5977 var
5978   PixelData: TglBitmapPixelData;
5979 begin
5980   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5981   FillWithColorFloat(
5982     aRed   / PixelData.Range.r,
5983     aGreen / PixelData.Range.g,
5984     aBlue  / PixelData.Range.b,
5985     aAlpha / PixelData.Range.a);
5986 end;
5987
5988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5989 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5990 var
5991   PixelData: TglBitmapPixelData;
5992 begin
5993   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5994   with PixelData do begin
5995     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5996     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5997     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5998     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5999   end;
6000   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6001 end;
6002
6003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6004 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6005 begin
6006   //check MIN filter
6007   case aMin of
6008     GL_NEAREST:
6009       fFilterMin := GL_NEAREST;
6010     GL_LINEAR:
6011       fFilterMin := GL_LINEAR;
6012     GL_NEAREST_MIPMAP_NEAREST:
6013       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6014     GL_LINEAR_MIPMAP_NEAREST:
6015       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6016     GL_NEAREST_MIPMAP_LINEAR:
6017       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6018     GL_LINEAR_MIPMAP_LINEAR:
6019       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6020     else
6021       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6022   end;
6023
6024   //check MAG filter
6025   case aMag of
6026     GL_NEAREST:
6027       fFilterMag := GL_NEAREST;
6028     GL_LINEAR:
6029       fFilterMag := GL_LINEAR;
6030     else
6031       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6032   end;
6033
6034   //apply filter
6035   if (ID > 0) then begin
6036     Bind(false);
6037     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6038
6039     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
6040       case fFilterMin of
6041         GL_NEAREST, GL_LINEAR:
6042           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6043         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6044           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6045         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6046           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6047       end;
6048     end else
6049       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6050   end;
6051 end;
6052
6053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6054 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6055
6056   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6057   begin
6058     case aValue of
6059       GL_CLAMP:
6060         aTarget := GL_CLAMP;
6061
6062       GL_REPEAT:
6063         aTarget := GL_REPEAT;
6064
6065       GL_CLAMP_TO_EDGE: begin
6066         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
6067           aTarget := GL_CLAMP_TO_EDGE
6068         else
6069           aTarget := GL_CLAMP;
6070       end;
6071
6072       GL_CLAMP_TO_BORDER: begin
6073         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6074           aTarget := GL_CLAMP_TO_BORDER
6075         else
6076           aTarget := GL_CLAMP;
6077       end;
6078
6079       GL_MIRRORED_REPEAT: begin
6080         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6081           aTarget := GL_MIRRORED_REPEAT
6082         else
6083           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6084       end;
6085     else
6086       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6087     end;
6088   end;
6089
6090 begin
6091   CheckAndSetWrap(S, fWrapS);
6092   CheckAndSetWrap(T, fWrapT);
6093   CheckAndSetWrap(R, fWrapR);
6094
6095   if (ID > 0) then begin
6096     Bind(false);
6097     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6098     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6099     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6100   end;
6101 end;
6102
6103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6104 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6105
6106   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6107   begin
6108     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6109        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6110       fSwizzle[aIndex] := aValue
6111     else
6112       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6113   end;
6114
6115 begin
6116   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6117     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6118   CheckAndSetValue(r, 0);
6119   CheckAndSetValue(g, 1);
6120   CheckAndSetValue(b, 2);
6121   CheckAndSetValue(a, 3);
6122
6123   if (ID > 0) then begin
6124     Bind(false);
6125     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6126   end;
6127 end;
6128
6129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6130 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6131 begin
6132   if aEnableTextureUnit then
6133     glEnable(Target);
6134   if (ID > 0) then
6135     glBindTexture(Target, ID);
6136 end;
6137
6138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6139 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6140 begin
6141   if aDisableTextureUnit then
6142     glDisable(Target);
6143   glBindTexture(Target, 0);
6144 end;
6145
6146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6147 constructor TglBitmap.Create;
6148 begin
6149   if (ClassType = TglBitmap) then
6150     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6151 {$IFDEF GLB_NATIVE_OGL}
6152   glbReadOpenGLExtensions;
6153 {$ENDIF}
6154   inherited Create;
6155   fFormat            := glBitmapGetDefaultFormat;
6156   fFreeDataOnDestroy := true;
6157 end;
6158
6159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6160 constructor TglBitmap.Create(const aFileName: String);
6161 begin
6162   Create;
6163   LoadFromFile(aFileName);
6164 end;
6165
6166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6167 constructor TglBitmap.Create(const aStream: TStream);
6168 begin
6169   Create;
6170   LoadFromStream(aStream);
6171 end;
6172
6173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6174 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6175 var
6176   ImageSize: Integer;
6177 begin
6178   Create;
6179   if not Assigned(aData) then begin
6180     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6181     GetMem(aData, ImageSize);
6182     try
6183       FillChar(aData^, ImageSize, #$FF);
6184       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6185     except
6186       if Assigned(aData) then
6187         FreeMem(aData);
6188       raise;
6189     end;
6190   end else begin
6191     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6192     fFreeDataOnDestroy := false;
6193   end;
6194 end;
6195
6196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6197 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6198 begin
6199   Create;
6200   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6201 end;
6202
6203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6204 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6205 begin
6206   Create;
6207   LoadFromResource(aInstance, aResource, aResType);
6208 end;
6209
6210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6211 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6212 begin
6213   Create;
6214   LoadFromResourceID(aInstance, aResourceID, aResType);
6215 end;
6216
6217 {$IFDEF GLB_SUPPORT_PNG_READ}
6218 {$IF DEFINED(GLB_LAZ_PNG)}
6219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6220 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6222 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6223 const
6224   MAGIC_LEN = 8;
6225   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6226 var
6227   reader: TLazReaderPNG;
6228   intf: TLazIntfImage;
6229   StreamPos: Int64;
6230   magic: String[MAGIC_LEN];
6231 begin
6232   result := true;
6233   StreamPos := aStream.Position;
6234
6235   SetLength(magic, MAGIC_LEN);
6236   aStream.Read(magic[1], MAGIC_LEN);
6237   aStream.Position := StreamPos;
6238   if (magic <> PNG_MAGIC) then begin
6239     result := false;
6240     exit;
6241   end;
6242
6243   intf   := TLazIntfImage.Create(0, 0);
6244   reader := TLazReaderPNG.Create;
6245   try try
6246     reader.UpdateDescription := true;
6247     reader.ImageRead(aStream, intf);
6248     AssignFromLazIntfImage(intf);
6249   except
6250     result := false;
6251     aStream.Position := StreamPos;
6252     exit;
6253   end;
6254   finally
6255     reader.Free;
6256     intf.Free;
6257   end;
6258 end;
6259
6260 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6262 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6263 var
6264   Surface: PSDL_Surface;
6265   RWops: PSDL_RWops;
6266 begin
6267   result := false;
6268   RWops := glBitmapCreateRWops(aStream);
6269   try
6270     if IMG_isPNG(RWops) > 0 then begin
6271       Surface := IMG_LoadPNG_RW(RWops);
6272       try
6273         AssignFromSurface(Surface);
6274         result := true;
6275       finally
6276         SDL_FreeSurface(Surface);
6277       end;
6278     end;
6279   finally
6280     SDL_FreeRW(RWops);
6281   end;
6282 end;
6283
6284 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6286 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6287 begin
6288   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6289 end;
6290
6291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6292 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6293 var
6294   StreamPos: Int64;
6295   signature: array [0..7] of byte;
6296   png: png_structp;
6297   png_info: png_infop;
6298
6299   TempHeight, TempWidth: Integer;
6300   Format: TglBitmapFormat;
6301
6302   png_data: pByte;
6303   png_rows: array of pByte;
6304   Row, LineSize: Integer;
6305 begin
6306   result := false;
6307
6308   if not init_libPNG then
6309     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6310
6311   try
6312     // signature
6313     StreamPos := aStream.Position;
6314     aStream.Read(signature{%H-}, 8);
6315     aStream.Position := StreamPos;
6316
6317     if png_check_sig(@signature, 8) <> 0 then begin
6318       // png read struct
6319       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6320       if png = nil then
6321         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6322
6323       // png info
6324       png_info := png_create_info_struct(png);
6325       if png_info = nil then begin
6326         png_destroy_read_struct(@png, nil, nil);
6327         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6328       end;
6329
6330       // set read callback
6331       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6332
6333       // read informations
6334       png_read_info(png, png_info);
6335
6336       // size
6337       TempHeight := png_get_image_height(png, png_info);
6338       TempWidth := png_get_image_width(png, png_info);
6339
6340       // format
6341       case png_get_color_type(png, png_info) of
6342         PNG_COLOR_TYPE_GRAY:
6343           Format := tfLuminance8;
6344         PNG_COLOR_TYPE_GRAY_ALPHA:
6345           Format := tfLuminance8Alpha8;
6346         PNG_COLOR_TYPE_RGB:
6347           Format := tfRGB8;
6348         PNG_COLOR_TYPE_RGB_ALPHA:
6349           Format := tfRGBA8;
6350         else
6351           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6352       end;
6353
6354       // cut upper 8 bit from 16 bit formats
6355       if png_get_bit_depth(png, png_info) > 8 then
6356         png_set_strip_16(png);
6357
6358       // expand bitdepth smaller than 8
6359       if png_get_bit_depth(png, png_info) < 8 then
6360         png_set_expand(png);
6361
6362       // allocating mem for scanlines
6363       LineSize := png_get_rowbytes(png, png_info);
6364       GetMem(png_data, TempHeight * LineSize);
6365       try
6366         SetLength(png_rows, TempHeight);
6367         for Row := Low(png_rows) to High(png_rows) do begin
6368           png_rows[Row] := png_data;
6369           Inc(png_rows[Row], Row * LineSize);
6370         end;
6371
6372         // read complete image into scanlines
6373         png_read_image(png, @png_rows[0]);
6374
6375         // read end
6376         png_read_end(png, png_info);
6377
6378         // destroy read struct
6379         png_destroy_read_struct(@png, @png_info, nil);
6380
6381         SetLength(png_rows, 0);
6382
6383         // set new data
6384         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6385
6386         result := true;
6387       except
6388         if Assigned(png_data) then
6389           FreeMem(png_data);
6390         raise;
6391       end;
6392     end;
6393   finally
6394     quit_libPNG;
6395   end;
6396 end;
6397
6398 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6400 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6401 var
6402   StreamPos: Int64;
6403   Png: TPNGObject;
6404   Header: String[8];
6405   Row, Col, PixSize, LineSize: Integer;
6406   NewImage, pSource, pDest, pAlpha: pByte;
6407   PngFormat: TglBitmapFormat;
6408   FormatDesc: TFormatDescriptor;
6409
6410 const
6411   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6412
6413 begin
6414   result := false;
6415
6416   StreamPos := aStream.Position;
6417   aStream.Read(Header[0], SizeOf(Header));
6418   aStream.Position := StreamPos;
6419
6420   {Test if the header matches}
6421   if Header = PngHeader then begin
6422     Png := TPNGObject.Create;
6423     try
6424       Png.LoadFromStream(aStream);
6425
6426       case Png.Header.ColorType of
6427         COLOR_GRAYSCALE:
6428           PngFormat := tfLuminance8;
6429         COLOR_GRAYSCALEALPHA:
6430           PngFormat := tfLuminance8Alpha8;
6431         COLOR_RGB:
6432           PngFormat := tfBGR8;
6433         COLOR_RGBALPHA:
6434           PngFormat := tfBGRA8;
6435         else
6436           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6437       end;
6438
6439       FormatDesc := TFormatDescriptor.Get(PngFormat);
6440       PixSize    := Round(FormatDesc.PixelSize);
6441       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6442
6443       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6444       try
6445         pDest := NewImage;
6446
6447         case Png.Header.ColorType of
6448           COLOR_RGB, COLOR_GRAYSCALE:
6449             begin
6450               for Row := 0 to Png.Height -1 do begin
6451                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6452                 Inc(pDest, LineSize);
6453               end;
6454             end;
6455           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6456             begin
6457               PixSize := PixSize -1;
6458
6459               for Row := 0 to Png.Height -1 do begin
6460                 pSource := Png.Scanline[Row];
6461                 pAlpha := pByte(Png.AlphaScanline[Row]);
6462
6463                 for Col := 0 to Png.Width -1 do begin
6464                   Move (pSource^, pDest^, PixSize);
6465                   Inc(pSource, PixSize);
6466                   Inc(pDest, PixSize);
6467
6468                   pDest^ := pAlpha^;
6469                   inc(pAlpha);
6470                   Inc(pDest);
6471                 end;
6472               end;
6473             end;
6474           else
6475             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6476         end;
6477
6478         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6479
6480         result := true;
6481       except
6482         if Assigned(NewImage) then
6483           FreeMem(NewImage);
6484         raise;
6485       end;
6486     finally
6487       Png.Free;
6488     end;
6489   end;
6490 end;
6491 {$IFEND}
6492 {$ENDIF}
6493
6494 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6495 {$IFDEF GLB_LIB_PNG}
6496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6497 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6498 begin
6499   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6500 end;
6501 {$ENDIF}
6502
6503 {$IF DEFINED(GLB_LAZ_PNG)}
6504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6505 procedure TglBitmap.SavePNG(const aStream: TStream);
6506 var
6507   png: TPortableNetworkGraphic;
6508   intf: TLazIntfImage;
6509   raw: TRawImage;
6510 begin
6511   png  := TPortableNetworkGraphic.Create;
6512   intf := TLazIntfImage.Create(0, 0);
6513   try
6514     if not AssignToLazIntfImage(intf) then
6515       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6516     intf.GetRawImage(raw);
6517     png.LoadFromRawImage(raw, false);
6518     png.SaveToStream(aStream);
6519   finally
6520     png.Free;
6521     intf.Free;
6522   end;
6523 end;
6524
6525 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6527 procedure TglBitmap.SavePNG(const aStream: TStream);
6528 var
6529   png: png_structp;
6530   png_info: png_infop;
6531   png_rows: array of pByte;
6532   LineSize: Integer;
6533   ColorType: Integer;
6534   Row: Integer;
6535   FormatDesc: TFormatDescriptor;
6536 begin
6537   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6538     raise EglBitmapUnsupportedFormat.Create(Format);
6539
6540   if not init_libPNG then
6541     raise Exception.Create('unable to initialize libPNG.');
6542
6543   try
6544     case Format of
6545       tfAlpha8, tfLuminance8:
6546         ColorType := PNG_COLOR_TYPE_GRAY;
6547       tfLuminance8Alpha8:
6548         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6549       tfBGR8, tfRGB8:
6550         ColorType := PNG_COLOR_TYPE_RGB;
6551       tfBGRA8, tfRGBA8:
6552         ColorType := PNG_COLOR_TYPE_RGBA;
6553       else
6554         raise EglBitmapUnsupportedFormat.Create(Format);
6555     end;
6556
6557     FormatDesc := TFormatDescriptor.Get(Format);
6558     LineSize := FormatDesc.GetSize(Width, 1);
6559
6560     // creating array for scanline
6561     SetLength(png_rows, Height);
6562     try
6563       for Row := 0 to Height - 1 do begin
6564         png_rows[Row] := Data;
6565         Inc(png_rows[Row], Row * LineSize)
6566       end;
6567
6568       // write struct
6569       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6570       if png = nil then
6571         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6572
6573       // create png info
6574       png_info := png_create_info_struct(png);
6575       if png_info = nil then begin
6576         png_destroy_write_struct(@png, nil);
6577         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6578       end;
6579
6580       // set read callback
6581       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6582
6583       // set compression
6584       png_set_compression_level(png, 6);
6585
6586       if Format in [tfBGR8, tfBGRA8] then
6587         png_set_bgr(png);
6588
6589       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6590       png_write_info(png, png_info);
6591       png_write_image(png, @png_rows[0]);
6592       png_write_end(png, png_info);
6593       png_destroy_write_struct(@png, @png_info);
6594     finally
6595       SetLength(png_rows, 0);
6596     end;
6597   finally
6598     quit_libPNG;
6599   end;
6600 end;
6601
6602 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6604 procedure TglBitmap.SavePNG(const aStream: TStream);
6605 var
6606   Png: TPNGObject;
6607
6608   pSource, pDest: pByte;
6609   X, Y, PixSize: Integer;
6610   ColorType: Cardinal;
6611   Alpha: Boolean;
6612
6613   pTemp: pByte;
6614   Temp: Byte;
6615 begin
6616   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6617     raise EglBitmapUnsupportedFormat.Create(Format);
6618
6619   case Format of
6620     tfAlpha8, tfLuminance8: begin
6621       ColorType := COLOR_GRAYSCALE;
6622       PixSize   := 1;
6623       Alpha     := false;
6624     end;
6625     tfLuminance8Alpha8: begin
6626       ColorType := COLOR_GRAYSCALEALPHA;
6627       PixSize   := 1;
6628       Alpha     := true;
6629     end;
6630     tfBGR8, tfRGB8: begin
6631       ColorType := COLOR_RGB;
6632       PixSize   := 3;
6633       Alpha     := false;
6634     end;
6635     tfBGRA8, tfRGBA8: begin
6636       ColorType := COLOR_RGBALPHA;
6637       PixSize   := 3;
6638       Alpha     := true
6639     end;
6640   else
6641     raise EglBitmapUnsupportedFormat.Create(Format);
6642   end;
6643
6644   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6645   try
6646     // Copy ImageData
6647     pSource := Data;
6648     for Y := 0 to Height -1 do begin
6649       pDest := png.ScanLine[Y];
6650       for X := 0 to Width -1 do begin
6651         Move(pSource^, pDest^, PixSize);
6652         Inc(pDest, PixSize);
6653         Inc(pSource, PixSize);
6654         if Alpha then begin
6655           png.AlphaScanline[Y]^[X] := pSource^;
6656           Inc(pSource);
6657         end;
6658       end;
6659
6660       // convert RGB line to BGR
6661       if Format in [tfRGB8, tfRGBA8] then begin
6662         pTemp := png.ScanLine[Y];
6663         for X := 0 to Width -1 do begin
6664           Temp := pByteArray(pTemp)^[0];
6665           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6666           pByteArray(pTemp)^[2] := Temp;
6667           Inc(pTemp, 3);
6668         end;
6669       end;
6670     end;
6671
6672     // Save to Stream
6673     Png.CompressionLevel := 6;
6674     Png.SaveToStream(aStream);
6675   finally
6676     FreeAndNil(Png);
6677   end;
6678 end;
6679 {$IFEND}
6680 {$ENDIF}
6681
6682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6683 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6685 {$IFDEF GLB_LIB_JPEG}
6686 type
6687   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6688   glBitmap_libJPEG_source_mgr = record
6689     pub: jpeg_source_mgr;
6690
6691     SrcStream: TStream;
6692     SrcBuffer: array [1..4096] of byte;
6693   end;
6694
6695   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6696   glBitmap_libJPEG_dest_mgr = record
6697     pub: jpeg_destination_mgr;
6698
6699     DestStream: TStream;
6700     DestBuffer: array [1..4096] of byte;
6701   end;
6702
6703 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6704 begin
6705   //DUMMY
6706 end;
6707
6708
6709 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6710 begin
6711   //DUMMY
6712 end;
6713
6714
6715 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6716 begin
6717   //DUMMY
6718 end;
6719
6720 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6721 begin
6722   //DUMMY
6723 end;
6724
6725
6726 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6727 begin
6728   //DUMMY
6729 end;
6730
6731
6732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6733 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6734 var
6735   src: glBitmap_libJPEG_source_mgr_ptr;
6736   bytes: integer;
6737 begin
6738   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6739
6740   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6741         if (bytes <= 0) then begin
6742                 src^.SrcBuffer[1] := $FF;
6743                 src^.SrcBuffer[2] := JPEG_EOI;
6744                 bytes := 2;
6745         end;
6746
6747         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6748         src^.pub.bytes_in_buffer := bytes;
6749
6750   result := true;
6751 end;
6752
6753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6754 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6755 var
6756   src: glBitmap_libJPEG_source_mgr_ptr;
6757 begin
6758   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6759
6760   if num_bytes > 0 then begin
6761     // wanted byte isn't in buffer so set stream position and read buffer
6762     if num_bytes > src^.pub.bytes_in_buffer then begin
6763       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6764       src^.pub.fill_input_buffer(cinfo);
6765     end else begin
6766       // wanted byte is in buffer so only skip
6767                 inc(src^.pub.next_input_byte, num_bytes);
6768                 dec(src^.pub.bytes_in_buffer, num_bytes);
6769     end;
6770   end;
6771 end;
6772
6773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6774 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6775 var
6776   dest: glBitmap_libJPEG_dest_mgr_ptr;
6777 begin
6778   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6779
6780   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6781     // write complete buffer
6782     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6783
6784     // reset buffer
6785     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6786     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6787   end;
6788
6789   result := true;
6790 end;
6791
6792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6793 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6794 var
6795   Idx: Integer;
6796   dest: glBitmap_libJPEG_dest_mgr_ptr;
6797 begin
6798   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6799
6800   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6801     // check for endblock
6802     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6803       // write endblock
6804       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6805
6806       // leave
6807       break;
6808     end else
6809       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6810   end;
6811 end;
6812 {$ENDIF}
6813
6814 {$IFDEF GLB_SUPPORT_JPEG_READ}
6815 {$IF DEFINED(GLB_LAZ_JPEG)}
6816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6817 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6818 const
6819   MAGIC_LEN = 2;
6820   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6821 var
6822   intf: TLazIntfImage;
6823   reader: TFPReaderJPEG;
6824   StreamPos: Int64;
6825   magic: String[MAGIC_LEN];
6826 begin
6827   result := true;
6828   StreamPos := aStream.Position;
6829
6830   SetLength(magic, MAGIC_LEN);
6831   aStream.Read(magic[1], MAGIC_LEN);
6832   aStream.Position := StreamPos;
6833   if (magic <> JPEG_MAGIC) then begin
6834     result := false;
6835     exit;
6836   end;
6837
6838   reader := TFPReaderJPEG.Create;
6839   intf := TLazIntfImage.Create(0, 0);
6840   try try
6841     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6842     reader.ImageRead(aStream, intf);
6843     AssignFromLazIntfImage(intf);
6844   except
6845     result := false;
6846     aStream.Position := StreamPos;
6847     exit;
6848   end;
6849   finally
6850     reader.Free;
6851     intf.Free;
6852   end;
6853 end;
6854
6855 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6857 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6858 var
6859   Surface: PSDL_Surface;
6860   RWops: PSDL_RWops;
6861 begin
6862   result := false;
6863
6864   RWops := glBitmapCreateRWops(aStream);
6865   try
6866     if IMG_isJPG(RWops) > 0 then begin
6867       Surface := IMG_LoadJPG_RW(RWops);
6868       try
6869         AssignFromSurface(Surface);
6870         result := true;
6871       finally
6872         SDL_FreeSurface(Surface);
6873       end;
6874     end;
6875   finally
6876     SDL_FreeRW(RWops);
6877   end;
6878 end;
6879
6880 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6882 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6883 var
6884   StreamPos: Int64;
6885   Temp: array[0..1]of Byte;
6886
6887   jpeg: jpeg_decompress_struct;
6888   jpeg_err: jpeg_error_mgr;
6889
6890   IntFormat: TglBitmapFormat;
6891   pImage: pByte;
6892   TempHeight, TempWidth: Integer;
6893
6894   pTemp: pByte;
6895   Row: Integer;
6896
6897   FormatDesc: TFormatDescriptor;
6898 begin
6899   result := false;
6900
6901   if not init_libJPEG then
6902     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6903
6904   try
6905     // reading first two bytes to test file and set cursor back to begin
6906     StreamPos := aStream.Position;
6907     aStream.Read({%H-}Temp[0], 2);
6908     aStream.Position := StreamPos;
6909
6910     // if Bitmap then read file.
6911     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6912       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6913       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6914
6915       // error managment
6916       jpeg.err := jpeg_std_error(@jpeg_err);
6917       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6918       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6919
6920       // decompression struct
6921       jpeg_create_decompress(@jpeg);
6922
6923       // allocation space for streaming methods
6924       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6925
6926       // seeting up custom functions
6927       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6928         pub.init_source       := glBitmap_libJPEG_init_source;
6929         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6930         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6931         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6932         pub.term_source       := glBitmap_libJPEG_term_source;
6933
6934         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6935         pub.next_input_byte := nil;   // until buffer loaded
6936
6937         SrcStream := aStream;
6938       end;
6939
6940       // set global decoding state
6941       jpeg.global_state := DSTATE_START;
6942
6943       // read header of jpeg
6944       jpeg_read_header(@jpeg, false);
6945
6946       // setting output parameter
6947       case jpeg.jpeg_color_space of
6948         JCS_GRAYSCALE:
6949           begin
6950             jpeg.out_color_space := JCS_GRAYSCALE;
6951             IntFormat := tfLuminance8;
6952           end;
6953         else
6954           jpeg.out_color_space := JCS_RGB;
6955           IntFormat := tfRGB8;
6956       end;
6957
6958       // reading image
6959       jpeg_start_decompress(@jpeg);
6960
6961       TempHeight := jpeg.output_height;
6962       TempWidth := jpeg.output_width;
6963
6964       FormatDesc := TFormatDescriptor.Get(IntFormat);
6965
6966       // creating new image
6967       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6968       try
6969         pTemp := pImage;
6970
6971         for Row := 0 to TempHeight -1 do begin
6972           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6973           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6974         end;
6975
6976         // finish decompression
6977         jpeg_finish_decompress(@jpeg);
6978
6979         // destroy decompression
6980         jpeg_destroy_decompress(@jpeg);
6981
6982         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6983
6984         result := true;
6985       except
6986         if Assigned(pImage) then
6987           FreeMem(pImage);
6988         raise;
6989       end;
6990     end;
6991   finally
6992     quit_libJPEG;
6993   end;
6994 end;
6995
6996 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6998 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6999 var
7000   bmp: TBitmap;
7001   jpg: TJPEGImage;
7002   StreamPos: Int64;
7003   Temp: array[0..1]of Byte;
7004 begin
7005   result := false;
7006
7007   // reading first two bytes to test file and set cursor back to begin
7008   StreamPos := aStream.Position;
7009   aStream.Read(Temp[0], 2);
7010   aStream.Position := StreamPos;
7011
7012   // if Bitmap then read file.
7013   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7014     bmp := TBitmap.Create;
7015     try
7016       jpg := TJPEGImage.Create;
7017       try
7018         jpg.LoadFromStream(aStream);
7019         bmp.Assign(jpg);
7020         result := AssignFromBitmap(bmp);
7021       finally
7022         jpg.Free;
7023       end;
7024     finally
7025       bmp.Free;
7026     end;
7027   end;
7028 end;
7029 {$IFEND}
7030 {$ENDIF}
7031
7032 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7033 {$IF DEFINED(GLB_LAZ_JPEG)}
7034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7035 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7036 var
7037   jpeg: TJPEGImage;
7038   intf: TLazIntfImage;
7039   raw: TRawImage;
7040 begin
7041   jpeg := TJPEGImage.Create;
7042   intf := TLazIntfImage.Create(0, 0);
7043   try
7044     if not AssignToLazIntfImage(intf) then
7045       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7046     intf.GetRawImage(raw);
7047     jpeg.LoadFromRawImage(raw, false);
7048     jpeg.SaveToStream(aStream);
7049   finally
7050     intf.Free;
7051     jpeg.Free;
7052   end;
7053 end;
7054
7055 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7057 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7058 var
7059   jpeg: jpeg_compress_struct;
7060   jpeg_err: jpeg_error_mgr;
7061   Row: Integer;
7062   pTemp, pTemp2: pByte;
7063
7064   procedure CopyRow(pDest, pSource: pByte);
7065   var
7066     X: Integer;
7067   begin
7068     for X := 0 to Width - 1 do begin
7069       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7070       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7071       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7072       Inc(pDest, 3);
7073       Inc(pSource, 3);
7074     end;
7075   end;
7076
7077 begin
7078   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7079     raise EglBitmapUnsupportedFormat.Create(Format);
7080
7081   if not init_libJPEG then
7082     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7083
7084   try
7085     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7086     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7087
7088     // error managment
7089     jpeg.err := jpeg_std_error(@jpeg_err);
7090     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7091     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7092
7093     // compression struct
7094     jpeg_create_compress(@jpeg);
7095
7096     // allocation space for streaming methods
7097     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7098
7099     // seeting up custom functions
7100     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7101       pub.init_destination    := glBitmap_libJPEG_init_destination;
7102       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7103       pub.term_destination    := glBitmap_libJPEG_term_destination;
7104
7105       pub.next_output_byte  := @DestBuffer[1];
7106       pub.free_in_buffer    := Length(DestBuffer);
7107
7108       DestStream := aStream;
7109     end;
7110
7111     // very important state
7112     jpeg.global_state := CSTATE_START;
7113     jpeg.image_width  := Width;
7114     jpeg.image_height := Height;
7115     case Format of
7116       tfAlpha8, tfLuminance8: begin
7117         jpeg.input_components := 1;
7118         jpeg.in_color_space   := JCS_GRAYSCALE;
7119       end;
7120       tfRGB8, tfBGR8: begin
7121         jpeg.input_components := 3;
7122         jpeg.in_color_space   := JCS_RGB;
7123       end;
7124     end;
7125
7126     jpeg_set_defaults(@jpeg);
7127     jpeg_set_quality(@jpeg, 95, true);
7128     jpeg_start_compress(@jpeg, true);
7129     pTemp := Data;
7130
7131     if Format = tfBGR8 then
7132       GetMem(pTemp2, fRowSize)
7133     else
7134       pTemp2 := pTemp;
7135
7136     try
7137       for Row := 0 to jpeg.image_height -1 do begin
7138         // prepare row
7139         if Format = tfBGR8 then
7140           CopyRow(pTemp2, pTemp)
7141         else
7142           pTemp2 := pTemp;
7143
7144         // write row
7145         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7146         inc(pTemp, fRowSize);
7147       end;
7148     finally
7149       // free memory
7150       if Format = tfBGR8 then
7151         FreeMem(pTemp2);
7152     end;
7153     jpeg_finish_compress(@jpeg);
7154     jpeg_destroy_compress(@jpeg);
7155   finally
7156     quit_libJPEG;
7157   end;
7158 end;
7159
7160 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7162 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7163 var
7164   Bmp: TBitmap;
7165   Jpg: TJPEGImage;
7166 begin
7167   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7168     raise EglBitmapUnsupportedFormat.Create(Format);
7169
7170   Bmp := TBitmap.Create;
7171   try
7172     Jpg := TJPEGImage.Create;
7173     try
7174       AssignToBitmap(Bmp);
7175       if (Format in [tfAlpha8, tfLuminance8]) then begin
7176         Jpg.Grayscale   := true;
7177         Jpg.PixelFormat := jf8Bit;
7178       end;
7179       Jpg.Assign(Bmp);
7180       Jpg.SaveToStream(aStream);
7181     finally
7182       FreeAndNil(Jpg);
7183     end;
7184   finally
7185     FreeAndNil(Bmp);
7186   end;
7187 end;
7188 {$IFEND}
7189 {$ENDIF}
7190
7191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7192 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7194 const
7195   BMP_MAGIC          = $4D42;
7196
7197   BMP_COMP_RGB       = 0;
7198   BMP_COMP_RLE8      = 1;
7199   BMP_COMP_RLE4      = 2;
7200   BMP_COMP_BITFIELDS = 3;
7201
7202 type
7203   TBMPHeader = packed record
7204     bfType: Word;
7205     bfSize: Cardinal;
7206     bfReserved1: Word;
7207     bfReserved2: Word;
7208     bfOffBits: Cardinal;
7209   end;
7210
7211   TBMPInfo = packed record
7212     biSize: Cardinal;
7213     biWidth: Longint;
7214     biHeight: Longint;
7215     biPlanes: Word;
7216     biBitCount: Word;
7217     biCompression: Cardinal;
7218     biSizeImage: Cardinal;
7219     biXPelsPerMeter: Longint;
7220     biYPelsPerMeter: Longint;
7221     biClrUsed: Cardinal;
7222     biClrImportant: Cardinal;
7223   end;
7224
7225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7226 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7227
7228   //////////////////////////////////////////////////////////////////////////////////////////////////
7229   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
7230   begin
7231     result := tfEmpty;
7232     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7233     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7234
7235     //Read Compression
7236     case aInfo.biCompression of
7237       BMP_COMP_RLE4,
7238       BMP_COMP_RLE8: begin
7239         raise EglBitmap.Create('RLE compression is not supported');
7240       end;
7241       BMP_COMP_BITFIELDS: begin
7242         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7243           aStream.Read(aMask.r, SizeOf(aMask.r));
7244           aStream.Read(aMask.g, SizeOf(aMask.g));
7245           aStream.Read(aMask.b, SizeOf(aMask.b));
7246           aStream.Read(aMask.a, SizeOf(aMask.a));
7247         end else
7248           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7249       end;
7250     end;
7251
7252     //get suitable format
7253     case aInfo.biBitCount of
7254        8: result := tfLuminance8;
7255       16: result := tfX1RGB5;
7256       24: result := tfRGB8;
7257       32: result := tfXRGB8;
7258     end;
7259   end;
7260
7261   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7262   var
7263     i, c: Integer;
7264     ColorTable: TbmpColorTable;
7265   begin
7266     result := nil;
7267     if (aInfo.biBitCount >= 16) then
7268       exit;
7269     aFormat := tfLuminance8;
7270     c := aInfo.biClrUsed;
7271     if (c = 0) then
7272       c := 1 shl aInfo.biBitCount;
7273     SetLength(ColorTable, c);
7274     for i := 0 to c-1 do begin
7275       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7276       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7277         aFormat := tfRGB8;
7278     end;
7279
7280     result := TbmpColorTableFormat.Create;
7281     result.PixelSize  := aInfo.biBitCount / 8;
7282     result.ColorTable := ColorTable;
7283     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
7284   end;
7285
7286   //////////////////////////////////////////////////////////////////////////////////////////////////
7287   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
7288     const aInfo: TBMPInfo): TbmpBitfieldFormat;
7289   var
7290     TmpFormat: TglBitmapFormat;
7291     FormatDesc: TFormatDescriptor;
7292   begin
7293     result := nil;
7294     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7295       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7296         FormatDesc := TFormatDescriptor.Get(TmpFormat);
7297         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
7298           aFormat := FormatDesc.Format;
7299           exit;
7300         end;
7301       end;
7302
7303       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7304         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7305       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7306         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7307
7308       result := TbmpBitfieldFormat.Create;
7309       result.PixelSize := aInfo.biBitCount / 8;
7310       result.RedMask   := aMask.r;
7311       result.GreenMask := aMask.g;
7312       result.BlueMask  := aMask.b;
7313       result.AlphaMask := aMask.a;
7314     end;
7315   end;
7316
7317 var
7318   //simple types
7319   StartPos: Int64;
7320   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7321   PaddingBuff: Cardinal;
7322   LineBuf, ImageData, TmpData: PByte;
7323   SourceMD, DestMD: Pointer;
7324   BmpFormat: TglBitmapFormat;
7325
7326   //records
7327   Mask: TglBitmapColorRec;
7328   Header: TBMPHeader;
7329   Info: TBMPInfo;
7330
7331   //classes
7332   SpecialFormat: TFormatDescriptor;
7333   FormatDesc: TFormatDescriptor;
7334
7335   //////////////////////////////////////////////////////////////////////////////////////////////////
7336   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7337   var
7338     i: Integer;
7339     Pixel: TglBitmapPixelData;
7340   begin
7341     aStream.Read(aLineBuf^, rbLineSize);
7342     SpecialFormat.PreparePixel(Pixel);
7343     for i := 0 to Info.biWidth-1 do begin
7344       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7345       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7346       FormatDesc.Map(Pixel, aData, DestMD);
7347     end;
7348   end;
7349
7350 begin
7351   result        := false;
7352   BmpFormat     := tfEmpty;
7353   SpecialFormat := nil;
7354   LineBuf       := nil;
7355   SourceMD      := nil;
7356   DestMD        := nil;
7357
7358   // Header
7359   StartPos := aStream.Position;
7360   aStream.Read(Header{%H-}, SizeOf(Header));
7361
7362   if Header.bfType = BMP_MAGIC then begin
7363     try try
7364       BmpFormat        := ReadInfo(Info, Mask);
7365       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7366       if not Assigned(SpecialFormat) then
7367         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7368       aStream.Position := StartPos + Header.bfOffBits;
7369
7370       if (BmpFormat <> tfEmpty) then begin
7371         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7372         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7373         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
7374         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7375
7376         //get Memory
7377         DestMD    := FormatDesc.CreateMappingData;
7378         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7379         GetMem(ImageData, ImageSize);
7380         if Assigned(SpecialFormat) then begin
7381           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7382           SourceMD := SpecialFormat.CreateMappingData;
7383         end;
7384
7385         //read Data
7386         try try
7387           FillChar(ImageData^, ImageSize, $FF);
7388           TmpData := ImageData;
7389           if (Info.biHeight > 0) then
7390             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7391           for i := 0 to Abs(Info.biHeight)-1 do begin
7392             if Assigned(SpecialFormat) then
7393               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7394             else
7395               aStream.Read(TmpData^, wbLineSize);   //else only read data
7396             if (Info.biHeight > 0) then
7397               dec(TmpData, wbLineSize)
7398             else
7399               inc(TmpData, wbLineSize);
7400             aStream.Read(PaddingBuff{%H-}, Padding);
7401           end;
7402           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7403           result := true;
7404         finally
7405           if Assigned(LineBuf) then
7406             FreeMem(LineBuf);
7407           if Assigned(SourceMD) then
7408             SpecialFormat.FreeMappingData(SourceMD);
7409           FormatDesc.FreeMappingData(DestMD);
7410         end;
7411         except
7412           if Assigned(ImageData) then
7413             FreeMem(ImageData);
7414           raise;
7415         end;
7416       end else
7417         raise EglBitmap.Create('LoadBMP - No suitable format found');
7418     except
7419       aStream.Position := StartPos;
7420       raise;
7421     end;
7422     finally
7423       FreeAndNil(SpecialFormat);
7424     end;
7425   end
7426     else aStream.Position := StartPos;
7427 end;
7428
7429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7430 procedure TglBitmap.SaveBMP(const aStream: TStream);
7431 var
7432   Header: TBMPHeader;
7433   Info: TBMPInfo;
7434   Converter: TFormatDescriptor;
7435   FormatDesc: TFormatDescriptor;
7436   SourceFD, DestFD: Pointer;
7437   pData, srcData, dstData, ConvertBuffer: pByte;
7438
7439   Pixel: TglBitmapPixelData;
7440   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7441   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7442
7443   PaddingBuff: Cardinal;
7444
7445   function GetLineWidth : Integer;
7446   begin
7447     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7448   end;
7449
7450 begin
7451   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7452     raise EglBitmapUnsupportedFormat.Create(Format);
7453
7454   Converter  := nil;
7455   FormatDesc := TFormatDescriptor.Get(Format);
7456   ImageSize  := FormatDesc.GetSize(Dimension);
7457
7458   FillChar(Header{%H-}, SizeOf(Header), 0);
7459   Header.bfType      := BMP_MAGIC;
7460   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7461   Header.bfReserved1 := 0;
7462   Header.bfReserved2 := 0;
7463   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7464
7465   FillChar(Info{%H-}, SizeOf(Info), 0);
7466   Info.biSize        := SizeOf(Info);
7467   Info.biWidth       := Width;
7468   Info.biHeight      := Height;
7469   Info.biPlanes      := 1;
7470   Info.biCompression := BMP_COMP_RGB;
7471   Info.biSizeImage   := ImageSize;
7472
7473   try
7474     case Format of
7475       tfLuminance4: begin
7476         Info.biBitCount  := 4;
7477         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7478         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7479         Converter := TbmpColorTableFormat.Create;
7480         with (Converter as TbmpColorTableFormat) do begin
7481           PixelSize := 0.5;
7482           Format    := Format;
7483           Range     := glBitmapColorRec($F, $F, $F, $0);
7484           CreateColorTable;
7485         end;
7486       end;
7487
7488       tfR3G3B2, tfLuminance8: begin
7489         Info.biBitCount  :=  8;
7490         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7491         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7492         Converter := TbmpColorTableFormat.Create;
7493         with (Converter as TbmpColorTableFormat) do begin
7494           PixelSize := 1;
7495           Format    := Format;
7496           if (Format = tfR3G3B2) then begin
7497             Range := glBitmapColorRec($7, $7, $3, $0);
7498             Shift := glBitmapShiftRec(0, 3, 6, 0);
7499           end else
7500             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7501           CreateColorTable;
7502         end;
7503       end;
7504
7505       tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
7506       tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4: begin
7507         Info.biBitCount    := 16;
7508         Info.biCompression := BMP_COMP_BITFIELDS;
7509       end;
7510
7511       tfBGR8, tfRGB8: begin
7512         Info.biBitCount := 24;
7513         if (Format = tfRGB8) then
7514           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7515       end;
7516
7517       tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
7518       tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8: begin
7519         Info.biBitCount    := 32;
7520         Info.biCompression := BMP_COMP_BITFIELDS;
7521       end;
7522     else
7523       raise EglBitmapUnsupportedFormat.Create(Format);
7524     end;
7525     Info.biXPelsPerMeter := 2835;
7526     Info.biYPelsPerMeter := 2835;
7527
7528     // prepare bitmasks
7529     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7530       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7531       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7532
7533       RedMask    := FormatDesc.RedMask;
7534       GreenMask  := FormatDesc.GreenMask;
7535       BlueMask   := FormatDesc.BlueMask;
7536       AlphaMask  := FormatDesc.AlphaMask;
7537     end;
7538
7539     // headers
7540     aStream.Write(Header, SizeOf(Header));
7541     aStream.Write(Info, SizeOf(Info));
7542
7543     // colortable
7544     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7545       with (Converter as TbmpColorTableFormat) do
7546         aStream.Write(ColorTable[0].b,
7547           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7548
7549     // bitmasks
7550     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7551       aStream.Write(RedMask,   SizeOf(Cardinal));
7552       aStream.Write(GreenMask, SizeOf(Cardinal));
7553       aStream.Write(BlueMask,  SizeOf(Cardinal));
7554       aStream.Write(AlphaMask, SizeOf(Cardinal));
7555     end;
7556
7557     // image data
7558     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7559     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7560     Padding     := GetLineWidth - wbLineSize;
7561     PaddingBuff := 0;
7562
7563     pData := Data;
7564     inc(pData, (Height-1) * rbLineSize);
7565
7566     // prepare row buffer. But only for RGB because RGBA supports color masks
7567     // so it's possible to change color within the image.
7568     if Assigned(Converter) then begin
7569       FormatDesc.PreparePixel(Pixel);
7570       GetMem(ConvertBuffer, wbLineSize);
7571       SourceFD := FormatDesc.CreateMappingData;
7572       DestFD   := Converter.CreateMappingData;
7573     end else
7574       ConvertBuffer := nil;
7575
7576     try
7577       for LineIdx := 0 to Height - 1 do begin
7578         // preparing row
7579         if Assigned(Converter) then begin
7580           srcData := pData;
7581           dstData := ConvertBuffer;
7582           for PixelIdx := 0 to Info.biWidth-1 do begin
7583             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7584             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7585             Converter.Map(Pixel, dstData, DestFD);
7586           end;
7587           aStream.Write(ConvertBuffer^, wbLineSize);
7588         end else begin
7589           aStream.Write(pData^, rbLineSize);
7590         end;
7591         dec(pData, rbLineSize);
7592         if (Padding > 0) then
7593           aStream.Write(PaddingBuff, Padding);
7594       end;
7595     finally
7596       // destroy row buffer
7597       if Assigned(ConvertBuffer) then begin
7598         FormatDesc.FreeMappingData(SourceFD);
7599         Converter.FreeMappingData(DestFD);
7600         FreeMem(ConvertBuffer);
7601       end;
7602     end;
7603   finally
7604     if Assigned(Converter) then
7605       Converter.Free;
7606   end;
7607 end;
7608
7609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7610 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7612 type
7613   TTGAHeader = packed record
7614     ImageID: Byte;
7615     ColorMapType: Byte;
7616     ImageType: Byte;
7617     //ColorMapSpec: Array[0..4] of Byte;
7618     ColorMapStart: Word;
7619     ColorMapLength: Word;
7620     ColorMapEntrySize: Byte;
7621     OrigX: Word;
7622     OrigY: Word;
7623     Width: Word;
7624     Height: Word;
7625     Bpp: Byte;
7626     ImageDesc: Byte;
7627   end;
7628
7629 const
7630   TGA_UNCOMPRESSED_RGB  =  2;
7631   TGA_UNCOMPRESSED_GRAY =  3;
7632   TGA_COMPRESSED_RGB    = 10;
7633   TGA_COMPRESSED_GRAY   = 11;
7634
7635   TGA_NONE_COLOR_TABLE  = 0;
7636
7637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7638 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7639 var
7640   Header: TTGAHeader;
7641   ImageData: System.PByte;
7642   StartPosition: Int64;
7643   PixelSize, LineSize: Integer;
7644   tgaFormat: TglBitmapFormat;
7645   FormatDesc: TFormatDescriptor;
7646   Counter: packed record
7647     X, Y: packed record
7648       low, high, dir: Integer;
7649     end;
7650   end;
7651
7652 const
7653   CACHE_SIZE = $4000;
7654
7655   ////////////////////////////////////////////////////////////////////////////////////////
7656   procedure ReadUncompressed;
7657   var
7658     i, j: Integer;
7659     buf, tmp1, tmp2: System.PByte;
7660   begin
7661     buf := nil;
7662     if (Counter.X.dir < 0) then
7663       GetMem(buf, LineSize);
7664     try
7665       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7666         tmp1 := ImageData;
7667         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7668         if (Counter.X.dir < 0) then begin               //flip X
7669           aStream.Read(buf^, LineSize);
7670           tmp2 := buf;
7671           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7672           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7673             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7674               tmp1^ := tmp2^;
7675               inc(tmp1);
7676               inc(tmp2);
7677             end;
7678             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7679           end;
7680         end else
7681           aStream.Read(tmp1^, LineSize);
7682         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7683       end;
7684     finally
7685       if Assigned(buf) then
7686         FreeMem(buf);
7687     end;
7688   end;
7689
7690   ////////////////////////////////////////////////////////////////////////////////////////
7691   procedure ReadCompressed;
7692
7693     /////////////////////////////////////////////////////////////////
7694     var
7695       TmpData: System.PByte;
7696       LinePixelsRead: Integer;
7697     procedure CheckLine;
7698     begin
7699       if (LinePixelsRead >= Header.Width) then begin
7700         LinePixelsRead := 0;
7701         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7702         TmpData := ImageData;
7703         inc(TmpData, Counter.Y.low * LineSize);           //set line
7704         if (Counter.X.dir < 0) then                       //if x flipped then
7705           inc(TmpData, LineSize - PixelSize);             //set last pixel
7706       end;
7707     end;
7708
7709     /////////////////////////////////////////////////////////////////
7710     var
7711       Cache: PByte;
7712       CacheSize, CachePos: Integer;
7713     procedure CachedRead(out Buffer; Count: Integer);
7714     var
7715       BytesRead: Integer;
7716     begin
7717       if (CachePos + Count > CacheSize) then begin
7718         //if buffer overflow save non read bytes
7719         BytesRead := 0;
7720         if (CacheSize - CachePos > 0) then begin
7721           BytesRead := CacheSize - CachePos;
7722           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7723           inc(CachePos, BytesRead);
7724         end;
7725
7726         //load cache from file
7727         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7728         aStream.Read(Cache^, CacheSize);
7729         CachePos := 0;
7730
7731         //read rest of requested bytes
7732         if (Count - BytesRead > 0) then begin
7733           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7734           inc(CachePos, Count - BytesRead);
7735         end;
7736       end else begin
7737         //if no buffer overflow just read the data
7738         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7739         inc(CachePos, Count);
7740       end;
7741     end;
7742
7743     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7744     begin
7745       case PixelSize of
7746         1: begin
7747           aBuffer^ := aData^;
7748           inc(aBuffer, Counter.X.dir);
7749         end;
7750         2: begin
7751           PWord(aBuffer)^ := PWord(aData)^;
7752           inc(aBuffer, 2 * Counter.X.dir);
7753         end;
7754         3: begin
7755           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7756           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7757           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7758           inc(aBuffer, 3 * Counter.X.dir);
7759         end;
7760         4: begin
7761           PCardinal(aBuffer)^ := PCardinal(aData)^;
7762           inc(aBuffer, 4 * Counter.X.dir);
7763         end;
7764       end;
7765     end;
7766
7767   var
7768     TotalPixelsToRead, TotalPixelsRead: Integer;
7769     Temp: Byte;
7770     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7771     PixelRepeat: Boolean;
7772     PixelsToRead, PixelCount: Integer;
7773   begin
7774     CacheSize := 0;
7775     CachePos  := 0;
7776
7777     TotalPixelsToRead := Header.Width * Header.Height;
7778     TotalPixelsRead   := 0;
7779     LinePixelsRead    := 0;
7780
7781     GetMem(Cache, CACHE_SIZE);
7782     try
7783       TmpData := ImageData;
7784       inc(TmpData, Counter.Y.low * LineSize);           //set line
7785       if (Counter.X.dir < 0) then                       //if x flipped then
7786         inc(TmpData, LineSize - PixelSize);             //set last pixel
7787
7788       repeat
7789         //read CommandByte
7790         CachedRead(Temp, 1);
7791         PixelRepeat  := (Temp and $80) > 0;
7792         PixelsToRead := (Temp and $7F) + 1;
7793         inc(TotalPixelsRead, PixelsToRead);
7794
7795         if PixelRepeat then
7796           CachedRead(buf[0], PixelSize);
7797         while (PixelsToRead > 0) do begin
7798           CheckLine;
7799           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7800           while (PixelCount > 0) do begin
7801             if not PixelRepeat then
7802               CachedRead(buf[0], PixelSize);
7803             PixelToBuffer(@buf[0], TmpData);
7804             inc(LinePixelsRead);
7805             dec(PixelsToRead);
7806             dec(PixelCount);
7807           end;
7808         end;
7809       until (TotalPixelsRead >= TotalPixelsToRead);
7810     finally
7811       FreeMem(Cache);
7812     end;
7813   end;
7814
7815   function IsGrayFormat: Boolean;
7816   begin
7817     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7818   end;
7819
7820 begin
7821   result := false;
7822
7823   // reading header to test file and set cursor back to begin
7824   StartPosition := aStream.Position;
7825   aStream.Read(Header{%H-}, SizeOf(Header));
7826
7827   // no colormapped files
7828   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7829     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7830   begin
7831     try
7832       if Header.ImageID <> 0 then       // skip image ID
7833         aStream.Position := aStream.Position + Header.ImageID;
7834
7835       tgaFormat := tfEmpty;
7836       case Header.Bpp of
7837          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7838                0: tgaFormat := tfLuminance8;
7839                8: tgaFormat := tfAlpha8;
7840             end;
7841
7842         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7843                0: tgaFormat := tfLuminance16;
7844                8: tgaFormat := tfLuminance8Alpha8;
7845             end else case (Header.ImageDesc and $F) of
7846                0: tgaFormat := tfX1RGB5;
7847                1: tgaFormat := tfA1RGB5;
7848                4: tgaFormat := tfARGB4;
7849             end;
7850
7851         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7852                0: tgaFormat := tfRGB8;
7853             end;
7854
7855         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7856                2: tgaFormat := tfA2RGB10;
7857                8: tgaFormat := tfARGB8;
7858             end;
7859       end;
7860
7861       if (tgaFormat = tfEmpty) then
7862         raise EglBitmap.Create('LoadTga - unsupported format');
7863
7864       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7865       PixelSize  := FormatDesc.GetSize(1, 1);
7866       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7867
7868       GetMem(ImageData, LineSize * Header.Height);
7869       try
7870         //column direction
7871         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7872           Counter.X.low  := Header.Height-1;;
7873           Counter.X.high := 0;
7874           Counter.X.dir  := -1;
7875         end else begin
7876           Counter.X.low  := 0;
7877           Counter.X.high := Header.Height-1;
7878           Counter.X.dir  := 1;
7879         end;
7880
7881         // Row direction
7882         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7883           Counter.Y.low  := 0;
7884           Counter.Y.high := Header.Height-1;
7885           Counter.Y.dir  := 1;
7886         end else begin
7887           Counter.Y.low  := Header.Height-1;;
7888           Counter.Y.high := 0;
7889           Counter.Y.dir  := -1;
7890         end;
7891
7892         // Read Image
7893         case Header.ImageType of
7894           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7895             ReadUncompressed;
7896           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7897             ReadCompressed;
7898         end;
7899
7900         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7901         result := true;
7902       except
7903         if Assigned(ImageData) then
7904           FreeMem(ImageData);
7905         raise;
7906       end;
7907     finally
7908       aStream.Position := StartPosition;
7909     end;
7910   end
7911     else aStream.Position := StartPosition;
7912 end;
7913
7914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7915 procedure TglBitmap.SaveTGA(const aStream: TStream);
7916 var
7917   Header: TTGAHeader;
7918   LineSize, Size, x, y: Integer;
7919   Pixel: TglBitmapPixelData;
7920   LineBuf, SourceData, DestData: PByte;
7921   SourceMD, DestMD: Pointer;
7922   FormatDesc: TFormatDescriptor;
7923   Converter: TFormatDescriptor;
7924 begin
7925   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7926     raise EglBitmapUnsupportedFormat.Create(Format);
7927
7928   //prepare header
7929   FillChar(Header{%H-}, SizeOf(Header), 0);
7930
7931   //set ImageType
7932   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7933                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7934     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7935   else
7936     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7937
7938   //set BitsPerPixel
7939   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7940     Header.Bpp := 8
7941   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7942                       tfRGB5X1, tfBGR5X1, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7943     Header.Bpp := 16
7944   else if (Format in [tfBGR8, tfRGB8]) then
7945     Header.Bpp := 24
7946   else
7947     Header.Bpp := 32;
7948
7949   //set AlphaBitCount
7950   case Format of
7951     tfRGB5A1, tfBGR5A1:
7952       Header.ImageDesc := 1 and $F;
7953     tfRGB10A2, tfBGR10A2:
7954       Header.ImageDesc := 2 and $F;
7955     tfRGBA4, tfBGRA4:
7956       Header.ImageDesc := 4 and $F;
7957     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7958       Header.ImageDesc := 8 and $F;
7959   end;
7960
7961   Header.Width     := Width;
7962   Header.Height    := Height;
7963   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7964   aStream.Write(Header, SizeOf(Header));
7965
7966   // convert RGB(A) to BGR(A)
7967   Converter  := nil;
7968   FormatDesc := TFormatDescriptor.Get(Format);
7969   Size       := FormatDesc.GetSize(Dimension);
7970   if Format in [tfRGB5X1, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7971     if (FormatDesc.RGBInverted = tfEmpty) then
7972       raise EglBitmap.Create('inverted RGB format is empty');
7973     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7974     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7975        (Converter.PixelSize <> FormatDesc.PixelSize) then
7976       raise EglBitmap.Create('invalid inverted RGB format');
7977   end;
7978
7979   if Assigned(Converter) then begin
7980     LineSize := FormatDesc.GetSize(Width, 1);
7981     GetMem(LineBuf, LineSize);
7982     SourceMD := FormatDesc.CreateMappingData;
7983     DestMD   := Converter.CreateMappingData;
7984     try
7985       SourceData := Data;
7986       for y := 0 to Height-1 do begin
7987         DestData := LineBuf;
7988         for x := 0 to Width-1 do begin
7989           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7990           Converter.Map(Pixel, DestData, DestMD);
7991         end;
7992         aStream.Write(LineBuf^, LineSize);
7993       end;
7994     finally
7995       FreeMem(LineBuf);
7996       FormatDesc.FreeMappingData(SourceMD);
7997       FormatDesc.FreeMappingData(DestMD);
7998     end;
7999   end else
8000     aStream.Write(Data^, Size);
8001 end;
8002
8003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8004 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8006 const
8007   DDS_MAGIC: Cardinal         = $20534444;
8008
8009   // DDS_header.dwFlags
8010   DDSD_CAPS                   = $00000001;
8011   DDSD_HEIGHT                 = $00000002;
8012   DDSD_WIDTH                  = $00000004;
8013   DDSD_PIXELFORMAT            = $00001000;
8014
8015   // DDS_header.sPixelFormat.dwFlags
8016   DDPF_ALPHAPIXELS            = $00000001;
8017   DDPF_ALPHA                  = $00000002;
8018   DDPF_FOURCC                 = $00000004;
8019   DDPF_RGB                    = $00000040;
8020   DDPF_LUMINANCE              = $00020000;
8021
8022   // DDS_header.sCaps.dwCaps1
8023   DDSCAPS_TEXTURE             = $00001000;
8024
8025   // DDS_header.sCaps.dwCaps2
8026   DDSCAPS2_CUBEMAP            = $00000200;
8027
8028   D3DFMT_DXT1                 = $31545844;
8029   D3DFMT_DXT3                 = $33545844;
8030   D3DFMT_DXT5                 = $35545844;
8031
8032 type
8033   TDDSPixelFormat = packed record
8034     dwSize: Cardinal;
8035     dwFlags: Cardinal;
8036     dwFourCC: Cardinal;
8037     dwRGBBitCount: Cardinal;
8038     dwRBitMask: Cardinal;
8039     dwGBitMask: Cardinal;
8040     dwBBitMask: Cardinal;
8041     dwABitMask: Cardinal;
8042   end;
8043
8044   TDDSCaps = packed record
8045     dwCaps1: Cardinal;
8046     dwCaps2: Cardinal;
8047     dwDDSX: Cardinal;
8048     dwReserved: Cardinal;
8049   end;
8050
8051   TDDSHeader = packed record
8052     dwSize: Cardinal;
8053     dwFlags: Cardinal;
8054     dwHeight: Cardinal;
8055     dwWidth: Cardinal;
8056     dwPitchOrLinearSize: Cardinal;
8057     dwDepth: Cardinal;
8058     dwMipMapCount: Cardinal;
8059     dwReserved: array[0..10] of Cardinal;
8060     PixelFormat: TDDSPixelFormat;
8061     Caps: TDDSCaps;
8062     dwReserved2: Cardinal;
8063   end;
8064
8065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8066 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8067 var
8068   Header: TDDSHeader;
8069   Converter: TbmpBitfieldFormat;
8070
8071   function GetDDSFormat: TglBitmapFormat;
8072   var
8073     fd: TFormatDescriptor;
8074     i: Integer;
8075     Range: TglBitmapColorRec;
8076     match: Boolean;
8077   begin
8078     result := tfEmpty;
8079     with Header.PixelFormat do begin
8080       // Compresses
8081       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8082         case Header.PixelFormat.dwFourCC of
8083           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8084           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8085           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8086         end;
8087       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
8088         // prepare masks
8089         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8090           Range.r := dwRBitMask;
8091           Range.g := dwGBitMask;
8092           Range.b := dwBBitMask;
8093         end else begin
8094           Range.r := dwRBitMask;
8095           Range.g := dwRBitMask;
8096           Range.b := dwRBitMask;
8097         end;
8098         Range.a := dwABitMask;
8099
8100         //find matching format
8101         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8102           fd := TFormatDescriptor.Get(result);
8103           if fd.MaskMatch(Range.r, Range.g, Range.b, Range.a) and
8104              (8 * fd.PixelSize = dwRGBBitCount) then
8105             exit;
8106         end;
8107
8108         //find format with same Range
8109         for i := 0 to 3 do begin
8110           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
8111             Range.arr[i] := Range.arr[i] shr 1;
8112         end;
8113         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8114           fd := TFormatDescriptor.Get(result);
8115           match := true;
8116           for i := 0 to 3 do
8117             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8118               match := false;
8119               break;
8120             end;
8121           if match then
8122             break;
8123         end;
8124
8125         //no format with same range found -> use default
8126         if (result = tfEmpty) then begin
8127           if (dwABitMask > 0) then
8128             result := tfRGBA8
8129           else
8130             result := tfRGB8;
8131         end;
8132
8133         Converter := TbmpBitfieldFormat.Create;
8134         Converter.RedMask   := dwRBitMask;
8135         Converter.GreenMask := dwGBitMask;
8136         Converter.BlueMask  := dwBBitMask;
8137         Converter.AlphaMask := dwABitMask;
8138         Converter.PixelSize := dwRGBBitCount / 8;
8139       end;
8140     end;
8141   end;
8142
8143 var
8144   StreamPos: Int64;
8145   x, y, LineSize, RowSize, Magic: Cardinal;
8146   NewImage, TmpData, RowData, SrcData: System.PByte;
8147   SourceMD, DestMD: Pointer;
8148   Pixel: TglBitmapPixelData;
8149   ddsFormat: TglBitmapFormat;
8150   FormatDesc: TFormatDescriptor;
8151
8152 begin
8153   result    := false;
8154   Converter := nil;
8155   StreamPos := aStream.Position;
8156
8157   // Magic
8158   aStream.Read(Magic{%H-}, sizeof(Magic));
8159   if (Magic <> DDS_MAGIC) then begin
8160     aStream.Position := StreamPos;
8161     exit;
8162   end;
8163
8164   //Header
8165   aStream.Read(Header{%H-}, sizeof(Header));
8166   if (Header.dwSize <> SizeOf(Header)) or
8167      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8168         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8169   begin
8170     aStream.Position := StreamPos;
8171     exit;
8172   end;
8173
8174   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8175     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8176
8177   ddsFormat := GetDDSFormat;
8178   try
8179     if (ddsFormat = tfEmpty) then
8180       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8181
8182     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8183     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
8184     GetMem(NewImage, Header.dwHeight * LineSize);
8185     try
8186       TmpData := NewImage;
8187
8188       //Converter needed
8189       if Assigned(Converter) then begin
8190         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8191         GetMem(RowData, RowSize);
8192         SourceMD := Converter.CreateMappingData;
8193         DestMD   := FormatDesc.CreateMappingData;
8194         try
8195           for y := 0 to Header.dwHeight-1 do begin
8196             TmpData := NewImage;
8197             inc(TmpData, y * LineSize);
8198             SrcData := RowData;
8199             aStream.Read(SrcData^, RowSize);
8200             for x := 0 to Header.dwWidth-1 do begin
8201               Converter.Unmap(SrcData, Pixel, SourceMD);
8202               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8203               FormatDesc.Map(Pixel, TmpData, DestMD);
8204             end;
8205           end;
8206         finally
8207           Converter.FreeMappingData(SourceMD);
8208           FormatDesc.FreeMappingData(DestMD);
8209           FreeMem(RowData);
8210         end;
8211       end else
8212
8213       // Compressed
8214       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8215         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8216         for Y := 0 to Header.dwHeight-1 do begin
8217           aStream.Read(TmpData^, RowSize);
8218           Inc(TmpData, LineSize);
8219         end;
8220       end else
8221
8222       // Uncompressed
8223       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8224         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8225         for Y := 0 to Header.dwHeight-1 do begin
8226           aStream.Read(TmpData^, RowSize);
8227           Inc(TmpData, LineSize);
8228         end;
8229       end else
8230         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8231
8232       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8233       result := true;
8234     except
8235       if Assigned(NewImage) then
8236         FreeMem(NewImage);
8237       raise;
8238     end;
8239   finally
8240     FreeAndNil(Converter);
8241   end;
8242 end;
8243
8244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8245 procedure TglBitmap.SaveDDS(const aStream: TStream);
8246 var
8247   Header: TDDSHeader;
8248   FormatDesc: TFormatDescriptor;
8249 begin
8250   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8251     raise EglBitmapUnsupportedFormat.Create(Format);
8252
8253   FormatDesc := TFormatDescriptor.Get(Format);
8254
8255   // Generell
8256   FillChar(Header{%H-}, SizeOf(Header), 0);
8257   Header.dwSize  := SizeOf(Header);
8258   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8259
8260   Header.dwWidth  := Max(1, Width);
8261   Header.dwHeight := Max(1, Height);
8262
8263   // Caps
8264   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8265
8266   // Pixelformat
8267   Header.PixelFormat.dwSize := sizeof(Header);
8268   if (FormatDesc.IsCompressed) then begin
8269     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8270     case Format of
8271       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8272       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8273       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8274     end;
8275   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
8276     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8277     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8278     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8279   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
8280     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8281     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8282     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8283     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8284   end else begin
8285     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8286     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8287     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8288     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
8289     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
8290     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8291   end;
8292
8293   if (FormatDesc.HasAlpha) then
8294     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8295
8296   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8297   aStream.Write(Header, SizeOf(Header));
8298   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8299 end;
8300
8301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8302 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8304 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8305   const aWidth: Integer; const aHeight: Integer);
8306 var
8307   pTemp: pByte;
8308   Size: Integer;
8309 begin
8310   if (aHeight > 1) then begin
8311     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8312     GetMem(pTemp, Size);
8313     try
8314       Move(aData^, pTemp^, Size);
8315       FreeMem(aData);
8316       aData := nil;
8317     except
8318       FreeMem(pTemp);
8319       raise;
8320     end;
8321   end else
8322     pTemp := aData;
8323   inherited SetDataPointer(pTemp, aFormat, aWidth);
8324 end;
8325
8326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8327 function TglBitmap1D.FlipHorz: Boolean;
8328 var
8329   Col: Integer;
8330   pTempDest, pDest, pSource: PByte;
8331 begin
8332   result := inherited FlipHorz;
8333   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8334     pSource := Data;
8335     GetMem(pDest, fRowSize);
8336     try
8337       pTempDest := pDest;
8338       Inc(pTempDest, fRowSize);
8339       for Col := 0 to Width-1 do begin
8340         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8341         Move(pSource^, pTempDest^, fPixelSize);
8342         Inc(pSource, fPixelSize);
8343       end;
8344       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8345       result := true;
8346     except
8347       if Assigned(pDest) then
8348         FreeMem(pDest);
8349       raise;
8350     end;
8351   end;
8352 end;
8353
8354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8355 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8356 var
8357   FormatDesc: TFormatDescriptor;
8358 begin
8359   // Upload data
8360   FormatDesc := TFormatDescriptor.Get(Format);
8361   if FormatDesc.IsCompressed then begin
8362     if not Assigned(glCompressedTexImage1D) then
8363       raise EglBitmap.Create('compressed formats not supported by video adapter');
8364     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8365   end else if aBuildWithGlu then
8366     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8367   else
8368     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8369
8370   // Free Data
8371   if (FreeDataAfterGenTexture) then
8372     FreeData;
8373 end;
8374
8375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8376 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8377 var
8378   BuildWithGlu, TexRec: Boolean;
8379   TexSize: Integer;
8380 begin
8381   if Assigned(Data) then begin
8382     // Check Texture Size
8383     if (aTestTextureSize) then begin
8384       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8385
8386       if (Width > TexSize) then
8387         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8388
8389       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8390                 (Target = GL_TEXTURE_RECTANGLE);
8391       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8392         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8393     end;
8394
8395     CreateId;
8396     SetupParameters(BuildWithGlu);
8397     UploadData(BuildWithGlu);
8398     glAreTexturesResident(1, @fID, @fIsResident);
8399   end;
8400 end;
8401
8402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8403 procedure TglBitmap1D.AfterConstruction;
8404 begin
8405   inherited;
8406   Target := GL_TEXTURE_1D;
8407 end;
8408
8409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8410 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8412 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8413 begin
8414   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8415     result := fLines[aIndex]
8416   else
8417     result := nil;
8418 end;
8419
8420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8421 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8422   const aWidth: Integer; const aHeight: Integer);
8423 var
8424   Idx, LineWidth: Integer;
8425 begin
8426   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8427
8428   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8429     // Assigning Data
8430     if Assigned(Data) then begin
8431       SetLength(fLines, GetHeight);
8432       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
8433
8434       for Idx := 0 to GetHeight-1 do begin
8435         fLines[Idx] := Data;
8436         Inc(fLines[Idx], Idx * LineWidth);
8437       end;
8438     end
8439       else SetLength(fLines, 0);
8440   end else begin
8441     SetLength(fLines, 0);
8442   end;
8443 end;
8444
8445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8446 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8447 var
8448   FormatDesc: TFormatDescriptor;
8449 begin
8450   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8451
8452   FormatDesc := TFormatDescriptor.Get(Format);
8453   if FormatDesc.IsCompressed then begin
8454     if not Assigned(glCompressedTexImage2D) then
8455       raise EglBitmap.Create('compressed formats not supported by video adapter');
8456     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8457   end else if aBuildWithGlu then begin
8458     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8459       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8460   end else begin
8461     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8462       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8463   end;
8464
8465   // Freigeben
8466   if (FreeDataAfterGenTexture) then
8467     FreeData;
8468 end;
8469
8470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8471 procedure TglBitmap2D.AfterConstruction;
8472 begin
8473   inherited;
8474   Target := GL_TEXTURE_2D;
8475 end;
8476
8477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8478 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8479 var
8480   Temp: pByte;
8481   Size, w, h: Integer;
8482   FormatDesc: TFormatDescriptor;
8483 begin
8484   FormatDesc := TFormatDescriptor.Get(aFormat);
8485   if FormatDesc.IsCompressed then
8486     raise EglBitmapUnsupportedFormat.Create(aFormat);
8487
8488   w    := aRight  - aLeft;
8489   h    := aBottom - aTop;
8490   Size := FormatDesc.GetSize(w, h);
8491   GetMem(Temp, Size);
8492   try
8493     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8494     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8495     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8496     FlipVert;
8497   except
8498     if Assigned(Temp) then
8499       FreeMem(Temp);
8500     raise;
8501   end;
8502 end;
8503
8504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8505 procedure TglBitmap2D.GetDataFromTexture;
8506 var
8507   Temp: PByte;
8508   TempWidth, TempHeight: Integer;
8509   TempIntFormat: GLint;
8510   IntFormat: TglBitmapFormat;
8511   FormatDesc: TFormatDescriptor;
8512 begin
8513   Bind;
8514
8515   // Request Data
8516   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8517   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8518   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8519
8520   IntFormat  := tfEmpty;
8521   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8522   IntFormat  := FormatDesc.Format;
8523
8524   // Getting data from OpenGL
8525   FormatDesc := TFormatDescriptor.Get(IntFormat);
8526   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8527   try
8528     if FormatDesc.IsCompressed then begin
8529       if not Assigned(glGetCompressedTexImage) then
8530         raise EglBitmap.Create('compressed formats not supported by video adapter');
8531       glGetCompressedTexImage(Target, 0, Temp)
8532     end else
8533       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8534     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8535   except
8536     if Assigned(Temp) then
8537       FreeMem(Temp);
8538     raise;
8539   end;
8540 end;
8541
8542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8543 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8544 var
8545   BuildWithGlu, PotTex, TexRec: Boolean;
8546   TexSize: Integer;
8547 begin
8548   if Assigned(Data) then begin
8549     // Check Texture Size
8550     if (aTestTextureSize) then begin
8551       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8552
8553       if ((Height > TexSize) or (Width > TexSize)) then
8554         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8555
8556       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8557       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8558       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8559         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8560     end;
8561
8562     CreateId;
8563     SetupParameters(BuildWithGlu);
8564     UploadData(Target, BuildWithGlu);
8565     glAreTexturesResident(1, @fID, @fIsResident);
8566   end;
8567 end;
8568
8569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8570 function TglBitmap2D.FlipHorz: Boolean;
8571 var
8572   Col, Row: Integer;
8573   TempDestData, DestData, SourceData: PByte;
8574   ImgSize: Integer;
8575 begin
8576   result := inherited FlipHorz;
8577   if Assigned(Data) then begin
8578     SourceData := Data;
8579     ImgSize := Height * fRowSize;
8580     GetMem(DestData, ImgSize);
8581     try
8582       TempDestData := DestData;
8583       Dec(TempDestData, fRowSize + fPixelSize);
8584       for Row := 0 to Height -1 do begin
8585         Inc(TempDestData, fRowSize * 2);
8586         for Col := 0 to Width -1 do begin
8587           Move(SourceData^, TempDestData^, fPixelSize);
8588           Inc(SourceData, fPixelSize);
8589           Dec(TempDestData, fPixelSize);
8590         end;
8591       end;
8592       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8593       result := true;
8594     except
8595       if Assigned(DestData) then
8596         FreeMem(DestData);
8597       raise;
8598     end;
8599   end;
8600 end;
8601
8602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8603 function TglBitmap2D.FlipVert: Boolean;
8604 var
8605   Row: Integer;
8606   TempDestData, DestData, SourceData: PByte;
8607 begin
8608   result := inherited FlipVert;
8609   if Assigned(Data) then begin
8610     SourceData := Data;
8611     GetMem(DestData, Height * fRowSize);
8612     try
8613       TempDestData := DestData;
8614       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8615       for Row := 0 to Height -1 do begin
8616         Move(SourceData^, TempDestData^, fRowSize);
8617         Dec(TempDestData, fRowSize);
8618         Inc(SourceData, fRowSize);
8619       end;
8620       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8621       result := true;
8622     except
8623       if Assigned(DestData) then
8624         FreeMem(DestData);
8625       raise;
8626     end;
8627   end;
8628 end;
8629
8630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8631 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8633 type
8634   TMatrixItem = record
8635     X, Y: Integer;
8636     W: Single;
8637   end;
8638
8639   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8640   TglBitmapToNormalMapRec = Record
8641     Scale: Single;
8642     Heights: array of Single;
8643     MatrixU : array of TMatrixItem;
8644     MatrixV : array of TMatrixItem;
8645   end;
8646
8647 const
8648   ONE_OVER_255 = 1 / 255;
8649
8650   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8651 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8652 var
8653   Val: Single;
8654 begin
8655   with FuncRec do begin
8656     Val :=
8657       Source.Data.r * LUMINANCE_WEIGHT_R +
8658       Source.Data.g * LUMINANCE_WEIGHT_G +
8659       Source.Data.b * LUMINANCE_WEIGHT_B;
8660     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8661   end;
8662 end;
8663
8664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8665 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8666 begin
8667   with FuncRec do
8668     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8669 end;
8670
8671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8672 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8673 type
8674   TVec = Array[0..2] of Single;
8675 var
8676   Idx: Integer;
8677   du, dv: Double;
8678   Len: Single;
8679   Vec: TVec;
8680
8681   function GetHeight(X, Y: Integer): Single;
8682   begin
8683     with FuncRec do begin
8684       X := Max(0, Min(Size.X -1, X));
8685       Y := Max(0, Min(Size.Y -1, Y));
8686       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8687     end;
8688   end;
8689
8690 begin
8691   with FuncRec do begin
8692     with PglBitmapToNormalMapRec(Args)^ do begin
8693       du := 0;
8694       for Idx := Low(MatrixU) to High(MatrixU) do
8695         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8696
8697       dv := 0;
8698       for Idx := Low(MatrixU) to High(MatrixU) do
8699         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8700
8701       Vec[0] := -du * Scale;
8702       Vec[1] := -dv * Scale;
8703       Vec[2] := 1;
8704     end;
8705
8706     // Normalize
8707     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8708     if Len <> 0 then begin
8709       Vec[0] := Vec[0] * Len;
8710       Vec[1] := Vec[1] * Len;
8711       Vec[2] := Vec[2] * Len;
8712     end;
8713
8714     // Farbe zuweisem
8715     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8716     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8717     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8718   end;
8719 end;
8720
8721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8722 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8723 var
8724   Rec: TglBitmapToNormalMapRec;
8725
8726   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8727   begin
8728     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8729       Matrix[Index].X := X;
8730       Matrix[Index].Y := Y;
8731       Matrix[Index].W := W;
8732     end;
8733   end;
8734
8735 begin
8736   if TFormatDescriptor.Get(Format).IsCompressed then
8737     raise EglBitmapUnsupportedFormat.Create(Format);
8738
8739   if aScale > 100 then
8740     Rec.Scale := 100
8741   else if aScale < -100 then
8742     Rec.Scale := -100
8743   else
8744     Rec.Scale := aScale;
8745
8746   SetLength(Rec.Heights, Width * Height);
8747   try
8748     case aFunc of
8749       nm4Samples: begin
8750         SetLength(Rec.MatrixU, 2);
8751         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8752         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8753
8754         SetLength(Rec.MatrixV, 2);
8755         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8756         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8757       end;
8758
8759       nmSobel: begin
8760         SetLength(Rec.MatrixU, 6);
8761         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8762         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8763         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8764         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8765         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8766         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8767
8768         SetLength(Rec.MatrixV, 6);
8769         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8770         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8771         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8772         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8773         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8774         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8775       end;
8776
8777       nm3x3: begin
8778         SetLength(Rec.MatrixU, 6);
8779         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8780         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8781         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8782         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8783         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8784         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8785
8786         SetLength(Rec.MatrixV, 6);
8787         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8788         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8789         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8790         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8791         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8792         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8793       end;
8794
8795       nm5x5: begin
8796         SetLength(Rec.MatrixU, 20);
8797         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8798         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8799         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8800         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8801         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8802         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8803         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8804         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8805         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8806         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8807         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8808         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8809         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8810         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8811         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8812         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8813         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8814         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8815         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8816         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8817
8818         SetLength(Rec.MatrixV, 20);
8819         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8820         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8821         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8822         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8823         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8824         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8825         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8826         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8827         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8828         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8829         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8830         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8831         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8832         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8833         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8834         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8835         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8836         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8837         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8838         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8839       end;
8840     end;
8841
8842     // Daten Sammeln
8843     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8844       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8845     else
8846       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8847     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8848   finally
8849     SetLength(Rec.Heights, 0);
8850   end;
8851 end;
8852
8853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8854 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8856 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8857 begin
8858   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8859 end;
8860
8861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8862 procedure TglBitmapCubeMap.AfterConstruction;
8863 begin
8864   inherited;
8865
8866   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8867     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8868
8869   SetWrap;
8870   Target   := GL_TEXTURE_CUBE_MAP;
8871   fGenMode := GL_REFLECTION_MAP;
8872 end;
8873
8874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8875 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8876 var
8877   BuildWithGlu: Boolean;
8878   TexSize: Integer;
8879 begin
8880   if (aTestTextureSize) then begin
8881     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8882
8883     if (Height > TexSize) or (Width > TexSize) then
8884       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8885
8886     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8887       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8888   end;
8889
8890   if (ID = 0) then
8891     CreateID;
8892   SetupParameters(BuildWithGlu);
8893   UploadData(aCubeTarget, BuildWithGlu);
8894 end;
8895
8896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8897 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8898 begin
8899   inherited Bind (aEnableTextureUnit);
8900   if aEnableTexCoordsGen then begin
8901     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8902     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8903     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8904     glEnable(GL_TEXTURE_GEN_S);
8905     glEnable(GL_TEXTURE_GEN_T);
8906     glEnable(GL_TEXTURE_GEN_R);
8907   end;
8908 end;
8909
8910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8911 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8912 begin
8913   inherited Unbind(aDisableTextureUnit);
8914   if aDisableTexCoordsGen then begin
8915     glDisable(GL_TEXTURE_GEN_S);
8916     glDisable(GL_TEXTURE_GEN_T);
8917     glDisable(GL_TEXTURE_GEN_R);
8918   end;
8919 end;
8920
8921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8922 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8924 type
8925   TVec = Array[0..2] of Single;
8926   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8927
8928   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8929   TglBitmapNormalMapRec = record
8930     HalfSize : Integer;
8931     Func: TglBitmapNormalMapGetVectorFunc;
8932   end;
8933
8934   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8935 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8936 begin
8937   aVec[0] := aHalfSize;
8938   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8939   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8940 end;
8941
8942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8943 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8944 begin
8945   aVec[0] := - aHalfSize;
8946   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8947   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8948 end;
8949
8950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8951 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8952 begin
8953   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8954   aVec[1] := aHalfSize;
8955   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8956 end;
8957
8958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8959 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8960 begin
8961   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8962   aVec[1] := - aHalfSize;
8963   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8964 end;
8965
8966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8967 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8968 begin
8969   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8970   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8971   aVec[2] := aHalfSize;
8972 end;
8973
8974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8975 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8976 begin
8977   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8978   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8979   aVec[2] := - aHalfSize;
8980 end;
8981
8982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8983 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8984 var
8985   i: Integer;
8986   Vec: TVec;
8987   Len: Single;
8988 begin
8989   with FuncRec do begin
8990     with PglBitmapNormalMapRec(Args)^ do begin
8991       Func(Vec, Position, HalfSize);
8992
8993       // Normalize
8994       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8995       if Len <> 0 then begin
8996         Vec[0] := Vec[0] * Len;
8997         Vec[1] := Vec[1] * Len;
8998         Vec[2] := Vec[2] * Len;
8999       end;
9000
9001       // Scale Vector and AddVectro
9002       Vec[0] := Vec[0] * 0.5 + 0.5;
9003       Vec[1] := Vec[1] * 0.5 + 0.5;
9004       Vec[2] := Vec[2] * 0.5 + 0.5;
9005     end;
9006
9007     // Set Color
9008     for i := 0 to 2 do
9009       Dest.Data.arr[i] := Round(Vec[i] * 255);
9010   end;
9011 end;
9012
9013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9014 procedure TglBitmapNormalMap.AfterConstruction;
9015 begin
9016   inherited;
9017   fGenMode := GL_NORMAL_MAP;
9018 end;
9019
9020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9021 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9022 var
9023   Rec: TglBitmapNormalMapRec;
9024   SizeRec: TglBitmapPixelPosition;
9025 begin
9026   Rec.HalfSize := aSize div 2;
9027   FreeDataAfterGenTexture := false;
9028
9029   SizeRec.Fields := [ffX, ffY];
9030   SizeRec.X := aSize;
9031   SizeRec.Y := aSize;
9032
9033   // Positive X
9034   Rec.Func := glBitmapNormalMapPosX;
9035   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9036   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9037
9038   // Negative X
9039   Rec.Func := glBitmapNormalMapNegX;
9040   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9041   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9042
9043   // Positive Y
9044   Rec.Func := glBitmapNormalMapPosY;
9045   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9046   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9047
9048   // Negative Y
9049   Rec.Func := glBitmapNormalMapNegY;
9050   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9051   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9052
9053   // Positive Z
9054   Rec.Func := glBitmapNormalMapPosZ;
9055   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9056   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9057
9058   // Negative Z
9059   Rec.Func := glBitmapNormalMapNegZ;
9060   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9061   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9062 end;
9063
9064
9065 initialization
9066   glBitmapSetDefaultFormat (tfEmpty);
9067   glBitmapSetDefaultMipmap (mmMipmap);
9068   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9069   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9070   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9071
9072   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9073   glBitmapSetDefaultDeleteTextureOnFree    (true);
9074
9075   TFormatDescriptor.Init;
9076
9077 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9078   OpenGLInitialized := false;
9079   InitOpenGLCS := TCriticalSection.Create;
9080 {$ENDIF}
9081
9082 finalization
9083   TFormatDescriptor.Finalize;
9084
9085 {$IFDEF GLB_NATIVE_OGL}
9086   if Assigned(GL_LibHandle) then
9087     glbFreeLibrary(GL_LibHandle);
9088
9089 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9090   if Assigned(GLU_LibHandle) then
9091     glbFreeLibrary(GLU_LibHandle);
9092   FreeAndNil(InitOpenGLCS);
9093 {$ENDIF}
9094 {$ENDIF}
9095
9096 end.