uglcBitmap.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 uglcBitmap;
 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   TglcBitmapFormat    = TglBitmapFormat;
1219   TglcBitmap1D        = TglBitmap1D;
1220   TglcBitmap2D        = TglBitmap2D;
1221   TglcBitmapCubeMap   = TglBitmapCubeMap;
1222   TglcBitmapNormalMap = TglBitmapNormalMap;
1223
1224 const
1225   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1226
1227 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1228 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1229 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1230 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1231 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1232 procedure glBitmapSetDefaultWrap(
1233   const S: Cardinal = GL_CLAMP_TO_EDGE;
1234   const T: Cardinal = GL_CLAMP_TO_EDGE;
1235   const R: Cardinal = GL_CLAMP_TO_EDGE);
1236
1237 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1238 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1239 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1240 function glBitmapGetDefaultFormat: TglBitmapFormat;
1241 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1242 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1243
1244 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1245 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1246 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1247
1248 var
1249   glBitmapDefaultDeleteTextureOnFree: Boolean;
1250   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1251   glBitmapDefaultFormat: TglBitmapFormat;
1252   glBitmapDefaultMipmap: TglBitmapMipMap;
1253   glBitmapDefaultFilterMin: Cardinal;
1254   glBitmapDefaultFilterMag: Cardinal;
1255   glBitmapDefaultWrapS: Cardinal;
1256   glBitmapDefaultWrapT: Cardinal;
1257   glBitmapDefaultWrapR: Cardinal;
1258   glDefaultSwizzle: array[0..3] of GLenum;
1259
1260 {$IFDEF GLB_DELPHI}
1261 function CreateGrayPalette: HPALETTE;
1262 {$ENDIF}
1263
1264 implementation
1265
1266 uses
1267   Math, syncobjs, typinfo
1268   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1269
1270 type
1271 {$IFNDEF fpc}
1272   QWord   = System.UInt64;
1273   PQWord  = ^QWord;
1274
1275   PtrInt  = Longint;
1276   PtrUInt = DWord;
1277 {$ENDIF}
1278
1279 ////////////////////////////////////////////////////////////////////////////////////////////////////
1280   TShiftRec = packed record
1281   case Integer of
1282     0: (r, g, b, a: Byte);
1283     1: (arr: array[0..3] of Byte);
1284   end;
1285
1286   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1287   private
1288     function GetRedMask: QWord;
1289     function GetGreenMask: QWord;
1290     function GetBlueMask: QWord;
1291     function GetAlphaMask: QWord;
1292   protected
1293     fFormat: TglBitmapFormat;
1294     fWithAlpha: TglBitmapFormat;
1295     fWithoutAlpha: TglBitmapFormat;
1296     fOpenGLFormat: TglBitmapFormat;
1297     fRGBInverted: TglBitmapFormat;
1298     fUncompressed: TglBitmapFormat;
1299
1300     fPixelSize: Single;
1301     fIsCompressed: Boolean;
1302
1303     fRange: TglBitmapColorRec;
1304     fShift: TShiftRec;
1305
1306     fglFormat:         GLenum;
1307     fglInternalFormat: GLenum;
1308     fglDataFormat:     GLenum;
1309
1310     function GetIsCompressed: Boolean; override;
1311     function GetHasRed: Boolean; override;
1312     function GetHasGreen: Boolean; override;
1313     function GetHasBlue: Boolean; override;
1314     function GetHasAlpha: Boolean; override;
1315
1316     function GetRGBInverted:  TglBitmapFormat; override;
1317     function GetWithAlpha:    TglBitmapFormat; override;
1318     function GetWithoutAlpha: TglBitmapFormat; override;
1319     function GetOpenGLFormat: TglBitmapFormat; override;
1320     function GetUncompressed: TglBitmapFormat; override;
1321
1322     function GetglFormat: GLenum; override;
1323     function GetglInternalFormat: GLenum; override;
1324     function GetglDataFormat: GLenum; override;
1325
1326     function GetComponents: Integer; virtual;
1327   public
1328     property Format:       TglBitmapFormat read fFormat;
1329     property Components:   Integer         read GetComponents;
1330     property PixelSize:    Single          read fPixelSize;
1331
1332     property Range: TglBitmapColorRec read fRange;
1333     property Shift: TShiftRec         read fShift;
1334
1335     property RedMask:   QWord read GetRedMask;
1336     property GreenMask: QWord read GetGreenMask;
1337     property BlueMask:  QWord read GetBlueMask;
1338     property AlphaMask: QWord read GetAlphaMask;
1339
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1342
1343     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1344     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1345
1346     function CreateMappingData: Pointer; virtual;
1347     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1348
1349     function IsEmpty:  Boolean; virtual;
1350     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1351
1352     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1353
1354     constructor Create; virtual;
1355   public
1356     class procedure Init;
1357     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1358     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1359     class procedure Clear;
1360     class procedure Finalize;
1361   end;
1362   TFormatDescriptorClass = class of TFormatDescriptor;
1363
1364   TfdEmpty = class(TFormatDescriptor);
1365
1366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1367   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370   end;
1371
1372   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1373     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1374     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1375   end;
1376
1377   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1378     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1379     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1380   end;
1381
1382   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385   end;
1386
1387   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390   end;
1391
1392   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395   end;
1396
1397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1398   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1399     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1400     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1401   end;
1402
1403   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1404     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1405     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1406   end;
1407
1408   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1409     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1410     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1411   end;
1412
1413   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1414     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1415     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1416   end;
1417
1418   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421   end;
1422
1423   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1424     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1425     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1426   end;
1427
1428   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431   end;
1432
1433   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1434     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1435     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1436   end;
1437
1438   TfdARGB_US4 = class(TfdRGB_US3) //4* unsigned short
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441   end;
1442
1443   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446   end;
1447
1448   TfdABGR_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1454   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1455     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1456     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1457   end;
1458
1459   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1460     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1461     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1462   end;
1463
1464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1465   TfdAlpha4 = class(TfdAlpha_UB1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdAlpha8 = class(TfdAlpha_UB1)
1470     constructor Create; override;
1471   end;
1472
1473   TfdAlpha16 = class(TfdAlpha_US1)
1474     constructor Create; override;
1475   end;
1476
1477   TfdLuminance4 = class(TfdLuminance_UB1)
1478     constructor Create; override;
1479   end;
1480
1481   TfdLuminance8 = class(TfdLuminance_UB1)
1482     constructor Create; override;
1483   end;
1484
1485   TfdLuminance16 = class(TfdLuminance_US1)
1486     constructor Create; override;
1487   end;
1488
1489   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1490     constructor Create; override;
1491   end;
1492
1493   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1494     constructor Create; override;
1495   end;
1496
1497   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1498     constructor Create; override;
1499   end;
1500
1501   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1502     constructor Create; override;
1503   end;
1504
1505   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1506     constructor Create; override;
1507   end;
1508
1509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1510   TfdR3G3B2 = class(TfdUniversal_UB1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdRGBX4 = class(TfdUniversal_US1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdXRGB4 = class(TfdUniversal_US1)
1519     constructor Create; override;
1520   end;
1521
1522   TfdR5G6B5 = class(TfdUniversal_US1)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGB5X1 = class(TfdUniversal_US1)
1527     constructor Create; override;
1528   end;
1529
1530   TfdX1RGB5 = class(TfdUniversal_US1)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGB8 = class(TfdRGB_UB3)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGBX8 = class(TfdUniversal_UI1)
1539     constructor Create; override;
1540   end;
1541
1542   TfdXRGB8 = class(TfdUniversal_UI1)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGB10X2 = class(TfdUniversal_UI1)
1547     constructor Create; override;
1548   end;
1549
1550   TfdX2RGB10 = class(TfdUniversal_UI1)
1551     constructor Create; override;
1552   end;
1553
1554   TfdRGB16 = class(TfdRGB_US3)
1555     constructor Create; override;
1556   end;
1557
1558   TfdRGBA4 = class(TfdUniversal_US1)
1559     constructor Create; override;
1560   end;
1561
1562   TfdARGB4 = class(TfdUniversal_US1)
1563     constructor Create; override;
1564   end;
1565
1566   TfdRGB5A1 = class(TfdUniversal_US1)
1567     constructor Create; override;
1568   end;
1569
1570   TfdA1RGB5 = class(TfdUniversal_US1)
1571     constructor Create; override;
1572   end;
1573
1574   TfdRGBA8 = class(TfdUniversal_UI1)
1575     constructor Create; override;
1576   end;
1577
1578   TfdARGB8 = class(TfdUniversal_UI1)
1579     constructor Create; override;
1580   end;
1581
1582   TfdRGB10A2 = class(TfdUniversal_UI1)
1583     constructor Create; override;
1584   end;
1585
1586   TfdA2RGB10 = class(TfdUniversal_UI1)
1587     constructor Create; override;
1588   end;
1589
1590   TfdRGBA16 = class(TfdUniversal_UI1)
1591     constructor Create; override;
1592   end;
1593
1594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1595   TfdBGRX4 = class(TfdUniversal_US1)
1596     constructor Create; override;
1597   end;
1598
1599   TfdXBGR4 = class(TfdUniversal_US1)
1600     constructor Create; override;
1601   end;
1602
1603   TfdB5G6R5 = class(TfdUniversal_US1)
1604     constructor Create; override;
1605   end;
1606
1607   TfdBGR5X1 = class(TfdUniversal_US1)
1608     constructor Create; override;
1609   end;
1610
1611   TfdX1BGR5 = class(TfdUniversal_US1)
1612     constructor Create; override;
1613   end;
1614
1615   TfdBGR8 = class(TfdBGR_UB3)
1616     constructor Create; override;
1617   end;
1618
1619   TfdBGRX8 = class(TfdUniversal_UI1)
1620     constructor Create; override;
1621   end;
1622
1623   TfdXBGR8 = class(TfdUniversal_UI1)
1624     constructor Create; override;
1625   end;
1626
1627   TfdBGR10X2 = class(TfdUniversal_UI1)
1628     constructor Create; override;
1629   end;
1630
1631   TfdX2BGR10 = class(TfdUniversal_UI1)
1632     constructor Create; override;
1633   end;
1634
1635   TfdBGR16 = class(TfdBGR_US3)
1636     constructor Create; override;
1637   end;
1638
1639   TfdBGRA4 = class(TfdUniversal_US1)
1640     constructor Create; override;
1641   end;
1642
1643   TfdABGR4 = class(TfdUniversal_US1)
1644     constructor Create; override;
1645   end;
1646
1647   TfdBGR5A1 = class(TfdUniversal_US1)
1648     constructor Create; override;
1649   end;
1650
1651   TfdA1BGR5 = class(TfdUniversal_US1)
1652     constructor Create; override;
1653   end;
1654
1655   TfdBGRA8 = class(TfdUniversal_UI1)
1656     constructor Create; override;
1657   end;
1658
1659   TfdABGR8 = class(TfdUniversal_UI1)
1660     constructor Create; override;
1661   end;
1662
1663   TfdBGR10A2 = class(TfdUniversal_UI1)
1664     constructor Create; override;
1665   end;
1666
1667   TfdA2BGR10 = class(TfdUniversal_UI1)
1668     constructor Create; override;
1669   end;
1670
1671   TfdBGRA16 = class(TfdBGRA_US4)
1672     constructor Create; override;
1673   end;
1674
1675   TfdDepth16 = class(TfdDepth_US1)
1676     constructor Create; override;
1677   end;
1678
1679   TfdDepth24 = class(TfdDepth_UI1)
1680     constructor Create; override;
1681   end;
1682
1683   TfdDepth32 = class(TfdDepth_UI1)
1684     constructor Create; override;
1685   end;
1686
1687   TfdS3tcDtx1RGBA = 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   TfdS3tcDtx3RGBA = 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   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1700     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1701     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1702     constructor Create; override;
1703   end;
1704
1705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1706   TbmpBitfieldFormat = class(TFormatDescriptor)
1707   private
1708     procedure SetRedMask  (const aValue: QWord);
1709     procedure SetGreenMask(const aValue: QWord);
1710     procedure SetBlueMask (const aValue: QWord);
1711     procedure SetAlphaMask(const aValue: QWord);
1712
1713     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1714   public
1715     property RedMask:   QWord read GetRedMask   write SetRedMask;
1716     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1717     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1718     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1719
1720     property PixelSize: Single read fPixelSize write fPixelSize;
1721
1722     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1723     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1724   end;
1725
1726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1727   TbmpColorTableEnty = packed record
1728     b, g, r, a: Byte;
1729   end;
1730   TbmpColorTable = array of TbmpColorTableEnty;
1731   TbmpColorTableFormat = class(TFormatDescriptor)
1732   private
1733     fColorTable: TbmpColorTable;
1734   public
1735     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1736     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1737     property Range:      TglBitmapColorRec read fRange      write fRange;
1738     property Shift:      TShiftRec         read fShift      write fShift;
1739     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1740
1741     procedure CreateColorTable;
1742
1743     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1744     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1745     destructor Destroy; override;
1746   end;
1747
1748 const
1749   LUMINANCE_WEIGHT_R = 0.30;
1750   LUMINANCE_WEIGHT_G = 0.59;
1751   LUMINANCE_WEIGHT_B = 0.11;
1752
1753   ALPHA_WEIGHT_R = 0.30;
1754   ALPHA_WEIGHT_G = 0.59;
1755   ALPHA_WEIGHT_B = 0.11;
1756
1757   DEPTH_WEIGHT_R = 0.333333333;
1758   DEPTH_WEIGHT_G = 0.333333333;
1759   DEPTH_WEIGHT_B = 0.333333333;
1760
1761   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1762
1763   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1764     TfdEmpty,
1765
1766     TfdAlpha4,
1767     TfdAlpha8,
1768     TfdAlpha16,
1769
1770     TfdLuminance4,
1771     TfdLuminance8,
1772     TfdLuminance16,
1773
1774     TfdLuminance4Alpha4,
1775     TfdLuminance6Alpha2,
1776     TfdLuminance8Alpha8,
1777     TfdLuminance12Alpha4,
1778     TfdLuminance16Alpha16,
1779
1780     TfdR3G3B2,
1781     TfdRGBX4,
1782     TfdXRGB4,
1783     TfdR5G6B5,
1784     TfdRGB5X1,
1785     TfdX1RGB5,
1786     TfdRGB8,
1787     TfdRGBX8,
1788     TfdXRGB8,
1789     TfdRGB10X2,
1790     TfdX2RGB10,
1791     TfdRGB16,
1792
1793     TfdRGBA4,
1794     TfdARGB4,
1795     TfdRGB5A1,
1796     TfdA1RGB5,
1797     TfdRGBA8,
1798     TfdARGB8,
1799     TfdRGB10A2,
1800     TfdA2RGB10,
1801     TfdRGBA16,
1802
1803     TfdBGRX4,
1804     TfdXBGR4,
1805     TfdB5G6R5,
1806     TfdBGR5X1,
1807     TfdX1BGR5,
1808     TfdBGR8,
1809     TfdBGRX8,
1810     TfdXBGR8,
1811     TfdBGR10X2,
1812     TfdX2BGR10,
1813     TfdBGR16,
1814
1815     TfdBGRA4,
1816     TfdABGR4,
1817     TfdBGR5A1,
1818     TfdA1BGR5,
1819     TfdBGRA8,
1820     TfdABGR8,
1821     TfdBGR10A2,
1822     TfdA2BGR10,
1823     TfdBGRA16,
1824
1825     TfdDepth16,
1826     TfdDepth24,
1827     TfdDepth32,
1828
1829     TfdS3tcDtx1RGBA,
1830     TfdS3tcDtx3RGBA,
1831     TfdS3tcDtx5RGBA
1832   );
1833
1834 var
1835   FormatDescriptorCS: TCriticalSection;
1836   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1837
1838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1840 begin
1841   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1842 end;
1843
1844 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1846 begin
1847   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1848 end;
1849
1850 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1851 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1852 begin
1853   result.Fields := [];
1854
1855   if X >= 0 then
1856     result.Fields := result.Fields + [ffX];
1857   if Y >= 0 then
1858     result.Fields := result.Fields + [ffY];
1859
1860   result.X := Max(0, X);
1861   result.Y := Max(0, Y);
1862 end;
1863
1864 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1865 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1866 begin
1867   result.r := r;
1868   result.g := g;
1869   result.b := b;
1870   result.a := a;
1871 end;
1872
1873 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1874 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1875 var
1876   i: Integer;
1877 begin
1878   result := false;
1879   for i := 0 to high(r1.arr) do
1880     if (r1.arr[i] <> r2.arr[i]) then
1881       exit;
1882   result := true;
1883 end;
1884
1885 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1886 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1887 begin
1888   result.r := r;
1889   result.g := g;
1890   result.b := b;
1891   result.a := a;
1892 end;
1893
1894 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1895 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1896 begin
1897   result := [];
1898
1899   if (aFormat in [
1900         //4 bbp
1901         tfLuminance4,
1902
1903         //8bpp
1904         tfR3G3B2, tfLuminance8,
1905
1906         //16bpp
1907         tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
1908         tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
1909
1910         //24bpp
1911         tfBGR8, tfRGB8,
1912
1913         //32bpp
1914         tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
1915         tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8]) then
1916     result := result + [ftBMP];
1917
1918   if (aFormat in [
1919         //8 bpp
1920         tfLuminance8, tfAlpha8,
1921
1922         //16 bpp
1923         tfLuminance16, tfLuminance8Alpha8,
1924         tfRGB5X1, tfX1RGB5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
1925         tfBGR5X1, tfX1BGR5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
1926
1927         //24 bpp
1928         tfRGB8, tfBGR8,
1929
1930         //32 bpp
1931         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1932     result := result + [ftTGA];
1933
1934   if (aFormat in [
1935         //8 bpp
1936         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1937         tfR3G3B2,
1938
1939         //16 bpp
1940         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1941         tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5,
1942         tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5,
1943
1944         //24 bpp
1945         tfRGB8, tfBGR8,
1946
1947         //32 bbp
1948         tfLuminance16Alpha16,
1949         tfRGBA8, tfRGB10A2,
1950         tfBGRA8, tfBGR10A2,
1951
1952         //compressed
1953         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1954     result := result + [ftDDS];
1955
1956   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1957   if aFormat in [
1958       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1959       tfRGB8, tfRGBA8,
1960       tfBGR8, tfBGRA8] then
1961     result := result + [ftPNG];
1962   {$ENDIF}
1963
1964   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1965   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1966     result := result + [ftJPEG];
1967   {$ENDIF}
1968 end;
1969
1970 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1971 function IsPowerOfTwo(aNumber: Integer): Boolean;
1972 begin
1973   while (aNumber and 1) = 0 do
1974     aNumber := aNumber shr 1;
1975   result := aNumber = 1;
1976 end;
1977
1978 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1979 function GetTopMostBit(aBitSet: QWord): Integer;
1980 begin
1981   result := 0;
1982   while aBitSet > 0 do begin
1983     inc(result);
1984     aBitSet := aBitSet shr 1;
1985   end;
1986 end;
1987
1988 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1989 function CountSetBits(aBitSet: QWord): Integer;
1990 begin
1991   result := 0;
1992   while aBitSet > 0 do begin
1993     if (aBitSet and 1) = 1 then
1994       inc(result);
1995     aBitSet := aBitSet shr 1;
1996   end;
1997 end;
1998
1999 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2000 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2001 begin
2002   result := Trunc(
2003     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2004     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2005     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2006 end;
2007
2008 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2009 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2010 begin
2011   result := Trunc(
2012     DEPTH_WEIGHT_R * aPixel.Data.r +
2013     DEPTH_WEIGHT_G * aPixel.Data.g +
2014     DEPTH_WEIGHT_B * aPixel.Data.b);
2015 end;
2016
2017 {$IFDEF GLB_NATIVE_OGL}
2018 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2019 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2020 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2021 var
2022   GL_LibHandle: Pointer = nil;
2023
2024 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2025 begin
2026   if not Assigned(aLibHandle) then
2027     aLibHandle := GL_LibHandle;
2028
2029 {$IF DEFINED(GLB_WIN)}
2030   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2031   if Assigned(result) then
2032     exit;
2033
2034   if Assigned(wglGetProcAddress) then
2035     result := wglGetProcAddress(aProcName);
2036 {$ELSEIF DEFINED(GLB_LINUX)}
2037   if Assigned(glXGetProcAddress) then begin
2038     result := glXGetProcAddress(aProcName);
2039     if Assigned(result) then
2040       exit;
2041   end;
2042
2043   if Assigned(glXGetProcAddressARB) then begin
2044     result := glXGetProcAddressARB(aProcName);
2045     if Assigned(result) then
2046       exit;
2047   end;
2048
2049   result := dlsym(aLibHandle, aProcName);
2050 {$IFEND}
2051   if not Assigned(result) and aRaiseOnErr then
2052     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2053 end;
2054
2055 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2056 var
2057   GLU_LibHandle: Pointer = nil;
2058   OpenGLInitialized: Boolean;
2059   InitOpenGLCS: TCriticalSection;
2060
2061 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2062 procedure glbInitOpenGL;
2063
2064   ////////////////////////////////////////////////////////////////////////////////
2065   function glbLoadLibrary(const aName: PChar): Pointer;
2066   begin
2067     {$IF DEFINED(GLB_WIN)}
2068     result := {%H-}Pointer(LoadLibrary(aName));
2069     {$ELSEIF DEFINED(GLB_LINUX)}
2070     result := dlopen(Name, RTLD_LAZY);
2071     {$ELSE}
2072     result := nil;
2073     {$IFEND}
2074   end;
2075
2076   ////////////////////////////////////////////////////////////////////////////////
2077   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2078   begin
2079     result := false;
2080     if not Assigned(aLibHandle) then
2081       exit;
2082
2083     {$IF DEFINED(GLB_WIN)}
2084     Result := FreeLibrary({%H-}HINST(aLibHandle));
2085     {$ELSEIF DEFINED(GLB_LINUX)}
2086     Result := dlclose(aLibHandle) = 0;
2087     {$IFEND}
2088   end;
2089
2090 begin
2091   if Assigned(GL_LibHandle) then
2092     glbFreeLibrary(GL_LibHandle);
2093
2094   if Assigned(GLU_LibHandle) then
2095     glbFreeLibrary(GLU_LibHandle);
2096
2097   GL_LibHandle := glbLoadLibrary(libopengl);
2098   if not Assigned(GL_LibHandle) then
2099     raise EglBitmap.Create('unable to load library: ' + libopengl);
2100
2101   GLU_LibHandle := glbLoadLibrary(libglu);
2102   if not Assigned(GLU_LibHandle) then
2103     raise EglBitmap.Create('unable to load library: ' + libglu);
2104
2105 {$IF DEFINED(GLB_WIN)}
2106   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2107 {$ELSEIF DEFINED(GLB_LINUX)}
2108   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2109   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2110 {$IFEND}
2111
2112   glEnable := glbGetProcAddress('glEnable');
2113   glDisable := glbGetProcAddress('glDisable');
2114   glGetString := glbGetProcAddress('glGetString');
2115   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2116   glTexParameteri := glbGetProcAddress('glTexParameteri');
2117   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2118   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2119   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2120   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2121   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2122   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2123   glTexGeni := glbGetProcAddress('glTexGeni');
2124   glGenTextures := glbGetProcAddress('glGenTextures');
2125   glBindTexture := glbGetProcAddress('glBindTexture');
2126   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2127   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2128   glReadPixels := glbGetProcAddress('glReadPixels');
2129   glPixelStorei := glbGetProcAddress('glPixelStorei');
2130   glTexImage1D := glbGetProcAddress('glTexImage1D');
2131   glTexImage2D := glbGetProcAddress('glTexImage2D');
2132   glGetTexImage := glbGetProcAddress('glGetTexImage');
2133
2134   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2135   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2136 end;
2137 {$ENDIF}
2138
2139 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2140 procedure glbReadOpenGLExtensions;
2141 var
2142   Buffer: AnsiString;
2143   MajorVersion, MinorVersion: Integer;
2144
2145   ///////////////////////////////////////////////////////////////////////////////////////////
2146   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2147   var
2148     Separator: Integer;
2149   begin
2150     aMinor := 0;
2151     aMajor := 0;
2152
2153     Separator := Pos(AnsiString('.'), aBuffer);
2154     if (Separator > 1) and (Separator < Length(aBuffer)) and
2155        (aBuffer[Separator - 1] in ['0'..'9']) and
2156        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2157
2158       Dec(Separator);
2159       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2160         Dec(Separator);
2161
2162       Delete(aBuffer, 1, Separator);
2163       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2164
2165       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2166         Inc(Separator);
2167
2168       Delete(aBuffer, Separator, 255);
2169       Separator := Pos(AnsiString('.'), aBuffer);
2170
2171       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2172       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2173     end;
2174   end;
2175
2176   ///////////////////////////////////////////////////////////////////////////////////////////
2177   function CheckExtension(const Extension: AnsiString): Boolean;
2178   var
2179     ExtPos: Integer;
2180   begin
2181     ExtPos := Pos(Extension, Buffer);
2182     result := ExtPos > 0;
2183     if result then
2184       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2185   end;
2186
2187   ///////////////////////////////////////////////////////////////////////////////////////////
2188   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2189   begin
2190     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2191   end;
2192
2193 begin
2194 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2195   InitOpenGLCS.Enter;
2196   try
2197     if not OpenGLInitialized then begin
2198       glbInitOpenGL;
2199       OpenGLInitialized := true;
2200     end;
2201   finally
2202     InitOpenGLCS.Leave;
2203   end;
2204 {$ENDIF}
2205
2206   // Version
2207   Buffer := glGetString(GL_VERSION);
2208   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2209
2210   GL_VERSION_1_2 := CheckVersion(1, 2);
2211   GL_VERSION_1_3 := CheckVersion(1, 3);
2212   GL_VERSION_1_4 := CheckVersion(1, 4);
2213   GL_VERSION_2_0 := CheckVersion(2, 0);
2214   GL_VERSION_3_3 := CheckVersion(3, 3);
2215
2216   // Extensions
2217   Buffer := glGetString(GL_EXTENSIONS);
2218   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2219   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2220   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2221   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2222   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2223   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2224   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2225   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2226   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2227   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2228   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2229   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2230   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2231   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2232
2233   if GL_VERSION_1_3 then begin
2234     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2235     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2236     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2237   end else begin
2238     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2239     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2240     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2241   end;
2242 end;
2243 {$ENDIF}
2244
2245 {$IFDEF GLB_SDL_IMAGE}
2246 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2250 begin
2251   result := TStream(context^.unknown.data1).Seek(offset, whence);
2252 end;
2253
2254 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2255 begin
2256   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2257 end;
2258
2259 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2260 begin
2261   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2262 end;
2263
2264 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2265 begin
2266   result := 0;
2267 end;
2268
2269 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2270 begin
2271   result := SDL_AllocRW;
2272
2273   if result = nil then
2274     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2275
2276   result^.seek := glBitmapRWseek;
2277   result^.read := glBitmapRWread;
2278   result^.write := glBitmapRWwrite;
2279   result^.close := glBitmapRWclose;
2280   result^.unknown.data1 := Stream;
2281 end;
2282 {$ENDIF}
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2286 begin
2287   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2292 begin
2293   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2298 begin
2299   glBitmapDefaultMipmap := aValue;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2304 begin
2305   glBitmapDefaultFormat := aFormat;
2306 end;
2307
2308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2309 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2310 begin
2311   glBitmapDefaultFilterMin := aMin;
2312   glBitmapDefaultFilterMag := aMag;
2313 end;
2314
2315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2317 begin
2318   glBitmapDefaultWrapS := S;
2319   glBitmapDefaultWrapT := T;
2320   glBitmapDefaultWrapR := R;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2325 begin
2326   glDefaultSwizzle[0] := r;
2327   glDefaultSwizzle[1] := g;
2328   glDefaultSwizzle[2] := b;
2329   glDefaultSwizzle[3] := a;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2334 begin
2335   result := glBitmapDefaultDeleteTextureOnFree;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2340 begin
2341   result := glBitmapDefaultFreeDataAfterGenTextures;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2346 begin
2347   result := glBitmapDefaultMipmap;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 function glBitmapGetDefaultFormat: TglBitmapFormat;
2352 begin
2353   result := glBitmapDefaultFormat;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2358 begin
2359   aMin := glBitmapDefaultFilterMin;
2360   aMag := glBitmapDefaultFilterMag;
2361 end;
2362
2363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2364 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2365 begin
2366   S := glBitmapDefaultWrapS;
2367   T := glBitmapDefaultWrapT;
2368   R := glBitmapDefaultWrapR;
2369 end;
2370
2371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2373 begin
2374   r := glDefaultSwizzle[0];
2375   g := glDefaultSwizzle[1];
2376   b := glDefaultSwizzle[2];
2377   a := glDefaultSwizzle[3];
2378 end;
2379
2380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2381 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetRedMask: QWord;
2384 begin
2385   result := fRange.r shl fShift.r;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetGreenMask: QWord;
2390 begin
2391   result := fRange.g shl fShift.g;
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.GetBlueMask: QWord;
2396 begin
2397   result := fRange.b shl fShift.b;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 function TFormatDescriptor.GetAlphaMask: QWord;
2402 begin
2403   result := fRange.a shl fShift.a;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function TFormatDescriptor.GetIsCompressed: Boolean;
2408 begin
2409   result := fIsCompressed;
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 function TFormatDescriptor.GetHasRed: Boolean;
2414 begin
2415   result := (fRange.r > 0);
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function TFormatDescriptor.GetHasGreen: Boolean;
2420 begin
2421   result := (fRange.g > 0);
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 function TFormatDescriptor.GetHasBlue: Boolean;
2426 begin
2427   result := (fRange.b > 0);
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 function TFormatDescriptor.GetHasAlpha: Boolean;
2432 begin
2433   result := (fRange.a > 0);
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
2438 begin
2439   result := fRGBInverted;
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
2444 begin
2445   result := fWithAlpha;
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
2450 begin
2451   result := fWithoutAlpha;
2452 end;
2453
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
2456 begin
2457   result := fOpenGLFormat;
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
2462 begin
2463   result := fUncompressed;
2464 end;
2465
2466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2467 function TFormatDescriptor.GetglFormat: GLenum;
2468 begin
2469   result := fglFormat;
2470 end;
2471
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 function TFormatDescriptor.GetglInternalFormat: GLenum;
2474 begin
2475   result := fglInternalFormat;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 function TFormatDescriptor.GetglDataFormat: GLenum;
2480 begin
2481   result := fglDataFormat;
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 function TFormatDescriptor.GetComponents: Integer;
2486 var
2487   i: Integer;
2488 begin
2489   result := 0;
2490   for i := 0 to 3 do
2491     if (fRange.arr[i] > 0) then
2492       inc(result);
2493 end;
2494
2495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2496 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2497 var
2498   w, h: Integer;
2499 begin
2500   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2501     w := Max(1, aSize.X);
2502     h := Max(1, aSize.Y);
2503     result := GetSize(w, h);
2504   end else
2505     result := 0;
2506 end;
2507
2508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2509 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2510 begin
2511   result := 0;
2512   if (aWidth <= 0) or (aHeight <= 0) then
2513     exit;
2514   result := Ceil(aWidth * aHeight * fPixelSize);
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 function TFormatDescriptor.CreateMappingData: Pointer;
2519 begin
2520   result := nil;
2521 end;
2522
2523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2525 begin
2526   //DUMMY
2527 end;
2528
2529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 function TFormatDescriptor.IsEmpty: Boolean;
2531 begin
2532   result := (fFormat = tfEmpty);
2533 end;
2534
2535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2536 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2537 begin
2538   result := false;
2539   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2540     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2541   if (aRedMask   <> RedMask) then
2542     exit;
2543   if (aGreenMask <> GreenMask) then
2544     exit;
2545   if (aBlueMask  <> BlueMask) then
2546     exit;
2547   if (aAlphaMask <> AlphaMask) then
2548     exit;
2549   result := true;
2550 end;
2551
2552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2553 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2554 begin
2555   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2556   aPixel.Data   := fRange;
2557   aPixel.Range  := fRange;
2558   aPixel.Format := fFormat;
2559 end;
2560
2561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2562 constructor TFormatDescriptor.Create;
2563 begin
2564   inherited Create;
2565
2566   fFormat       := tfEmpty;
2567   fWithAlpha    := tfEmpty;
2568   fWithoutAlpha := tfEmpty;
2569   fOpenGLFormat := tfEmpty;
2570   fRGBInverted  := tfEmpty;
2571   fUncompressed := tfEmpty;
2572
2573   fPixelSize    := 0.0;
2574   fIsCompressed := false;
2575
2576   fglFormat         := 0;
2577   fglInternalFormat := 0;
2578   fglDataFormat     := 0;
2579
2580   FillChar(fRange, 0, SizeOf(fRange));
2581   FillChar(fShift, 0, SizeOf(fShift));
2582 end;
2583
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2588 begin
2589   aData^ := aPixel.Data.a;
2590   inc(aData);
2591 end;
2592
2593 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 begin
2595   aPixel.Data.r := 0;
2596   aPixel.Data.g := 0;
2597   aPixel.Data.b := 0;
2598   aPixel.Data.a := aData^;
2599   inc(aData);
2600 end;
2601
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2606 begin
2607   aData^ := LuminanceWeight(aPixel);
2608   inc(aData);
2609 end;
2610
2611 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2612 begin
2613   aPixel.Data.r := aData^;
2614   aPixel.Data.g := aData^;
2615   aPixel.Data.b := aData^;
2616   aPixel.Data.a := 0;
2617   inc(aData);
2618 end;
2619
2620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2621 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2624 var
2625   i: Integer;
2626 begin
2627   aData^ := 0;
2628   for i := 0 to 3 do
2629     if (fRange.arr[i] > 0) then
2630       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2631   inc(aData);
2632 end;
2633
2634 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2635 var
2636   i: Integer;
2637 begin
2638   for i := 0 to 3 do
2639     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2640   inc(aData);
2641 end;
2642
2643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2647 begin
2648   inherited Map(aPixel, aData, aMapData);
2649   aData^ := aPixel.Data.a;
2650   inc(aData);
2651 end;
2652
2653 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2654 begin
2655   inherited Unmap(aData, aPixel, aMapData);
2656   aPixel.Data.a := aData^;
2657   inc(aData);
2658 end;
2659
2660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2661 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2663 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2664 begin
2665   aData^ := aPixel.Data.b;
2666   inc(aData);
2667   aData^ := aPixel.Data.g;
2668   inc(aData);
2669   aData^ := aPixel.Data.r;
2670   inc(aData);
2671 end;
2672
2673 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2674 begin
2675   aPixel.Data.b := aData^;
2676   inc(aData);
2677   aPixel.Data.g := aData^;
2678   inc(aData);
2679   aPixel.Data.r := aData^;
2680   inc(aData);
2681   aPixel.Data.a := 0;
2682 end;
2683
2684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2685 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2688 begin
2689   aData^ := aPixel.Data.r;
2690   inc(aData);
2691   aData^ := aPixel.Data.g;
2692   inc(aData);
2693   aData^ := aPixel.Data.b;
2694   inc(aData);
2695 end;
2696
2697 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2698 begin
2699   aPixel.Data.r := aData^;
2700   inc(aData);
2701   aPixel.Data.g := aData^;
2702   inc(aData);
2703   aPixel.Data.b := aData^;
2704   inc(aData);
2705   aPixel.Data.a := 0;
2706 end;
2707
2708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2709 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2711 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2712 begin
2713   PWord(aData)^ := aPixel.Data.a;
2714   inc(aData, 2);
2715 end;
2716
2717 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2718 begin
2719   aPixel.Data.r := 0;
2720   aPixel.Data.g := 0;
2721   aPixel.Data.b := 0;
2722   aPixel.Data.a := PWord(aData)^;
2723   inc(aData, 2);
2724 end;
2725
2726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2727 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2729 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2730 begin
2731   PWord(aData)^ := LuminanceWeight(aPixel);
2732   inc(aData, 2);
2733 end;
2734
2735 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2736 begin
2737   aPixel.Data.r := PWord(aData)^;
2738   aPixel.Data.g := PWord(aData)^;
2739   aPixel.Data.b := PWord(aData)^;
2740   aPixel.Data.a := 0;
2741   inc(aData, 2);
2742 end;
2743
2744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2745 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2747 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2748 var
2749   i: Integer;
2750 begin
2751   PWord(aData)^ := 0;
2752   for i := 0 to 3 do
2753     if (fRange.arr[i] > 0) then
2754       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2755   inc(aData, 2);
2756 end;
2757
2758 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2759 var
2760   i: Integer;
2761 begin
2762   for i := 0 to 3 do
2763     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2764   inc(aData, 2);
2765 end;
2766
2767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2770 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2771 begin
2772   PWord(aData)^ := DepthWeight(aPixel);
2773   inc(aData, 2);
2774 end;
2775
2776 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2777 begin
2778   aPixel.Data.r := PWord(aData)^;
2779   aPixel.Data.g := PWord(aData)^;
2780   aPixel.Data.b := PWord(aData)^;
2781   aPixel.Data.a := PWord(aData)^;;
2782   inc(aData, 2);
2783 end;
2784
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2789 begin
2790   inherited Map(aPixel, aData, aMapData);
2791   PWord(aData)^ := aPixel.Data.a;
2792   inc(aData, 2);
2793 end;
2794
2795 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2796 begin
2797   inherited Unmap(aData, aPixel, aMapData);
2798   aPixel.Data.a := PWord(aData)^;
2799   inc(aData, 2);
2800 end;
2801
2802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2803 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2805 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2806 begin
2807   PWord(aData)^ := aPixel.Data.b;
2808   inc(aData, 2);
2809   PWord(aData)^ := aPixel.Data.g;
2810   inc(aData, 2);
2811   PWord(aData)^ := aPixel.Data.r;
2812   inc(aData, 2);
2813 end;
2814
2815 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2816 begin
2817   aPixel.Data.b := PWord(aData)^;
2818   inc(aData, 2);
2819   aPixel.Data.g := PWord(aData)^;
2820   inc(aData, 2);
2821   aPixel.Data.r := PWord(aData)^;
2822   inc(aData, 2);
2823   aPixel.Data.a := 0;
2824 end;
2825
2826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2829 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2830 begin
2831   PWord(aData)^ := aPixel.Data.r;
2832   inc(aData, 2);
2833   PWord(aData)^ := aPixel.Data.g;
2834   inc(aData, 2);
2835   PWord(aData)^ := aPixel.Data.b;
2836   inc(aData, 2);
2837 end;
2838
2839 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2840 begin
2841   aPixel.Data.r := PWord(aData)^;
2842   inc(aData, 2);
2843   aPixel.Data.g := PWord(aData)^;
2844   inc(aData, 2);
2845   aPixel.Data.b := PWord(aData)^;
2846   inc(aData, 2);
2847   aPixel.Data.a := 0;
2848 end;
2849
2850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2851 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2854 begin
2855   PWord(aData)^ := aPixel.Data.a;
2856   inc(aData, 2);
2857   inherited Map(aPixel, aData, aMapData);
2858 end;
2859
2860 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2861 begin
2862   aPixel.Data.a := PWord(aData)^;
2863   inc(aData, 2);
2864   inherited Unmap(aData, aPixel, aMapData);
2865 end;
2866
2867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2868 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2869 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2870 procedure TfdARGB_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2871 begin
2872   inherited Map(aPixel, aData, aMapData);
2873   PWord(aData)^ := aPixel.Data.a;
2874   inc(aData, 2);
2875 end;
2876
2877 procedure TfdARGB_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2878 begin
2879   inherited Unmap(aData, aPixel, aMapData);
2880   aPixel.Data.a := PWord(aData)^;
2881   inc(aData, 2);
2882 end;
2883
2884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2887 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2888 begin
2889   PWord(aData)^ := aPixel.Data.a;
2890   inc(aData, 2);
2891   inherited Map(aPixel, aData, aMapData);
2892 end;
2893
2894 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2895 begin
2896   aPixel.Data.a := PWord(aData)^;
2897   inc(aData, 2);
2898   inherited Unmap(aData, aPixel, aMapData);
2899 end;
2900
2901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2902 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2904 procedure TfdABGR_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2905 begin
2906   inherited Map(aPixel, aData, aMapData);
2907   PWord(aData)^ := aPixel.Data.a;
2908   inc(aData, 2);
2909 end;
2910
2911 procedure TfdABGR_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2912 begin
2913   inherited Unmap(aData, aPixel, aMapData);
2914   aPixel.Data.a := PWord(aData)^;
2915   inc(aData, 2);
2916 end;
2917
2918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2922 var
2923   i: Integer;
2924 begin
2925   PCardinal(aData)^ := 0;
2926   for i := 0 to 3 do
2927     if (fRange.arr[i] > 0) then
2928       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2929   inc(aData, 4);
2930 end;
2931
2932 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2933 var
2934   i: Integer;
2935 begin
2936   for i := 0 to 3 do
2937     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2938   inc(aData, 2);
2939 end;
2940
2941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2942 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2944 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2945 begin
2946   PCardinal(aData)^ := DepthWeight(aPixel);
2947   inc(aData, 4);
2948 end;
2949
2950 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2951 begin
2952   aPixel.Data.r := PCardinal(aData)^;
2953   aPixel.Data.g := PCardinal(aData)^;
2954   aPixel.Data.b := PCardinal(aData)^;
2955   aPixel.Data.a := 0;
2956   inc(aData, 4);
2957 end;
2958
2959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2962 constructor TfdAlpha4.Create;
2963 begin
2964   inherited Create;
2965   fPixelSize        := 1.0;
2966   fFormat           := tfAlpha4;
2967   fWithAlpha        := tfAlpha4;
2968   fOpenGLFormat     := tfAlpha4;
2969   fRange.a          := $FF;
2970   fglFormat         := GL_ALPHA;
2971   fglInternalFormat := GL_ALPHA4;
2972   fglDataFormat     := GL_UNSIGNED_BYTE;
2973 end;
2974
2975 constructor TfdAlpha8.Create;
2976 begin
2977   inherited Create;
2978   fPixelSize        := 1.0;
2979   fFormat           := tfAlpha8;
2980   fWithAlpha        := tfAlpha8;
2981   fOpenGLFormat     := tfAlpha8;
2982   fRange.a          := $FF;
2983   fglFormat         := GL_ALPHA;
2984   fglInternalFormat := GL_ALPHA8;
2985   fglDataFormat     := GL_UNSIGNED_BYTE;
2986 end;
2987
2988 constructor TfdAlpha16.Create;
2989 begin
2990   inherited Create;
2991   fPixelSize        := 2.0;
2992   fFormat           := tfAlpha16;
2993   fWithAlpha        := tfAlpha16;
2994   fOpenGLFormat     := tfAlpha16;
2995   fRange.a          := $FFFF;
2996   fglFormat         := GL_ALPHA;
2997   fglInternalFormat := GL_ALPHA16;
2998   fglDataFormat     := GL_UNSIGNED_SHORT;
2999 end;
3000
3001 constructor TfdLuminance4.Create;
3002 begin
3003   inherited Create;
3004   fPixelSize        := 1.0;
3005   fFormat           := tfLuminance4;
3006   fWithAlpha        := tfLuminance4Alpha4;
3007   fWithoutAlpha     := tfLuminance4;
3008   fOpenGLFormat     := tfLuminance4;
3009   fRange.r          := $FF;
3010   fRange.g          := $FF;
3011   fRange.b          := $FF;
3012   fglFormat         := GL_LUMINANCE;
3013   fglInternalFormat := GL_LUMINANCE4;
3014   fglDataFormat     := GL_UNSIGNED_BYTE;
3015 end;
3016
3017 constructor TfdLuminance8.Create;
3018 begin
3019   inherited Create;
3020   fPixelSize        := 1.0;
3021   fFormat           := tfLuminance8;
3022   fWithAlpha        := tfLuminance8Alpha8;
3023   fWithoutAlpha     := tfLuminance8;
3024   fOpenGLFormat     := tfLuminance8;
3025   fRange.r          := $FF;
3026   fRange.g          := $FF;
3027   fRange.b          := $FF;
3028   fglFormat         := GL_LUMINANCE;
3029   fglInternalFormat := GL_LUMINANCE8;
3030   fglDataFormat     := GL_UNSIGNED_BYTE;
3031 end;
3032
3033 constructor TfdLuminance16.Create;
3034 begin
3035   inherited Create;
3036   fPixelSize        := 2.0;
3037   fFormat           := tfLuminance16;
3038   fWithAlpha        := tfLuminance16Alpha16;
3039   fWithoutAlpha     := tfLuminance16;
3040   fOpenGLFormat     := tfLuminance16;
3041   fRange.r          := $FFFF;
3042   fRange.g          := $FFFF;
3043   fRange.b          := $FFFF;
3044   fglFormat         := GL_LUMINANCE;
3045   fglInternalFormat := GL_LUMINANCE16;
3046   fglDataFormat     := GL_UNSIGNED_SHORT;
3047 end;
3048
3049 constructor TfdLuminance4Alpha4.Create;
3050 begin
3051   inherited Create;
3052   fPixelSize        := 2.0;
3053   fFormat           := tfLuminance4Alpha4;
3054   fWithAlpha        := tfLuminance4Alpha4;
3055   fWithoutAlpha     := tfLuminance4;
3056   fOpenGLFormat     := tfLuminance4Alpha4;
3057   fRange.r          := $FF;
3058   fRange.g          := $FF;
3059   fRange.b          := $FF;
3060   fRange.a          := $FF;
3061   fShift.r          := 0;
3062   fShift.g          := 0;
3063   fShift.b          := 0;
3064   fShift.a          := 8;
3065   fglFormat         := GL_LUMINANCE_ALPHA;
3066   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3067   fglDataFormat     := GL_UNSIGNED_BYTE;
3068 end;
3069
3070 constructor TfdLuminance6Alpha2.Create;
3071 begin
3072   inherited Create;
3073   fPixelSize        := 2.0;
3074   fFormat           := tfLuminance6Alpha2;
3075   fWithAlpha        := tfLuminance6Alpha2;
3076   fWithoutAlpha     := tfLuminance8;
3077   fOpenGLFormat     := tfLuminance6Alpha2;
3078   fRange.r          := $FF;
3079   fRange.g          := $FF;
3080   fRange.b          := $FF;
3081   fRange.a          := $FF;
3082   fShift.r          := 0;
3083   fShift.g          := 0;
3084   fShift.b          := 0;
3085   fShift.a          := 8;
3086   fglFormat         := GL_LUMINANCE_ALPHA;
3087   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3088   fglDataFormat     := GL_UNSIGNED_BYTE;
3089 end;
3090
3091 constructor TfdLuminance8Alpha8.Create;
3092 begin
3093   inherited Create;
3094   fPixelSize        := 2.0;
3095   fFormat           := tfLuminance8Alpha8;
3096   fWithAlpha        := tfLuminance8Alpha8;
3097   fWithoutAlpha     := tfLuminance8;
3098   fOpenGLFormat     := tfLuminance8Alpha8;
3099   fRange.r          := $FF;
3100   fRange.g          := $FF;
3101   fRange.b          := $FF;
3102   fRange.a          := $FF;
3103   fShift.r          := 0;
3104   fShift.g          := 0;
3105   fShift.b          := 0;
3106   fShift.a          := 8;
3107   fglFormat         := GL_LUMINANCE_ALPHA;
3108   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3109   fglDataFormat     := GL_UNSIGNED_BYTE;
3110 end;
3111
3112 constructor TfdLuminance12Alpha4.Create;
3113 begin
3114   inherited Create;
3115   fPixelSize        := 4.0;
3116   fFormat           := tfLuminance12Alpha4;
3117   fWithAlpha        := tfLuminance12Alpha4;
3118   fWithoutAlpha     := tfLuminance16;
3119   fOpenGLFormat     := tfLuminance12Alpha4;
3120   fRange.r          := $FFFF;
3121   fRange.g          := $FFFF;
3122   fRange.b          := $FFFF;
3123   fRange.a          := $FFFF;
3124   fShift.r          := 0;
3125   fShift.g          := 0;
3126   fShift.b          := 0;
3127   fShift.a          := 16;
3128   fglFormat         := GL_LUMINANCE_ALPHA;
3129   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3130   fglDataFormat     := GL_UNSIGNED_SHORT;
3131 end;
3132
3133 constructor TfdLuminance16Alpha16.Create;
3134 begin
3135   inherited Create;
3136   fPixelSize        := 4.0;
3137   fFormat           := tfLuminance16Alpha16;
3138   fWithAlpha        := tfLuminance16Alpha16;
3139   fWithoutAlpha     := tfLuminance16;
3140   fOpenGLFormat     := tfLuminance16Alpha16;
3141   fRange.r          := $FFFF;
3142   fRange.g          := $FFFF;
3143   fRange.b          := $FFFF;
3144   fRange.a          := $FFFF;
3145   fShift.r          := 0;
3146   fShift.g          := 0;
3147   fShift.b          := 0;
3148   fShift.a          := 16;
3149   fglFormat         := GL_LUMINANCE_ALPHA;
3150   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3151   fglDataFormat     := GL_UNSIGNED_SHORT;
3152 end;
3153
3154 constructor TfdR3G3B2.Create;
3155 begin
3156   inherited Create;
3157   fPixelSize        := 1.0;
3158   fFormat           := tfR3G3B2;
3159   fWithAlpha        := tfRGBA4;
3160   fWithoutAlpha     := tfR3G3B2;
3161   fOpenGLFormat     := tfR3G3B2;
3162   fRGBInverted      := tfEmpty;
3163   fRange.r          := $07;
3164   fRange.g          := $07;
3165   fRange.b          := $04;
3166   fShift.r          := 5;
3167   fShift.g          := 2;
3168   fShift.b          := 0;
3169   fglFormat         := GL_RGB;
3170   fglInternalFormat := GL_R3_G3_B2;
3171   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3172 end;
3173
3174 constructor TfdRGBX4.Create;
3175 begin
3176   inherited Create;
3177   fPixelSize        := 2.0;
3178   fFormat           := tfRGBX4;
3179   fWithAlpha        := tfRGBA4;
3180   fWithoutAlpha     := tfRGBX4;
3181   fOpenGLFormat     := tfRGBX4;
3182   fRGBInverted      := tfBGRX4;
3183   fRange.r          := $0F;
3184   fRange.g          := $0F;
3185   fRange.b          := $0F;
3186   fRange.a          := $00;
3187   fShift.r          := 12;
3188   fShift.g          :=  8;
3189   fShift.b          :=  4;
3190   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3191   fglInternalFormat := GL_RGB4;
3192   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3193 end;
3194
3195 constructor TfdXRGB4.Create;
3196 begin
3197   inherited Create;
3198   fPixelSize        := 2.0;
3199   fFormat           := tfXRGB4;
3200   fWithAlpha        := tfARGB4;
3201   fWithoutAlpha     := tfXRGB4;
3202   fOpenGLFormat     := tfXRGB4;
3203   fRGBInverted      := tfXBGR4;
3204   fRange.r          := $0F;
3205   fRange.g          := $0F;
3206   fRange.b          := $0F;
3207   fShift.r          := 8;
3208   fShift.g          := 4;
3209   fShift.b          := 0;
3210   fglFormat         := GL_BGRA;
3211   fglInternalFormat := GL_RGB4;
3212   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3213 end;
3214
3215 constructor TfdR5G6B5.Create;
3216 begin
3217   inherited Create;
3218   fPixelSize        := 2.0;
3219   fFormat           := tfR5G6B5;
3220   fWithAlpha        := tfRGB5A1;
3221   fWithoutAlpha     := tfR5G6B5;
3222   fOpenGLFormat     := tfR5G6B5;
3223   fRGBInverted      := tfB5G6R5;
3224   fRange.r          := $1F;
3225   fRange.g          := $3F;
3226   fRange.b          := $1F;
3227   fShift.r          := 11;
3228   fShift.g          := 5;
3229   fShift.b          := 0;
3230   fglFormat         := GL_RGB;
3231   fglInternalFormat := GL_RGB565;
3232   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3233 end;
3234
3235 constructor TfdRGB5X1.Create;
3236 begin
3237   inherited Create;
3238   fPixelSize        := 2.0;
3239   fFormat           := tfRGB5X1;
3240   fWithAlpha        := tfRGB5A1;
3241   fWithoutAlpha     := tfRGB5X1;
3242   fOpenGLFormat     := tfRGB5X1;
3243   fRGBInverted      := tfBGR5X1;
3244   fRange.r          := $1F;
3245   fRange.g          := $1F;
3246   fRange.b          := $1F;
3247   fShift.r          := 11;
3248   fShift.g          :=  6;
3249   fShift.b          :=  1;
3250   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3251   fglInternalFormat := GL_RGB5;
3252   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3253 end;
3254
3255 constructor TfdX1RGB5.Create;
3256 begin
3257   inherited Create;
3258   fPixelSize        := 2.0;
3259   fFormat           := tfX1RGB5;
3260   fWithAlpha        := tfA1RGB5;
3261   fWithoutAlpha     := tfX1RGB5;
3262   fOpenGLFormat     := tfX1RGB5;
3263   fRGBInverted      := tfX1BGR5;
3264   fRange.r          := $1F;
3265   fRange.g          := $1F;
3266   fRange.b          := $1F;
3267   fShift.r          := 10;
3268   fShift.g          :=  5;
3269   fShift.b          :=  0;
3270   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3271   fglInternalFormat := GL_RGB5;
3272   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3273 end;
3274
3275 constructor TfdRGB8.Create;
3276 begin
3277   inherited Create;
3278   fPixelSize        := 3.0;
3279   fFormat           := tfRGB8;
3280   fWithAlpha        := tfRGBA8;
3281   fWithoutAlpha     := tfRGB8;
3282   fOpenGLFormat     := tfRGB8;
3283   fRGBInverted      := tfBGR8;
3284   fRange.r          := $FF;
3285   fRange.g          := $FF;
3286   fRange.b          := $FF;
3287   fShift.r          := 16;
3288   fShift.g          :=  8;
3289   fShift.b          :=  0;
3290   fglFormat         := GL_BGR;    // reverse byte order to match little endianess
3291   fglInternalFormat := GL_RGB8;   // as if u interpret the 3 bytes as unsigned integer
3292   fglDataFormat     := GL_UNSIGNED_BYTE;
3293 end;
3294
3295 constructor TfdRGBX8.Create;
3296 begin
3297   inherited Create;
3298   fPixelSize        := 4.0;
3299   fFormat           := tfRGBX8;
3300   fWithAlpha        := tfRGBA8;
3301   fWithoutAlpha     := tfRGBX8;
3302   fOpenGLFormat     := tfRGB8;
3303   fRGBInverted      := tfBGRX8;
3304   fRange.r          := $FF;
3305   fRange.g          := $FF;
3306   fRange.b          := $FF;
3307   fShift.r          := 24;
3308   fShift.g          := 16;
3309   fShift.b          := 8;
3310   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3311   fglInternalFormat := GL_RGB8;
3312   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3313 end;
3314
3315 constructor TfdXRGB8.Create;
3316 begin
3317   inherited Create;
3318   fPixelSize        := 4.0;
3319   fFormat           := tfXRGB8;
3320   fWithAlpha        := tfXRGB8;
3321   fWithoutAlpha     := tfXRGB8;
3322   fOpenGLFormat     := tfRGB8;
3323   fRGBInverted      := tfXBGR8;
3324   fRange.r          := $FF;
3325   fRange.g          := $FF;
3326   fRange.b          := $FF;
3327   fShift.r          := 16;
3328   fShift.g          :=  8;
3329   fShift.b          :=  0;
3330   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3331   fglInternalFormat := GL_RGB8;
3332   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3333 end;
3334
3335 constructor TfdRGB10X2.Create;
3336 begin
3337   inherited Create;
3338   fPixelSize        := 3.0;
3339   fFormat           := tfRGB10X2;
3340   fWithAlpha        := tfRGB10A2;
3341   fWithoutAlpha     := tfRGB10X2;
3342   fOpenGLFormat     := tfRGB10X2;
3343   fRGBInverted      := tfBGR10X2;
3344   fRange.r          := $03FF;
3345   fRange.g          := $03FF;
3346   fRange.b          := $03FF;
3347   fShift.r          := 22;
3348   fShift.g          := 12;
3349   fShift.b          :=  2;
3350   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3351   fglInternalFormat := GL_RGB10;
3352   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3353 end;
3354
3355 constructor TfdX2RGB10.Create;
3356 begin
3357   inherited Create;
3358   fPixelSize        := 3.0;
3359   fFormat           := tfX2RGB10;
3360   fWithAlpha        := tfA2RGB10;
3361   fWithoutAlpha     := tfX2RGB10;
3362   fOpenGLFormat     := tfX2RGB10;
3363   fRGBInverted      := tfX2BGR10;
3364   fRange.r          := $03FF;
3365   fRange.g          := $03FF;
3366   fRange.b          := $03FF;
3367   fShift.r          := 20;
3368   fShift.g          := 10;
3369   fShift.b          :=  0;
3370   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3371   fglInternalFormat := GL_RGB10;
3372   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3373 end;
3374
3375 constructor TfdRGB16.Create;
3376 begin
3377   inherited Create;
3378   fPixelSize        := 6.0;
3379   fFormat           := tfRGB16;
3380   fWithAlpha        := tfRGBA16;
3381   fWithoutAlpha     := tfRGB16;
3382   fOpenGLFormat     := tfRGB16;
3383   fRGBInverted      := tfBGR16;
3384   fRange.r          := $FFFF;
3385   fRange.g          := $FFFF;
3386   fRange.b          := $FFFF;
3387   fShift.r          := 32;
3388   fShift.g          := 16;
3389   fShift.b          :=  0;
3390   fglFormat         := GL_BGR;     // reverse byte order to match little endianess
3391   fglInternalFormat := GL_RGB16;   // as if u interpret the 3 bytes as unsigned integer
3392   fglDataFormat     := GL_UNSIGNED_SHORT;
3393 end;
3394
3395 constructor TfdRGBA4.Create;
3396 begin
3397   inherited Create;
3398   fPixelSize        := 2.0;
3399   fFormat           := tfRGBA4;
3400   fWithAlpha        := tfRGBA4;
3401   fWithoutAlpha     := tfRGBX4;
3402   fOpenGLFormat     := tfRGBA4;
3403   fRGBInverted      := tfBGRA4;
3404   fRange.r          := $0F;
3405   fRange.g          := $0F;
3406   fRange.b          := $0F;
3407   fRange.a          := $0F;
3408   fShift.r          := 12;
3409   fShift.g          :=  8;
3410   fShift.b          :=  4;
3411   fShift.a          :=  0;
3412   fglFormat         := GL_RGBA;
3413   fglInternalFormat := GL_RGBA4;
3414   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3415 end;
3416
3417 constructor TfdARGB4.Create;
3418 begin
3419   inherited Create;
3420   fPixelSize        := 2.0;
3421   fFormat           := tfARGB4;
3422   fWithAlpha        := tfARGB4;
3423   fWithoutAlpha     := tfXRGB4;
3424   fOpenGLFormat     := tfARGB4;
3425   fRGBInverted      := tfABGR4;
3426   fRange.r          := $0F;
3427   fRange.g          := $0F;
3428   fRange.b          := $0F;
3429   fRange.a          := $0F;
3430   fShift.r          :=  8;
3431   fShift.g          :=  4;
3432   fShift.b          :=  0;
3433   fShift.a          := 12;
3434   fglFormat         := GL_BGRA;
3435   fglInternalFormat := GL_RGBA4;
3436   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3437 end;
3438
3439 constructor TfdRGB5A1.Create;
3440 begin
3441   inherited Create;
3442   fPixelSize        := 2.0;
3443   fFormat           := tfRGB5A1;
3444   fWithAlpha        := tfRGB5A1;
3445   fWithoutAlpha     := tfRGB5X1;
3446   fOpenGLFormat     := tfRGB5A1;
3447   fRGBInverted      := tfBGR5A1;
3448   fRange.r          := $1F;
3449   fRange.g          := $1F;
3450   fRange.b          := $1F;
3451   fRange.a          := $01;
3452   fShift.r          := 11;
3453   fShift.g          :=  6;
3454   fShift.b          :=  1;
3455   fShift.a          :=  0;
3456   fglFormat         := GL_RGBA;
3457   fglInternalFormat := GL_RGB5_A1;
3458   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3459 end;
3460
3461 constructor TfdA1RGB5.Create;
3462 begin
3463   inherited Create;
3464   fPixelSize        := 2.0;
3465   fFormat           := tfA1RGB5;
3466   fWithAlpha        := tfA1RGB5;
3467   fWithoutAlpha     := tfX1RGB5;
3468   fOpenGLFormat     := tfA1RGB5;
3469   fRGBInverted      := tfA1BGR5;
3470   fRange.r          := $1F;
3471   fRange.g          := $1F;
3472   fRange.b          := $1F;
3473   fRange.a          := $01;
3474   fShift.r          := 10;
3475   fShift.g          :=  5;
3476   fShift.b          :=  0;
3477   fShift.a          := 15;
3478   fglFormat         := GL_BGRA;
3479   fglInternalFormat := GL_RGB5_A1;
3480   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3481 end;
3482
3483 constructor TfdRGBA8.Create;
3484 begin
3485   inherited Create;
3486   fPixelSize        := 4.0;
3487   fFormat           := tfRGBA8;
3488   fWithAlpha        := tfRGBA8;
3489   fWithoutAlpha     := tfRGB8;
3490   fOpenGLFormat     := tfRGBA8;
3491   fRGBInverted      := tfBGRA8;
3492   fRange.r          := $FF;
3493   fRange.g          := $FF;
3494   fRange.b          := $FF;
3495   fRange.a          := $FF;
3496   fShift.r          := 24;
3497   fShift.g          := 16;
3498   fShift.b          :=  8;
3499   fShift.a          :=  0;
3500   fglFormat         := GL_RGBA;
3501   fglInternalFormat := GL_RGBA8;
3502   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3503 end;
3504
3505 constructor TfdARGB8.Create;
3506 begin
3507   inherited Create;
3508   fPixelSize        := 4.0;
3509   fFormat           := tfARGB8;
3510   fWithAlpha        := tfARGB8;
3511   fWithoutAlpha     := tfRGB8;
3512   fOpenGLFormat     := tfARGB8;
3513   fRGBInverted      := tfABGR8;
3514   fRange.r          := $FF;
3515   fRange.g          := $FF;
3516   fRange.b          := $FF;
3517   fRange.a          := $FF;
3518   fShift.r          := 16;
3519   fShift.g          :=  8;
3520   fShift.b          :=  0;
3521   fShift.a          := 24;
3522   fglFormat         := GL_BGRA;
3523   fglInternalFormat := GL_RGBA8;
3524   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3525 end;
3526
3527 constructor TfdRGB10A2.Create;
3528 begin
3529   inherited Create;
3530   fPixelSize        := 3.0;
3531   fFormat           := tfRGB10A2;
3532   fWithAlpha        := tfRGB10A2;
3533   fWithoutAlpha     := tfRGB10X2;
3534   fOpenGLFormat     := tfRGB10A2;
3535   fRGBInverted      := tfBGR10A2;
3536   fRange.r          := $03FF;
3537   fRange.g          := $03FF;
3538   fRange.b          := $03FF;
3539   fRange.a          := $0003;
3540   fShift.r          := 22;
3541   fShift.g          := 12;
3542   fShift.b          :=  2;
3543   fShift.a          :=  0;
3544   fglFormat         := GL_RGBA;
3545   fglInternalFormat := GL_RGB10_A2;
3546   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3547 end;
3548
3549 constructor TfdA2RGB10.Create;
3550 begin
3551   inherited Create;
3552   fPixelSize        := 3.0;
3553   fFormat           := tfA2RGB10;
3554   fWithAlpha        := tfA2RGB10;
3555   fWithoutAlpha     := tfX2RGB10;
3556   fOpenGLFormat     := tfA2RGB10;
3557   fRGBInverted      := tfA2BGR10;
3558   fRange.r          := $03FF;
3559   fRange.g          := $03FF;
3560   fRange.b          := $03FF;
3561   fRange.a          := $0003;
3562   fShift.r          := 20;
3563   fShift.g          := 10;
3564   fShift.b          :=  0;
3565   fShift.a          := 30;
3566   fglFormat         := GL_BGRA;
3567   fglInternalFormat := GL_RGB10_A2;
3568   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3569 end;
3570
3571 constructor TfdRGBA16.Create;
3572 begin
3573   inherited Create;
3574   fPixelSize        := 8.0;
3575   fFormat           := tfRGBA16;
3576   fWithAlpha        := tfRGBA16;
3577   fWithoutAlpha     := tfRGB16;
3578   fOpenGLFormat     := tfRGBA16;
3579   fRGBInverted      := tfBGRA16;
3580   fRange.r          := $FFFF;
3581   fRange.g          := $FFFF;
3582   fRange.b          := $FFFF;
3583   fRange.a          := $FFFF;
3584   fShift.r          := 48;
3585   fShift.g          := 32;
3586   fShift.b          := 16;
3587   fShift.a          :=  0;
3588   fglFormat         := GL_BGRA;     // reverse byte order to match little endianess
3589   fglInternalFormat := GL_RGBA16;   // as if u interpret the 3 bytes as unsigned integer
3590   fglDataFormat     := GL_UNSIGNED_SHORT;
3591 end;
3592
3593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3595 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3596 constructor TfdBGRX4.Create;
3597 begin
3598   inherited Create;
3599   fPixelSize        := 2.0;
3600   fFormat           := tfBGRX4;
3601   fWithAlpha        := tfBGRA4;
3602   fWithoutAlpha     := tfBGRX4;
3603   fOpenGLFormat     := tfBGRX4;
3604   fRGBInverted      := tfRGBX4;
3605   fRange.r          := $0F;
3606   fRange.g          := $0F;
3607   fRange.b          := $0F;
3608   fShift.r          :=  4;
3609   fShift.g          :=  8;
3610   fShift.b          := 12;
3611   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3612   fglInternalFormat := GL_RGB4;
3613   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3614 end;
3615
3616 constructor TfdXBGR4.Create;
3617 begin
3618   inherited Create;
3619   fPixelSize        := 2.0;
3620   fFormat           := tfXBGR4;
3621   fWithAlpha        := tfABGR4;
3622   fWithoutAlpha     := tfXBGR4;
3623   fOpenGLFormat     := tfXBGR4;
3624   fRGBInverted      := tfXRGB4;
3625   fRange.r          := $0F;
3626   fRange.g          := $0F;
3627   fRange.b          := $0F;
3628   fRange.a          := $0F;
3629   fShift.r          := 0;
3630   fShift.g          := 4;
3631   fShift.b          := 8;
3632   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3633   fglInternalFormat := GL_RGB4;
3634   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3635 end;
3636
3637 constructor TfdB5G6R5.Create;
3638 begin
3639   inherited Create;
3640   fPixelSize        := 2.0;
3641   fFormat           := tfB5G6R5;
3642   fWithAlpha        := tfBGR5A1;
3643   fWithoutAlpha     := tfB5G6R5;
3644   fOpenGLFormat     := tfB5G6R5;
3645   fRGBInverted      := tfR5G6B5;
3646   fRange.r          := $1F;
3647   fRange.g          := $3F;
3648   fRange.b          := $1F;
3649   fShift.r          :=  0;
3650   fShift.g          :=  5;
3651   fShift.b          := 11;
3652   fglFormat         := GL_RGB;
3653   fglInternalFormat := GL_RGB565;
3654   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3655 end;
3656
3657 constructor TfdBGR5X1.Create;
3658 begin
3659   inherited Create;
3660   fPixelSize        := 2.0;
3661   fFormat           := tfBGR5X1;
3662   fWithAlpha        := tfBGR5A1;
3663   fWithoutAlpha     := tfBGR5X1;
3664   fOpenGLFormat     := tfBGR5X1;
3665   fRGBInverted      := tfRGB5X1;
3666   fRange.r          := $1F;
3667   fRange.g          := $1F;
3668   fRange.b          := $1F;
3669   fShift.r          :=  1;
3670   fShift.g          :=  6;
3671   fShift.b          := 11;
3672   fglFormat         := GL_BGRA;
3673   fglInternalFormat := GL_RGB5;
3674   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3675 end;
3676
3677 constructor TfdX1BGR5.Create;
3678 begin
3679   inherited Create;
3680   fPixelSize        := 2.0;
3681   fFormat           := tfX1BGR5;
3682   fWithAlpha        := tfA1BGR5;
3683   fWithoutAlpha     := tfX1BGR5;
3684   fOpenGLFormat     := tfX1BGR5;
3685   fRGBInverted      := tfX1RGB5;
3686   fRange.r          := $1F;
3687   fRange.g          := $1F;
3688   fRange.b          := $1F;
3689   fShift.r          :=  0;
3690   fShift.g          :=  5;
3691   fShift.b          := 10;
3692   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3693   fglInternalFormat := GL_RGB5;
3694   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3695 end;
3696
3697 constructor TfdBGR8.Create;
3698 begin
3699   inherited Create;
3700   fPixelSize        := 3.0;
3701   fFormat           := tfBGR8;
3702   fWithAlpha        := tfBGRA8;
3703   fWithoutAlpha     := tfBGR8;
3704   fOpenGLFormat     := tfBGR8;
3705   fRGBInverted      := tfRGB8;
3706   fRange.r          := $FF;
3707   fRange.g          := $FF;
3708   fRange.b          := $FF;
3709   fShift.r          :=  0;
3710   fShift.g          :=  8;
3711   fShift.b          := 16;
3712   fglFormat         := GL_RGB;      // reverse byte order to match little endianess
3713   fglInternalFormat := GL_RGB8;     // as if u interpret the 3 bytes as unsigned integer
3714   fglDataFormat     := GL_UNSIGNED_BYTE;
3715 end;
3716
3717 constructor TfdBGRX8.Create;
3718 begin
3719   inherited Create;
3720   fPixelSize        := 4.0;
3721   fFormat           := tfBGRX8;
3722   fWithAlpha        := tfBGRA8;
3723   fWithoutAlpha     := tfBGRX8;
3724   fOpenGLFormat     := tfBGRX8;
3725   fRGBInverted      := tfRGBX8;
3726   fRange.r          := $FF;
3727   fRange.g          := $FF;
3728   fRange.b          := $FF;
3729   fShift.r          :=  8;
3730   fShift.g          := 16;
3731   fShift.b          := 24;
3732   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3733   fglInternalFormat := GL_RGB8;
3734   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3735 end;
3736
3737 constructor TfdXBGR8.Create;
3738 begin
3739   inherited Create;
3740   fPixelSize        := 4.0;
3741   fFormat           := tfXBGR8;
3742   fWithAlpha        := tfABGR8;
3743   fWithoutAlpha     := tfXBGR8;
3744   fOpenGLFormat     := tfXBGR8;
3745   fRGBInverted      := tfXRGB8;
3746   fRange.r          := $FF;
3747   fRange.g          := $FF;
3748   fRange.b          := $FF;
3749   fShift.r          :=  0;
3750   fShift.g          :=  8;
3751   fShift.b          := 16;
3752   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3753   fglInternalFormat := GL_RGB8;
3754   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3755 end;
3756
3757 constructor TfdBGR10X2.Create;
3758 begin
3759   inherited Create;
3760   fPixelSize        := 3.0;
3761   fFormat           := tfBGR10X2;
3762   fWithAlpha        := tfBGR10A2;
3763   fWithoutAlpha     := tfBGR10X2;
3764   fOpenGLFormat     := tfBGR10X2;
3765   fRGBInverted      := tfRGB10X2;
3766   fRange.r          := $03FF;
3767   fRange.g          := $03FF;
3768   fRange.b          := $03FF;
3769   fShift.r          :=  2;
3770   fShift.g          := 12;
3771   fShift.b          := 22;
3772   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3773   fglInternalFormat := GL_RGB10;
3774   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3775 end;
3776
3777 constructor TfdX2BGR10.Create;
3778 begin
3779   inherited Create;
3780   fPixelSize        := 3.0;
3781   fFormat           := tfX2BGR10;
3782   fWithAlpha        := tfA2BGR10;
3783   fWithoutAlpha     := tfX2BGR10;
3784   fOpenGLFormat     := tfX2BGR10;
3785   fRGBInverted      := tfX2RGB10;
3786   fRange.r          := $03FF;
3787   fRange.g          := $03FF;
3788   fRange.b          := $03FF;
3789   fShift.r          :=  0;
3790   fShift.g          := 10;
3791   fShift.b          := 20;
3792   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3793   fglInternalFormat := GL_RGB10;
3794   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3795 end;
3796
3797 constructor TfdBGR16.Create;
3798 begin
3799   inherited Create;
3800   fPixelSize        := 6.0;
3801   fFormat           := tfBGR16;
3802   fWithAlpha        := tfBGRA16;
3803   fWithoutAlpha     := tfBGR16;
3804   fOpenGLFormat     := tfBGR16;
3805   fRGBInverted      := tfRGB16;
3806   fRange.r          := $FFFF;
3807   fRange.g          := $FFFF;
3808   fRange.b          := $FFFF;
3809   fShift.r          :=  0;
3810   fShift.g          := 16;
3811   fShift.b          := 32;
3812   fglFormat         := GL_RGB;      // reverse byte order to match little endianess
3813   fglInternalFormat := GL_RGB16;    // as if u interpret the 3 bytes as unsigned integer
3814   fglDataFormat     := GL_UNSIGNED_SHORT;
3815 end;
3816
3817 constructor TfdBGRA4.Create;
3818 begin
3819   inherited Create;
3820   fPixelSize        := 2.0;
3821   fFormat           := tfBGRA4;
3822   fWithAlpha        := tfBGRA4;
3823   fWithoutAlpha     := tfBGRX4;
3824   fOpenGLFormat     := tfBGRA4;
3825   fRGBInverted      := tfRGBA4;
3826   fRange.r          := $0F;
3827   fRange.g          := $0F;
3828   fRange.b          := $0F;
3829   fRange.a          := $0F;
3830   fShift.r          :=  4;
3831   fShift.g          :=  8;
3832   fShift.b          := 12;
3833   fShift.a          :=  0;
3834   fglFormat         := GL_BGRA;
3835   fglInternalFormat := GL_RGBA4;
3836   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3837 end;
3838
3839 constructor TfdABGR4.Create;
3840 begin
3841   inherited Create;
3842   fPixelSize        := 2.0;
3843   fFormat           := tfABGR4;
3844   fWithAlpha        := tfABGR4;
3845   fWithoutAlpha     := tfXBGR4;
3846   fOpenGLFormat     := tfABGR4;
3847   fRGBInverted      := tfARGB4;
3848   fRange.r          := $0F;
3849   fRange.g          := $0F;
3850   fRange.b          := $0F;
3851   fRange.a          := $0F;
3852   fShift.r          :=  0;
3853   fShift.g          :=  4;
3854   fShift.b          :=  8;
3855   fShift.a          := 12;
3856   fglFormat         := GL_RGBA;
3857   fglInternalFormat := GL_RGBA4;
3858   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3859 end;
3860
3861 constructor TfdBGR5A1.Create;
3862 begin
3863   inherited Create;
3864   fPixelSize        := 2.0;
3865   fFormat           := tfBGR5A1;
3866   fWithAlpha        := tfBGR5A1;
3867   fWithoutAlpha     := tfBGR5X1;
3868   fOpenGLFormat     := tfBGR5A1;
3869   fRGBInverted      := tfRGB5A1;
3870   fRange.r          := $1F;
3871   fRange.g          := $1F;
3872   fRange.b          := $1F;
3873   fRange.a          := $01;
3874   fShift.r          :=  1;
3875   fShift.g          :=  6;
3876   fShift.b          := 11;
3877   fShift.a          :=  0;
3878   fglFormat         := GL_BGRA;
3879   fglInternalFormat := GL_RGB5_A1;
3880   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3881 end;
3882
3883 constructor TfdA1BGR5.Create;
3884 begin
3885   inherited Create;
3886   fPixelSize        := 2.0;
3887   fFormat           := tfA1BGR5;
3888   fWithAlpha        := tfA1BGR5;
3889   fWithoutAlpha     := tfX1BGR5;
3890   fOpenGLFormat     := tfA1BGR5;
3891   fRGBInverted      := tfA1RGB5;
3892   fRange.r          := $1F;
3893   fRange.g          := $1F;
3894   fRange.b          := $1F;
3895   fRange.a          := $01;
3896   fShift.r          :=  0;
3897   fShift.g          :=  5;
3898   fShift.b          := 10;
3899   fShift.a          := 15;
3900   fglFormat         := GL_RGBA;
3901   fglInternalFormat := GL_RGB5_A1;
3902   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3903 end;
3904
3905 constructor TfdBGRA8.Create;
3906 begin
3907   inherited Create;
3908   fPixelSize        := 4.0;
3909   fFormat           := tfBGRA8;
3910   fWithAlpha        := tfBGRA8;
3911   fWithoutAlpha     := tfBGR8;
3912   fOpenGLFormat     := tfBGRA8;
3913   fRGBInverted      := tfRGBA8;
3914   fRange.r          := $FF;
3915   fRange.g          := $FF;
3916   fRange.b          := $FF;
3917   fRange.a          := $FF;
3918   fShift.r          :=  8;
3919   fShift.g          := 16;
3920   fShift.b          := 24;
3921   fShift.a          :=  0;
3922   fglFormat         := GL_BGRA;
3923   fglInternalFormat := GL_RGBA8;
3924   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3925 end;
3926
3927 constructor TfdABGR8.Create;
3928 begin
3929   inherited Create;
3930   fPixelSize        := 4.0;
3931   fFormat           := tfABGR8;
3932   fWithAlpha        := tfABGR8;
3933   fWithoutAlpha     := tfBGR8;
3934   fOpenGLFormat     := tfABGR8;
3935   fRGBInverted      := tfARGB8;
3936   fRange.r          := $FF;
3937   fRange.g          := $FF;
3938   fRange.b          := $FF;
3939   fRange.a          := $FF;
3940   fShift.r          :=  0;
3941   fShift.g          :=  8;
3942   fShift.b          := 16;
3943   fShift.a          := 24;
3944   fglFormat         := GL_RGBA;
3945   fglInternalFormat := GL_RGBA8;
3946   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3947 end;
3948
3949 constructor TfdBGR10A2.Create;
3950 begin
3951   inherited Create;
3952   fPixelSize        := 3.0;
3953   fFormat           := tfBGR10A2;
3954   fWithAlpha        := tfBGR10A2;
3955   fWithoutAlpha     := tfBGR10X2;
3956   fOpenGLFormat     := tfBGR10A2;
3957   fRGBInverted      := tfRGB10A2;
3958   fRange.r          := $03FF;
3959   fRange.g          := $03FF;
3960   fRange.b          := $03FF;
3961   fRange.a          := $0003;
3962   fShift.r          :=  2;
3963   fShift.g          := 12;
3964   fShift.b          := 22;
3965   fShift.a          :=  0;
3966   fglFormat         := GL_BGRA;
3967   fglInternalFormat := GL_RGB10_A2;
3968   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3969 end;
3970
3971 constructor TfdA2BGR10.Create;
3972 begin
3973   inherited Create;
3974   fPixelSize        := 3.0;
3975   fFormat           := tfA2BGR10;
3976   fWithAlpha        := tfA2BGR10;
3977   fWithoutAlpha     := tfX2BGR10;
3978   fOpenGLFormat     := tfA2BGR10;
3979   fRGBInverted      := tfA2RGB10;
3980   fRange.r          := $03FF;
3981   fRange.g          := $03FF;
3982   fRange.b          := $03FF;
3983   fRange.a          := $0003;
3984   fShift.r          :=  0;
3985   fShift.g          := 10;
3986   fShift.b          := 20;
3987   fShift.a          := 30;
3988   fglFormat         := GL_RGBA;
3989   fglInternalFormat := GL_RGB10_A2;
3990   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3991 end;
3992
3993 constructor TfdBGRA16.Create;
3994 begin
3995   inherited Create;
3996   fPixelSize        := 8.0;
3997   fFormat           := tfBGRA16;
3998   fWithAlpha        := tfBGRA16;
3999   fWithoutAlpha     := tfBGR16;
4000   fOpenGLFormat     := tfBGRA16;
4001   fRGBInverted      := tfRGBA16;
4002   fRange.r          := $FFFF;
4003   fRange.g          := $FFFF;
4004   fRange.b          := $FFFF;
4005   fRange.a          := $FFFF;
4006   fShift.r          := 16;
4007   fShift.g          := 32;
4008   fShift.b          := 48;
4009   fShift.a          :=  0;
4010   fglFormat         := GL_RGBA;      // reverse byte order to match little endianess
4011   fglInternalFormat := GL_RGBA16;    // as if u interpret the 3 bytes as unsigned integer
4012   fglDataFormat     := GL_UNSIGNED_SHORT;
4013 end;
4014
4015 constructor TfdDepth16.Create;
4016 begin
4017   inherited Create;
4018   fPixelSize        := 2.0;
4019   fFormat           := tfDepth16;
4020   fWithoutAlpha     := tfDepth16;
4021   fOpenGLFormat     := tfDepth16;
4022   fRange.r          := $FFFF;
4023   fRange.g          := $FFFF;
4024   fRange.b          := $FFFF;
4025   fRange.a          := $FFFF;
4026   fglFormat         := GL_DEPTH_COMPONENT;
4027   fglInternalFormat := GL_DEPTH_COMPONENT16;
4028   fglDataFormat     := GL_UNSIGNED_SHORT;
4029 end;
4030
4031 constructor TfdDepth24.Create;
4032 begin
4033   inherited Create;
4034   fPixelSize        := 3.0;
4035   fFormat           := tfDepth24;
4036   fWithoutAlpha     := tfDepth24;
4037   fOpenGLFormat     := tfDepth24;
4038   fRange.r          := $FFFFFF;
4039   fRange.g          := $FFFFFF;
4040   fRange.b          := $FFFFFF;
4041   fRange.a          := $FFFFFF;
4042   fglFormat         := GL_DEPTH_COMPONENT;
4043   fglInternalFormat := GL_DEPTH_COMPONENT24;
4044   fglDataFormat     := GL_UNSIGNED_INT;
4045 end;
4046
4047 constructor TfdDepth32.Create;
4048 begin
4049   inherited Create;
4050   fPixelSize        := 4.0;
4051   fFormat           := tfDepth32;
4052   fWithoutAlpha     := tfDepth32;
4053   fOpenGLFormat     := tfDepth32;
4054   fRange.r          := $FFFFFFFF;
4055   fRange.g          := $FFFFFFFF;
4056   fRange.b          := $FFFFFFFF;
4057   fRange.a          := $FFFFFFFF;
4058   fglFormat         := GL_DEPTH_COMPONENT;
4059   fglInternalFormat := GL_DEPTH_COMPONENT32;
4060   fglDataFormat     := GL_UNSIGNED_INT;
4061 end;
4062
4063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4064 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4066 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4067 begin
4068   raise EglBitmap.Create('mapping for compressed formats is not supported');
4069 end;
4070
4071 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4072 begin
4073   raise EglBitmap.Create('mapping for compressed formats is not supported');
4074 end;
4075
4076 constructor TfdS3tcDtx1RGBA.Create;
4077 begin
4078   inherited Create;
4079   fFormat           := tfS3tcDtx1RGBA;
4080   fWithAlpha        := tfS3tcDtx1RGBA;
4081   fOpenGLFormat     := tfS3tcDtx1RGBA;
4082   fUncompressed     := tfRGB5A1;
4083   fPixelSize        := 0.5;
4084   fIsCompressed     := true;
4085   fglFormat         := GL_COMPRESSED_RGBA;
4086   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4087   fglDataFormat     := GL_UNSIGNED_BYTE;
4088 end;
4089
4090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4091 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4094 begin
4095   raise EglBitmap.Create('mapping for compressed formats is not supported');
4096 end;
4097
4098 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4099 begin
4100   raise EglBitmap.Create('mapping for compressed formats is not supported');
4101 end;
4102
4103 constructor TfdS3tcDtx3RGBA.Create;
4104 begin
4105   inherited Create;
4106   fFormat           := tfS3tcDtx3RGBA;
4107   fWithAlpha        := tfS3tcDtx3RGBA;
4108   fOpenGLFormat     := tfS3tcDtx3RGBA;
4109   fUncompressed     := tfRGBA8;
4110   fPixelSize        := 1.0;
4111   fIsCompressed     := true;
4112   fglFormat         := GL_COMPRESSED_RGBA;
4113   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4114   fglDataFormat     := GL_UNSIGNED_BYTE;
4115 end;
4116
4117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4121 begin
4122   raise EglBitmap.Create('mapping for compressed formats is not supported');
4123 end;
4124
4125 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4126 begin
4127   raise EglBitmap.Create('mapping for compressed formats is not supported');
4128 end;
4129
4130 constructor TfdS3tcDtx5RGBA.Create;
4131 begin
4132   inherited Create;
4133   fFormat           := tfS3tcDtx3RGBA;
4134   fWithAlpha        := tfS3tcDtx3RGBA;
4135   fOpenGLFormat     := tfS3tcDtx3RGBA;
4136   fUncompressed     := tfRGBA8;
4137   fPixelSize        := 1.0;
4138   fIsCompressed     := true;
4139   fglFormat         := GL_COMPRESSED_RGBA;
4140   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4141   fglDataFormat     := GL_UNSIGNED_BYTE;
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4148 var
4149   f: TglBitmapFormat;
4150 begin
4151   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4152     result := TFormatDescriptor.Get(f);
4153     if (result.glInternalFormat = aInternalFormat) then
4154       exit;
4155   end;
4156   result := TFormatDescriptor.Get(tfEmpty);
4157 end;
4158
4159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4160 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4162 class procedure TFormatDescriptor.Init;
4163 begin
4164   if not Assigned(FormatDescriptorCS) then
4165     FormatDescriptorCS := TCriticalSection.Create;
4166 end;
4167
4168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4169 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4170 begin
4171   FormatDescriptorCS.Enter;
4172   try
4173     result := FormatDescriptors[aFormat];
4174     if not Assigned(result) then begin
4175       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4176       FormatDescriptors[aFormat] := result;
4177     end;
4178   finally
4179     FormatDescriptorCS.Leave;
4180   end;
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4185 begin
4186   result := Get(Get(aFormat).WithAlpha);
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 class procedure TFormatDescriptor.Clear;
4191 var
4192   f: TglBitmapFormat;
4193 begin
4194   FormatDescriptorCS.Enter;
4195   try
4196     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4197       FreeAndNil(FormatDescriptors[f]);
4198   finally
4199     FormatDescriptorCS.Leave;
4200   end;
4201 end;
4202
4203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4204 class procedure TFormatDescriptor.Finalize;
4205 begin
4206   Clear;
4207   FreeAndNil(FormatDescriptorCS);
4208 end;
4209
4210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4211 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4213 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
4214 begin
4215   Update(aValue, fRange.r, fShift.r);
4216 end;
4217
4218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4219 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
4220 begin
4221   Update(aValue, fRange.g, fShift.g);
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
4226 begin
4227   Update(aValue, fRange.b, fShift.b);
4228 end;
4229
4230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4231 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
4232 begin
4233   Update(aValue, fRange.a, fShift.a);
4234 end;
4235
4236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4237 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
4238   aShift: Byte);
4239 begin
4240   aShift := 0;
4241   aRange := 0;
4242   if (aMask = 0) then
4243     exit;
4244   while (aMask > 0) and ((aMask and 1) = 0) do begin
4245     inc(aShift);
4246     aMask := aMask shr 1;
4247   end;
4248   aRange := 1;
4249   while (aMask > 0) do begin
4250     aRange := aRange shl 1;
4251     aMask  := aMask  shr 1;
4252   end;
4253   dec(aRange);
4254
4255   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4260 var
4261   data: QWord;
4262   s: Integer;
4263 begin
4264   data :=
4265     ((aPixel.Data.r and fRange.r) shl fShift.r) or
4266     ((aPixel.Data.g and fRange.g) shl fShift.g) or
4267     ((aPixel.Data.b and fRange.b) shl fShift.b) or
4268     ((aPixel.Data.a and fRange.a) shl fShift.a);
4269   s := Round(fPixelSize);
4270   case s of
4271     1:           aData^  := data;
4272     2:     PWord(aData)^ := data;
4273     4: PCardinal(aData)^ := data;
4274     8:    PQWord(aData)^ := data;
4275   else
4276     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4277   end;
4278   inc(aData, s);
4279 end;
4280
4281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4282 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4283 var
4284   data: QWord;
4285   s, i: Integer;
4286 begin
4287   s := Round(fPixelSize);
4288   case s of
4289     1: data :=           aData^;
4290     2: data :=     PWord(aData)^;
4291     4: data := PCardinal(aData)^;
4292     8: data :=    PQWord(aData)^;
4293   else
4294     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
4295   end;
4296   for i := 0 to 3 do
4297     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
4298   inc(aData, s);
4299 end;
4300
4301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4302 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4304 procedure TbmpColorTableFormat.CreateColorTable;
4305 var
4306   i: Integer;
4307 begin
4308   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
4309     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
4310
4311   if (Format = tfLuminance4) then
4312     SetLength(fColorTable, 16)
4313   else
4314     SetLength(fColorTable, 256);
4315
4316   case Format of
4317     tfLuminance4: begin
4318       for i := 0 to High(fColorTable) do begin
4319         fColorTable[i].r := 16 * i;
4320         fColorTable[i].g := 16 * i;
4321         fColorTable[i].b := 16 * i;
4322         fColorTable[i].a := 0;
4323       end;
4324     end;
4325
4326     tfLuminance8: begin
4327       for i := 0 to High(fColorTable) do begin
4328         fColorTable[i].r := i;
4329         fColorTable[i].g := i;
4330         fColorTable[i].b := i;
4331         fColorTable[i].a := 0;
4332       end;
4333     end;
4334
4335     tfR3G3B2: begin
4336       for i := 0 to High(fColorTable) do begin
4337         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4338         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4339         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4340         fColorTable[i].a := 0;
4341       end;
4342     end;
4343   end;
4344 end;
4345
4346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4347 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4348 var
4349   d: Byte;
4350 begin
4351   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
4352     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
4353
4354   case Format of
4355     tfLuminance4: begin
4356       if (aMapData = nil) then
4357         aData^ := 0;
4358       d := LuminanceWeight(aPixel) and Range.r;
4359       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
4360       inc(PByte(aMapData), 4);
4361       if ({%H-}PtrUInt(aMapData) >= 8) then begin
4362         inc(aData);
4363         aMapData := nil;
4364       end;
4365     end;
4366
4367     tfLuminance8: begin
4368       aData^ := LuminanceWeight(aPixel) and Range.r;
4369       inc(aData);
4370     end;
4371
4372     tfR3G3B2: begin
4373       aData^ := Round(
4374         ((aPixel.Data.r and Range.r) shl Shift.r) or
4375         ((aPixel.Data.g and Range.g) shl Shift.g) or
4376         ((aPixel.Data.b and Range.b) shl Shift.b));
4377       inc(aData);
4378     end;
4379   end;
4380 end;
4381
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4384 var
4385   idx: QWord;
4386   s: Integer;
4387   bits: Byte;
4388   f: Single;
4389 begin
4390   s    := Trunc(fPixelSize);
4391   f    := fPixelSize - s;
4392   bits := Round(8 * f);
4393   case s of
4394     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
4395     1: idx :=           aData^;
4396     2: idx :=     PWord(aData)^;
4397     4: idx := PCardinal(aData)^;
4398     8: idx :=    PQWord(aData)^;
4399   else
4400     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
4401   end;
4402   if (idx >= Length(fColorTable)) then
4403     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
4404   with fColorTable[idx] do begin
4405     aPixel.Data.r := r;
4406     aPixel.Data.g := g;
4407     aPixel.Data.b := b;
4408     aPixel.Data.a := a;
4409   end;
4410   inc(PByte(aMapData), bits);
4411   if ({%H-}PtrUInt(aMapData) >= 8) then begin
4412     inc(aData, 1);
4413     dec(PByte(aMapData), 8);
4414   end;
4415   inc(aData, s);
4416 end;
4417
4418 destructor TbmpColorTableFormat.Destroy;
4419 begin
4420   SetLength(fColorTable, 0);
4421   inherited Destroy;
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4427 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4428 var
4429   i: Integer;
4430 begin
4431   for i := 0 to 3 do begin
4432     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4433       if (aSourceFD.Range.arr[i] > 0) then
4434         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4435       else
4436         aPixel.Data.arr[i] := 0;
4437     end;
4438   end;
4439 end;
4440
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4443 begin
4444   with aFuncRec do begin
4445     if (Source.Range.r   > 0) then
4446       Dest.Data.r := Source.Data.r;
4447     if (Source.Range.g > 0) then
4448       Dest.Data.g := Source.Data.g;
4449     if (Source.Range.b  > 0) then
4450       Dest.Data.b := Source.Data.b;
4451     if (Source.Range.a > 0) then
4452       Dest.Data.a := Source.Data.a;
4453   end;
4454 end;
4455
4456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4457 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4458 var
4459   i: Integer;
4460 begin
4461   with aFuncRec do begin
4462     for i := 0 to 3 do
4463       if (Source.Range.arr[i] > 0) then
4464         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4465   end;
4466 end;
4467
4468 type
4469   TShiftData = packed record
4470     case Integer of
4471       0: (r, g, b, a: SmallInt);
4472       1: (arr: array[0..3] of SmallInt);
4473   end;
4474   PShiftData = ^TShiftData;
4475
4476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4477 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4478 var
4479   i: Integer;
4480 begin
4481   with aFuncRec do
4482     for i := 0 to 3 do
4483       if (Source.Range.arr[i] > 0) then
4484         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4485 end;
4486
4487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4488 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4489 begin
4490   with aFuncRec do begin
4491     Dest.Data := Source.Data;
4492     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4493       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4494       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4495       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4496     end;
4497     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4498       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4499     end;
4500   end;
4501 end;
4502
4503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4504 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4505 var
4506   i: Integer;
4507 begin
4508   with aFuncRec do begin
4509     for i := 0 to 3 do
4510       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4511   end;
4512 end;
4513
4514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4515 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4516 var
4517   Temp: Single;
4518 begin
4519   with FuncRec do begin
4520     if (FuncRec.Args = nil) then begin //source has no alpha
4521       Temp :=
4522         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4523         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4524         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4525       Dest.Data.a := Round(Dest.Range.a * Temp);
4526     end else
4527       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4528   end;
4529 end;
4530
4531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4532 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4533 type
4534   PglBitmapPixelData = ^TglBitmapPixelData;
4535 begin
4536   with FuncRec do begin
4537     Dest.Data.r := Source.Data.r;
4538     Dest.Data.g := Source.Data.g;
4539     Dest.Data.b := Source.Data.b;
4540
4541     with PglBitmapPixelData(Args)^ do
4542       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4543           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4544           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4545         Dest.Data.a := 0
4546       else
4547         Dest.Data.a := Dest.Range.a;
4548   end;
4549 end;
4550
4551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4552 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4553 begin
4554   with FuncRec do begin
4555     Dest.Data.r := Source.Data.r;
4556     Dest.Data.g := Source.Data.g;
4557     Dest.Data.b := Source.Data.b;
4558     Dest.Data.a := PCardinal(Args)^;
4559   end;
4560 end;
4561
4562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4563 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4564 type
4565   PRGBPix = ^TRGBPix;
4566   TRGBPix = array [0..2] of byte;
4567 var
4568   Temp: Byte;
4569 begin
4570   while aWidth > 0 do begin
4571     Temp := PRGBPix(aData)^[0];
4572     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4573     PRGBPix(aData)^[2] := Temp;
4574
4575     if aHasAlpha then
4576       Inc(aData, 4)
4577     else
4578       Inc(aData, 3);
4579     dec(aWidth);
4580   end;
4581 end;
4582
4583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4584 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4586 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4587 begin
4588   result := TFormatDescriptor.Get(Format);
4589 end;
4590
4591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4592 function TglBitmap.GetWidth: Integer;
4593 begin
4594   if (ffX in fDimension.Fields) then
4595     result := fDimension.X
4596   else
4597     result := -1;
4598 end;
4599
4600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4601 function TglBitmap.GetHeight: Integer;
4602 begin
4603   if (ffY in fDimension.Fields) then
4604     result := fDimension.Y
4605   else
4606     result := -1;
4607 end;
4608
4609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4610 function TglBitmap.GetFileWidth: Integer;
4611 begin
4612   result := Max(1, Width);
4613 end;
4614
4615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4616 function TglBitmap.GetFileHeight: Integer;
4617 begin
4618   result := Max(1, Height);
4619 end;
4620
4621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4622 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4623 begin
4624   if fCustomData = aValue then
4625     exit;
4626   fCustomData := aValue;
4627 end;
4628
4629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4630 procedure TglBitmap.SetCustomName(const aValue: String);
4631 begin
4632   if fCustomName = aValue then
4633     exit;
4634   fCustomName := aValue;
4635 end;
4636
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4639 begin
4640   if fCustomNameW = aValue then
4641     exit;
4642   fCustomNameW := aValue;
4643 end;
4644
4645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4646 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4647 begin
4648   if fFreeDataOnDestroy = aValue then
4649     exit;
4650   fFreeDataOnDestroy := aValue;
4651 end;
4652
4653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4654 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4655 begin
4656   if fDeleteTextureOnFree = aValue then
4657     exit;
4658   fDeleteTextureOnFree := aValue;
4659 end;
4660
4661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4662 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4663 begin
4664   if fFormat = aValue then
4665     exit;
4666   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4667     raise EglBitmapUnsupportedFormat.Create(Format);
4668   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4669 end;
4670
4671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4672 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4673 begin
4674   if fFreeDataAfterGenTexture = aValue then
4675     exit;
4676   fFreeDataAfterGenTexture := aValue;
4677 end;
4678
4679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4680 procedure TglBitmap.SetID(const aValue: Cardinal);
4681 begin
4682   if fID = aValue then
4683     exit;
4684   fID := aValue;
4685 end;
4686
4687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4688 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4689 begin
4690   if fMipMap = aValue then
4691     exit;
4692   fMipMap := aValue;
4693 end;
4694
4695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4696 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4697 begin
4698   if fTarget = aValue then
4699     exit;
4700   fTarget := aValue;
4701 end;
4702
4703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4704 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4705 var
4706   MaxAnisotropic: Integer;
4707 begin
4708   fAnisotropic := aValue;
4709   if (ID > 0) then begin
4710     if GL_EXT_texture_filter_anisotropic then begin
4711       if fAnisotropic > 0 then begin
4712         Bind(false);
4713         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4714         if aValue > MaxAnisotropic then
4715           fAnisotropic := MaxAnisotropic;
4716         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4717       end;
4718     end else begin
4719       fAnisotropic := 0;
4720     end;
4721   end;
4722 end;
4723
4724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4725 procedure TglBitmap.CreateID;
4726 begin
4727   if (ID <> 0) then
4728     glDeleteTextures(1, @fID);
4729   glGenTextures(1, @fID);
4730   Bind(false);
4731 end;
4732
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4735 begin
4736   // Set Up Parameters
4737   SetWrap(fWrapS, fWrapT, fWrapR);
4738   SetFilter(fFilterMin, fFilterMag);
4739   SetAnisotropic(fAnisotropic);
4740   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4741
4742   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4743     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4744
4745   // Mip Maps Generation Mode
4746   aBuildWithGlu := false;
4747   if (MipMap = mmMipmap) then begin
4748     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4749       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4750     else
4751       aBuildWithGlu := true;
4752   end else if (MipMap = mmMipmapGlu) then
4753     aBuildWithGlu := true;
4754 end;
4755
4756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4757 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4758   const aWidth: Integer; const aHeight: Integer);
4759 var
4760   s: Single;
4761 begin
4762   if (Data <> aData) then begin
4763     if (Assigned(Data)) then
4764       FreeMem(Data);
4765     fData := aData;
4766   end;
4767
4768   if not Assigned(fData) then begin
4769     fPixelSize := 0;
4770     fRowSize   := 0;
4771   end else begin
4772     FillChar(fDimension, SizeOf(fDimension), 0);
4773     if aWidth <> -1 then begin
4774       fDimension.Fields := fDimension.Fields + [ffX];
4775       fDimension.X := aWidth;
4776     end;
4777
4778     if aHeight <> -1 then begin
4779       fDimension.Fields := fDimension.Fields + [ffY];
4780       fDimension.Y := aHeight;
4781     end;
4782
4783     s := TFormatDescriptor.Get(aFormat).PixelSize;
4784     fFormat    := aFormat;
4785     fPixelSize := Ceil(s);
4786     fRowSize   := Ceil(s * aWidth);
4787   end;
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.FlipHorz: Boolean;
4792 begin
4793   result := false;
4794 end;
4795
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 function TglBitmap.FlipVert: Boolean;
4798 begin
4799   result := false;
4800 end;
4801
4802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4803 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4805 procedure TglBitmap.AfterConstruction;
4806 begin
4807   inherited AfterConstruction;
4808
4809   fID         := 0;
4810   fTarget     := 0;
4811   fIsResident := false;
4812
4813   fMipMap                  := glBitmapDefaultMipmap;
4814   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4815   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4816
4817   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4818   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4819   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4820 end;
4821
4822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4823 procedure TglBitmap.BeforeDestruction;
4824 var
4825   NewData: PByte;
4826 begin
4827   if fFreeDataOnDestroy then begin
4828     NewData := nil;
4829     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4830   end;
4831   if (fID > 0) and fDeleteTextureOnFree then
4832     glDeleteTextures(1, @fID);
4833   inherited BeforeDestruction;
4834 end;
4835
4836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4837 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4838 var
4839   TempPos: Integer;
4840 begin
4841   if not Assigned(aResType) then begin
4842     TempPos   := Pos('.', aResource);
4843     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4844     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4845   end;
4846 end;
4847
4848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4849 procedure TglBitmap.LoadFromFile(const aFilename: String);
4850 var
4851   fs: TFileStream;
4852 begin
4853   if not FileExists(aFilename) then
4854     raise EglBitmap.Create('file does not exist: ' + aFilename);
4855   fFilename := aFilename;
4856   fs := TFileStream.Create(fFilename, fmOpenRead);
4857   try
4858     fs.Position := 0;
4859     LoadFromStream(fs);
4860   finally
4861     fs.Free;
4862   end;
4863 end;
4864
4865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4866 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4867 begin
4868   {$IFDEF GLB_SUPPORT_PNG_READ}
4869   if not LoadPNG(aStream) then
4870   {$ENDIF}
4871   {$IFDEF GLB_SUPPORT_JPEG_READ}
4872   if not LoadJPEG(aStream) then
4873   {$ENDIF}
4874   if not LoadDDS(aStream) then
4875   if not LoadTGA(aStream) then
4876   if not LoadBMP(aStream) then
4877     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4878 end;
4879
4880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4881 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4882   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4883 var
4884   tmpData: PByte;
4885   size: Integer;
4886 begin
4887   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4888   GetMem(tmpData, size);
4889   try
4890     FillChar(tmpData^, size, #$FF);
4891     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4892   except
4893     if Assigned(tmpData) then
4894       FreeMem(tmpData);
4895     raise;
4896   end;
4897   AddFunc(Self, aFunc, false, aFormat, aArgs);
4898 end;
4899
4900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4901 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4902 var
4903   rs: TResourceStream;
4904 begin
4905   PrepareResType(aResource, aResType);
4906   rs := TResourceStream.Create(aInstance, aResource, aResType);
4907   try
4908     LoadFromStream(rs);
4909   finally
4910     rs.Free;
4911   end;
4912 end;
4913
4914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4915 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4916 var
4917   rs: TResourceStream;
4918 begin
4919   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4920   try
4921     LoadFromStream(rs);
4922   finally
4923     rs.Free;
4924   end;
4925 end;
4926
4927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4928 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4929 var
4930   fs: TFileStream;
4931 begin
4932   fs := TFileStream.Create(aFileName, fmCreate);
4933   try
4934     fs.Position := 0;
4935     SaveToStream(fs, aFileType);
4936   finally
4937     fs.Free;
4938   end;
4939 end;
4940
4941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4942 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4943 begin
4944   case aFileType of
4945     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4946     ftPNG:  SavePNG(aStream);
4947     {$ENDIF}
4948     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4949     ftJPEG: SaveJPEG(aStream);
4950     {$ENDIF}
4951     ftDDS:  SaveDDS(aStream);
4952     ftTGA:  SaveTGA(aStream);
4953     ftBMP:  SaveBMP(aStream);
4954   end;
4955 end;
4956
4957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4958 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4959 begin
4960   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4961 end;
4962
4963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4964 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4965   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4966 var
4967   DestData, TmpData, SourceData: pByte;
4968   TempHeight, TempWidth: Integer;
4969   SourceFD, DestFD: TFormatDescriptor;
4970   SourceMD, DestMD: Pointer;
4971
4972   FuncRec: TglBitmapFunctionRec;
4973 begin
4974   Assert(Assigned(Data));
4975   Assert(Assigned(aSource));
4976   Assert(Assigned(aSource.Data));
4977
4978   result := false;
4979   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4980     SourceFD := TFormatDescriptor.Get(aSource.Format);
4981     DestFD   := TFormatDescriptor.Get(aFormat);
4982
4983     if (SourceFD.IsCompressed) then
4984       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4985     if (DestFD.IsCompressed) then
4986       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4987
4988     // inkompatible Formats so CreateTemp
4989     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4990       aCreateTemp := true;
4991
4992     // Values
4993     TempHeight := Max(1, aSource.Height);
4994     TempWidth  := Max(1, aSource.Width);
4995
4996     FuncRec.Sender := Self;
4997     FuncRec.Args   := aArgs;
4998
4999     TmpData := nil;
5000     if aCreateTemp then begin
5001       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5002       DestData := TmpData;
5003     end else
5004       DestData := Data;
5005
5006     try
5007       SourceFD.PreparePixel(FuncRec.Source);
5008       DestFD.PreparePixel  (FuncRec.Dest);
5009
5010       SourceMD := SourceFD.CreateMappingData;
5011       DestMD   := DestFD.CreateMappingData;
5012
5013       FuncRec.Size            := aSource.Dimension;
5014       FuncRec.Position.Fields := FuncRec.Size.Fields;
5015
5016       try
5017         SourceData := aSource.Data;
5018         FuncRec.Position.Y := 0;
5019         while FuncRec.Position.Y < TempHeight do begin
5020           FuncRec.Position.X := 0;
5021           while FuncRec.Position.X < TempWidth do begin
5022             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5023             aFunc(FuncRec);
5024             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5025             inc(FuncRec.Position.X);
5026           end;
5027           inc(FuncRec.Position.Y);
5028         end;
5029
5030         // Updating Image or InternalFormat
5031         if aCreateTemp then
5032           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5033         else if (aFormat <> fFormat) then
5034           Format := aFormat;
5035
5036         result := true;
5037       finally
5038         SourceFD.FreeMappingData(SourceMD);
5039         DestFD.FreeMappingData(DestMD);
5040       end;
5041     except
5042       if aCreateTemp and Assigned(TmpData) then
5043         FreeMem(TmpData);
5044       raise;
5045     end;
5046   end;
5047 end;
5048
5049 {$IFDEF GLB_SDL}
5050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5051 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5052 var
5053   Row, RowSize: Integer;
5054   SourceData, TmpData: PByte;
5055   TempDepth: Integer;
5056   FormatDesc: TFormatDescriptor;
5057
5058   function GetRowPointer(Row: Integer): pByte;
5059   begin
5060     result := aSurface.pixels;
5061     Inc(result, Row * RowSize);
5062   end;
5063
5064 begin
5065   result := false;
5066
5067   FormatDesc := TFormatDescriptor.Get(Format);
5068   if FormatDesc.IsCompressed then
5069     raise EglBitmapUnsupportedFormat.Create(Format);
5070
5071   if Assigned(Data) then begin
5072     case Trunc(FormatDesc.PixelSize) of
5073       1: TempDepth :=  8;
5074       2: TempDepth := 16;
5075       3: TempDepth := 24;
5076       4: TempDepth := 32;
5077     else
5078       raise EglBitmapUnsupportedFormat.Create(Format);
5079     end;
5080
5081     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5082       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5083     SourceData := Data;
5084     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5085
5086     for Row := 0 to FileHeight-1 do begin
5087       TmpData := GetRowPointer(Row);
5088       if Assigned(TmpData) then begin
5089         Move(SourceData^, TmpData^, RowSize);
5090         inc(SourceData, RowSize);
5091       end;
5092     end;
5093     result := true;
5094   end;
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5099 var
5100   pSource, pData, pTempData: PByte;
5101   Row, RowSize, TempWidth, TempHeight: Integer;
5102   IntFormat: TglBitmapFormat;
5103   FormatDesc: TFormatDescriptor;
5104
5105   function GetRowPointer(Row: Integer): pByte;
5106   begin
5107     result := aSurface^.pixels;
5108     Inc(result, Row * RowSize);
5109   end;
5110
5111 begin
5112   result := false;
5113   if (Assigned(aSurface)) then begin
5114     with aSurface^.format^ do begin
5115       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
5116         FormatDesc := TFormatDescriptor.Get(IntFormat);
5117         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
5118           break;
5119       end;
5120       if (IntFormat = tfEmpty) then
5121         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
5122     end;
5123
5124     TempWidth  := aSurface^.w;
5125     TempHeight := aSurface^.h;
5126     RowSize := FormatDesc.GetSize(TempWidth, 1);
5127     GetMem(pData, TempHeight * RowSize);
5128     try
5129       pTempData := pData;
5130       for Row := 0 to TempHeight -1 do begin
5131         pSource := GetRowPointer(Row);
5132         if (Assigned(pSource)) then begin
5133           Move(pSource^, pTempData^, RowSize);
5134           Inc(pTempData, RowSize);
5135         end;
5136       end;
5137       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5138       result := true;
5139     except
5140       if Assigned(pData) then
5141         FreeMem(pData);
5142       raise;
5143     end;
5144   end;
5145 end;
5146
5147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5148 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5149 var
5150   Row, Col, AlphaInterleave: Integer;
5151   pSource, pDest: PByte;
5152
5153   function GetRowPointer(Row: Integer): pByte;
5154   begin
5155     result := aSurface.pixels;
5156     Inc(result, Row * Width);
5157   end;
5158
5159 begin
5160   result := false;
5161   if Assigned(Data) then begin
5162     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
5163       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5164
5165       AlphaInterleave := 0;
5166       case Format of
5167         tfLuminance8Alpha8:
5168           AlphaInterleave := 1;
5169         tfBGRA8, tfRGBA8:
5170           AlphaInterleave := 3;
5171       end;
5172
5173       pSource := Data;
5174       for Row := 0 to Height -1 do begin
5175         pDest := GetRowPointer(Row);
5176         if Assigned(pDest) then begin
5177           for Col := 0 to Width -1 do begin
5178             Inc(pSource, AlphaInterleave);
5179             pDest^ := pSource^;
5180             Inc(pDest);
5181             Inc(pSource);
5182           end;
5183         end;
5184       end;
5185       result := true;
5186     end;
5187   end;
5188 end;
5189
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5192 var
5193   bmp: TglBitmap2D;
5194 begin
5195   bmp := TglBitmap2D.Create;
5196   try
5197     bmp.AssignFromSurface(aSurface);
5198     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5199   finally
5200     bmp.Free;
5201   end;
5202 end;
5203 {$ENDIF}
5204
5205 {$IFDEF GLB_DELPHI}
5206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5207 function CreateGrayPalette: HPALETTE;
5208 var
5209   Idx: Integer;
5210   Pal: PLogPalette;
5211 begin
5212   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5213
5214   Pal.palVersion := $300;
5215   Pal.palNumEntries := 256;
5216
5217   for Idx := 0 to Pal.palNumEntries - 1 do begin
5218     Pal.palPalEntry[Idx].peRed   := Idx;
5219     Pal.palPalEntry[Idx].peGreen := Idx;
5220     Pal.palPalEntry[Idx].peBlue  := Idx;
5221     Pal.palPalEntry[Idx].peFlags := 0;
5222   end;
5223   Result := CreatePalette(Pal^);
5224   FreeMem(Pal);
5225 end;
5226
5227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5228 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5229 var
5230   Row: Integer;
5231   pSource, pData: PByte;
5232 begin
5233   result := false;
5234   if Assigned(Data) then begin
5235     if Assigned(aBitmap) then begin
5236       aBitmap.Width  := Width;
5237       aBitmap.Height := Height;
5238
5239       case Format of
5240         tfAlpha8, tfLuminance8: begin
5241           aBitmap.PixelFormat := pf8bit;
5242           aBitmap.Palette     := CreateGrayPalette;
5243         end;
5244         tfRGB5A1:
5245           aBitmap.PixelFormat := pf15bit;
5246         tfR5G6B5:
5247           aBitmap.PixelFormat := pf16bit;
5248         tfRGB8, tfBGR8:
5249           aBitmap.PixelFormat := pf24bit;
5250         tfRGBA8, tfBGRA8:
5251           aBitmap.PixelFormat := pf32bit;
5252       else
5253         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5254       end;
5255
5256       pSource := Data;
5257       for Row := 0 to FileHeight -1 do begin
5258         pData := aBitmap.Scanline[Row];
5259         Move(pSource^, pData^, fRowSize);
5260         Inc(pSource, fRowSize);
5261         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
5262           SwapRGB(pData, FileWidth, Format = tfRGBA8);
5263       end;
5264       result := true;
5265     end;
5266   end;
5267 end;
5268
5269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5270 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5271 var
5272   pSource, pData, pTempData: PByte;
5273   Row, RowSize, TempWidth, TempHeight: Integer;
5274   IntFormat: TglBitmapFormat;
5275 begin
5276   result := false;
5277
5278   if (Assigned(aBitmap)) then begin
5279     case aBitmap.PixelFormat of
5280       pf8bit:
5281         IntFormat := tfLuminance8;
5282       pf15bit:
5283         IntFormat := tfRGB5A1;
5284       pf16bit:
5285         IntFormat := tfR5G6B5;
5286       pf24bit:
5287         IntFormat := tfBGR8;
5288       pf32bit:
5289         IntFormat := tfBGRA8;
5290     else
5291       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5292     end;
5293
5294     TempWidth  := aBitmap.Width;
5295     TempHeight := aBitmap.Height;
5296     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5297     GetMem(pData, TempHeight * RowSize);
5298     try
5299       pTempData := pData;
5300       for Row := 0 to TempHeight -1 do begin
5301         pSource := aBitmap.Scanline[Row];
5302         if (Assigned(pSource)) then begin
5303           Move(pSource^, pTempData^, RowSize);
5304           Inc(pTempData, RowSize);
5305         end;
5306       end;
5307       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5308       result := true;
5309     except
5310       if Assigned(pData) then
5311         FreeMem(pData);
5312       raise;
5313     end;
5314   end;
5315 end;
5316
5317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5318 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5319 var
5320   Row, Col, AlphaInterleave: Integer;
5321   pSource, pDest: PByte;
5322 begin
5323   result := false;
5324
5325   if Assigned(Data) then begin
5326     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
5327       if Assigned(aBitmap) then begin
5328         aBitmap.PixelFormat := pf8bit;
5329         aBitmap.Palette     := CreateGrayPalette;
5330         aBitmap.Width       := Width;
5331         aBitmap.Height      := Height;
5332
5333         case Format of
5334           tfLuminance8Alpha8:
5335             AlphaInterleave := 1;
5336           tfRGBA8, tfBGRA8:
5337             AlphaInterleave := 3;
5338           else
5339             AlphaInterleave := 0;
5340         end;
5341
5342         // Copy Data
5343         pSource := Data;
5344
5345         for Row := 0 to Height -1 do begin
5346           pDest := aBitmap.Scanline[Row];
5347           if Assigned(pDest) then begin
5348             for Col := 0 to Width -1 do begin
5349               Inc(pSource, AlphaInterleave);
5350               pDest^ := pSource^;
5351               Inc(pDest);
5352               Inc(pSource);
5353             end;
5354           end;
5355         end;
5356         result := true;
5357       end;
5358     end;
5359   end;
5360 end;
5361
5362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5363 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5364 var
5365   tex: TglBitmap2D;
5366 begin
5367   tex := TglBitmap2D.Create;
5368   try
5369     tex.AssignFromBitmap(ABitmap);
5370     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5371   finally
5372     tex.Free;
5373   end;
5374 end;
5375 {$ENDIF}
5376
5377 {$IFDEF GLB_LAZARUS}
5378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5379 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5380 var
5381   rid: TRawImageDescription;
5382   FormatDesc: TFormatDescriptor;
5383 begin
5384   result := false;
5385   if not Assigned(aImage) or (Format = tfEmpty) then
5386     exit;
5387   FormatDesc := TFormatDescriptor.Get(Format);
5388   if FormatDesc.IsCompressed then
5389     exit;
5390
5391   FillChar(rid{%H-}, SizeOf(rid), 0);
5392   if (Format in [
5393        tfAlpha4, tfAlpha8, tfAlpha16,
5394        tfLuminance4, tfLuminance8, tfLuminance16,
5395        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16]) then
5396     rid.Format := ricfGray
5397   else
5398     rid.Format := ricfRGBA;
5399
5400   rid.Width        := Width;
5401   rid.Height       := Height;
5402   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
5403   rid.BitOrder     := riboBitsInOrder;
5404   rid.ByteOrder    := riboLSBFirst;
5405   rid.LineOrder    := riloTopToBottom;
5406   rid.LineEnd      := rileTight;
5407   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
5408   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5409   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5410   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5411   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5412   rid.RedShift     := FormatDesc.Shift.r;
5413   rid.GreenShift   := FormatDesc.Shift.g;
5414   rid.BlueShift    := FormatDesc.Shift.b;
5415   rid.AlphaShift   := FormatDesc.Shift.a;
5416
5417   rid.MaskBitsPerPixel  := 0;
5418   rid.PaletteColorCount := 0;
5419
5420   aImage.DataDescription := rid;
5421   aImage.CreateData;
5422
5423   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5424
5425   result := true;
5426 end;
5427
5428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5429 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5430 var
5431   f: TglBitmapFormat;
5432   FormatDesc: TFormatDescriptor;
5433   ImageData: PByte;
5434   ImageSize: Integer;
5435   CanCopy: Boolean;
5436
5437   procedure CopyConvert;
5438   var
5439     bfFormat: TbmpBitfieldFormat;
5440     pSourceLine, pDestLine: PByte;
5441     pSourceMD, pDestMD: Pointer;
5442     x, y: Integer;
5443     pixel: TglBitmapPixelData;
5444   begin
5445     bfFormat  := TbmpBitfieldFormat.Create;
5446     with aImage.DataDescription do begin
5447       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5448       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5449       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5450       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5451       bfFormat.PixelSize := BitsPerPixel / 8;
5452     end;
5453     pSourceMD := bfFormat.CreateMappingData;
5454     pDestMD   := FormatDesc.CreateMappingData;
5455     try
5456       for y := 0 to aImage.Height-1 do begin
5457         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5458         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5459         for x := 0 to aImage.Width-1 do begin
5460           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5461           FormatDesc.Map(pixel, pDestLine, pDestMD);
5462         end;
5463       end;
5464     finally
5465       FormatDesc.FreeMappingData(pDestMD);
5466       bfFormat.FreeMappingData(pSourceMD);
5467       bfFormat.Free;
5468     end;
5469   end;
5470
5471 begin
5472   result := false;
5473   if not Assigned(aImage) then
5474     exit;
5475   for f := High(f) downto Low(f) do begin
5476     FormatDesc := TFormatDescriptor.Get(f);
5477     with aImage.DataDescription do
5478       if FormatDesc.MaskMatch(
5479         (QWord(1 shl RedPrec  )-1) shl RedShift,
5480         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5481         (QWord(1 shl BluePrec )-1) shl BlueShift,
5482         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5483         break;
5484   end;
5485
5486   if (f = tfEmpty) then
5487     exit;
5488
5489   CanCopy :=
5490     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5491     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5492
5493   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5494   ImageData := GetMem(ImageSize);
5495   try
5496     if CanCopy then
5497       Move(aImage.PixelData^, ImageData^, ImageSize)
5498     else
5499       CopyConvert;
5500     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5501   except
5502     if Assigned(ImageData) then
5503       FreeMem(ImageData);
5504     raise;
5505   end;
5506
5507   result := true;
5508 end;
5509
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5512 var
5513   rid: TRawImageDescription;
5514   FormatDesc: TFormatDescriptor;
5515   Pixel: TglBitmapPixelData;
5516   x, y: Integer;
5517   srcMD: Pointer;
5518   src, dst: PByte;
5519 begin
5520   result := false;
5521   if not Assigned(aImage) or (Format = tfEmpty) then
5522     exit;
5523   FormatDesc := TFormatDescriptor.Get(Format);
5524   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5525     exit;
5526
5527   FillChar(rid{%H-}, SizeOf(rid), 0);
5528   rid.Format       := ricfGray;
5529   rid.Width        := Width;
5530   rid.Height       := Height;
5531   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5532   rid.BitOrder     := riboBitsInOrder;
5533   rid.ByteOrder    := riboLSBFirst;
5534   rid.LineOrder    := riloTopToBottom;
5535   rid.LineEnd      := rileTight;
5536   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5537   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5538   rid.GreenPrec    := 0;
5539   rid.BluePrec     := 0;
5540   rid.AlphaPrec    := 0;
5541   rid.RedShift     := 0;
5542   rid.GreenShift   := 0;
5543   rid.BlueShift    := 0;
5544   rid.AlphaShift   := 0;
5545
5546   rid.MaskBitsPerPixel  := 0;
5547   rid.PaletteColorCount := 0;
5548
5549   aImage.DataDescription := rid;
5550   aImage.CreateData;
5551
5552   srcMD := FormatDesc.CreateMappingData;
5553   try
5554     FormatDesc.PreparePixel(Pixel);
5555     src := Data;
5556     dst := aImage.PixelData;
5557     for y := 0 to Height-1 do
5558       for x := 0 to Width-1 do begin
5559         FormatDesc.Unmap(src, Pixel, srcMD);
5560         case rid.BitsPerPixel of
5561            8: begin
5562             dst^ := Pixel.Data.a;
5563             inc(dst);
5564           end;
5565           16: begin
5566             PWord(dst)^ := Pixel.Data.a;
5567             inc(dst, 2);
5568           end;
5569           24: begin
5570             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5571             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5572             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5573             inc(dst, 3);
5574           end;
5575           32: begin
5576             PCardinal(dst)^ := Pixel.Data.a;
5577             inc(dst, 4);
5578           end;
5579         else
5580           raise EglBitmapUnsupportedFormat.Create(Format);
5581         end;
5582       end;
5583   finally
5584     FormatDesc.FreeMappingData(srcMD);
5585   end;
5586   result := true;
5587 end;
5588
5589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5590 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5591 var
5592   tex: TglBitmap2D;
5593 begin
5594   tex := TglBitmap2D.Create;
5595   try
5596     tex.AssignFromLazIntfImage(aImage);
5597     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5598   finally
5599     tex.Free;
5600   end;
5601 end;
5602 {$ENDIF}
5603
5604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5605 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5606   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5607 var
5608   rs: TResourceStream;
5609 begin
5610   PrepareResType(aResource, aResType);
5611   rs := TResourceStream.Create(aInstance, aResource, aResType);
5612   try
5613     result := AddAlphaFromStream(rs, aFunc, aArgs);
5614   finally
5615     rs.Free;
5616   end;
5617 end;
5618
5619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5620 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5621   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5622 var
5623   rs: TResourceStream;
5624 begin
5625   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5626   try
5627     result := AddAlphaFromStream(rs, aFunc, aArgs);
5628   finally
5629     rs.Free;
5630   end;
5631 end;
5632
5633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5634 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5635 begin
5636   if TFormatDescriptor.Get(Format).IsCompressed then
5637     raise EglBitmapUnsupportedFormat.Create(Format);
5638   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5639 end;
5640
5641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5642 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5643 var
5644   FS: TFileStream;
5645 begin
5646   FS := TFileStream.Create(aFileName, fmOpenRead);
5647   try
5648     result := AddAlphaFromStream(FS, aFunc, aArgs);
5649   finally
5650     FS.Free;
5651   end;
5652 end;
5653
5654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5655 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5656 var
5657   tex: TglBitmap2D;
5658 begin
5659   tex := TglBitmap2D.Create(aStream);
5660   try
5661     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5662   finally
5663     tex.Free;
5664   end;
5665 end;
5666
5667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5668 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5669 var
5670   DestData, DestData2, SourceData: pByte;
5671   TempHeight, TempWidth: Integer;
5672   SourceFD, DestFD: TFormatDescriptor;
5673   SourceMD, DestMD, DestMD2: Pointer;
5674
5675   FuncRec: TglBitmapFunctionRec;
5676 begin
5677   result := false;
5678
5679   Assert(Assigned(Data));
5680   Assert(Assigned(aBitmap));
5681   Assert(Assigned(aBitmap.Data));
5682
5683   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5684     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5685
5686     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5687     DestFD   := TFormatDescriptor.Get(Format);
5688
5689     if not Assigned(aFunc) then begin
5690       aFunc        := glBitmapAlphaFunc;
5691       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5692     end else
5693       FuncRec.Args := aArgs;
5694
5695     // Values
5696     TempHeight := aBitmap.FileHeight;
5697     TempWidth  := aBitmap.FileWidth;
5698
5699     FuncRec.Sender          := Self;
5700     FuncRec.Size            := Dimension;
5701     FuncRec.Position.Fields := FuncRec.Size.Fields;
5702
5703     DestData   := Data;
5704     DestData2  := Data;
5705     SourceData := aBitmap.Data;
5706
5707     // Mapping
5708     SourceFD.PreparePixel(FuncRec.Source);
5709     DestFD.PreparePixel  (FuncRec.Dest);
5710
5711     SourceMD := SourceFD.CreateMappingData;
5712     DestMD   := DestFD.CreateMappingData;
5713     DestMD2  := DestFD.CreateMappingData;
5714     try
5715       FuncRec.Position.Y := 0;
5716       while FuncRec.Position.Y < TempHeight do begin
5717         FuncRec.Position.X := 0;
5718         while FuncRec.Position.X < TempWidth do begin
5719           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5720           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5721           aFunc(FuncRec);
5722           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5723           inc(FuncRec.Position.X);
5724         end;
5725         inc(FuncRec.Position.Y);
5726       end;
5727     finally
5728       SourceFD.FreeMappingData(SourceMD);
5729       DestFD.FreeMappingData(DestMD);
5730       DestFD.FreeMappingData(DestMD2);
5731     end;
5732   end;
5733 end;
5734
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5737 begin
5738   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5739 end;
5740
5741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5742 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5743 var
5744   PixelData: TglBitmapPixelData;
5745 begin
5746   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5747   result := AddAlphaFromColorKeyFloat(
5748     aRed   / PixelData.Range.r,
5749     aGreen / PixelData.Range.g,
5750     aBlue  / PixelData.Range.b,
5751     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5752 end;
5753
5754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5755 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5756 var
5757   values: array[0..2] of Single;
5758   tmp: Cardinal;
5759   i: Integer;
5760   PixelData: TglBitmapPixelData;
5761 begin
5762   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5763   with PixelData do begin
5764     values[0] := aRed;
5765     values[1] := aGreen;
5766     values[2] := aBlue;
5767
5768     for i := 0 to 2 do begin
5769       tmp          := Trunc(Range.arr[i] * aDeviation);
5770       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5771       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5772     end;
5773     Data.a  := 0;
5774     Range.a := 0;
5775   end;
5776   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5777 end;
5778
5779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5780 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5781 begin
5782   result := AddAlphaFromValueFloat(aAlpha / $FF);
5783 end;
5784
5785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5786 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5787 var
5788   PixelData: TglBitmapPixelData;
5789 begin
5790   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5791   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5792 end;
5793
5794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5795 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5796 var
5797   PixelData: TglBitmapPixelData;
5798 begin
5799   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5800   with PixelData do
5801     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5802   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5803 end;
5804
5805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5806 function TglBitmap.RemoveAlpha: Boolean;
5807 var
5808   FormatDesc: TFormatDescriptor;
5809 begin
5810   result := false;
5811   FormatDesc := TFormatDescriptor.Get(Format);
5812   if Assigned(Data) then begin
5813     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5814       raise EglBitmapUnsupportedFormat.Create(Format);
5815     result := ConvertTo(FormatDesc.WithoutAlpha);
5816   end;
5817 end;
5818
5819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5820 function TglBitmap.Clone: TglBitmap;
5821 var
5822   Temp: TglBitmap;
5823   TempPtr: PByte;
5824   Size: Integer;
5825 begin
5826   result := nil;
5827   Temp := (ClassType.Create as TglBitmap);
5828   try
5829     // copy texture data if assigned
5830     if Assigned(Data) then begin
5831       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5832       GetMem(TempPtr, Size);
5833       try
5834         Move(Data^, TempPtr^, Size);
5835         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5836       except
5837         if Assigned(TempPtr) then
5838           FreeMem(TempPtr);
5839         raise;
5840       end;
5841     end else begin
5842       TempPtr := nil;
5843       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5844     end;
5845
5846         // copy properties
5847     Temp.fID                      := ID;
5848     Temp.fTarget                  := Target;
5849     Temp.fFormat                  := Format;
5850     Temp.fMipMap                  := MipMap;
5851     Temp.fAnisotropic             := Anisotropic;
5852     Temp.fBorderColor             := fBorderColor;
5853     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5854     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5855     Temp.fFilterMin               := fFilterMin;
5856     Temp.fFilterMag               := fFilterMag;
5857     Temp.fWrapS                   := fWrapS;
5858     Temp.fWrapT                   := fWrapT;
5859     Temp.fWrapR                   := fWrapR;
5860     Temp.fFilename                := fFilename;
5861     Temp.fCustomName              := fCustomName;
5862     Temp.fCustomNameW             := fCustomNameW;
5863     Temp.fCustomData              := fCustomData;
5864
5865     result := Temp;
5866   except
5867     FreeAndNil(Temp);
5868     raise;
5869   end;
5870 end;
5871
5872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5873 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5874 var
5875   SourceFD, DestFD: TFormatDescriptor;
5876   SourcePD, DestPD: TglBitmapPixelData;
5877   ShiftData: TShiftData;
5878
5879   function DataIsIdentical: Boolean;
5880   begin
5881     result :=
5882       (SourceFD.RedMask   = DestFD.RedMask)   and
5883       (SourceFD.GreenMask = DestFD.GreenMask) and
5884       (SourceFD.BlueMask  = DestFD.BlueMask)  and
5885       (SourceFD.AlphaMask = DestFD.AlphaMask);
5886   end;
5887
5888   function CanCopyDirect: Boolean;
5889   begin
5890     result :=
5891       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5892       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5893       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5894       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5895   end;
5896
5897   function CanShift: Boolean;
5898   begin
5899     result :=
5900       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5901       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5902       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5903       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5904   end;
5905
5906   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5907   begin
5908     result := 0;
5909     while (aSource > aDest) and (aSource > 0) do begin
5910       inc(result);
5911       aSource := aSource shr 1;
5912     end;
5913   end;
5914
5915 begin
5916   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5917     SourceFD := TFormatDescriptor.Get(Format);
5918     DestFD   := TFormatDescriptor.Get(aFormat);
5919
5920     if DataIsIdentical then begin
5921       result := true;
5922       Format := aFormat;
5923       exit;
5924     end;
5925
5926     SourceFD.PreparePixel(SourcePD);
5927     DestFD.PreparePixel  (DestPD);
5928
5929     if CanCopyDirect then
5930       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5931     else if CanShift then begin
5932       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5933       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5934       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5935       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5936       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5937     end else
5938       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5939   end else
5940     result := true;
5941 end;
5942
5943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5944 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5945 begin
5946   if aUseRGB or aUseAlpha then
5947     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5948       ((Byte(aUseAlpha) and 1) shl 1) or
5949        (Byte(aUseRGB)   and 1)      ));
5950 end;
5951
5952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5953 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5954 begin
5955   fBorderColor[0] := aRed;
5956   fBorderColor[1] := aGreen;
5957   fBorderColor[2] := aBlue;
5958   fBorderColor[3] := aAlpha;
5959   if (ID > 0) then begin
5960     Bind(false);
5961     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5962   end;
5963 end;
5964
5965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5966 procedure TglBitmap.FreeData;
5967 var
5968   TempPtr: PByte;
5969 begin
5970   TempPtr := nil;
5971   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5972 end;
5973
5974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5975 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5976   const aAlpha: Byte);
5977 begin
5978   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5979 end;
5980
5981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5982 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5983 var
5984   PixelData: TglBitmapPixelData;
5985 begin
5986   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5987   FillWithColorFloat(
5988     aRed   / PixelData.Range.r,
5989     aGreen / PixelData.Range.g,
5990     aBlue  / PixelData.Range.b,
5991     aAlpha / PixelData.Range.a);
5992 end;
5993
5994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5995 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5996 var
5997   PixelData: TglBitmapPixelData;
5998 begin
5999   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6000   with PixelData do begin
6001     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6002     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6003     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6004     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6005   end;
6006   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
6007 end;
6008
6009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6010 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6011 begin
6012   //check MIN filter
6013   case aMin of
6014     GL_NEAREST:
6015       fFilterMin := GL_NEAREST;
6016     GL_LINEAR:
6017       fFilterMin := GL_LINEAR;
6018     GL_NEAREST_MIPMAP_NEAREST:
6019       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6020     GL_LINEAR_MIPMAP_NEAREST:
6021       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6022     GL_NEAREST_MIPMAP_LINEAR:
6023       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6024     GL_LINEAR_MIPMAP_LINEAR:
6025       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6026     else
6027       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6028   end;
6029
6030   //check MAG filter
6031   case aMag of
6032     GL_NEAREST:
6033       fFilterMag := GL_NEAREST;
6034     GL_LINEAR:
6035       fFilterMag := GL_LINEAR;
6036     else
6037       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6038   end;
6039
6040   //apply filter
6041   if (ID > 0) then begin
6042     Bind(false);
6043     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6044
6045     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
6046       case fFilterMin of
6047         GL_NEAREST, GL_LINEAR:
6048           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6049         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6050           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6051         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6052           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6053       end;
6054     end else
6055       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6056   end;
6057 end;
6058
6059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6060 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6061
6062   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6063   begin
6064     case aValue of
6065       GL_CLAMP:
6066         aTarget := GL_CLAMP;
6067
6068       GL_REPEAT:
6069         aTarget := GL_REPEAT;
6070
6071       GL_CLAMP_TO_EDGE: begin
6072         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
6073           aTarget := GL_CLAMP_TO_EDGE
6074         else
6075           aTarget := GL_CLAMP;
6076       end;
6077
6078       GL_CLAMP_TO_BORDER: begin
6079         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6080           aTarget := GL_CLAMP_TO_BORDER
6081         else
6082           aTarget := GL_CLAMP;
6083       end;
6084
6085       GL_MIRRORED_REPEAT: begin
6086         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6087           aTarget := GL_MIRRORED_REPEAT
6088         else
6089           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6090       end;
6091     else
6092       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6093     end;
6094   end;
6095
6096 begin
6097   CheckAndSetWrap(S, fWrapS);
6098   CheckAndSetWrap(T, fWrapT);
6099   CheckAndSetWrap(R, fWrapR);
6100
6101   if (ID > 0) then begin
6102     Bind(false);
6103     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6104     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6105     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6106   end;
6107 end;
6108
6109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6110 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6111
6112   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6113   begin
6114     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6115        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6116       fSwizzle[aIndex] := aValue
6117     else
6118       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6119   end;
6120
6121 begin
6122   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6123     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6124   CheckAndSetValue(r, 0);
6125   CheckAndSetValue(g, 1);
6126   CheckAndSetValue(b, 2);
6127   CheckAndSetValue(a, 3);
6128
6129   if (ID > 0) then begin
6130     Bind(false);
6131     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6132   end;
6133 end;
6134
6135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6136 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6137 begin
6138   if aEnableTextureUnit then
6139     glEnable(Target);
6140   if (ID > 0) then
6141     glBindTexture(Target, ID);
6142 end;
6143
6144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6145 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6146 begin
6147   if aDisableTextureUnit then
6148     glDisable(Target);
6149   glBindTexture(Target, 0);
6150 end;
6151
6152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6153 constructor TglBitmap.Create;
6154 begin
6155   if (ClassType = TglBitmap) then
6156     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6157 {$IFDEF GLB_NATIVE_OGL}
6158   glbReadOpenGLExtensions;
6159 {$ENDIF}
6160   inherited Create;
6161   fFormat            := glBitmapGetDefaultFormat;
6162   fFreeDataOnDestroy := true;
6163 end;
6164
6165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6166 constructor TglBitmap.Create(const aFileName: String);
6167 begin
6168   Create;
6169   LoadFromFile(aFileName);
6170 end;
6171
6172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6173 constructor TglBitmap.Create(const aStream: TStream);
6174 begin
6175   Create;
6176   LoadFromStream(aStream);
6177 end;
6178
6179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6180 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
6181 var
6182   ImageSize: Integer;
6183 begin
6184   Create;
6185   if not Assigned(aData) then begin
6186     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6187     GetMem(aData, ImageSize);
6188     try
6189       FillChar(aData^, ImageSize, #$FF);
6190       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6191     except
6192       if Assigned(aData) then
6193         FreeMem(aData);
6194       raise;
6195     end;
6196   end else begin
6197     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6198     fFreeDataOnDestroy := false;
6199   end;
6200 end;
6201
6202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6203 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6204 begin
6205   Create;
6206   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6207 end;
6208
6209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6210 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6211 begin
6212   Create;
6213   LoadFromResource(aInstance, aResource, aResType);
6214 end;
6215
6216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6217 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6218 begin
6219   Create;
6220   LoadFromResourceID(aInstance, aResourceID, aResType);
6221 end;
6222
6223 {$IFDEF GLB_SUPPORT_PNG_READ}
6224 {$IF DEFINED(GLB_LAZ_PNG)}
6225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6226 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6228 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6229 const
6230   MAGIC_LEN = 8;
6231   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6232 var
6233   reader: TLazReaderPNG;
6234   intf: TLazIntfImage;
6235   StreamPos: Int64;
6236   magic: String[MAGIC_LEN];
6237 begin
6238   result := true;
6239   StreamPos := aStream.Position;
6240
6241   SetLength(magic, MAGIC_LEN);
6242   aStream.Read(magic[1], MAGIC_LEN);
6243   aStream.Position := StreamPos;
6244   if (magic <> PNG_MAGIC) then begin
6245     result := false;
6246     exit;
6247   end;
6248
6249   intf   := TLazIntfImage.Create(0, 0);
6250   reader := TLazReaderPNG.Create;
6251   try try
6252     reader.UpdateDescription := true;
6253     reader.ImageRead(aStream, intf);
6254     AssignFromLazIntfImage(intf);
6255   except
6256     result := false;
6257     aStream.Position := StreamPos;
6258     exit;
6259   end;
6260   finally
6261     reader.Free;
6262     intf.Free;
6263   end;
6264 end;
6265
6266 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6268 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6269 var
6270   Surface: PSDL_Surface;
6271   RWops: PSDL_RWops;
6272 begin
6273   result := false;
6274   RWops := glBitmapCreateRWops(aStream);
6275   try
6276     if IMG_isPNG(RWops) > 0 then begin
6277       Surface := IMG_LoadPNG_RW(RWops);
6278       try
6279         AssignFromSurface(Surface);
6280         result := true;
6281       finally
6282         SDL_FreeSurface(Surface);
6283       end;
6284     end;
6285   finally
6286     SDL_FreeRW(RWops);
6287   end;
6288 end;
6289
6290 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6292 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6293 begin
6294   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6295 end;
6296
6297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6298 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6299 var
6300   StreamPos: Int64;
6301   signature: array [0..7] of byte;
6302   png: png_structp;
6303   png_info: png_infop;
6304
6305   TempHeight, TempWidth: Integer;
6306   Format: TglBitmapFormat;
6307
6308   png_data: pByte;
6309   png_rows: array of pByte;
6310   Row, LineSize: Integer;
6311 begin
6312   result := false;
6313
6314   if not init_libPNG then
6315     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6316
6317   try
6318     // signature
6319     StreamPos := aStream.Position;
6320     aStream.Read(signature{%H-}, 8);
6321     aStream.Position := StreamPos;
6322
6323     if png_check_sig(@signature, 8) <> 0 then begin
6324       // png read struct
6325       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6326       if png = nil then
6327         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6328
6329       // png info
6330       png_info := png_create_info_struct(png);
6331       if png_info = nil then begin
6332         png_destroy_read_struct(@png, nil, nil);
6333         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6334       end;
6335
6336       // set read callback
6337       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6338
6339       // read informations
6340       png_read_info(png, png_info);
6341
6342       // size
6343       TempHeight := png_get_image_height(png, png_info);
6344       TempWidth := png_get_image_width(png, png_info);
6345
6346       // format
6347       case png_get_color_type(png, png_info) of
6348         PNG_COLOR_TYPE_GRAY:
6349           Format := tfLuminance8;
6350         PNG_COLOR_TYPE_GRAY_ALPHA:
6351           Format := tfLuminance8Alpha8;
6352         PNG_COLOR_TYPE_RGB:
6353           Format := tfRGB8;
6354         PNG_COLOR_TYPE_RGB_ALPHA:
6355           Format := tfRGBA8;
6356         else
6357           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6358       end;
6359
6360       // cut upper 8 bit from 16 bit formats
6361       if png_get_bit_depth(png, png_info) > 8 then
6362         png_set_strip_16(png);
6363
6364       // expand bitdepth smaller than 8
6365       if png_get_bit_depth(png, png_info) < 8 then
6366         png_set_expand(png);
6367
6368       // allocating mem for scanlines
6369       LineSize := png_get_rowbytes(png, png_info);
6370       GetMem(png_data, TempHeight * LineSize);
6371       try
6372         SetLength(png_rows, TempHeight);
6373         for Row := Low(png_rows) to High(png_rows) do begin
6374           png_rows[Row] := png_data;
6375           Inc(png_rows[Row], Row * LineSize);
6376         end;
6377
6378         // read complete image into scanlines
6379         png_read_image(png, @png_rows[0]);
6380
6381         // read end
6382         png_read_end(png, png_info);
6383
6384         // destroy read struct
6385         png_destroy_read_struct(@png, @png_info, nil);
6386
6387         SetLength(png_rows, 0);
6388
6389         // set new data
6390         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6391
6392         result := true;
6393       except
6394         if Assigned(png_data) then
6395           FreeMem(png_data);
6396         raise;
6397       end;
6398     end;
6399   finally
6400     quit_libPNG;
6401   end;
6402 end;
6403
6404 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6406 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6407 var
6408   StreamPos: Int64;
6409   Png: TPNGObject;
6410   Header: String[8];
6411   Row, Col, PixSize, LineSize: Integer;
6412   NewImage, pSource, pDest, pAlpha: pByte;
6413   PngFormat: TglBitmapFormat;
6414   FormatDesc: TFormatDescriptor;
6415
6416 const
6417   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6418
6419 begin
6420   result := false;
6421
6422   StreamPos := aStream.Position;
6423   aStream.Read(Header[0], SizeOf(Header));
6424   aStream.Position := StreamPos;
6425
6426   {Test if the header matches}
6427   if Header = PngHeader then begin
6428     Png := TPNGObject.Create;
6429     try
6430       Png.LoadFromStream(aStream);
6431
6432       case Png.Header.ColorType of
6433         COLOR_GRAYSCALE:
6434           PngFormat := tfLuminance8;
6435         COLOR_GRAYSCALEALPHA:
6436           PngFormat := tfLuminance8Alpha8;
6437         COLOR_RGB:
6438           PngFormat := tfBGR8;
6439         COLOR_RGBALPHA:
6440           PngFormat := tfBGRA8;
6441         else
6442           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6443       end;
6444
6445       FormatDesc := TFormatDescriptor.Get(PngFormat);
6446       PixSize    := Round(FormatDesc.PixelSize);
6447       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6448
6449       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6450       try
6451         pDest := NewImage;
6452
6453         case Png.Header.ColorType of
6454           COLOR_RGB, COLOR_GRAYSCALE:
6455             begin
6456               for Row := 0 to Png.Height -1 do begin
6457                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6458                 Inc(pDest, LineSize);
6459               end;
6460             end;
6461           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6462             begin
6463               PixSize := PixSize -1;
6464
6465               for Row := 0 to Png.Height -1 do begin
6466                 pSource := Png.Scanline[Row];
6467                 pAlpha := pByte(Png.AlphaScanline[Row]);
6468
6469                 for Col := 0 to Png.Width -1 do begin
6470                   Move (pSource^, pDest^, PixSize);
6471                   Inc(pSource, PixSize);
6472                   Inc(pDest, PixSize);
6473
6474                   pDest^ := pAlpha^;
6475                   inc(pAlpha);
6476                   Inc(pDest);
6477                 end;
6478               end;
6479             end;
6480           else
6481             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6482         end;
6483
6484         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6485
6486         result := true;
6487       except
6488         if Assigned(NewImage) then
6489           FreeMem(NewImage);
6490         raise;
6491       end;
6492     finally
6493       Png.Free;
6494     end;
6495   end;
6496 end;
6497 {$IFEND}
6498 {$ENDIF}
6499
6500 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6501 {$IFDEF GLB_LIB_PNG}
6502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6503 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6504 begin
6505   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6506 end;
6507 {$ENDIF}
6508
6509 {$IF DEFINED(GLB_LAZ_PNG)}
6510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6511 procedure TglBitmap.SavePNG(const aStream: TStream);
6512 var
6513   png: TPortableNetworkGraphic;
6514   intf: TLazIntfImage;
6515   raw: TRawImage;
6516 begin
6517   png  := TPortableNetworkGraphic.Create;
6518   intf := TLazIntfImage.Create(0, 0);
6519   try
6520     if not AssignToLazIntfImage(intf) then
6521       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6522     intf.GetRawImage(raw);
6523     png.LoadFromRawImage(raw, false);
6524     png.SaveToStream(aStream);
6525   finally
6526     png.Free;
6527     intf.Free;
6528   end;
6529 end;
6530
6531 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6533 procedure TglBitmap.SavePNG(const aStream: TStream);
6534 var
6535   png: png_structp;
6536   png_info: png_infop;
6537   png_rows: array of pByte;
6538   LineSize: Integer;
6539   ColorType: Integer;
6540   Row: Integer;
6541   FormatDesc: TFormatDescriptor;
6542 begin
6543   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6544     raise EglBitmapUnsupportedFormat.Create(Format);
6545
6546   if not init_libPNG then
6547     raise Exception.Create('unable to initialize libPNG.');
6548
6549   try
6550     case Format of
6551       tfAlpha8, tfLuminance8:
6552         ColorType := PNG_COLOR_TYPE_GRAY;
6553       tfLuminance8Alpha8:
6554         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6555       tfBGR8, tfRGB8:
6556         ColorType := PNG_COLOR_TYPE_RGB;
6557       tfBGRA8, tfRGBA8:
6558         ColorType := PNG_COLOR_TYPE_RGBA;
6559       else
6560         raise EglBitmapUnsupportedFormat.Create(Format);
6561     end;
6562
6563     FormatDesc := TFormatDescriptor.Get(Format);
6564     LineSize := FormatDesc.GetSize(Width, 1);
6565
6566     // creating array for scanline
6567     SetLength(png_rows, Height);
6568     try
6569       for Row := 0 to Height - 1 do begin
6570         png_rows[Row] := Data;
6571         Inc(png_rows[Row], Row * LineSize)
6572       end;
6573
6574       // write struct
6575       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6576       if png = nil then
6577         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6578
6579       // create png info
6580       png_info := png_create_info_struct(png);
6581       if png_info = nil then begin
6582         png_destroy_write_struct(@png, nil);
6583         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6584       end;
6585
6586       // set read callback
6587       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6588
6589       // set compression
6590       png_set_compression_level(png, 6);
6591
6592       if Format in [tfBGR8, tfBGRA8] then
6593         png_set_bgr(png);
6594
6595       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6596       png_write_info(png, png_info);
6597       png_write_image(png, @png_rows[0]);
6598       png_write_end(png, png_info);
6599       png_destroy_write_struct(@png, @png_info);
6600     finally
6601       SetLength(png_rows, 0);
6602     end;
6603   finally
6604     quit_libPNG;
6605   end;
6606 end;
6607
6608 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6610 procedure TglBitmap.SavePNG(const aStream: TStream);
6611 var
6612   Png: TPNGObject;
6613
6614   pSource, pDest: pByte;
6615   X, Y, PixSize: Integer;
6616   ColorType: Cardinal;
6617   Alpha: Boolean;
6618
6619   pTemp: pByte;
6620   Temp: Byte;
6621 begin
6622   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6623     raise EglBitmapUnsupportedFormat.Create(Format);
6624
6625   case Format of
6626     tfAlpha8, tfLuminance8: begin
6627       ColorType := COLOR_GRAYSCALE;
6628       PixSize   := 1;
6629       Alpha     := false;
6630     end;
6631     tfLuminance8Alpha8: begin
6632       ColorType := COLOR_GRAYSCALEALPHA;
6633       PixSize   := 1;
6634       Alpha     := true;
6635     end;
6636     tfBGR8, tfRGB8: begin
6637       ColorType := COLOR_RGB;
6638       PixSize   := 3;
6639       Alpha     := false;
6640     end;
6641     tfBGRA8, tfRGBA8: begin
6642       ColorType := COLOR_RGBALPHA;
6643       PixSize   := 3;
6644       Alpha     := true
6645     end;
6646   else
6647     raise EglBitmapUnsupportedFormat.Create(Format);
6648   end;
6649
6650   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6651   try
6652     // Copy ImageData
6653     pSource := Data;
6654     for Y := 0 to Height -1 do begin
6655       pDest := png.ScanLine[Y];
6656       for X := 0 to Width -1 do begin
6657         Move(pSource^, pDest^, PixSize);
6658         Inc(pDest, PixSize);
6659         Inc(pSource, PixSize);
6660         if Alpha then begin
6661           png.AlphaScanline[Y]^[X] := pSource^;
6662           Inc(pSource);
6663         end;
6664       end;
6665
6666       // convert RGB line to BGR
6667       if Format in [tfRGB8, tfRGBA8] then begin
6668         pTemp := png.ScanLine[Y];
6669         for X := 0 to Width -1 do begin
6670           Temp := pByteArray(pTemp)^[0];
6671           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6672           pByteArray(pTemp)^[2] := Temp;
6673           Inc(pTemp, 3);
6674         end;
6675       end;
6676     end;
6677
6678     // Save to Stream
6679     Png.CompressionLevel := 6;
6680     Png.SaveToStream(aStream);
6681   finally
6682     FreeAndNil(Png);
6683   end;
6684 end;
6685 {$IFEND}
6686 {$ENDIF}
6687
6688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6689 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6691 {$IFDEF GLB_LIB_JPEG}
6692 type
6693   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6694   glBitmap_libJPEG_source_mgr = record
6695     pub: jpeg_source_mgr;
6696
6697     SrcStream: TStream;
6698     SrcBuffer: array [1..4096] of byte;
6699   end;
6700
6701   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6702   glBitmap_libJPEG_dest_mgr = record
6703     pub: jpeg_destination_mgr;
6704
6705     DestStream: TStream;
6706     DestBuffer: array [1..4096] of byte;
6707   end;
6708
6709 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6710 begin
6711   //DUMMY
6712 end;
6713
6714
6715 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6716 begin
6717   //DUMMY
6718 end;
6719
6720
6721 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6722 begin
6723   //DUMMY
6724 end;
6725
6726 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6727 begin
6728   //DUMMY
6729 end;
6730
6731
6732 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6733 begin
6734   //DUMMY
6735 end;
6736
6737
6738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6739 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6740 var
6741   src: glBitmap_libJPEG_source_mgr_ptr;
6742   bytes: integer;
6743 begin
6744   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6745
6746   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6747         if (bytes <= 0) then begin
6748                 src^.SrcBuffer[1] := $FF;
6749                 src^.SrcBuffer[2] := JPEG_EOI;
6750                 bytes := 2;
6751         end;
6752
6753         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6754         src^.pub.bytes_in_buffer := bytes;
6755
6756   result := true;
6757 end;
6758
6759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6760 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6761 var
6762   src: glBitmap_libJPEG_source_mgr_ptr;
6763 begin
6764   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6765
6766   if num_bytes > 0 then begin
6767     // wanted byte isn't in buffer so set stream position and read buffer
6768     if num_bytes > src^.pub.bytes_in_buffer then begin
6769       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6770       src^.pub.fill_input_buffer(cinfo);
6771     end else begin
6772       // wanted byte is in buffer so only skip
6773                 inc(src^.pub.next_input_byte, num_bytes);
6774                 dec(src^.pub.bytes_in_buffer, num_bytes);
6775     end;
6776   end;
6777 end;
6778
6779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6780 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6781 var
6782   dest: glBitmap_libJPEG_dest_mgr_ptr;
6783 begin
6784   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6785
6786   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6787     // write complete buffer
6788     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6789
6790     // reset buffer
6791     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6792     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6793   end;
6794
6795   result := true;
6796 end;
6797
6798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6799 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6800 var
6801   Idx: Integer;
6802   dest: glBitmap_libJPEG_dest_mgr_ptr;
6803 begin
6804   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6805
6806   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6807     // check for endblock
6808     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6809       // write endblock
6810       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6811
6812       // leave
6813       break;
6814     end else
6815       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6816   end;
6817 end;
6818 {$ENDIF}
6819
6820 {$IFDEF GLB_SUPPORT_JPEG_READ}
6821 {$IF DEFINED(GLB_LAZ_JPEG)}
6822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6823 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6824 const
6825   MAGIC_LEN = 2;
6826   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6827 var
6828   intf: TLazIntfImage;
6829   reader: TFPReaderJPEG;
6830   StreamPos: Int64;
6831   magic: String[MAGIC_LEN];
6832 begin
6833   result := true;
6834   StreamPos := aStream.Position;
6835
6836   SetLength(magic, MAGIC_LEN);
6837   aStream.Read(magic[1], MAGIC_LEN);
6838   aStream.Position := StreamPos;
6839   if (magic <> JPEG_MAGIC) then begin
6840     result := false;
6841     exit;
6842   end;
6843
6844   reader := TFPReaderJPEG.Create;
6845   intf := TLazIntfImage.Create(0, 0);
6846   try try
6847     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6848     reader.ImageRead(aStream, intf);
6849     AssignFromLazIntfImage(intf);
6850   except
6851     result := false;
6852     aStream.Position := StreamPos;
6853     exit;
6854   end;
6855   finally
6856     reader.Free;
6857     intf.Free;
6858   end;
6859 end;
6860
6861 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6863 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6864 var
6865   Surface: PSDL_Surface;
6866   RWops: PSDL_RWops;
6867 begin
6868   result := false;
6869
6870   RWops := glBitmapCreateRWops(aStream);
6871   try
6872     if IMG_isJPG(RWops) > 0 then begin
6873       Surface := IMG_LoadJPG_RW(RWops);
6874       try
6875         AssignFromSurface(Surface);
6876         result := true;
6877       finally
6878         SDL_FreeSurface(Surface);
6879       end;
6880     end;
6881   finally
6882     SDL_FreeRW(RWops);
6883   end;
6884 end;
6885
6886 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6888 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6889 var
6890   StreamPos: Int64;
6891   Temp: array[0..1]of Byte;
6892
6893   jpeg: jpeg_decompress_struct;
6894   jpeg_err: jpeg_error_mgr;
6895
6896   IntFormat: TglBitmapFormat;
6897   pImage: pByte;
6898   TempHeight, TempWidth: Integer;
6899
6900   pTemp: pByte;
6901   Row: Integer;
6902
6903   FormatDesc: TFormatDescriptor;
6904 begin
6905   result := false;
6906
6907   if not init_libJPEG then
6908     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6909
6910   try
6911     // reading first two bytes to test file and set cursor back to begin
6912     StreamPos := aStream.Position;
6913     aStream.Read({%H-}Temp[0], 2);
6914     aStream.Position := StreamPos;
6915
6916     // if Bitmap then read file.
6917     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6918       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6919       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6920
6921       // error managment
6922       jpeg.err := jpeg_std_error(@jpeg_err);
6923       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6924       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6925
6926       // decompression struct
6927       jpeg_create_decompress(@jpeg);
6928
6929       // allocation space for streaming methods
6930       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6931
6932       // seeting up custom functions
6933       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6934         pub.init_source       := glBitmap_libJPEG_init_source;
6935         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6936         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6937         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6938         pub.term_source       := glBitmap_libJPEG_term_source;
6939
6940         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6941         pub.next_input_byte := nil;   // until buffer loaded
6942
6943         SrcStream := aStream;
6944       end;
6945
6946       // set global decoding state
6947       jpeg.global_state := DSTATE_START;
6948
6949       // read header of jpeg
6950       jpeg_read_header(@jpeg, false);
6951
6952       // setting output parameter
6953       case jpeg.jpeg_color_space of
6954         JCS_GRAYSCALE:
6955           begin
6956             jpeg.out_color_space := JCS_GRAYSCALE;
6957             IntFormat := tfLuminance8;
6958           end;
6959         else
6960           jpeg.out_color_space := JCS_RGB;
6961           IntFormat := tfRGB8;
6962       end;
6963
6964       // reading image
6965       jpeg_start_decompress(@jpeg);
6966
6967       TempHeight := jpeg.output_height;
6968       TempWidth := jpeg.output_width;
6969
6970       FormatDesc := TFormatDescriptor.Get(IntFormat);
6971
6972       // creating new image
6973       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6974       try
6975         pTemp := pImage;
6976
6977         for Row := 0 to TempHeight -1 do begin
6978           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6979           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6980         end;
6981
6982         // finish decompression
6983         jpeg_finish_decompress(@jpeg);
6984
6985         // destroy decompression
6986         jpeg_destroy_decompress(@jpeg);
6987
6988         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6989
6990         result := true;
6991       except
6992         if Assigned(pImage) then
6993           FreeMem(pImage);
6994         raise;
6995       end;
6996     end;
6997   finally
6998     quit_libJPEG;
6999   end;
7000 end;
7001
7002 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7004 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7005 var
7006   bmp: TBitmap;
7007   jpg: TJPEGImage;
7008   StreamPos: Int64;
7009   Temp: array[0..1]of Byte;
7010 begin
7011   result := false;
7012
7013   // reading first two bytes to test file and set cursor back to begin
7014   StreamPos := aStream.Position;
7015   aStream.Read(Temp[0], 2);
7016   aStream.Position := StreamPos;
7017
7018   // if Bitmap then read file.
7019   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7020     bmp := TBitmap.Create;
7021     try
7022       jpg := TJPEGImage.Create;
7023       try
7024         jpg.LoadFromStream(aStream);
7025         bmp.Assign(jpg);
7026         result := AssignFromBitmap(bmp);
7027       finally
7028         jpg.Free;
7029       end;
7030     finally
7031       bmp.Free;
7032     end;
7033   end;
7034 end;
7035 {$IFEND}
7036 {$ENDIF}
7037
7038 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7039 {$IF DEFINED(GLB_LAZ_JPEG)}
7040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7041 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7042 var
7043   jpeg: TJPEGImage;
7044   intf: TLazIntfImage;
7045   raw: TRawImage;
7046 begin
7047   jpeg := TJPEGImage.Create;
7048   intf := TLazIntfImage.Create(0, 0);
7049   try
7050     if not AssignToLazIntfImage(intf) then
7051       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7052     intf.GetRawImage(raw);
7053     jpeg.LoadFromRawImage(raw, false);
7054     jpeg.SaveToStream(aStream);
7055   finally
7056     intf.Free;
7057     jpeg.Free;
7058   end;
7059 end;
7060
7061 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7063 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7064 var
7065   jpeg: jpeg_compress_struct;
7066   jpeg_err: jpeg_error_mgr;
7067   Row: Integer;
7068   pTemp, pTemp2: pByte;
7069
7070   procedure CopyRow(pDest, pSource: pByte);
7071   var
7072     X: Integer;
7073   begin
7074     for X := 0 to Width - 1 do begin
7075       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7076       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7077       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7078       Inc(pDest, 3);
7079       Inc(pSource, 3);
7080     end;
7081   end;
7082
7083 begin
7084   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7085     raise EglBitmapUnsupportedFormat.Create(Format);
7086
7087   if not init_libJPEG then
7088     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7089
7090   try
7091     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7092     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7093
7094     // error managment
7095     jpeg.err := jpeg_std_error(@jpeg_err);
7096     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7097     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7098
7099     // compression struct
7100     jpeg_create_compress(@jpeg);
7101
7102     // allocation space for streaming methods
7103     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7104
7105     // seeting up custom functions
7106     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7107       pub.init_destination    := glBitmap_libJPEG_init_destination;
7108       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7109       pub.term_destination    := glBitmap_libJPEG_term_destination;
7110
7111       pub.next_output_byte  := @DestBuffer[1];
7112       pub.free_in_buffer    := Length(DestBuffer);
7113
7114       DestStream := aStream;
7115     end;
7116
7117     // very important state
7118     jpeg.global_state := CSTATE_START;
7119     jpeg.image_width  := Width;
7120     jpeg.image_height := Height;
7121     case Format of
7122       tfAlpha8, tfLuminance8: begin
7123         jpeg.input_components := 1;
7124         jpeg.in_color_space   := JCS_GRAYSCALE;
7125       end;
7126       tfRGB8, tfBGR8: begin
7127         jpeg.input_components := 3;
7128         jpeg.in_color_space   := JCS_RGB;
7129       end;
7130     end;
7131
7132     jpeg_set_defaults(@jpeg);
7133     jpeg_set_quality(@jpeg, 95, true);
7134     jpeg_start_compress(@jpeg, true);
7135     pTemp := Data;
7136
7137     if Format = tfBGR8 then
7138       GetMem(pTemp2, fRowSize)
7139     else
7140       pTemp2 := pTemp;
7141
7142     try
7143       for Row := 0 to jpeg.image_height -1 do begin
7144         // prepare row
7145         if Format = tfBGR8 then
7146           CopyRow(pTemp2, pTemp)
7147         else
7148           pTemp2 := pTemp;
7149
7150         // write row
7151         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7152         inc(pTemp, fRowSize);
7153       end;
7154     finally
7155       // free memory
7156       if Format = tfBGR8 then
7157         FreeMem(pTemp2);
7158     end;
7159     jpeg_finish_compress(@jpeg);
7160     jpeg_destroy_compress(@jpeg);
7161   finally
7162     quit_libJPEG;
7163   end;
7164 end;
7165
7166 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7168 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7169 var
7170   Bmp: TBitmap;
7171   Jpg: TJPEGImage;
7172 begin
7173   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7174     raise EglBitmapUnsupportedFormat.Create(Format);
7175
7176   Bmp := TBitmap.Create;
7177   try
7178     Jpg := TJPEGImage.Create;
7179     try
7180       AssignToBitmap(Bmp);
7181       if (Format in [tfAlpha8, tfLuminance8]) then begin
7182         Jpg.Grayscale   := true;
7183         Jpg.PixelFormat := jf8Bit;
7184       end;
7185       Jpg.Assign(Bmp);
7186       Jpg.SaveToStream(aStream);
7187     finally
7188       FreeAndNil(Jpg);
7189     end;
7190   finally
7191     FreeAndNil(Bmp);
7192   end;
7193 end;
7194 {$IFEND}
7195 {$ENDIF}
7196
7197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7198 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7200 const
7201   BMP_MAGIC          = $4D42;
7202
7203   BMP_COMP_RGB       = 0;
7204   BMP_COMP_RLE8      = 1;
7205   BMP_COMP_RLE4      = 2;
7206   BMP_COMP_BITFIELDS = 3;
7207
7208 type
7209   TBMPHeader = packed record
7210     bfType: Word;
7211     bfSize: Cardinal;
7212     bfReserved1: Word;
7213     bfReserved2: Word;
7214     bfOffBits: Cardinal;
7215   end;
7216
7217   TBMPInfo = packed record
7218     biSize: Cardinal;
7219     biWidth: Longint;
7220     biHeight: Longint;
7221     biPlanes: Word;
7222     biBitCount: Word;
7223     biCompression: Cardinal;
7224     biSizeImage: Cardinal;
7225     biXPelsPerMeter: Longint;
7226     biYPelsPerMeter: Longint;
7227     biClrUsed: Cardinal;
7228     biClrImportant: Cardinal;
7229   end;
7230
7231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7232 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7233
7234   //////////////////////////////////////////////////////////////////////////////////////////////////
7235   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
7236   begin
7237     result := tfEmpty;
7238     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7239     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7240
7241     //Read Compression
7242     case aInfo.biCompression of
7243       BMP_COMP_RLE4,
7244       BMP_COMP_RLE8: begin
7245         raise EglBitmap.Create('RLE compression is not supported');
7246       end;
7247       BMP_COMP_BITFIELDS: begin
7248         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7249           aStream.Read(aMask.r, SizeOf(aMask.r));
7250           aStream.Read(aMask.g, SizeOf(aMask.g));
7251           aStream.Read(aMask.b, SizeOf(aMask.b));
7252           aStream.Read(aMask.a, SizeOf(aMask.a));
7253         end else
7254           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7255       end;
7256     end;
7257
7258     //get suitable format
7259     case aInfo.biBitCount of
7260        8: result := tfLuminance8;
7261       16: result := tfX1RGB5;
7262       24: result := tfRGB8;
7263       32: result := tfXRGB8;
7264     end;
7265   end;
7266
7267   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7268   var
7269     i, c: Integer;
7270     ColorTable: TbmpColorTable;
7271   begin
7272     result := nil;
7273     if (aInfo.biBitCount >= 16) then
7274       exit;
7275     aFormat := tfLuminance8;
7276     c := aInfo.biClrUsed;
7277     if (c = 0) then
7278       c := 1 shl aInfo.biBitCount;
7279     SetLength(ColorTable, c);
7280     for i := 0 to c-1 do begin
7281       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7282       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7283         aFormat := tfRGB8;
7284     end;
7285
7286     result := TbmpColorTableFormat.Create;
7287     result.PixelSize  := aInfo.biBitCount / 8;
7288     result.ColorTable := ColorTable;
7289     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
7290   end;
7291
7292   //////////////////////////////////////////////////////////////////////////////////////////////////
7293   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
7294     const aInfo: TBMPInfo): TbmpBitfieldFormat;
7295   var
7296     TmpFormat: TglBitmapFormat;
7297     FormatDesc: TFormatDescriptor;
7298   begin
7299     result := nil;
7300     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7301       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7302         FormatDesc := TFormatDescriptor.Get(TmpFormat);
7303         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
7304           aFormat := FormatDesc.Format;
7305           exit;
7306         end;
7307       end;
7308
7309       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7310         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7311       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7312         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7313
7314       result := TbmpBitfieldFormat.Create;
7315       result.PixelSize := aInfo.biBitCount / 8;
7316       result.RedMask   := aMask.r;
7317       result.GreenMask := aMask.g;
7318       result.BlueMask  := aMask.b;
7319       result.AlphaMask := aMask.a;
7320     end;
7321   end;
7322
7323 var
7324   //simple types
7325   StartPos: Int64;
7326   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7327   PaddingBuff: Cardinal;
7328   LineBuf, ImageData, TmpData: PByte;
7329   SourceMD, DestMD: Pointer;
7330   BmpFormat: TglBitmapFormat;
7331
7332   //records
7333   Mask: TglBitmapColorRec;
7334   Header: TBMPHeader;
7335   Info: TBMPInfo;
7336
7337   //classes
7338   SpecialFormat: TFormatDescriptor;
7339   FormatDesc: TFormatDescriptor;
7340
7341   //////////////////////////////////////////////////////////////////////////////////////////////////
7342   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7343   var
7344     i: Integer;
7345     Pixel: TglBitmapPixelData;
7346   begin
7347     aStream.Read(aLineBuf^, rbLineSize);
7348     SpecialFormat.PreparePixel(Pixel);
7349     for i := 0 to Info.biWidth-1 do begin
7350       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7351       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7352       FormatDesc.Map(Pixel, aData, DestMD);
7353     end;
7354   end;
7355
7356 begin
7357   result        := false;
7358   BmpFormat     := tfEmpty;
7359   SpecialFormat := nil;
7360   LineBuf       := nil;
7361   SourceMD      := nil;
7362   DestMD        := nil;
7363
7364   // Header
7365   StartPos := aStream.Position;
7366   aStream.Read(Header{%H-}, SizeOf(Header));
7367
7368   if Header.bfType = BMP_MAGIC then begin
7369     try try
7370       BmpFormat        := ReadInfo(Info, Mask);
7371       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7372       if not Assigned(SpecialFormat) then
7373         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7374       aStream.Position := StartPos + Header.bfOffBits;
7375
7376       if (BmpFormat <> tfEmpty) then begin
7377         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7378         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7379         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
7380         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7381
7382         //get Memory
7383         DestMD    := FormatDesc.CreateMappingData;
7384         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7385         GetMem(ImageData, ImageSize);
7386         if Assigned(SpecialFormat) then begin
7387           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7388           SourceMD := SpecialFormat.CreateMappingData;
7389         end;
7390
7391         //read Data
7392         try try
7393           FillChar(ImageData^, ImageSize, $FF);
7394           TmpData := ImageData;
7395           if (Info.biHeight > 0) then
7396             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7397           for i := 0 to Abs(Info.biHeight)-1 do begin
7398             if Assigned(SpecialFormat) then
7399               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7400             else
7401               aStream.Read(TmpData^, wbLineSize);   //else only read data
7402             if (Info.biHeight > 0) then
7403               dec(TmpData, wbLineSize)
7404             else
7405               inc(TmpData, wbLineSize);
7406             aStream.Read(PaddingBuff{%H-}, Padding);
7407           end;
7408           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7409           result := true;
7410         finally
7411           if Assigned(LineBuf) then
7412             FreeMem(LineBuf);
7413           if Assigned(SourceMD) then
7414             SpecialFormat.FreeMappingData(SourceMD);
7415           FormatDesc.FreeMappingData(DestMD);
7416         end;
7417         except
7418           if Assigned(ImageData) then
7419             FreeMem(ImageData);
7420           raise;
7421         end;
7422       end else
7423         raise EglBitmap.Create('LoadBMP - No suitable format found');
7424     except
7425       aStream.Position := StartPos;
7426       raise;
7427     end;
7428     finally
7429       FreeAndNil(SpecialFormat);
7430     end;
7431   end
7432     else aStream.Position := StartPos;
7433 end;
7434
7435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7436 procedure TglBitmap.SaveBMP(const aStream: TStream);
7437 var
7438   Header: TBMPHeader;
7439   Info: TBMPInfo;
7440   Converter: TFormatDescriptor;
7441   FormatDesc: TFormatDescriptor;
7442   SourceFD, DestFD: Pointer;
7443   pData, srcData, dstData, ConvertBuffer: pByte;
7444
7445   Pixel: TglBitmapPixelData;
7446   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7447   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7448
7449   PaddingBuff: Cardinal;
7450
7451   function GetLineWidth : Integer;
7452   begin
7453     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7454   end;
7455
7456 begin
7457   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7458     raise EglBitmapUnsupportedFormat.Create(Format);
7459
7460   Converter  := nil;
7461   FormatDesc := TFormatDescriptor.Get(Format);
7462   ImageSize  := FormatDesc.GetSize(Dimension);
7463
7464   FillChar(Header{%H-}, SizeOf(Header), 0);
7465   Header.bfType      := BMP_MAGIC;
7466   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7467   Header.bfReserved1 := 0;
7468   Header.bfReserved2 := 0;
7469   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7470
7471   FillChar(Info{%H-}, SizeOf(Info), 0);
7472   Info.biSize        := SizeOf(Info);
7473   Info.biWidth       := Width;
7474   Info.biHeight      := Height;
7475   Info.biPlanes      := 1;
7476   Info.biCompression := BMP_COMP_RGB;
7477   Info.biSizeImage   := ImageSize;
7478
7479   try
7480     case Format of
7481       tfLuminance4: begin
7482         Info.biBitCount  := 4;
7483         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7484         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7485         Converter := TbmpColorTableFormat.Create;
7486         with (Converter as TbmpColorTableFormat) do begin
7487           PixelSize := 0.5;
7488           Format    := Format;
7489           Range     := glBitmapColorRec($F, $F, $F, $0);
7490           CreateColorTable;
7491         end;
7492       end;
7493
7494       tfR3G3B2, tfLuminance8: begin
7495         Info.biBitCount  :=  8;
7496         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7497         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7498         Converter := TbmpColorTableFormat.Create;
7499         with (Converter as TbmpColorTableFormat) do begin
7500           PixelSize := 1;
7501           Format    := Format;
7502           if (Format = tfR3G3B2) then begin
7503             Range := glBitmapColorRec($7, $7, $3, $0);
7504             Shift := glBitmapShiftRec(0, 3, 6, 0);
7505           end else
7506             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7507           CreateColorTable;
7508         end;
7509       end;
7510
7511       tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
7512       tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4: begin
7513         Info.biBitCount    := 16;
7514         Info.biCompression := BMP_COMP_BITFIELDS;
7515       end;
7516
7517       tfBGR8, tfRGB8: begin
7518         Info.biBitCount := 24;
7519         if (Format = tfRGB8) then
7520           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7521       end;
7522
7523       tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
7524       tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8: begin
7525         Info.biBitCount    := 32;
7526         Info.biCompression := BMP_COMP_BITFIELDS;
7527       end;
7528     else
7529       raise EglBitmapUnsupportedFormat.Create(Format);
7530     end;
7531     Info.biXPelsPerMeter := 2835;
7532     Info.biYPelsPerMeter := 2835;
7533
7534     // prepare bitmasks
7535     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7536       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7537       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7538
7539       RedMask    := FormatDesc.RedMask;
7540       GreenMask  := FormatDesc.GreenMask;
7541       BlueMask   := FormatDesc.BlueMask;
7542       AlphaMask  := FormatDesc.AlphaMask;
7543     end;
7544
7545     // headers
7546     aStream.Write(Header, SizeOf(Header));
7547     aStream.Write(Info, SizeOf(Info));
7548
7549     // colortable
7550     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7551       with (Converter as TbmpColorTableFormat) do
7552         aStream.Write(ColorTable[0].b,
7553           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7554
7555     // bitmasks
7556     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7557       aStream.Write(RedMask,   SizeOf(Cardinal));
7558       aStream.Write(GreenMask, SizeOf(Cardinal));
7559       aStream.Write(BlueMask,  SizeOf(Cardinal));
7560       aStream.Write(AlphaMask, SizeOf(Cardinal));
7561     end;
7562
7563     // image data
7564     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7565     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7566     Padding     := GetLineWidth - wbLineSize;
7567     PaddingBuff := 0;
7568
7569     pData := Data;
7570     inc(pData, (Height-1) * rbLineSize);
7571
7572     // prepare row buffer. But only for RGB because RGBA supports color masks
7573     // so it's possible to change color within the image.
7574     if Assigned(Converter) then begin
7575       FormatDesc.PreparePixel(Pixel);
7576       GetMem(ConvertBuffer, wbLineSize);
7577       SourceFD := FormatDesc.CreateMappingData;
7578       DestFD   := Converter.CreateMappingData;
7579     end else
7580       ConvertBuffer := nil;
7581
7582     try
7583       for LineIdx := 0 to Height - 1 do begin
7584         // preparing row
7585         if Assigned(Converter) then begin
7586           srcData := pData;
7587           dstData := ConvertBuffer;
7588           for PixelIdx := 0 to Info.biWidth-1 do begin
7589             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7590             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7591             Converter.Map(Pixel, dstData, DestFD);
7592           end;
7593           aStream.Write(ConvertBuffer^, wbLineSize);
7594         end else begin
7595           aStream.Write(pData^, rbLineSize);
7596         end;
7597         dec(pData, rbLineSize);
7598         if (Padding > 0) then
7599           aStream.Write(PaddingBuff, Padding);
7600       end;
7601     finally
7602       // destroy row buffer
7603       if Assigned(ConvertBuffer) then begin
7604         FormatDesc.FreeMappingData(SourceFD);
7605         Converter.FreeMappingData(DestFD);
7606         FreeMem(ConvertBuffer);
7607       end;
7608     end;
7609   finally
7610     if Assigned(Converter) then
7611       Converter.Free;
7612   end;
7613 end;
7614
7615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7616 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7618 type
7619   TTGAHeader = packed record
7620     ImageID: Byte;
7621     ColorMapType: Byte;
7622     ImageType: Byte;
7623     //ColorMapSpec: Array[0..4] of Byte;
7624     ColorMapStart: Word;
7625     ColorMapLength: Word;
7626     ColorMapEntrySize: Byte;
7627     OrigX: Word;
7628     OrigY: Word;
7629     Width: Word;
7630     Height: Word;
7631     Bpp: Byte;
7632     ImageDesc: Byte;
7633   end;
7634
7635 const
7636   TGA_UNCOMPRESSED_RGB  =  2;
7637   TGA_UNCOMPRESSED_GRAY =  3;
7638   TGA_COMPRESSED_RGB    = 10;
7639   TGA_COMPRESSED_GRAY   = 11;
7640
7641   TGA_NONE_COLOR_TABLE  = 0;
7642
7643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7644 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7645 var
7646   Header: TTGAHeader;
7647   ImageData: System.PByte;
7648   StartPosition: Int64;
7649   PixelSize, LineSize: Integer;
7650   tgaFormat: TglBitmapFormat;
7651   FormatDesc: TFormatDescriptor;
7652   Counter: packed record
7653     X, Y: packed record
7654       low, high, dir: Integer;
7655     end;
7656   end;
7657
7658 const
7659   CACHE_SIZE = $4000;
7660
7661   ////////////////////////////////////////////////////////////////////////////////////////
7662   procedure ReadUncompressed;
7663   var
7664     i, j: Integer;
7665     buf, tmp1, tmp2: System.PByte;
7666   begin
7667     buf := nil;
7668     if (Counter.X.dir < 0) then
7669       GetMem(buf, LineSize);
7670     try
7671       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7672         tmp1 := ImageData;
7673         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7674         if (Counter.X.dir < 0) then begin               //flip X
7675           aStream.Read(buf^, LineSize);
7676           tmp2 := buf;
7677           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7678           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7679             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7680               tmp1^ := tmp2^;
7681               inc(tmp1);
7682               inc(tmp2);
7683             end;
7684             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7685           end;
7686         end else
7687           aStream.Read(tmp1^, LineSize);
7688         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7689       end;
7690     finally
7691       if Assigned(buf) then
7692         FreeMem(buf);
7693     end;
7694   end;
7695
7696   ////////////////////////////////////////////////////////////////////////////////////////
7697   procedure ReadCompressed;
7698
7699     /////////////////////////////////////////////////////////////////
7700     var
7701       TmpData: System.PByte;
7702       LinePixelsRead: Integer;
7703     procedure CheckLine;
7704     begin
7705       if (LinePixelsRead >= Header.Width) then begin
7706         LinePixelsRead := 0;
7707         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7708         TmpData := ImageData;
7709         inc(TmpData, Counter.Y.low * LineSize);           //set line
7710         if (Counter.X.dir < 0) then                       //if x flipped then
7711           inc(TmpData, LineSize - PixelSize);             //set last pixel
7712       end;
7713     end;
7714
7715     /////////////////////////////////////////////////////////////////
7716     var
7717       Cache: PByte;
7718       CacheSize, CachePos: Integer;
7719     procedure CachedRead(out Buffer; Count: Integer);
7720     var
7721       BytesRead: Integer;
7722     begin
7723       if (CachePos + Count > CacheSize) then begin
7724         //if buffer overflow save non read bytes
7725         BytesRead := 0;
7726         if (CacheSize - CachePos > 0) then begin
7727           BytesRead := CacheSize - CachePos;
7728           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7729           inc(CachePos, BytesRead);
7730         end;
7731
7732         //load cache from file
7733         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7734         aStream.Read(Cache^, CacheSize);
7735         CachePos := 0;
7736
7737         //read rest of requested bytes
7738         if (Count - BytesRead > 0) then begin
7739           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7740           inc(CachePos, Count - BytesRead);
7741         end;
7742       end else begin
7743         //if no buffer overflow just read the data
7744         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7745         inc(CachePos, Count);
7746       end;
7747     end;
7748
7749     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7750     begin
7751       case PixelSize of
7752         1: begin
7753           aBuffer^ := aData^;
7754           inc(aBuffer, Counter.X.dir);
7755         end;
7756         2: begin
7757           PWord(aBuffer)^ := PWord(aData)^;
7758           inc(aBuffer, 2 * Counter.X.dir);
7759         end;
7760         3: begin
7761           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7762           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7763           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7764           inc(aBuffer, 3 * Counter.X.dir);
7765         end;
7766         4: begin
7767           PCardinal(aBuffer)^ := PCardinal(aData)^;
7768           inc(aBuffer, 4 * Counter.X.dir);
7769         end;
7770       end;
7771     end;
7772
7773   var
7774     TotalPixelsToRead, TotalPixelsRead: Integer;
7775     Temp: Byte;
7776     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7777     PixelRepeat: Boolean;
7778     PixelsToRead, PixelCount: Integer;
7779   begin
7780     CacheSize := 0;
7781     CachePos  := 0;
7782
7783     TotalPixelsToRead := Header.Width * Header.Height;
7784     TotalPixelsRead   := 0;
7785     LinePixelsRead    := 0;
7786
7787     GetMem(Cache, CACHE_SIZE);
7788     try
7789       TmpData := ImageData;
7790       inc(TmpData, Counter.Y.low * LineSize);           //set line
7791       if (Counter.X.dir < 0) then                       //if x flipped then
7792         inc(TmpData, LineSize - PixelSize);             //set last pixel
7793
7794       repeat
7795         //read CommandByte
7796         CachedRead(Temp, 1);
7797         PixelRepeat  := (Temp and $80) > 0;
7798         PixelsToRead := (Temp and $7F) + 1;
7799         inc(TotalPixelsRead, PixelsToRead);
7800
7801         if PixelRepeat then
7802           CachedRead(buf[0], PixelSize);
7803         while (PixelsToRead > 0) do begin
7804           CheckLine;
7805           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7806           while (PixelCount > 0) do begin
7807             if not PixelRepeat then
7808               CachedRead(buf[0], PixelSize);
7809             PixelToBuffer(@buf[0], TmpData);
7810             inc(LinePixelsRead);
7811             dec(PixelsToRead);
7812             dec(PixelCount);
7813           end;
7814         end;
7815       until (TotalPixelsRead >= TotalPixelsToRead);
7816     finally
7817       FreeMem(Cache);
7818     end;
7819   end;
7820
7821   function IsGrayFormat: Boolean;
7822   begin
7823     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7824   end;
7825
7826 begin
7827   result := false;
7828
7829   // reading header to test file and set cursor back to begin
7830   StartPosition := aStream.Position;
7831   aStream.Read(Header{%H-}, SizeOf(Header));
7832
7833   // no colormapped files
7834   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7835     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7836   begin
7837     try
7838       if Header.ImageID <> 0 then       // skip image ID
7839         aStream.Position := aStream.Position + Header.ImageID;
7840
7841       tgaFormat := tfEmpty;
7842       case Header.Bpp of
7843          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7844                0: tgaFormat := tfLuminance8;
7845                8: tgaFormat := tfAlpha8;
7846             end;
7847
7848         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7849                0: tgaFormat := tfLuminance16;
7850                8: tgaFormat := tfLuminance8Alpha8;
7851             end else case (Header.ImageDesc and $F) of
7852                0: tgaFormat := tfX1RGB5;
7853                1: tgaFormat := tfA1RGB5;
7854                4: tgaFormat := tfARGB4;
7855             end;
7856
7857         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7858                0: tgaFormat := tfRGB8;
7859             end;
7860
7861         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7862                2: tgaFormat := tfA2RGB10;
7863                8: tgaFormat := tfARGB8;
7864             end;
7865       end;
7866
7867       if (tgaFormat = tfEmpty) then
7868         raise EglBitmap.Create('LoadTga - unsupported format');
7869
7870       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7871       PixelSize  := FormatDesc.GetSize(1, 1);
7872       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7873
7874       GetMem(ImageData, LineSize * Header.Height);
7875       try
7876         //column direction
7877         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7878           Counter.X.low  := Header.Height-1;;
7879           Counter.X.high := 0;
7880           Counter.X.dir  := -1;
7881         end else begin
7882           Counter.X.low  := 0;
7883           Counter.X.high := Header.Height-1;
7884           Counter.X.dir  := 1;
7885         end;
7886
7887         // Row direction
7888         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7889           Counter.Y.low  := 0;
7890           Counter.Y.high := Header.Height-1;
7891           Counter.Y.dir  := 1;
7892         end else begin
7893           Counter.Y.low  := Header.Height-1;;
7894           Counter.Y.high := 0;
7895           Counter.Y.dir  := -1;
7896         end;
7897
7898         // Read Image
7899         case Header.ImageType of
7900           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7901             ReadUncompressed;
7902           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7903             ReadCompressed;
7904         end;
7905
7906         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7907         result := true;
7908       except
7909         if Assigned(ImageData) then
7910           FreeMem(ImageData);
7911         raise;
7912       end;
7913     finally
7914       aStream.Position := StartPosition;
7915     end;
7916   end
7917     else aStream.Position := StartPosition;
7918 end;
7919
7920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7921 procedure TglBitmap.SaveTGA(const aStream: TStream);
7922 var
7923   Header: TTGAHeader;
7924   LineSize, Size, x, y: Integer;
7925   Pixel: TglBitmapPixelData;
7926   LineBuf, SourceData, DestData: PByte;
7927   SourceMD, DestMD: Pointer;
7928   FormatDesc: TFormatDescriptor;
7929   Converter: TFormatDescriptor;
7930 begin
7931   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7932     raise EglBitmapUnsupportedFormat.Create(Format);
7933
7934   //prepare header
7935   FillChar(Header{%H-}, SizeOf(Header), 0);
7936
7937   //set ImageType
7938   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7939                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7940     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7941   else
7942     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7943
7944   //set BitsPerPixel
7945   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7946     Header.Bpp := 8
7947   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7948                       tfRGB5X1, tfBGR5X1, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7949     Header.Bpp := 16
7950   else if (Format in [tfBGR8, tfRGB8]) then
7951     Header.Bpp := 24
7952   else
7953     Header.Bpp := 32;
7954
7955   //set AlphaBitCount
7956   case Format of
7957     tfRGB5A1, tfBGR5A1:
7958       Header.ImageDesc := 1 and $F;
7959     tfRGB10A2, tfBGR10A2:
7960       Header.ImageDesc := 2 and $F;
7961     tfRGBA4, tfBGRA4:
7962       Header.ImageDesc := 4 and $F;
7963     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7964       Header.ImageDesc := 8 and $F;
7965   end;
7966
7967   Header.Width     := Width;
7968   Header.Height    := Height;
7969   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7970   aStream.Write(Header, SizeOf(Header));
7971
7972   // convert RGB(A) to BGR(A)
7973   Converter  := nil;
7974   FormatDesc := TFormatDescriptor.Get(Format);
7975   Size       := FormatDesc.GetSize(Dimension);
7976   if Format in [tfRGB5X1, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7977     if (FormatDesc.RGBInverted = tfEmpty) then
7978       raise EglBitmap.Create('inverted RGB format is empty');
7979     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7980     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7981        (Converter.PixelSize <> FormatDesc.PixelSize) then
7982       raise EglBitmap.Create('invalid inverted RGB format');
7983   end;
7984
7985   if Assigned(Converter) then begin
7986     LineSize := FormatDesc.GetSize(Width, 1);
7987     GetMem(LineBuf, LineSize);
7988     SourceMD := FormatDesc.CreateMappingData;
7989     DestMD   := Converter.CreateMappingData;
7990     try
7991       SourceData := Data;
7992       for y := 0 to Height-1 do begin
7993         DestData := LineBuf;
7994         for x := 0 to Width-1 do begin
7995           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7996           Converter.Map(Pixel, DestData, DestMD);
7997         end;
7998         aStream.Write(LineBuf^, LineSize);
7999       end;
8000     finally
8001       FreeMem(LineBuf);
8002       FormatDesc.FreeMappingData(SourceMD);
8003       FormatDesc.FreeMappingData(DestMD);
8004     end;
8005   end else
8006     aStream.Write(Data^, Size);
8007 end;
8008
8009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8010 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8012 const
8013   DDS_MAGIC: Cardinal         = $20534444;
8014
8015   // DDS_header.dwFlags
8016   DDSD_CAPS                   = $00000001;
8017   DDSD_HEIGHT                 = $00000002;
8018   DDSD_WIDTH                  = $00000004;
8019   DDSD_PIXELFORMAT            = $00001000;
8020
8021   // DDS_header.sPixelFormat.dwFlags
8022   DDPF_ALPHAPIXELS            = $00000001;
8023   DDPF_ALPHA                  = $00000002;
8024   DDPF_FOURCC                 = $00000004;
8025   DDPF_RGB                    = $00000040;
8026   DDPF_LUMINANCE              = $00020000;
8027
8028   // DDS_header.sCaps.dwCaps1
8029   DDSCAPS_TEXTURE             = $00001000;
8030
8031   // DDS_header.sCaps.dwCaps2
8032   DDSCAPS2_CUBEMAP            = $00000200;
8033
8034   D3DFMT_DXT1                 = $31545844;
8035   D3DFMT_DXT3                 = $33545844;
8036   D3DFMT_DXT5                 = $35545844;
8037
8038 type
8039   TDDSPixelFormat = packed record
8040     dwSize: Cardinal;
8041     dwFlags: Cardinal;
8042     dwFourCC: Cardinal;
8043     dwRGBBitCount: Cardinal;
8044     dwRBitMask: Cardinal;
8045     dwGBitMask: Cardinal;
8046     dwBBitMask: Cardinal;
8047     dwABitMask: Cardinal;
8048   end;
8049
8050   TDDSCaps = packed record
8051     dwCaps1: Cardinal;
8052     dwCaps2: Cardinal;
8053     dwDDSX: Cardinal;
8054     dwReserved: Cardinal;
8055   end;
8056
8057   TDDSHeader = packed record
8058     dwSize: Cardinal;
8059     dwFlags: Cardinal;
8060     dwHeight: Cardinal;
8061     dwWidth: Cardinal;
8062     dwPitchOrLinearSize: Cardinal;
8063     dwDepth: Cardinal;
8064     dwMipMapCount: Cardinal;
8065     dwReserved: array[0..10] of Cardinal;
8066     PixelFormat: TDDSPixelFormat;
8067     Caps: TDDSCaps;
8068     dwReserved2: Cardinal;
8069   end;
8070
8071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8072 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8073 var
8074   Header: TDDSHeader;
8075   Converter: TbmpBitfieldFormat;
8076
8077   function GetDDSFormat: TglBitmapFormat;
8078   var
8079     fd: TFormatDescriptor;
8080     i: Integer;
8081     Range: TglBitmapColorRec;
8082     match: Boolean;
8083   begin
8084     result := tfEmpty;
8085     with Header.PixelFormat do begin
8086       // Compresses
8087       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8088         case Header.PixelFormat.dwFourCC of
8089           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8090           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8091           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8092         end;
8093       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
8094         // prepare masks
8095         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8096           Range.r := dwRBitMask;
8097           Range.g := dwGBitMask;
8098           Range.b := dwBBitMask;
8099         end else begin
8100           Range.r := dwRBitMask;
8101           Range.g := dwRBitMask;
8102           Range.b := dwRBitMask;
8103         end;
8104         Range.a := dwABitMask;
8105
8106         //find matching format
8107         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8108           fd := TFormatDescriptor.Get(result);
8109           if fd.MaskMatch(Range.r, Range.g, Range.b, Range.a) and
8110              (8 * fd.PixelSize = dwRGBBitCount) then
8111             exit;
8112         end;
8113
8114         //find format with same Range
8115         for i := 0 to 3 do begin
8116           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
8117             Range.arr[i] := Range.arr[i] shr 1;
8118         end;
8119         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8120           fd := TFormatDescriptor.Get(result);
8121           match := true;
8122           for i := 0 to 3 do
8123             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8124               match := false;
8125               break;
8126             end;
8127           if match then
8128             break;
8129         end;
8130
8131         //no format with same range found -> use default
8132         if (result = tfEmpty) then begin
8133           if (dwABitMask > 0) then
8134             result := tfRGBA8
8135           else
8136             result := tfRGB8;
8137         end;
8138
8139         Converter := TbmpBitfieldFormat.Create;
8140         Converter.RedMask   := dwRBitMask;
8141         Converter.GreenMask := dwGBitMask;
8142         Converter.BlueMask  := dwBBitMask;
8143         Converter.AlphaMask := dwABitMask;
8144         Converter.PixelSize := dwRGBBitCount / 8;
8145       end;
8146     end;
8147   end;
8148
8149 var
8150   StreamPos: Int64;
8151   x, y, LineSize, RowSize, Magic: Cardinal;
8152   NewImage, TmpData, RowData, SrcData: System.PByte;
8153   SourceMD, DestMD: Pointer;
8154   Pixel: TglBitmapPixelData;
8155   ddsFormat: TglBitmapFormat;
8156   FormatDesc: TFormatDescriptor;
8157
8158 begin
8159   result    := false;
8160   Converter := nil;
8161   StreamPos := aStream.Position;
8162
8163   // Magic
8164   aStream.Read(Magic{%H-}, sizeof(Magic));
8165   if (Magic <> DDS_MAGIC) then begin
8166     aStream.Position := StreamPos;
8167     exit;
8168   end;
8169
8170   //Header
8171   aStream.Read(Header{%H-}, sizeof(Header));
8172   if (Header.dwSize <> SizeOf(Header)) or
8173      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8174         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8175   begin
8176     aStream.Position := StreamPos;
8177     exit;
8178   end;
8179
8180   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8181     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8182
8183   ddsFormat := GetDDSFormat;
8184   try
8185     if (ddsFormat = tfEmpty) then
8186       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8187
8188     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8189     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
8190     GetMem(NewImage, Header.dwHeight * LineSize);
8191     try
8192       TmpData := NewImage;
8193
8194       //Converter needed
8195       if Assigned(Converter) then begin
8196         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8197         GetMem(RowData, RowSize);
8198         SourceMD := Converter.CreateMappingData;
8199         DestMD   := FormatDesc.CreateMappingData;
8200         try
8201           for y := 0 to Header.dwHeight-1 do begin
8202             TmpData := NewImage;
8203             inc(TmpData, y * LineSize);
8204             SrcData := RowData;
8205             aStream.Read(SrcData^, RowSize);
8206             for x := 0 to Header.dwWidth-1 do begin
8207               Converter.Unmap(SrcData, Pixel, SourceMD);
8208               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8209               FormatDesc.Map(Pixel, TmpData, DestMD);
8210             end;
8211           end;
8212         finally
8213           Converter.FreeMappingData(SourceMD);
8214           FormatDesc.FreeMappingData(DestMD);
8215           FreeMem(RowData);
8216         end;
8217       end else
8218
8219       // Compressed
8220       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8221         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8222         for Y := 0 to Header.dwHeight-1 do begin
8223           aStream.Read(TmpData^, RowSize);
8224           Inc(TmpData, LineSize);
8225         end;
8226       end else
8227
8228       // Uncompressed
8229       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8230         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8231         for Y := 0 to Header.dwHeight-1 do begin
8232           aStream.Read(TmpData^, RowSize);
8233           Inc(TmpData, LineSize);
8234         end;
8235       end else
8236         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8237
8238       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8239       result := true;
8240     except
8241       if Assigned(NewImage) then
8242         FreeMem(NewImage);
8243       raise;
8244     end;
8245   finally
8246     FreeAndNil(Converter);
8247   end;
8248 end;
8249
8250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8251 procedure TglBitmap.SaveDDS(const aStream: TStream);
8252 var
8253   Header: TDDSHeader;
8254   FormatDesc: TFormatDescriptor;
8255 begin
8256   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8257     raise EglBitmapUnsupportedFormat.Create(Format);
8258
8259   FormatDesc := TFormatDescriptor.Get(Format);
8260
8261   // Generell
8262   FillChar(Header{%H-}, SizeOf(Header), 0);
8263   Header.dwSize  := SizeOf(Header);
8264   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8265
8266   Header.dwWidth  := Max(1, Width);
8267   Header.dwHeight := Max(1, Height);
8268
8269   // Caps
8270   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8271
8272   // Pixelformat
8273   Header.PixelFormat.dwSize := sizeof(Header);
8274   if (FormatDesc.IsCompressed) then begin
8275     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8276     case Format of
8277       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8278       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8279       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8280     end;
8281   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
8282     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8283     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8284     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8285   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
8286     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8287     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8288     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8289     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8290   end else begin
8291     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8292     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
8293     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
8294     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
8295     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
8296     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
8297   end;
8298
8299   if (FormatDesc.HasAlpha) then
8300     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8301
8302   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8303   aStream.Write(Header, SizeOf(Header));
8304   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8305 end;
8306
8307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8308 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8310 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8311   const aWidth: Integer; const aHeight: Integer);
8312 var
8313   pTemp: pByte;
8314   Size: Integer;
8315 begin
8316   if (aHeight > 1) then begin
8317     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8318     GetMem(pTemp, Size);
8319     try
8320       Move(aData^, pTemp^, Size);
8321       FreeMem(aData);
8322       aData := nil;
8323     except
8324       FreeMem(pTemp);
8325       raise;
8326     end;
8327   end else
8328     pTemp := aData;
8329   inherited SetDataPointer(pTemp, aFormat, aWidth);
8330 end;
8331
8332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8333 function TglBitmap1D.FlipHorz: Boolean;
8334 var
8335   Col: Integer;
8336   pTempDest, pDest, pSource: PByte;
8337 begin
8338   result := inherited FlipHorz;
8339   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8340     pSource := Data;
8341     GetMem(pDest, fRowSize);
8342     try
8343       pTempDest := pDest;
8344       Inc(pTempDest, fRowSize);
8345       for Col := 0 to Width-1 do begin
8346         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8347         Move(pSource^, pTempDest^, fPixelSize);
8348         Inc(pSource, fPixelSize);
8349       end;
8350       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8351       result := true;
8352     except
8353       if Assigned(pDest) then
8354         FreeMem(pDest);
8355       raise;
8356     end;
8357   end;
8358 end;
8359
8360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8361 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8362 var
8363   FormatDesc: TFormatDescriptor;
8364 begin
8365   // Upload data
8366   FormatDesc := TFormatDescriptor.Get(Format);
8367   if FormatDesc.IsCompressed then begin
8368     if not Assigned(glCompressedTexImage1D) then
8369       raise EglBitmap.Create('compressed formats not supported by video adapter');
8370     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8371   end else if aBuildWithGlu then
8372     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8373   else
8374     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8375
8376   // Free Data
8377   if (FreeDataAfterGenTexture) then
8378     FreeData;
8379 end;
8380
8381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8382 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8383 var
8384   BuildWithGlu, TexRec: Boolean;
8385   TexSize: Integer;
8386 begin
8387   if Assigned(Data) then begin
8388     // Check Texture Size
8389     if (aTestTextureSize) then begin
8390       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8391
8392       if (Width > TexSize) then
8393         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8394
8395       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8396                 (Target = GL_TEXTURE_RECTANGLE);
8397       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8398         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8399     end;
8400
8401     CreateId;
8402     SetupParameters(BuildWithGlu);
8403     UploadData(BuildWithGlu);
8404     glAreTexturesResident(1, @fID, @fIsResident);
8405   end;
8406 end;
8407
8408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8409 procedure TglBitmap1D.AfterConstruction;
8410 begin
8411   inherited;
8412   Target := GL_TEXTURE_1D;
8413 end;
8414
8415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8416 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8418 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8419 begin
8420   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8421     result := fLines[aIndex]
8422   else
8423     result := nil;
8424 end;
8425
8426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8427 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8428   const aWidth: Integer; const aHeight: Integer);
8429 var
8430   Idx, LineWidth: Integer;
8431 begin
8432   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8433
8434   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8435     // Assigning Data
8436     if Assigned(Data) then begin
8437       SetLength(fLines, GetHeight);
8438       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
8439
8440       for Idx := 0 to GetHeight-1 do begin
8441         fLines[Idx] := Data;
8442         Inc(fLines[Idx], Idx * LineWidth);
8443       end;
8444     end
8445       else SetLength(fLines, 0);
8446   end else begin
8447     SetLength(fLines, 0);
8448   end;
8449 end;
8450
8451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8452 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8453 var
8454   FormatDesc: TFormatDescriptor;
8455 begin
8456   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8457
8458   FormatDesc := TFormatDescriptor.Get(Format);
8459   if FormatDesc.IsCompressed then begin
8460     if not Assigned(glCompressedTexImage2D) then
8461       raise EglBitmap.Create('compressed formats not supported by video adapter');
8462     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8463   end else if aBuildWithGlu then begin
8464     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8465       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8466   end else begin
8467     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8468       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8469   end;
8470
8471   // Freigeben
8472   if (FreeDataAfterGenTexture) then
8473     FreeData;
8474 end;
8475
8476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8477 procedure TglBitmap2D.AfterConstruction;
8478 begin
8479   inherited;
8480   Target := GL_TEXTURE_2D;
8481 end;
8482
8483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8484 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8485 var
8486   Temp: pByte;
8487   Size, w, h: Integer;
8488   FormatDesc: TFormatDescriptor;
8489 begin
8490   FormatDesc := TFormatDescriptor.Get(aFormat);
8491   if FormatDesc.IsCompressed then
8492     raise EglBitmapUnsupportedFormat.Create(aFormat);
8493
8494   w    := aRight  - aLeft;
8495   h    := aBottom - aTop;
8496   Size := FormatDesc.GetSize(w, h);
8497   GetMem(Temp, Size);
8498   try
8499     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8500     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8501     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8502     FlipVert;
8503   except
8504     if Assigned(Temp) then
8505       FreeMem(Temp);
8506     raise;
8507   end;
8508 end;
8509
8510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8511 procedure TglBitmap2D.GetDataFromTexture;
8512 var
8513   Temp: PByte;
8514   TempWidth, TempHeight: Integer;
8515   TempIntFormat: GLint;
8516   IntFormat: TglBitmapFormat;
8517   FormatDesc: TFormatDescriptor;
8518 begin
8519   Bind;
8520
8521   // Request Data
8522   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8523   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8524   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8525
8526   IntFormat  := tfEmpty;
8527   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8528   IntFormat  := FormatDesc.Format;
8529
8530   // Getting data from OpenGL
8531   FormatDesc := TFormatDescriptor.Get(IntFormat);
8532   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8533   try
8534     if FormatDesc.IsCompressed then begin
8535       if not Assigned(glGetCompressedTexImage) then
8536         raise EglBitmap.Create('compressed formats not supported by video adapter');
8537       glGetCompressedTexImage(Target, 0, Temp)
8538     end else
8539       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8540     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8541   except
8542     if Assigned(Temp) then
8543       FreeMem(Temp);
8544     raise;
8545   end;
8546 end;
8547
8548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8549 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8550 var
8551   BuildWithGlu, PotTex, TexRec: Boolean;
8552   TexSize: Integer;
8553 begin
8554   if Assigned(Data) then begin
8555     // Check Texture Size
8556     if (aTestTextureSize) then begin
8557       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8558
8559       if ((Height > TexSize) or (Width > TexSize)) then
8560         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8561
8562       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8563       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8564       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8565         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8566     end;
8567
8568     CreateId;
8569     SetupParameters(BuildWithGlu);
8570     UploadData(Target, BuildWithGlu);
8571     glAreTexturesResident(1, @fID, @fIsResident);
8572   end;
8573 end;
8574
8575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8576 function TglBitmap2D.FlipHorz: Boolean;
8577 var
8578   Col, Row: Integer;
8579   TempDestData, DestData, SourceData: PByte;
8580   ImgSize: Integer;
8581 begin
8582   result := inherited FlipHorz;
8583   if Assigned(Data) then begin
8584     SourceData := Data;
8585     ImgSize := Height * fRowSize;
8586     GetMem(DestData, ImgSize);
8587     try
8588       TempDestData := DestData;
8589       Dec(TempDestData, fRowSize + fPixelSize);
8590       for Row := 0 to Height -1 do begin
8591         Inc(TempDestData, fRowSize * 2);
8592         for Col := 0 to Width -1 do begin
8593           Move(SourceData^, TempDestData^, fPixelSize);
8594           Inc(SourceData, fPixelSize);
8595           Dec(TempDestData, fPixelSize);
8596         end;
8597       end;
8598       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8599       result := true;
8600     except
8601       if Assigned(DestData) then
8602         FreeMem(DestData);
8603       raise;
8604     end;
8605   end;
8606 end;
8607
8608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8609 function TglBitmap2D.FlipVert: Boolean;
8610 var
8611   Row: Integer;
8612   TempDestData, DestData, SourceData: PByte;
8613 begin
8614   result := inherited FlipVert;
8615   if Assigned(Data) then begin
8616     SourceData := Data;
8617     GetMem(DestData, Height * fRowSize);
8618     try
8619       TempDestData := DestData;
8620       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8621       for Row := 0 to Height -1 do begin
8622         Move(SourceData^, TempDestData^, fRowSize);
8623         Dec(TempDestData, fRowSize);
8624         Inc(SourceData, fRowSize);
8625       end;
8626       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8627       result := true;
8628     except
8629       if Assigned(DestData) then
8630         FreeMem(DestData);
8631       raise;
8632     end;
8633   end;
8634 end;
8635
8636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8637 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8639 type
8640   TMatrixItem = record
8641     X, Y: Integer;
8642     W: Single;
8643   end;
8644
8645   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8646   TglBitmapToNormalMapRec = Record
8647     Scale: Single;
8648     Heights: array of Single;
8649     MatrixU : array of TMatrixItem;
8650     MatrixV : array of TMatrixItem;
8651   end;
8652
8653 const
8654   ONE_OVER_255 = 1 / 255;
8655
8656   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8657 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8658 var
8659   Val: Single;
8660 begin
8661   with FuncRec do begin
8662     Val :=
8663       Source.Data.r * LUMINANCE_WEIGHT_R +
8664       Source.Data.g * LUMINANCE_WEIGHT_G +
8665       Source.Data.b * LUMINANCE_WEIGHT_B;
8666     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8667   end;
8668 end;
8669
8670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8671 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8672 begin
8673   with FuncRec do
8674     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8675 end;
8676
8677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8678 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8679 type
8680   TVec = Array[0..2] of Single;
8681 var
8682   Idx: Integer;
8683   du, dv: Double;
8684   Len: Single;
8685   Vec: TVec;
8686
8687   function GetHeight(X, Y: Integer): Single;
8688   begin
8689     with FuncRec do begin
8690       X := Max(0, Min(Size.X -1, X));
8691       Y := Max(0, Min(Size.Y -1, Y));
8692       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8693     end;
8694   end;
8695
8696 begin
8697   with FuncRec do begin
8698     with PglBitmapToNormalMapRec(Args)^ do begin
8699       du := 0;
8700       for Idx := Low(MatrixU) to High(MatrixU) do
8701         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8702
8703       dv := 0;
8704       for Idx := Low(MatrixU) to High(MatrixU) do
8705         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8706
8707       Vec[0] := -du * Scale;
8708       Vec[1] := -dv * Scale;
8709       Vec[2] := 1;
8710     end;
8711
8712     // Normalize
8713     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8714     if Len <> 0 then begin
8715       Vec[0] := Vec[0] * Len;
8716       Vec[1] := Vec[1] * Len;
8717       Vec[2] := Vec[2] * Len;
8718     end;
8719
8720     // Farbe zuweisem
8721     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8722     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8723     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8724   end;
8725 end;
8726
8727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8728 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8729 var
8730   Rec: TglBitmapToNormalMapRec;
8731
8732   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8733   begin
8734     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8735       Matrix[Index].X := X;
8736       Matrix[Index].Y := Y;
8737       Matrix[Index].W := W;
8738     end;
8739   end;
8740
8741 begin
8742   if TFormatDescriptor.Get(Format).IsCompressed then
8743     raise EglBitmapUnsupportedFormat.Create(Format);
8744
8745   if aScale > 100 then
8746     Rec.Scale := 100
8747   else if aScale < -100 then
8748     Rec.Scale := -100
8749   else
8750     Rec.Scale := aScale;
8751
8752   SetLength(Rec.Heights, Width * Height);
8753   try
8754     case aFunc of
8755       nm4Samples: begin
8756         SetLength(Rec.MatrixU, 2);
8757         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8758         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8759
8760         SetLength(Rec.MatrixV, 2);
8761         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8762         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8763       end;
8764
8765       nmSobel: begin
8766         SetLength(Rec.MatrixU, 6);
8767         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8768         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8769         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8770         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8771         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8772         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8773
8774         SetLength(Rec.MatrixV, 6);
8775         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8776         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8777         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8778         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8779         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8780         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8781       end;
8782
8783       nm3x3: begin
8784         SetLength(Rec.MatrixU, 6);
8785         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8786         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8787         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8788         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8789         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8790         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8791
8792         SetLength(Rec.MatrixV, 6);
8793         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8794         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8795         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8796         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8797         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8798         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8799       end;
8800
8801       nm5x5: begin
8802         SetLength(Rec.MatrixU, 20);
8803         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8804         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8805         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8806         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8807         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8808         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8809         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8810         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8811         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8812         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8813         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8814         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8815         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8816         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8817         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8818         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8819         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8820         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8821         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8822         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8823
8824         SetLength(Rec.MatrixV, 20);
8825         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8826         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8827         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8828         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8829         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8830         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8831         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8832         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8833         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8834         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8835         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8836         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8837         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8838         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8839         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8840         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8841         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8842         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8843         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8844         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8845       end;
8846     end;
8847
8848     // Daten Sammeln
8849     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8850       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8851     else
8852       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8853     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8854   finally
8855     SetLength(Rec.Heights, 0);
8856   end;
8857 end;
8858
8859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8860 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8862 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8863 begin
8864   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8865 end;
8866
8867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8868 procedure TglBitmapCubeMap.AfterConstruction;
8869 begin
8870   inherited;
8871
8872   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8873     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8874
8875   SetWrap;
8876   Target   := GL_TEXTURE_CUBE_MAP;
8877   fGenMode := GL_REFLECTION_MAP;
8878 end;
8879
8880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8881 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8882 var
8883   BuildWithGlu: Boolean;
8884   TexSize: Integer;
8885 begin
8886   if (aTestTextureSize) then begin
8887     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8888
8889     if (Height > TexSize) or (Width > TexSize) then
8890       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8891
8892     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8893       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8894   end;
8895
8896   if (ID = 0) then
8897     CreateID;
8898   SetupParameters(BuildWithGlu);
8899   UploadData(aCubeTarget, BuildWithGlu);
8900 end;
8901
8902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8903 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8904 begin
8905   inherited Bind (aEnableTextureUnit);
8906   if aEnableTexCoordsGen then begin
8907     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8908     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8909     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8910     glEnable(GL_TEXTURE_GEN_S);
8911     glEnable(GL_TEXTURE_GEN_T);
8912     glEnable(GL_TEXTURE_GEN_R);
8913   end;
8914 end;
8915
8916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8917 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8918 begin
8919   inherited Unbind(aDisableTextureUnit);
8920   if aDisableTexCoordsGen then begin
8921     glDisable(GL_TEXTURE_GEN_S);
8922     glDisable(GL_TEXTURE_GEN_T);
8923     glDisable(GL_TEXTURE_GEN_R);
8924   end;
8925 end;
8926
8927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8928 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8929 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8930 type
8931   TVec = Array[0..2] of Single;
8932   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8933
8934   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8935   TglBitmapNormalMapRec = record
8936     HalfSize : Integer;
8937     Func: TglBitmapNormalMapGetVectorFunc;
8938   end;
8939
8940   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8941 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8942 begin
8943   aVec[0] := aHalfSize;
8944   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8945   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8946 end;
8947
8948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8949 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8950 begin
8951   aVec[0] := - aHalfSize;
8952   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8953   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8954 end;
8955
8956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8957 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8958 begin
8959   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8960   aVec[1] := aHalfSize;
8961   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8962 end;
8963
8964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8965 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8966 begin
8967   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8968   aVec[1] := - aHalfSize;
8969   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8970 end;
8971
8972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8973 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8974 begin
8975   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8976   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8977   aVec[2] := aHalfSize;
8978 end;
8979
8980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8981 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8982 begin
8983   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8984   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8985   aVec[2] := - aHalfSize;
8986 end;
8987
8988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8989 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8990 var
8991   i: Integer;
8992   Vec: TVec;
8993   Len: Single;
8994 begin
8995   with FuncRec do begin
8996     with PglBitmapNormalMapRec(Args)^ do begin
8997       Func(Vec, Position, HalfSize);
8998
8999       // Normalize
9000       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9001       if Len <> 0 then begin
9002         Vec[0] := Vec[0] * Len;
9003         Vec[1] := Vec[1] * Len;
9004         Vec[2] := Vec[2] * Len;
9005       end;
9006
9007       // Scale Vector and AddVectro
9008       Vec[0] := Vec[0] * 0.5 + 0.5;
9009       Vec[1] := Vec[1] * 0.5 + 0.5;
9010       Vec[2] := Vec[2] * 0.5 + 0.5;
9011     end;
9012
9013     // Set Color
9014     for i := 0 to 2 do
9015       Dest.Data.arr[i] := Round(Vec[i] * 255);
9016   end;
9017 end;
9018
9019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9020 procedure TglBitmapNormalMap.AfterConstruction;
9021 begin
9022   inherited;
9023   fGenMode := GL_NORMAL_MAP;
9024 end;
9025
9026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9027 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9028 var
9029   Rec: TglBitmapNormalMapRec;
9030   SizeRec: TglBitmapPixelPosition;
9031 begin
9032   Rec.HalfSize := aSize div 2;
9033   FreeDataAfterGenTexture := false;
9034
9035   SizeRec.Fields := [ffX, ffY];
9036   SizeRec.X := aSize;
9037   SizeRec.Y := aSize;
9038
9039   // Positive X
9040   Rec.Func := glBitmapNormalMapPosX;
9041   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9042   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9043
9044   // Negative X
9045   Rec.Func := glBitmapNormalMapNegX;
9046   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9047   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9048
9049   // Positive Y
9050   Rec.Func := glBitmapNormalMapPosY;
9051   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9052   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9053
9054   // Negative Y
9055   Rec.Func := glBitmapNormalMapNegY;
9056   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9057   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9058
9059   // Positive Z
9060   Rec.Func := glBitmapNormalMapPosZ;
9061   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9062   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9063
9064   // Negative Z
9065   Rec.Func := glBitmapNormalMapNegZ;
9066   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
9067   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9068 end;
9069
9070
9071 initialization
9072   glBitmapSetDefaultFormat (tfEmpty);
9073   glBitmapSetDefaultMipmap (mmMipmap);
9074   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9075   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9076   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9077
9078   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9079   glBitmapSetDefaultDeleteTextureOnFree    (true);
9080
9081   TFormatDescriptor.Init;
9082
9083 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9084   OpenGLInitialized := false;
9085   InitOpenGLCS := TCriticalSection.Create;
9086 {$ENDIF}
9087
9088 finalization
9089   TFormatDescriptor.Finalize;
9090
9091 {$IFDEF GLB_NATIVE_OGL}
9092   if Assigned(GL_LibHandle) then
9093     glbFreeLibrary(GL_LibHandle);
9094
9095 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9096   if Assigned(GLU_LibHandle) then
9097     glbFreeLibrary(GLU_LibHandle);
9098   FreeAndNil(InitOpenGLCS);
9099 {$ENDIF}
9100 {$ENDIF}
9101
9102 end.