glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE warn '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 TBitmap from Delphi (not lazarus)
 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     tfAlpha12,
 782     tfAlpha16,
 783
 784     tfLuminance4,
 785     tfLuminance8,
 786     tfLuminance12,
 787     tfLuminance16,
 788
 789     tfLuminance4Alpha4,
 790     tfLuminance6Alpha2,
 791     tfLuminance8Alpha8,
 792     tfLuminance12Alpha4,
 793     tfLuminance12Alpha12,
 794     tfLuminance16Alpha16,
 795
 796     tfR3G3B2,
 797     tfRGB4,
 798     tfR5G6B5,
 799     tfRGB5,
 800     tfRGB8,
 801     tfRGB10,
 802     tfRGB12,
 803     tfRGB16,
 804
 805     tfRGBA2,
 806     tfRGBA4,
 807     tfRGB5A1,
 808     tfRGBA8,
 809     tfRGB10A2,
 810     tfRGBA12,
 811     tfRGBA16,
 812
 813     tfBGR4,
 814     tfB5G6R5,
 815     tfBGR5,
 816     tfBGR8,
 817     tfBGR10,
 818     tfBGR12,
 819     tfBGR16,
 820
 821     tfBGRA2,
 822     tfBGRA4,
 823     tfBGR5A1,
 824     tfBGRA8,
 825     tfBGR10A2,
 826     tfBGRA12,
 827     tfBGRA16,
 828
 829     tfDepth16,
 830     tfDepth24,
 831     tfDepth32,
 832
 833     tfS3tcDtx1RGBA,
 834     tfS3tcDtx3RGBA,
 835     tfS3tcDtx5RGBA
 836   );
 837
 838   TglBitmapFileType = (
 839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 841      ftDDS,
 842      ftTGA,
 843      ftBMP);
 844    TglBitmapFileTypes = set of TglBitmapFileType;
 845
 846    TglBitmapMipMap = (
 847      mmNone,
 848      mmMipmap,
 849      mmMipmapGlu);
 850
 851    TglBitmapNormalMapFunc = (
 852      nm4Samples,
 853      nmSobel,
 854      nm3x3,
 855      nm5x5);
 856
 857  ////////////////////////////////////////////////////////////////////////////////////////////////////
 858    EglBitmap                  = class(Exception);
 859    EglBitmapNotSupported      = class(Exception);
 860    EglBitmapSizeToLarge       = class(EglBitmap);
 861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 862    EglBitmapUnsupportedFormat = class(EglBitmap)
 863    public
 864      constructor Create(const aFormat: TglBitmapFormat); overload;
 865      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 866    end;
 867
 868 ////////////////////////////////////////////////////////////////////////////////////////////////////
 869   TglBitmapColorRec = packed record
 870   case Integer of
 871     0: (r, g, b, a: Cardinal);
 872     1: (arr: array[0..3] of Cardinal);
 873   end;
 874
 875   TglBitmapPixelData = packed record
 876     Data, Range: TglBitmapColorRec;
 877     Format: TglBitmapFormat;
 878   end;
 879   PglBitmapPixelData = ^TglBitmapPixelData;
 880
 881 ////////////////////////////////////////////////////////////////////////////////////////////////////
 882   TglBitmapPixelPositionFields = set of (ffX, ffY);
 883   TglBitmapPixelPosition = record
 884     Fields : TglBitmapPixelPositionFields;
 885     X : Word;
 886     Y : Word;
 887   end;
 888
 889   TglBitmapFormatDescriptor = class(TObject)
 890   protected
 891     function GetIsCompressed: Boolean; virtual; abstract;
 892     function GetHasAlpha:     Boolean; virtual; abstract;
 893
 894     function GetglDataFormat:     GLenum;  virtual; abstract;
 895     function GetglFormat:         GLenum;  virtual; abstract;
 896     function GetglInternalFormat: GLenum;  virtual; abstract;
 897   public
 898     property IsCompressed: Boolean read GetIsCompressed;
 899     property HasAlpha:     Boolean read GetHasAlpha;
 900
 901     property glFormat:         GLenum  read GetglFormat;
 902     property glInternalFormat: GLenum  read GetglInternalFormat;
 903     property glDataFormat:     GLenum  read GetglDataFormat;
 904   end;
 905
 906 ////////////////////////////////////////////////////////////////////////////////////////////////////
 907   TglBitmap = class;
 908   TglBitmapFunctionRec = record
 909     Sender:   TglBitmap;
 910     Size:     TglBitmapPixelPosition;
 911     Position: TglBitmapPixelPosition;
 912     Source:   TglBitmapPixelData;
 913     Dest:     TglBitmapPixelData;
 914     Args:     Pointer;
 915   end;
 916   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 917
 918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 919   TglBitmap = class
 920   private
 921     function GetFormatDesc: TglBitmapFormatDescriptor;
 922   protected
 923     fID: GLuint;
 924     fTarget: GLuint;
 925     fAnisotropic: Integer;
 926     fDeleteTextureOnFree: Boolean;
 927     fFreeDataOnDestroy: Boolean;
 928     fFreeDataAfterGenTexture: Boolean;
 929     fData: PByte;
 930     fIsResident: Boolean;
 931     fBorderColor: array[0..3] of Single;
 932
 933     fDimension: TglBitmapPixelPosition;
 934     fMipMap: TglBitmapMipMap;
 935     fFormat: TglBitmapFormat;
 936
 937     // Mapping
 938     fPixelSize: Integer;
 939     fRowSize: Integer;
 940
 941     // Filtering
 942     fFilterMin: GLenum;
 943     fFilterMag: GLenum;
 944
 945     // TexturWarp
 946     fWrapS: GLenum;
 947     fWrapT: GLenum;
 948     fWrapR: GLenum;
 949
 950     //Swizzle
 951     fSwizzle: array[0..3] of GLenum;
 952
 953     // CustomData
 954     fFilename: String;
 955     fCustomName: String;
 956     fCustomNameW: WideString;
 957     fCustomData: Pointer;
 958
 959     //Getter
 960     function GetWidth:  Integer; virtual;
 961     function GetHeight: Integer; virtual;
 962
 963     function GetFileWidth:  Integer; virtual;
 964     function GetFileHeight: Integer; virtual;
 965
 966     //Setter
 967     procedure SetCustomData(const aValue: Pointer);
 968     procedure SetCustomName(const aValue: String);
 969     procedure SetCustomNameW(const aValue: WideString);
 970     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 971     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 972     procedure SetFormat(const aValue: TglBitmapFormat);
 973     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 974     procedure SetID(const aValue: Cardinal);
 975     procedure SetMipMap(const aValue: TglBitmapMipMap);
 976     procedure SetTarget(const aValue: Cardinal);
 977     procedure SetAnisotropic(const aValue: Integer);
 978
 979     procedure CreateID;
 980     procedure SetupParameters(out aBuildWithGlu: Boolean);
 981     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 982       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 983     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 984
 985     function FlipHorz: Boolean; virtual;
 986     function FlipVert: Boolean; virtual;
 987
 988     property Width:  Integer read GetWidth;
 989     property Height: Integer read GetHeight;
 990
 991     property FileWidth:  Integer read GetFileWidth;
 992     property FileHeight: Integer read GetFileHeight;
 993   public
 994     //Properties
 995     property ID:           Cardinal        read fID          write SetID;
 996     property Target:       Cardinal        read fTarget      write SetTarget;
 997     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 998     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 999     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1000
1001     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1002
1003     property Filename:    String     read fFilename;
1004     property CustomName:  String     read fCustomName  write SetCustomName;
1005     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1006     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1007
1008     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1009     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1010     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1011
1012     property Dimension:  TglBitmapPixelPosition  read fDimension;
1013     property Data:       PByte                   read fData;
1014     property IsResident: Boolean                 read fIsResident;
1015
1016     procedure AfterConstruction; override;
1017     procedure BeforeDestruction; override;
1018
1019     procedure PrepareResType(var aResource: String; var aResType: PChar);
1020
1021     //Load
1022     procedure LoadFromFile(const aFilename: String);
1023     procedure LoadFromStream(const aStream: TStream); virtual;
1024     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1025       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1026     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1027     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1028
1029     //Save
1030     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1031     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1032
1033     //Convert
1034     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1035     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1036       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1037   public
1038     //Alpha & Co
1039     {$IFDEF GLB_SDL}
1040     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1041     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1042     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1043     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1044       const aArgs: Pointer = nil): Boolean;
1045     {$ENDIF}
1046
1047     {$IFDEF GLB_DELPHI}
1048     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1049     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1050     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1051     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1052       const aArgs: Pointer = nil): Boolean;
1053     {$ENDIF}
1054
1055     {$IFDEF GLB_LAZARUS}
1056     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1057     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1058     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1059     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1060       const aArgs: Pointer = nil): Boolean;
1061     {$ENDIF}
1062
1063     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1064       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1065     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1066       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067
1068     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1069     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1070     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1071     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1072
1073     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1074     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1075     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1076
1077     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1078     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1079     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1080
1081     function RemoveAlpha: Boolean; virtual;
1082   public
1083     //Common
1084     function Clone: TglBitmap;
1085     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1086     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1087     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1088     procedure FreeData;
1089
1090     //ColorFill
1091     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1092     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1093     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1094
1095     //TexParameters
1096     procedure SetFilter(const aMin, aMag: GLenum);
1097     procedure SetWrap(
1098       const S: GLenum = GL_CLAMP_TO_EDGE;
1099       const T: GLenum = GL_CLAMP_TO_EDGE;
1100       const R: GLenum = GL_CLAMP_TO_EDGE);
1101     procedure SetSwizzle(const r, g, b, a: GLenum);
1102
1103     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1104     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1105
1106     //Constructors
1107     constructor Create; overload;
1108     constructor Create(const aFileName: String); overload;
1109     constructor Create(const aStream: TStream); overload;
1110     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1111     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1112     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1113     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1114   private
1115     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1116     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1117
1118     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1119     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1120
1121     function LoadBMP(const aStream: TStream): Boolean; virtual;
1122     procedure SaveBMP(const aStream: TStream); virtual;
1123
1124     function LoadTGA(const aStream: TStream): Boolean; virtual;
1125     procedure SaveTGA(const aStream: TStream); virtual;
1126
1127     function LoadDDS(const aStream: TStream): Boolean; virtual;
1128     procedure SaveDDS(const aStream: TStream); virtual;
1129   end;
1130
1131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1132   TglBitmap1D = class(TglBitmap)
1133   protected
1134     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1135       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1136     procedure UploadData(const aBuildWithGlu: Boolean);
1137   public
1138     property Width;
1139     procedure AfterConstruction; override;
1140     function FlipHorz: Boolean; override;
1141     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1142   end;
1143
1144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1145   TglBitmap2D = class(TglBitmap)
1146   protected
1147     fLines: array of PByte;
1148     function GetScanline(const aIndex: Integer): Pointer;
1149     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1150       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1151     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1152   public
1153     property Width;
1154     property Height;
1155     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1156
1157     procedure AfterConstruction; override;
1158
1159     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1160     procedure GetDataFromTexture;
1161     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1162
1163     function FlipHorz: Boolean; override;
1164     function FlipVert: Boolean; override;
1165
1166     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1167       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1168   end;
1169
1170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1171   TglBitmapCubeMap = class(TglBitmap2D)
1172   protected
1173     fGenMode: Integer;
1174     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1175   public
1176     procedure AfterConstruction; override;
1177     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1178     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1179     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1180   end;
1181
1182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1183   TglBitmapNormalMap = class(TglBitmapCubeMap)
1184   public
1185     procedure AfterConstruction; override;
1186     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1187   end;
1188
1189 const
1190   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1191
1192 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1193 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1194 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1195 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1196 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1197 procedure glBitmapSetDefaultWrap(
1198   const S: Cardinal = GL_CLAMP_TO_EDGE;
1199   const T: Cardinal = GL_CLAMP_TO_EDGE;
1200   const R: Cardinal = GL_CLAMP_TO_EDGE);
1201
1202 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1203 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1204 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1205 function glBitmapGetDefaultFormat: TglBitmapFormat;
1206 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1207 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1208
1209 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1210 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1211 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1212
1213 var
1214   glBitmapDefaultDeleteTextureOnFree: Boolean;
1215   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1216   glBitmapDefaultFormat: TglBitmapFormat;
1217   glBitmapDefaultMipmap: TglBitmapMipMap;
1218   glBitmapDefaultFilterMin: Cardinal;
1219   glBitmapDefaultFilterMag: Cardinal;
1220   glBitmapDefaultWrapS: Cardinal;
1221   glBitmapDefaultWrapT: Cardinal;
1222   glBitmapDefaultWrapR: Cardinal;
1223   glDefaultSwizzle: array[0..3] of GLenum;
1224
1225 {$IFDEF GLB_DELPHI}
1226 function CreateGrayPalette: HPALETTE;
1227 {$ENDIF}
1228
1229 implementation
1230
1231 uses
1232   Math, syncobjs, typinfo
1233   {$IFDEF GLB_DELPHI}, Types{$ENDIF};
1234
1235 type
1236 {$IFNDEF fpc}
1237   QWord   = System.UInt64;
1238   PQWord  = ^QWord;
1239
1240   PtrInt  = Longint;
1241   PtrUInt = DWord;
1242 {$ENDIF}
1243
1244 ////////////////////////////////////////////////////////////////////////////////////////////////////
1245   TShiftRec = packed record
1246   case Integer of
1247     0: (r, g, b, a: Byte);
1248     1: (arr: array[0..3] of Byte);
1249   end;
1250
1251   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1252   private
1253     function GetRedMask: QWord;
1254     function GetGreenMask: QWord;
1255     function GetBlueMask: QWord;
1256     function GetAlphaMask: QWord;
1257   protected
1258     fFormat: TglBitmapFormat;
1259     fWithAlpha: TglBitmapFormat;
1260     fWithoutAlpha: TglBitmapFormat;
1261     fRGBInverted: TglBitmapFormat;
1262     fUncompressed: TglBitmapFormat;
1263     fPixelSize: Single;
1264     fIsCompressed: Boolean;
1265
1266     fRange: TglBitmapColorRec;
1267     fShift: TShiftRec;
1268
1269     fglFormat:         GLenum;
1270     fglInternalFormat: GLenum;
1271     fglDataFormat:     GLenum;
1272
1273     function GetIsCompressed: Boolean; override;
1274     function GetHasAlpha: Boolean; override;
1275
1276     function GetglFormat: GLenum; override;
1277     function GetglInternalFormat: GLenum; override;
1278     function GetglDataFormat: GLenum; override;
1279
1280     function GetComponents: Integer; virtual;
1281   public
1282     property Format:       TglBitmapFormat read fFormat;
1283     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1284     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1285     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1286     property Components:   Integer         read GetComponents;
1287     property PixelSize:    Single          read fPixelSize;
1288
1289     property Range: TglBitmapColorRec read fRange;
1290     property Shift: TShiftRec         read fShift;
1291
1292     property RedMask:   QWord read GetRedMask;
1293     property GreenMask: QWord read GetGreenMask;
1294     property BlueMask:  QWord read GetBlueMask;
1295     property AlphaMask: QWord read GetAlphaMask;
1296
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1299
1300     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1301     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1302
1303     function CreateMappingData: Pointer; virtual;
1304     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1305
1306     function IsEmpty:  Boolean; virtual;
1307     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1308
1309     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1310
1311     constructor Create; virtual;
1312   public
1313     class procedure Init;
1314     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1315     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1316     class procedure Clear;
1317     class procedure Finalize;
1318   end;
1319   TFormatDescriptorClass = class of TFormatDescriptor;
1320
1321   TfdEmpty = class(TFormatDescriptor);
1322
1323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1324   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327     constructor Create; override;
1328   end;
1329
1330   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333     constructor Create; override;
1334   end;
1335
1336   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1337     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1338     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1339     constructor Create; override;
1340   end;
1341
1342   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1343     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1344     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1345     constructor Create; override;
1346   end;
1347
1348   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1349     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1350     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1351     constructor Create; override;
1352   end;
1353
1354   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357     constructor Create; override;
1358   end;
1359
1360   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363     constructor Create; override;
1364   end;
1365
1366   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369     constructor Create; override;
1370   end;
1371
1372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1373   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376     constructor Create; override;
1377   end;
1378
1379   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382     constructor Create; override;
1383   end;
1384
1385   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388     constructor Create; override;
1389   end;
1390
1391   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394     constructor Create; override;
1395   end;
1396
1397   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400     constructor Create; override;
1401   end;
1402
1403   TfdRGB_US3 = class(TFormatDescriptor) //3* 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     constructor Create; override;
1407   end;
1408
1409   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1410     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1411     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1412     constructor Create; override;
1413   end;
1414
1415   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1416     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1417     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1418     constructor Create; override;
1419   end;
1420
1421   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1422     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1423     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1424     constructor Create; override;
1425   end;
1426
1427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1428   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
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     constructor Create; override;
1432   end;
1433
1434   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1435     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1436     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1437     constructor Create; override;
1438   end;
1439
1440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1441   TfdAlpha4 = class(TfdAlpha_UB1)
1442     constructor Create; override;
1443   end;
1444
1445   TfdAlpha8 = class(TfdAlpha_UB1)
1446     constructor Create; override;
1447   end;
1448
1449   TfdAlpha12 = class(TfdAlpha_US1)
1450     constructor Create; override;
1451   end;
1452
1453   TfdAlpha16 = class(TfdAlpha_US1)
1454     constructor Create; override;
1455   end;
1456
1457   TfdLuminance4 = class(TfdLuminance_UB1)
1458     constructor Create; override;
1459   end;
1460
1461   TfdLuminance8 = class(TfdLuminance_UB1)
1462     constructor Create; override;
1463   end;
1464
1465   TfdLuminance12 = class(TfdLuminance_US1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdLuminance16 = class(TfdLuminance_US1)
1470     constructor Create; override;
1471   end;
1472
1473   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1474     constructor Create; override;
1475   end;
1476
1477   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1478     constructor Create; override;
1479   end;
1480
1481   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1482     constructor Create; override;
1483   end;
1484
1485   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1486     constructor Create; override;
1487   end;
1488
1489   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1490     constructor Create; override;
1491   end;
1492
1493   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1494     constructor Create; override;
1495   end;
1496
1497   TfdR3G3B2 = class(TfdUniversal_UB1)
1498     constructor Create; override;
1499   end;
1500
1501   TfdRGB4 = class(TfdUniversal_US1)
1502     constructor Create; override;
1503   end;
1504
1505   TfdR5G6B5 = class(TfdUniversal_US1)
1506     constructor Create; override;
1507   end;
1508
1509   TfdRGB5 = class(TfdUniversal_US1)
1510     constructor Create; override;
1511   end;
1512
1513   TfdRGB8 = class(TfdRGB_UB3)
1514     constructor Create; override;
1515   end;
1516
1517   TfdRGB10 = class(TfdUniversal_UI1)
1518     constructor Create; override;
1519   end;
1520
1521   TfdRGB12 = class(TfdRGB_US3)
1522     constructor Create; override;
1523   end;
1524
1525   TfdRGB16 = class(TfdRGB_US3)
1526     constructor Create; override;
1527   end;
1528
1529   TfdRGBA2 = class(TfdRGBA_UB4)
1530     constructor Create; override;
1531   end;
1532
1533   TfdRGBA4 = class(TfdUniversal_US1)
1534     constructor Create; override;
1535   end;
1536
1537   TfdRGB5A1 = class(TfdUniversal_US1)
1538     constructor Create; override;
1539   end;
1540
1541   TfdRGBA8 = class(TfdRGBA_UB4)
1542     constructor Create; override;
1543   end;
1544
1545   TfdRGB10A2 = class(TfdUniversal_UI1)
1546     constructor Create; override;
1547   end;
1548
1549   TfdRGBA12 = class(TfdRGBA_US4)
1550     constructor Create; override;
1551   end;
1552
1553   TfdRGBA16 = class(TfdRGBA_US4)
1554     constructor Create; override;
1555   end;
1556
1557   TfdBGR4 = class(TfdUniversal_US1)
1558     constructor Create; override;
1559   end;
1560
1561   TfdB5G6R5 = class(TfdUniversal_US1)
1562     constructor Create; override;
1563   end;
1564
1565   TfdBGR5 = class(TfdUniversal_US1)
1566     constructor Create; override;
1567   end;
1568
1569   TfdBGR8 = class(TfdBGR_UB3)
1570     constructor Create; override;
1571   end;
1572
1573   TfdBGR10 = class(TfdUniversal_UI1)
1574     constructor Create; override;
1575   end;
1576
1577   TfdBGR12 = class(TfdBGR_US3)
1578     constructor Create; override;
1579   end;
1580
1581   TfdBGR16 = class(TfdBGR_US3)
1582     constructor Create; override;
1583   end;
1584
1585   TfdBGRA2 = class(TfdBGRA_UB4)
1586     constructor Create; override;
1587   end;
1588
1589   TfdBGRA4 = class(TfdUniversal_US1)
1590     constructor Create; override;
1591   end;
1592
1593   TfdBGR5A1 = class(TfdUniversal_US1)
1594     constructor Create; override;
1595   end;
1596
1597   TfdBGRA8 = class(TfdBGRA_UB4)
1598     constructor Create; override;
1599   end;
1600
1601   TfdBGR10A2 = class(TfdUniversal_UI1)
1602     constructor Create; override;
1603   end;
1604
1605   TfdBGRA12 = class(TfdBGRA_US4)
1606     constructor Create; override;
1607   end;
1608
1609   TfdBGRA16 = class(TfdBGRA_US4)
1610     constructor Create; override;
1611   end;
1612
1613   TfdDepth16 = class(TfdDepth_US1)
1614     constructor Create; override;
1615   end;
1616
1617   TfdDepth24 = class(TfdDepth_UI1)
1618     constructor Create; override;
1619   end;
1620
1621   TfdDepth32 = class(TfdDepth_UI1)
1622     constructor Create; override;
1623   end;
1624
1625   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1626     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1627     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1628     constructor Create; override;
1629   end;
1630
1631   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1632     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1633     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1634     constructor Create; override;
1635   end;
1636
1637   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1638     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1639     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1640     constructor Create; override;
1641   end;
1642
1643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1644   TbmpBitfieldFormat = class(TFormatDescriptor)
1645   private
1646     procedure SetRedMask  (const aValue: QWord);
1647     procedure SetGreenMask(const aValue: QWord);
1648     procedure SetBlueMask (const aValue: QWord);
1649     procedure SetAlphaMask(const aValue: QWord);
1650
1651     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1652   public
1653     property RedMask:   QWord read GetRedMask   write SetRedMask;
1654     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1655     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1656     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1657
1658     property PixelSize: Single read fPixelSize write fPixelSize;
1659
1660     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1661     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1662   end;
1663
1664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1665   TbmpColorTableEnty = packed record
1666     b, g, r, a: Byte;
1667   end;
1668   TbmpColorTable = array of TbmpColorTableEnty;
1669   TbmpColorTableFormat = class(TFormatDescriptor)
1670   private
1671     fColorTable: TbmpColorTable;
1672   public
1673     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1674     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1675     property Range:      TglBitmapColorRec read fRange      write fRange;
1676     property Shift:      TShiftRec         read fShift      write fShift;
1677     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1678
1679     procedure CreateColorTable;
1680
1681     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1682     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1683     destructor Destroy; override;
1684   end;
1685
1686 const
1687   LUMINANCE_WEIGHT_R = 0.30;
1688   LUMINANCE_WEIGHT_G = 0.59;
1689   LUMINANCE_WEIGHT_B = 0.11;
1690
1691   ALPHA_WEIGHT_R = 0.30;
1692   ALPHA_WEIGHT_G = 0.59;
1693   ALPHA_WEIGHT_B = 0.11;
1694
1695   DEPTH_WEIGHT_R = 0.333333333;
1696   DEPTH_WEIGHT_G = 0.333333333;
1697   DEPTH_WEIGHT_B = 0.333333333;
1698
1699   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1700
1701   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1702     TfdEmpty,
1703
1704     TfdAlpha4,
1705     TfdAlpha8,
1706     TfdAlpha12,
1707     TfdAlpha16,
1708
1709     TfdLuminance4,
1710     TfdLuminance8,
1711     TfdLuminance12,
1712     TfdLuminance16,
1713
1714     TfdLuminance4Alpha4,
1715     TfdLuminance6Alpha2,
1716     TfdLuminance8Alpha8,
1717     TfdLuminance12Alpha4,
1718     TfdLuminance12Alpha12,
1719     TfdLuminance16Alpha16,
1720
1721     TfdR3G3B2,
1722     TfdRGB4,
1723     TfdR5G6B5,
1724     TfdRGB5,
1725     TfdRGB8,
1726     TfdRGB10,
1727     TfdRGB12,
1728     TfdRGB16,
1729
1730     TfdRGBA2,
1731     TfdRGBA4,
1732     TfdRGB5A1,
1733     TfdRGBA8,
1734     TfdRGB10A2,
1735     TfdRGBA12,
1736     TfdRGBA16,
1737
1738     TfdBGR4,
1739     TfdB5G6R5,
1740     TfdBGR5,
1741     TfdBGR8,
1742     TfdBGR10,
1743     TfdBGR12,
1744     TfdBGR16,
1745
1746     TfdBGRA2,
1747     TfdBGRA4,
1748     TfdBGR5A1,
1749     TfdBGRA8,
1750     TfdBGR10A2,
1751     TfdBGRA12,
1752     TfdBGRA16,
1753
1754     TfdDepth16,
1755     TfdDepth24,
1756     TfdDepth32,
1757
1758     TfdS3tcDtx1RGBA,
1759     TfdS3tcDtx3RGBA,
1760     TfdS3tcDtx5RGBA
1761   );
1762
1763 var
1764   FormatDescriptorCS: TCriticalSection;
1765   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1766
1767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1768 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1769 begin
1770   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1771 end;
1772
1773 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1775 begin
1776   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1777 end;
1778
1779 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1780 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1781 begin
1782   result.Fields := [];
1783
1784   if X >= 0 then
1785     result.Fields := result.Fields + [ffX];
1786   if Y >= 0 then
1787     result.Fields := result.Fields + [ffY];
1788
1789   result.X := Max(0, X);
1790   result.Y := Max(0, Y);
1791 end;
1792
1793 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1794 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1795 begin
1796   result.r := r;
1797   result.g := g;
1798   result.b := b;
1799   result.a := a;
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1804 var
1805   i: Integer;
1806 begin
1807   result := false;
1808   for i := 0 to high(r1.arr) do
1809     if (r1.arr[i] <> r2.arr[i]) then
1810       exit;
1811   result := true;
1812 end;
1813
1814 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1815 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1816 begin
1817   result.r := r;
1818   result.g := g;
1819   result.b := b;
1820   result.a := a;
1821 end;
1822
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1825 begin
1826   result := [];
1827
1828   if (aFormat in [
1829         //4 bbp
1830         tfLuminance4,
1831
1832         //8bpp
1833         tfR3G3B2, tfLuminance8,
1834
1835         //16bpp
1836         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1837         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1838
1839         //24bpp
1840         tfBGR8, tfRGB8,
1841
1842         //32bpp
1843         tfRGB10, tfRGB10A2, tfRGBA8,
1844         tfBGR10, tfBGR10A2, tfBGRA8]) then
1845     result := result + [ftBMP];
1846
1847   if (aFormat in [
1848         //8 bpp
1849         tfLuminance8, tfAlpha8,
1850
1851         //16 bpp
1852         tfLuminance16, tfLuminance8Alpha8,
1853         tfRGB5, tfRGB5A1, tfRGBA4,
1854         tfBGR5, tfBGR5A1, tfBGRA4,
1855
1856         //24 bpp
1857         tfRGB8, tfBGR8,
1858
1859         //32 bpp
1860         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1861     result := result + [ftTGA];
1862
1863   if (aFormat in [
1864         //8 bpp
1865         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1866         tfR3G3B2, tfRGBA2, tfBGRA2,
1867
1868         //16 bpp
1869         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1870         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1871         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1872
1873         //24 bpp
1874         tfRGB8, tfBGR8,
1875
1876         //32 bbp
1877         tfLuminance16Alpha16,
1878         tfRGBA8, tfRGB10A2,
1879         tfBGRA8, tfBGR10A2,
1880
1881         //compressed
1882         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1883     result := result + [ftDDS];
1884
1885   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1886   if aFormat in [
1887       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1888       tfRGB8, tfRGBA8,
1889       tfBGR8, tfBGRA8] then
1890     result := result + [ftPNG];
1891   {$ENDIF}
1892
1893   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1894   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1895     result := result + [ftJPEG];
1896   {$ENDIF}
1897 end;
1898
1899 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1900 function IsPowerOfTwo(aNumber: Integer): Boolean;
1901 begin
1902   while (aNumber and 1) = 0 do
1903     aNumber := aNumber shr 1;
1904   result := aNumber = 1;
1905 end;
1906
1907 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1908 function GetTopMostBit(aBitSet: QWord): Integer;
1909 begin
1910   result := 0;
1911   while aBitSet > 0 do begin
1912     inc(result);
1913     aBitSet := aBitSet shr 1;
1914   end;
1915 end;
1916
1917 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1918 function CountSetBits(aBitSet: QWord): Integer;
1919 begin
1920   result := 0;
1921   while aBitSet > 0 do begin
1922     if (aBitSet and 1) = 1 then
1923       inc(result);
1924     aBitSet := aBitSet shr 1;
1925   end;
1926 end;
1927
1928 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1929 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1930 begin
1931   result := Trunc(
1932     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1933     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1934     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1935 end;
1936
1937 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1938 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1939 begin
1940   result := Trunc(
1941     DEPTH_WEIGHT_R * aPixel.Data.r +
1942     DEPTH_WEIGHT_G * aPixel.Data.g +
1943     DEPTH_WEIGHT_B * aPixel.Data.b);
1944 end;
1945
1946 {$IFDEF GLB_NATIVE_OGL}
1947 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1948 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1950 var
1951   GL_LibHandle: Pointer = nil;
1952
1953 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1954 begin
1955   if not Assigned(aLibHandle) then
1956     aLibHandle := GL_LibHandle;
1957
1958 {$IF DEFINED(GLB_WIN)}
1959   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1960   if Assigned(result) then
1961     exit;
1962
1963   if Assigned(wglGetProcAddress) then
1964     result := wglGetProcAddress(aProcName);
1965 {$ELSEIF DEFINED(GLB_LINUX)}
1966   if Assigned(glXGetProcAddress) then begin
1967     result := glXGetProcAddress(aProcName);
1968     if Assigned(result) then
1969       exit;
1970   end;
1971
1972   if Assigned(glXGetProcAddressARB) then begin
1973     result := glXGetProcAddressARB(aProcName);
1974     if Assigned(result) then
1975       exit;
1976   end;
1977
1978   result := dlsym(aLibHandle, aProcName);
1979 {$IFEND}
1980   if not Assigned(result) and aRaiseOnErr then
1981     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1982 end;
1983
1984 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1985 var
1986   GLU_LibHandle: Pointer = nil;
1987   OpenGLInitialized: Boolean;
1988   InitOpenGLCS: TCriticalSection;
1989
1990 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1991 procedure glbInitOpenGL;
1992
1993   ////////////////////////////////////////////////////////////////////////////////
1994   function glbLoadLibrary(const aName: PChar): Pointer;
1995   begin
1996     {$IF DEFINED(GLB_WIN)}
1997     result := {%H-}Pointer(LoadLibrary(aName));
1998     {$ELSEIF DEFINED(GLB_LINUX)}
1999     result := dlopen(Name, RTLD_LAZY);
2000     {$ELSE}
2001     result := nil;
2002     {$IFEND}
2003   end;
2004
2005   ////////////////////////////////////////////////////////////////////////////////
2006   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2007   begin
2008     result := false;
2009     if not Assigned(aLibHandle) then
2010       exit;
2011
2012     {$IF DEFINED(GLB_WIN)}
2013     Result := FreeLibrary({%H-}HINST(aLibHandle));
2014     {$ELSEIF DEFINED(GLB_LINUX)}
2015     Result := dlclose(aLibHandle) = 0;
2016     {$IFEND}
2017   end;
2018
2019 begin
2020   if Assigned(GL_LibHandle) then
2021     glbFreeLibrary(GL_LibHandle);
2022
2023   if Assigned(GLU_LibHandle) then
2024     glbFreeLibrary(GLU_LibHandle);
2025
2026   GL_LibHandle := glbLoadLibrary(libopengl);
2027   if not Assigned(GL_LibHandle) then
2028     raise EglBitmap.Create('unable to load library: ' + libopengl);
2029
2030   GLU_LibHandle := glbLoadLibrary(libglu);
2031   if not Assigned(GLU_LibHandle) then
2032     raise EglBitmap.Create('unable to load library: ' + libglu);
2033
2034 {$IF DEFINED(GLB_WIN)}
2035   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2036 {$ELSEIF DEFINED(GLB_LINUX)}
2037   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2038   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2039 {$IFEND}
2040
2041   glEnable := glbGetProcAddress('glEnable');
2042   glDisable := glbGetProcAddress('glDisable');
2043   glGetString := glbGetProcAddress('glGetString');
2044   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2045   glTexParameteri := glbGetProcAddress('glTexParameteri');
2046   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2047   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2048   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2049   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2050   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2051   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2052   glTexGeni := glbGetProcAddress('glTexGeni');
2053   glGenTextures := glbGetProcAddress('glGenTextures');
2054   glBindTexture := glbGetProcAddress('glBindTexture');
2055   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2056   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2057   glReadPixels := glbGetProcAddress('glReadPixels');
2058   glPixelStorei := glbGetProcAddress('glPixelStorei');
2059   glTexImage1D := glbGetProcAddress('glTexImage1D');
2060   glTexImage2D := glbGetProcAddress('glTexImage2D');
2061   glGetTexImage := glbGetProcAddress('glGetTexImage');
2062
2063   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2064   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2065 end;
2066 {$ENDIF}
2067
2068 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 procedure glbReadOpenGLExtensions;
2070 var
2071   Buffer: AnsiString;
2072   MajorVersion, MinorVersion: Integer;
2073
2074   ///////////////////////////////////////////////////////////////////////////////////////////
2075   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2076   var
2077     Separator: Integer;
2078   begin
2079     aMinor := 0;
2080     aMajor := 0;
2081
2082     Separator := Pos(AnsiString('.'), aBuffer);
2083     if (Separator > 1) and (Separator < Length(aBuffer)) and
2084        (aBuffer[Separator - 1] in ['0'..'9']) and
2085        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2086
2087       Dec(Separator);
2088       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2089         Dec(Separator);
2090
2091       Delete(aBuffer, 1, Separator);
2092       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2093
2094       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2095         Inc(Separator);
2096
2097       Delete(aBuffer, Separator, 255);
2098       Separator := Pos(AnsiString('.'), aBuffer);
2099
2100       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2101       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2102     end;
2103   end;
2104
2105   ///////////////////////////////////////////////////////////////////////////////////////////
2106   function CheckExtension(const Extension: AnsiString): Boolean;
2107   var
2108     ExtPos: Integer;
2109   begin
2110     ExtPos := Pos(Extension, Buffer);
2111     result := ExtPos > 0;
2112     if result then
2113       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2114   end;
2115
2116   ///////////////////////////////////////////////////////////////////////////////////////////
2117   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2118   begin
2119     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2120   end;
2121
2122 begin
2123 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2124   InitOpenGLCS.Enter;
2125   try
2126     if not OpenGLInitialized then begin
2127       glbInitOpenGL;
2128       OpenGLInitialized := true;
2129     end;
2130   finally
2131     InitOpenGLCS.Leave;
2132   end;
2133 {$ENDIF}
2134
2135   // Version
2136   Buffer := glGetString(GL_VERSION);
2137   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2138
2139   GL_VERSION_1_2 := CheckVersion(1, 2);
2140   GL_VERSION_1_3 := CheckVersion(1, 3);
2141   GL_VERSION_1_4 := CheckVersion(1, 4);
2142   GL_VERSION_2_0 := CheckVersion(2, 0);
2143   GL_VERSION_3_3 := CheckVersion(3, 3);
2144
2145   // Extensions
2146   Buffer := glGetString(GL_EXTENSIONS);
2147   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2148   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2149   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2150   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2151   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2152   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2153   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2154   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2155   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2156   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2157   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2158   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2159   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2160   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2161
2162   if GL_VERSION_1_3 then begin
2163     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2164     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2165     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2166   end else begin
2167     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2168     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2169     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2170   end;
2171 end;
2172 {$ENDIF}
2173
2174 {$IFDEF GLB_SDL_IMAGE}
2175 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2176 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2177 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2178 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2179 begin
2180   result := TStream(context^.unknown.data1).Seek(offset, whence);
2181 end;
2182
2183 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2184 begin
2185   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2186 end;
2187
2188 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2189 begin
2190   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2191 end;
2192
2193 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2194 begin
2195   result := 0;
2196 end;
2197
2198 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2199 begin
2200   result := SDL_AllocRW;
2201
2202   if result = nil then
2203     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2204
2205   result^.seek := glBitmapRWseek;
2206   result^.read := glBitmapRWread;
2207   result^.write := glBitmapRWwrite;
2208   result^.close := glBitmapRWclose;
2209   result^.unknown.data1 := Stream;
2210 end;
2211 {$ENDIF}
2212
2213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2214 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2215 begin
2216   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2217 end;
2218
2219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2221 begin
2222   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2223 end;
2224
2225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2226 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2227 begin
2228   glBitmapDefaultMipmap := aValue;
2229 end;
2230
2231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2232 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2233 begin
2234   glBitmapDefaultFormat := aFormat;
2235 end;
2236
2237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2238 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2239 begin
2240   glBitmapDefaultFilterMin := aMin;
2241   glBitmapDefaultFilterMag := aMag;
2242 end;
2243
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2246 begin
2247   glBitmapDefaultWrapS := S;
2248   glBitmapDefaultWrapT := T;
2249   glBitmapDefaultWrapR := R;
2250 end;
2251
2252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2254 begin
2255   glDefaultSwizzle[0] := r;
2256   glDefaultSwizzle[1] := g;
2257   glDefaultSwizzle[2] := b;
2258   glDefaultSwizzle[3] := a;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2263 begin
2264   result := glBitmapDefaultDeleteTextureOnFree;
2265 end;
2266
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2269 begin
2270   result := glBitmapDefaultFreeDataAfterGenTextures;
2271 end;
2272
2273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2274 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2275 begin
2276   result := glBitmapDefaultMipmap;
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 function glBitmapGetDefaultFormat: TglBitmapFormat;
2281 begin
2282   result := glBitmapDefaultFormat;
2283 end;
2284
2285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2286 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2287 begin
2288   aMin := glBitmapDefaultFilterMin;
2289   aMag := glBitmapDefaultFilterMag;
2290 end;
2291
2292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2293 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2294 begin
2295   S := glBitmapDefaultWrapS;
2296   T := glBitmapDefaultWrapT;
2297   R := glBitmapDefaultWrapR;
2298 end;
2299
2300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2301 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2302 begin
2303   r := glDefaultSwizzle[0];
2304   g := glDefaultSwizzle[1];
2305   b := glDefaultSwizzle[2];
2306   a := glDefaultSwizzle[3];
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 function TFormatDescriptor.GetRedMask: QWord;
2313 begin
2314   result := fRange.r shl fShift.r;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function TFormatDescriptor.GetGreenMask: QWord;
2319 begin
2320   result := fRange.g shl fShift.g;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function TFormatDescriptor.GetBlueMask: QWord;
2325 begin
2326   result := fRange.b shl fShift.b;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function TFormatDescriptor.GetAlphaMask: QWord;
2331 begin
2332   result := fRange.a shl fShift.a;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function TFormatDescriptor.GetIsCompressed: Boolean;
2337 begin
2338   result := fIsCompressed;
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 function TFormatDescriptor.GetHasAlpha: Boolean;
2343 begin
2344   result := (fRange.a > 0);
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 function TFormatDescriptor.GetglFormat: GLenum;
2349 begin
2350   result := fglFormat;
2351 end;
2352
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 function TFormatDescriptor.GetglInternalFormat: GLenum;
2355 begin
2356   result := fglInternalFormat;
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 function TFormatDescriptor.GetglDataFormat: GLenum;
2361 begin
2362   result := fglDataFormat;
2363 end;
2364
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 function TFormatDescriptor.GetComponents: Integer;
2367 var
2368   i: Integer;
2369 begin
2370   result := 0;
2371   for i := 0 to 3 do
2372     if (fRange.arr[i] > 0) then
2373       inc(result);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2378 var
2379   w, h: Integer;
2380 begin
2381   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2382     w := Max(1, aSize.X);
2383     h := Max(1, aSize.Y);
2384     result := GetSize(w, h);
2385   end else
2386     result := 0;
2387 end;
2388
2389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2390 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2391 begin
2392   result := 0;
2393   if (aWidth <= 0) or (aHeight <= 0) then
2394     exit;
2395   result := Ceil(aWidth * aHeight * fPixelSize);
2396 end;
2397
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 function TFormatDescriptor.CreateMappingData: Pointer;
2400 begin
2401   result := nil;
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2406 begin
2407   //DUMMY
2408 end;
2409
2410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2411 function TFormatDescriptor.IsEmpty: Boolean;
2412 begin
2413   result := (fFormat = tfEmpty);
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2418 begin
2419   result := false;
2420   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2421     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2422   if (aRedMask   <> RedMask) then
2423     exit;
2424   if (aGreenMask <> GreenMask) then
2425     exit;
2426   if (aBlueMask  <> BlueMask) then
2427     exit;
2428   if (aAlphaMask <> AlphaMask) then
2429     exit;
2430   result := true;
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2435 begin
2436   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2437   aPixel.Data   := fRange;
2438   aPixel.Range  := fRange;
2439   aPixel.Format := fFormat;
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 constructor TFormatDescriptor.Create;
2444 begin
2445   inherited Create;
2446
2447   fFormat       := tfEmpty;
2448   fWithAlpha    := tfEmpty;
2449   fWithoutAlpha := tfEmpty;
2450   fRGBInverted  := tfEmpty;
2451   fUncompressed := tfEmpty;
2452   fPixelSize    := 0.0;
2453   fIsCompressed := false;
2454
2455   fglFormat         := 0;
2456   fglInternalFormat := 0;
2457   fglDataFormat     := 0;
2458
2459   FillChar(fRange, 0, SizeOf(fRange));
2460   FillChar(fShift, 0, SizeOf(fShift));
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2467 begin
2468   aData^ := aPixel.Data.a;
2469   inc(aData);
2470 end;
2471
2472 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2473 begin
2474   aPixel.Data.r := 0;
2475   aPixel.Data.g := 0;
2476   aPixel.Data.b := 0;
2477   aPixel.Data.a := aData^;
2478   inc(aData);
2479 end;
2480
2481 constructor TfdAlpha_UB1.Create;
2482 begin
2483   inherited Create;
2484   fPixelSize        := 1.0;
2485   fRange.a          := $FF;
2486   fglFormat         := GL_ALPHA;
2487   fglDataFormat     := GL_UNSIGNED_BYTE;
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   aData^ := LuminanceWeight(aPixel);
2496   inc(aData);
2497 end;
2498
2499 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.r := aData^;
2502   aPixel.Data.g := aData^;
2503   aPixel.Data.b := aData^;
2504   aPixel.Data.a := 0;
2505   inc(aData);
2506 end;
2507
2508 constructor TfdLuminance_UB1.Create;
2509 begin
2510   inherited Create;
2511   fPixelSize        := 1.0;
2512   fRange.r          := $FF;
2513   fRange.g          := $FF;
2514   fRange.b          := $FF;
2515   fglFormat         := GL_LUMINANCE;
2516   fglDataFormat     := GL_UNSIGNED_BYTE;
2517 end;
2518
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 var
2524   i: Integer;
2525 begin
2526   aData^ := 0;
2527   for i := 0 to 3 do
2528     if (fRange.arr[i] > 0) then
2529       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2530   inc(aData);
2531 end;
2532
2533 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2534 var
2535   i: Integer;
2536 begin
2537   for i := 0 to 3 do
2538     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2539   inc(aData);
2540 end;
2541
2542 constructor TfdUniversal_UB1.Create;
2543 begin
2544   inherited Create;
2545   fPixelSize := 1.0;
2546 end;
2547
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2552 begin
2553   inherited Map(aPixel, aData, aMapData);
2554   aData^ := aPixel.Data.a;
2555   inc(aData);
2556 end;
2557
2558 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2559 begin
2560   inherited Unmap(aData, aPixel, aMapData);
2561   aPixel.Data.a := aData^;
2562   inc(aData);
2563 end;
2564
2565 constructor TfdLuminanceAlpha_UB2.Create;
2566 begin
2567   inherited Create;
2568   fPixelSize        := 2.0;
2569   fRange.a          := $FF;
2570   fShift.a          :=   8;
2571   fglFormat         := GL_LUMINANCE_ALPHA;
2572   fglDataFormat     := GL_UNSIGNED_BYTE;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   aData^ := aPixel.Data.r;
2581   inc(aData);
2582   aData^ := aPixel.Data.g;
2583   inc(aData);
2584   aData^ := aPixel.Data.b;
2585   inc(aData);
2586 end;
2587
2588 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2589 begin
2590   aPixel.Data.r := aData^;
2591   inc(aData);
2592   aPixel.Data.g := aData^;
2593   inc(aData);
2594   aPixel.Data.b := aData^;
2595   inc(aData);
2596   aPixel.Data.a := 0;
2597 end;
2598
2599 constructor TfdRGB_UB3.Create;
2600 begin
2601   inherited Create;
2602   fPixelSize        := 3.0;
2603   fRange.r          := $FF;
2604   fRange.g          := $FF;
2605   fRange.b          := $FF;
2606   fShift.r          :=   0;
2607   fShift.g          :=   8;
2608   fShift.b          :=  16;
2609   fglFormat         := GL_RGB;
2610   fglDataFormat     := GL_UNSIGNED_BYTE;
2611 end;
2612
2613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2617 begin
2618   aData^ := aPixel.Data.b;
2619   inc(aData);
2620   aData^ := aPixel.Data.g;
2621   inc(aData);
2622   aData^ := aPixel.Data.r;
2623   inc(aData);
2624 end;
2625
2626 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2627 begin
2628   aPixel.Data.b := aData^;
2629   inc(aData);
2630   aPixel.Data.g := aData^;
2631   inc(aData);
2632   aPixel.Data.r := aData^;
2633   inc(aData);
2634   aPixel.Data.a := 0;
2635 end;
2636
2637 constructor TfdBGR_UB3.Create;
2638 begin
2639   fPixelSize        := 3.0;
2640   fRange.r          := $FF;
2641   fRange.g          := $FF;
2642   fRange.b          := $FF;
2643   fShift.r          :=  16;
2644   fShift.g          :=   8;
2645   fShift.b          :=   0;
2646   fglFormat         := GL_BGR;
2647   fglDataFormat     := GL_UNSIGNED_BYTE;
2648 end;
2649
2650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2651 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2653 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2654 begin
2655   inherited Map(aPixel, aData, aMapData);
2656   aData^ := aPixel.Data.a;
2657   inc(aData);
2658 end;
2659
2660 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2661 begin
2662   inherited Unmap(aData, aPixel, aMapData);
2663   aPixel.Data.a := aData^;
2664   inc(aData);
2665 end;
2666
2667 constructor TfdRGBA_UB4.Create;
2668 begin
2669   inherited Create;
2670   fPixelSize        := 4.0;
2671   fRange.a          := $FF;
2672   fShift.a          :=  24;
2673   fglFormat         := GL_RGBA;
2674   fglDataFormat     := GL_UNSIGNED_BYTE;
2675 end;
2676
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2681 begin
2682   inherited Map(aPixel, aData, aMapData);
2683   aData^ := aPixel.Data.a;
2684   inc(aData);
2685 end;
2686
2687 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2688 begin
2689   inherited Unmap(aData, aPixel, aMapData);
2690   aPixel.Data.a := aData^;
2691   inc(aData);
2692 end;
2693
2694 constructor TfdBGRA_UB4.Create;
2695 begin
2696   inherited Create;
2697   fPixelSize        := 4.0;
2698   fRange.a          := $FF;
2699   fShift.a          :=  24;
2700   fglFormat         := GL_BGRA;
2701   fglDataFormat     := GL_UNSIGNED_BYTE;
2702 end;
2703
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2708 begin
2709   PWord(aData)^ := aPixel.Data.a;
2710   inc(aData, 2);
2711 end;
2712
2713 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2714 begin
2715   aPixel.Data.r := 0;
2716   aPixel.Data.g := 0;
2717   aPixel.Data.b := 0;
2718   aPixel.Data.a := PWord(aData)^;
2719   inc(aData, 2);
2720 end;
2721
2722 constructor TfdAlpha_US1.Create;
2723 begin
2724   inherited Create;
2725   fPixelSize        := 2.0;
2726   fRange.a          := $FFFF;
2727   fglFormat         := GL_ALPHA;
2728   fglDataFormat     := GL_UNSIGNED_SHORT;
2729 end;
2730
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2735 begin
2736   PWord(aData)^ := LuminanceWeight(aPixel);
2737   inc(aData, 2);
2738 end;
2739
2740 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2741 begin
2742   aPixel.Data.r := PWord(aData)^;
2743   aPixel.Data.g := PWord(aData)^;
2744   aPixel.Data.b := PWord(aData)^;
2745   aPixel.Data.a := 0;
2746   inc(aData, 2);
2747 end;
2748
2749 constructor TfdLuminance_US1.Create;
2750 begin
2751   inherited Create;
2752   fPixelSize        := 2.0;
2753   fRange.r          := $FFFF;
2754   fRange.g          := $FFFF;
2755   fRange.b          := $FFFF;
2756   fglFormat         := GL_LUMINANCE;
2757   fglDataFormat     := GL_UNSIGNED_SHORT;
2758 end;
2759
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2764 var
2765   i: Integer;
2766 begin
2767   PWord(aData)^ := 0;
2768   for i := 0 to 3 do
2769     if (fRange.arr[i] > 0) then
2770       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2771   inc(aData, 2);
2772 end;
2773
2774 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2775 var
2776   i: Integer;
2777 begin
2778   for i := 0 to 3 do
2779     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2780   inc(aData, 2);
2781 end;
2782
2783 constructor TfdUniversal_US1.Create;
2784 begin
2785   inherited Create;
2786   fPixelSize := 2.0;
2787 end;
2788
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2793 begin
2794   PWord(aData)^ := DepthWeight(aPixel);
2795   inc(aData, 2);
2796 end;
2797
2798 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2799 begin
2800   aPixel.Data.r := PWord(aData)^;
2801   aPixel.Data.g := PWord(aData)^;
2802   aPixel.Data.b := PWord(aData)^;
2803   aPixel.Data.a := 0;
2804   inc(aData, 2);
2805 end;
2806
2807 constructor TfdDepth_US1.Create;
2808 begin
2809   inherited Create;
2810   fPixelSize        := 2.0;
2811   fRange.r          := $FFFF;
2812   fRange.g          := $FFFF;
2813   fRange.b          := $FFFF;
2814   fglFormat         := GL_DEPTH_COMPONENT;
2815   fglDataFormat     := GL_UNSIGNED_SHORT;
2816 end;
2817
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2822 begin
2823   inherited Map(aPixel, aData, aMapData);
2824   PWord(aData)^ := aPixel.Data.a;
2825   inc(aData, 2);
2826 end;
2827
2828 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2829 begin
2830   inherited Unmap(aData, aPixel, aMapData);
2831   aPixel.Data.a := PWord(aData)^;
2832   inc(aData, 2);
2833 end;
2834
2835 constructor TfdLuminanceAlpha_US2.Create;
2836 begin
2837   inherited Create;
2838   fPixelSize        :=   4.0;
2839   fRange.a          := $FFFF;
2840   fShift.a          :=    16;
2841   fglFormat         := GL_LUMINANCE_ALPHA;
2842   fglDataFormat     := GL_UNSIGNED_SHORT;
2843 end;
2844
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2849 begin
2850   PWord(aData)^ := aPixel.Data.r;
2851   inc(aData, 2);
2852   PWord(aData)^ := aPixel.Data.g;
2853   inc(aData, 2);
2854   PWord(aData)^ := aPixel.Data.b;
2855   inc(aData, 2);
2856 end;
2857
2858 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2859 begin
2860   aPixel.Data.r := PWord(aData)^;
2861   inc(aData, 2);
2862   aPixel.Data.g := PWord(aData)^;
2863   inc(aData, 2);
2864   aPixel.Data.b := PWord(aData)^;
2865   inc(aData, 2);
2866   aPixel.Data.a := 0;
2867 end;
2868
2869 constructor TfdRGB_US3.Create;
2870 begin
2871   inherited Create;
2872   fPixelSize        :=   6.0;
2873   fRange.r          := $FFFF;
2874   fRange.g          := $FFFF;
2875   fRange.b          := $FFFF;
2876   fShift.r          :=     0;
2877   fShift.g          :=    16;
2878   fShift.b          :=    32;
2879   fglFormat         := GL_RGB;
2880   fglDataFormat     := GL_UNSIGNED_SHORT;
2881 end;
2882
2883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2887 begin
2888   PWord(aData)^ := aPixel.Data.b;
2889   inc(aData, 2);
2890   PWord(aData)^ := aPixel.Data.g;
2891   inc(aData, 2);
2892   PWord(aData)^ := aPixel.Data.r;
2893   inc(aData, 2);
2894 end;
2895
2896 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2897 begin
2898   aPixel.Data.b := PWord(aData)^;
2899   inc(aData, 2);
2900   aPixel.Data.g := PWord(aData)^;
2901   inc(aData, 2);
2902   aPixel.Data.r := PWord(aData)^;
2903   inc(aData, 2);
2904   aPixel.Data.a := 0;
2905 end;
2906
2907 constructor TfdBGR_US3.Create;
2908 begin
2909   inherited Create;
2910   fPixelSize        :=   6.0;
2911   fRange.r          := $FFFF;
2912   fRange.g          := $FFFF;
2913   fRange.b          := $FFFF;
2914   fShift.r          :=    32;
2915   fShift.g          :=    16;
2916   fShift.b          :=     0;
2917   fglFormat         := GL_BGR;
2918   fglDataFormat     := GL_UNSIGNED_SHORT;
2919 end;
2920
2921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2922 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2924 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2925 begin
2926   inherited Map(aPixel, aData, aMapData);
2927   PWord(aData)^ := aPixel.Data.a;
2928   inc(aData, 2);
2929 end;
2930
2931 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 begin
2933   inherited Unmap(aData, aPixel, aMapData);
2934   aPixel.Data.a := PWord(aData)^;
2935   inc(aData, 2);
2936 end;
2937
2938 constructor TfdRGBA_US4.Create;
2939 begin
2940   inherited Create;
2941   fPixelSize        :=   8.0;
2942   fRange.a          := $FFFF;
2943   fShift.a          :=    48;
2944   fglFormat         := GL_RGBA;
2945   fglDataFormat     := GL_UNSIGNED_SHORT;
2946 end;
2947
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2952 begin
2953   inherited Map(aPixel, aData, aMapData);
2954   PWord(aData)^ := aPixel.Data.a;
2955   inc(aData, 2);
2956 end;
2957
2958 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2959 begin
2960   inherited Unmap(aData, aPixel, aMapData);
2961   aPixel.Data.a := PWord(aData)^;
2962   inc(aData, 2);
2963 end;
2964
2965 constructor TfdBGRA_US4.Create;
2966 begin
2967   inherited Create;
2968   fPixelSize        :=   8.0;
2969   fRange.a          := $FFFF;
2970   fShift.a          :=    48;
2971   fglFormat         := GL_BGRA;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2979 var
2980   i: Integer;
2981 begin
2982   PCardinal(aData)^ := 0;
2983   for i := 0 to 3 do
2984     if (fRange.arr[i] > 0) then
2985       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2986   inc(aData, 4);
2987 end;
2988
2989 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2990 var
2991   i: Integer;
2992 begin
2993   for i := 0 to 3 do
2994     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2995   inc(aData, 2);
2996 end;
2997
2998 constructor TfdUniversal_UI1.Create;
2999 begin
3000   inherited Create;
3001   fPixelSize := 4.0;
3002 end;
3003
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3007 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3008 begin
3009   PCardinal(aData)^ := DepthWeight(aPixel);
3010   inc(aData, 4);
3011 end;
3012
3013 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3014 begin
3015   aPixel.Data.r := PCardinal(aData)^;
3016   aPixel.Data.g := PCardinal(aData)^;
3017   aPixel.Data.b := PCardinal(aData)^;
3018   aPixel.Data.a := 0;
3019   inc(aData, 4);
3020 end;
3021
3022 constructor TfdDepth_UI1.Create;
3023 begin
3024   inherited Create;
3025   fPixelSize        := 4.0;
3026   fRange.r          := $FFFFFFFF;
3027   fRange.g          := $FFFFFFFF;
3028   fRange.b          := $FFFFFFFF;
3029   fglFormat         := GL_DEPTH_COMPONENT;
3030   fglDataFormat     := GL_UNSIGNED_INT;
3031 end;
3032
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 constructor TfdAlpha4.Create;
3037 begin
3038   inherited Create;
3039   fFormat           := tfAlpha4;
3040   fWithAlpha        := tfAlpha4;
3041   fglInternalFormat := GL_ALPHA4;
3042 end;
3043
3044 constructor TfdAlpha8.Create;
3045 begin
3046   inherited Create;
3047   fFormat           := tfAlpha8;
3048   fWithAlpha        := tfAlpha8;
3049   fglInternalFormat := GL_ALPHA8;
3050 end;
3051
3052 constructor TfdAlpha12.Create;
3053 begin
3054   inherited Create;
3055   fFormat           := tfAlpha12;
3056   fWithAlpha        := tfAlpha12;
3057   fglInternalFormat := GL_ALPHA12;
3058 end;
3059
3060 constructor TfdAlpha16.Create;
3061 begin
3062   inherited Create;
3063   fFormat           := tfAlpha16;
3064   fWithAlpha        := tfAlpha16;
3065   fglInternalFormat := GL_ALPHA16;
3066 end;
3067
3068 constructor TfdLuminance4.Create;
3069 begin
3070   inherited Create;
3071   fFormat           := tfLuminance4;
3072   fWithAlpha        := tfLuminance4Alpha4;
3073   fWithoutAlpha     := tfLuminance4;
3074   fglInternalFormat := GL_LUMINANCE4;
3075 end;
3076
3077 constructor TfdLuminance8.Create;
3078 begin
3079   inherited Create;
3080   fFormat           := tfLuminance8;
3081   fWithAlpha        := tfLuminance8Alpha8;
3082   fWithoutAlpha     := tfLuminance8;
3083   fglInternalFormat := GL_LUMINANCE8;
3084 end;
3085
3086 constructor TfdLuminance12.Create;
3087 begin
3088   inherited Create;
3089   fFormat           := tfLuminance12;
3090   fWithAlpha        := tfLuminance12Alpha12;
3091   fWithoutAlpha     := tfLuminance12;
3092   fglInternalFormat := GL_LUMINANCE12;
3093 end;
3094
3095 constructor TfdLuminance16.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfLuminance16;
3099   fWithAlpha        := tfLuminance16Alpha16;
3100   fWithoutAlpha     := tfLuminance16;
3101   fglInternalFormat := GL_LUMINANCE16;
3102 end;
3103
3104 constructor TfdLuminance4Alpha4.Create;
3105 begin
3106   inherited Create;
3107   fFormat           := tfLuminance4Alpha4;
3108   fWithAlpha        := tfLuminance4Alpha4;
3109   fWithoutAlpha     := tfLuminance4;
3110   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3111 end;
3112
3113 constructor TfdLuminance6Alpha2.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfLuminance6Alpha2;
3117   fWithAlpha        := tfLuminance6Alpha2;
3118   fWithoutAlpha     := tfLuminance8;
3119   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3120 end;
3121
3122 constructor TfdLuminance8Alpha8.Create;
3123 begin
3124   inherited Create;
3125   fFormat           := tfLuminance8Alpha8;
3126   fWithAlpha        := tfLuminance8Alpha8;
3127   fWithoutAlpha     := tfLuminance8;
3128   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3129 end;
3130
3131 constructor TfdLuminance12Alpha4.Create;
3132 begin
3133   inherited Create;
3134   fFormat           := tfLuminance12Alpha4;
3135   fWithAlpha        := tfLuminance12Alpha4;
3136   fWithoutAlpha     := tfLuminance12;
3137   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3138 end;
3139
3140 constructor TfdLuminance12Alpha12.Create;
3141 begin
3142   inherited Create;
3143   fFormat           := tfLuminance12Alpha12;
3144   fWithAlpha        := tfLuminance12Alpha12;
3145   fWithoutAlpha     := tfLuminance12;
3146   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3147 end;
3148
3149 constructor TfdLuminance16Alpha16.Create;
3150 begin
3151   inherited Create;
3152   fFormat           := tfLuminance16Alpha16;
3153   fWithAlpha        := tfLuminance16Alpha16;
3154   fWithoutAlpha     := tfLuminance16;
3155   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3156 end;
3157
3158 constructor TfdR3G3B2.Create;
3159 begin
3160   inherited Create;
3161   fFormat           := tfR3G3B2;
3162   fWithAlpha        := tfRGBA2;
3163   fWithoutAlpha     := tfR3G3B2;
3164   fRange.r          := $7;
3165   fRange.g          := $7;
3166   fRange.b          := $3;
3167   fShift.r          :=  0;
3168   fShift.g          :=  3;
3169   fShift.b          :=  6;
3170   fglFormat         := GL_RGB;
3171   fglInternalFormat := GL_R3_G3_B2;
3172   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3173 end;
3174
3175 constructor TfdRGB4.Create;
3176 begin
3177   inherited Create;
3178   fFormat           := tfRGB4;
3179   fWithAlpha        := tfRGBA4;
3180   fWithoutAlpha     := tfRGB4;
3181   fRGBInverted      := tfBGR4;
3182   fRange.r          := $F;
3183   fRange.g          := $F;
3184   fRange.b          := $F;
3185   fShift.r          :=  0;
3186   fShift.g          :=  4;
3187   fShift.b          :=  8;
3188   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3189   fglInternalFormat := GL_RGB4;
3190   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3191 end;
3192
3193 constructor TfdR5G6B5.Create;
3194 begin
3195   inherited Create;
3196   fFormat           := tfR5G6B5;
3197   fWithAlpha        := tfRGBA4;
3198   fWithoutAlpha     := tfR5G6B5;
3199   fRGBInverted      := tfB5G6R5;
3200   fRange.r          := $1F;
3201   fRange.g          := $3F;
3202   fRange.b          := $1F;
3203   fShift.r          :=   0;
3204   fShift.g          :=   5;
3205   fShift.b          :=  11;
3206   fglFormat         := GL_RGB;
3207   fglInternalFormat := GL_RGB565;
3208   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3209 end;
3210
3211 constructor TfdRGB5.Create;
3212 begin
3213   inherited Create;
3214   fFormat           := tfRGB5;
3215   fWithAlpha        := tfRGB5A1;
3216   fWithoutAlpha     := tfRGB5;
3217   fRGBInverted      := tfBGR5;
3218   fRange.r          := $1F;
3219   fRange.g          := $1F;
3220   fRange.b          := $1F;
3221   fShift.r          :=   0;
3222   fShift.g          :=   5;
3223   fShift.b          :=  10;
3224   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3225   fglInternalFormat := GL_RGB5;
3226   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3227 end;
3228
3229 constructor TfdRGB8.Create;
3230 begin
3231   inherited Create;
3232   fFormat           := tfRGB8;
3233   fWithAlpha        := tfRGBA8;
3234   fWithoutAlpha     := tfRGB8;
3235   fRGBInverted      := tfBGR8;
3236   fglInternalFormat := GL_RGB8;
3237 end;
3238
3239 constructor TfdRGB10.Create;
3240 begin
3241   inherited Create;
3242   fFormat           := tfRGB10;
3243   fWithAlpha        := tfRGB10A2;
3244   fWithoutAlpha     := tfRGB10;
3245   fRGBInverted      := tfBGR10;
3246   fRange.r          := $3FF;
3247   fRange.g          := $3FF;
3248   fRange.b          := $3FF;
3249   fShift.r          :=    0;
3250   fShift.g          :=   10;
3251   fShift.b          :=   20;
3252   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3253   fglInternalFormat := GL_RGB10;
3254   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3255 end;
3256
3257 constructor TfdRGB12.Create;
3258 begin
3259   inherited Create;
3260   fFormat           := tfRGB12;
3261   fWithAlpha        := tfRGBA12;
3262   fWithoutAlpha     := tfRGB12;
3263   fRGBInverted      := tfBGR12;
3264   fglInternalFormat := GL_RGB12;
3265 end;
3266
3267 constructor TfdRGB16.Create;
3268 begin
3269   inherited Create;
3270   fFormat           := tfRGB16;
3271   fWithAlpha        := tfRGBA16;
3272   fWithoutAlpha     := tfRGB16;
3273   fRGBInverted      := tfBGR16;
3274   fglInternalFormat := GL_RGB16;
3275 end;
3276
3277 constructor TfdRGBA2.Create;
3278 begin
3279   inherited Create;
3280   fFormat           := tfRGBA2;
3281   fWithAlpha        := tfRGBA2;
3282   fWithoutAlpha     := tfR3G3B2;
3283   fRGBInverted      := tfBGRA2;
3284   fglInternalFormat := GL_RGBA2;
3285 end;
3286
3287 constructor TfdRGBA4.Create;
3288 begin
3289   inherited Create;
3290   fFormat           := tfRGBA4;
3291   fWithAlpha        := tfRGBA4;
3292   fWithoutAlpha     := tfRGB4;
3293   fRGBInverted      := tfBGRA4;
3294   fRange.r          := $F;
3295   fRange.g          := $F;
3296   fRange.b          := $F;
3297   fRange.a          := $F;
3298   fShift.r          :=  0;
3299   fShift.g          :=  4;
3300   fShift.b          :=  8;
3301   fShift.a          := 12;
3302   fglFormat         := GL_RGBA;
3303   fglInternalFormat := GL_RGBA4;
3304   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3305 end;
3306
3307 constructor TfdRGB5A1.Create;
3308 begin
3309   inherited Create;
3310   fFormat           := tfRGB5A1;
3311   fWithAlpha        := tfRGB5A1;
3312   fWithoutAlpha     := tfRGB5;
3313   fRGBInverted      := tfBGR5A1;
3314   fRange.r          := $1F;
3315   fRange.g          := $1F;
3316   fRange.b          := $1F;
3317   fRange.a          := $01;
3318   fShift.r          :=   0;
3319   fShift.g          :=   5;
3320   fShift.b          :=  10;
3321   fShift.a          :=  15;
3322   fglFormat         := GL_RGBA;
3323   fglInternalFormat := GL_RGB5_A1;
3324   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3325 end;
3326
3327 constructor TfdRGBA8.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfRGBA8;
3331   fWithAlpha        := tfRGBA8;
3332   fWithoutAlpha     := tfRGB8;
3333   fRGBInverted      := tfBGRA8;
3334   fglInternalFormat := GL_RGBA8;
3335 end;
3336
3337 constructor TfdRGB10A2.Create;
3338 begin
3339   inherited Create;
3340   fFormat           := tfRGB10A2;
3341   fWithAlpha        := tfRGB10A2;
3342   fWithoutAlpha     := tfRGB10;
3343   fRGBInverted      := tfBGR10A2;
3344   fRange.r          := $3FF;
3345   fRange.g          := $3FF;
3346   fRange.b          := $3FF;
3347   fRange.a          := $003;
3348   fShift.r          :=    0;
3349   fShift.g          :=   10;
3350   fShift.b          :=   20;
3351   fShift.a          :=   30;
3352   fglFormat         := GL_RGBA;
3353   fglInternalFormat := GL_RGB10_A2;
3354   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3355 end;
3356
3357 constructor TfdRGBA12.Create;
3358 begin
3359   inherited Create;
3360   fFormat           := tfRGBA12;
3361   fWithAlpha        := tfRGBA12;
3362   fWithoutAlpha     := tfRGB12;
3363   fRGBInverted      := tfBGRA12;
3364   fglInternalFormat := GL_RGBA12;
3365 end;
3366
3367 constructor TfdRGBA16.Create;
3368 begin
3369   inherited Create;
3370   fFormat           := tfRGBA16;
3371   fWithAlpha        := tfRGBA16;
3372   fWithoutAlpha     := tfRGB16;
3373   fRGBInverted      := tfBGRA16;
3374   fglInternalFormat := GL_RGBA16;
3375 end;
3376
3377 constructor TfdBGR4.Create;
3378 begin
3379   inherited Create;
3380   fPixelSize        := 2.0;
3381   fFormat           := tfBGR4;
3382   fWithAlpha        := tfBGRA4;
3383   fWithoutAlpha     := tfBGR4;
3384   fRGBInverted      := tfRGB4;
3385   fRange.r          := $F;
3386   fRange.g          := $F;
3387   fRange.b          := $F;
3388   fRange.a          := $0;
3389   fShift.r          :=  8;
3390   fShift.g          :=  4;
3391   fShift.b          :=  0;
3392   fShift.a          :=  0;
3393   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3394   fglInternalFormat := GL_RGB4;
3395   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3396 end;
3397
3398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3401 constructor TfdB5G6R5.Create;
3402 begin
3403   inherited Create;
3404   fFormat           := tfB5G6R5;
3405   fWithAlpha        := tfBGRA4;
3406   fWithoutAlpha     := tfB5G6R5;
3407   fRGBInverted      := tfR5G6B5;
3408   fRange.r          := $1F;
3409   fRange.g          := $3F;
3410   fRange.b          := $1F;
3411   fShift.r          :=  11;
3412   fShift.g          :=   5;
3413   fShift.b          :=   0;
3414   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3415   fglInternalFormat := GL_RGB8;
3416   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3417 end;
3418
3419 constructor TfdBGR5.Create;
3420 begin
3421   inherited Create;
3422   fPixelSize        := 2.0;
3423   fFormat           := tfBGR5;
3424   fWithAlpha        := tfBGR5A1;
3425   fWithoutAlpha     := tfBGR5;
3426   fRGBInverted      := tfRGB5;
3427   fRange.r          := $1F;
3428   fRange.g          := $1F;
3429   fRange.b          := $1F;
3430   fRange.a          := $00;
3431   fShift.r          :=  10;
3432   fShift.g          :=   5;
3433   fShift.b          :=   0;
3434   fShift.a          :=   0;
3435   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3436   fglInternalFormat := GL_RGB5;
3437   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3438 end;
3439
3440 constructor TfdBGR8.Create;
3441 begin
3442   inherited Create;
3443   fFormat           := tfBGR8;
3444   fWithAlpha        := tfBGRA8;
3445   fWithoutAlpha     := tfBGR8;
3446   fRGBInverted      := tfRGB8;
3447   fglInternalFormat := GL_RGB8;
3448 end;
3449
3450 constructor TfdBGR10.Create;
3451 begin
3452   inherited Create;
3453   fFormat           := tfBGR10;
3454   fWithAlpha        := tfBGR10A2;
3455   fWithoutAlpha     := tfBGR10;
3456   fRGBInverted      := tfRGB10;
3457   fRange.r          := $3FF;
3458   fRange.g          := $3FF;
3459   fRange.b          := $3FF;
3460   fRange.a          := $000;
3461   fShift.r          :=   20;
3462   fShift.g          :=   10;
3463   fShift.b          :=    0;
3464   fShift.a          :=    0;
3465   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3466   fglInternalFormat := GL_RGB10;
3467   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3468 end;
3469
3470 constructor TfdBGR12.Create;
3471 begin
3472   inherited Create;
3473   fFormat           := tfBGR12;
3474   fWithAlpha        := tfBGRA12;
3475   fWithoutAlpha     := tfBGR12;
3476   fRGBInverted      := tfRGB12;
3477   fglInternalFormat := GL_RGB12;
3478 end;
3479
3480 constructor TfdBGR16.Create;
3481 begin
3482   inherited Create;
3483   fFormat           := tfBGR16;
3484   fWithAlpha        := tfBGRA16;
3485   fWithoutAlpha     := tfBGR16;
3486   fRGBInverted      := tfRGB16;
3487   fglInternalFormat := GL_RGB16;
3488 end;
3489
3490 constructor TfdBGRA2.Create;
3491 begin
3492   inherited Create;
3493   fFormat           := tfBGRA2;
3494   fWithAlpha        := tfBGRA4;
3495   fWithoutAlpha     := tfBGR4;
3496   fRGBInverted      := tfRGBA2;
3497   fglInternalFormat := GL_RGBA2;
3498 end;
3499
3500 constructor TfdBGRA4.Create;
3501 begin
3502   inherited Create;
3503   fFormat           := tfBGRA4;
3504   fWithAlpha        := tfBGRA4;
3505   fWithoutAlpha     := tfBGR4;
3506   fRGBInverted      := tfRGBA4;
3507   fRange.r          := $F;
3508   fRange.g          := $F;
3509   fRange.b          := $F;
3510   fRange.a          := $F;
3511   fShift.r          :=  8;
3512   fShift.g          :=  4;
3513   fShift.b          :=  0;
3514   fShift.a          := 12;
3515   fglFormat         := GL_BGRA;
3516   fglInternalFormat := GL_RGBA4;
3517   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3518 end;
3519
3520 constructor TfdBGR5A1.Create;
3521 begin
3522   inherited Create;
3523   fFormat           := tfBGR5A1;
3524   fWithAlpha        := tfBGR5A1;
3525   fWithoutAlpha     := tfBGR5;
3526   fRGBInverted      := tfRGB5A1;
3527   fRange.r          := $1F;
3528   fRange.g          := $1F;
3529   fRange.b          := $1F;
3530   fRange.a          := $01;
3531   fShift.r          :=  10;
3532   fShift.g          :=   5;
3533   fShift.b          :=   0;
3534   fShift.a          :=  15;
3535   fglFormat         := GL_BGRA;
3536   fglInternalFormat := GL_RGB5_A1;
3537   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3538 end;
3539
3540 constructor TfdBGRA8.Create;
3541 begin
3542   inherited Create;
3543   fFormat           := tfBGRA8;
3544   fWithAlpha        := tfBGRA8;
3545   fWithoutAlpha     := tfBGR8;
3546   fRGBInverted      := tfRGBA8;
3547   fglInternalFormat := GL_RGBA8;
3548 end;
3549
3550 constructor TfdBGR10A2.Create;
3551 begin
3552   inherited Create;
3553   fFormat           := tfBGR10A2;
3554   fWithAlpha        := tfBGR10A2;
3555   fWithoutAlpha     := tfBGR10;
3556   fRGBInverted      := tfRGB10A2;
3557   fRange.r          := $3FF;
3558   fRange.g          := $3FF;
3559   fRange.b          := $3FF;
3560   fRange.a          := $003;
3561   fShift.r          :=   20;
3562   fShift.g          :=   10;
3563   fShift.b          :=    0;
3564   fShift.a          :=   30;
3565   fglFormat         := GL_BGRA;
3566   fglInternalFormat := GL_RGB10_A2;
3567   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3568 end;
3569
3570 constructor TfdBGRA12.Create;
3571 begin
3572   inherited Create;
3573   fFormat           := tfBGRA12;
3574   fWithAlpha        := tfBGRA12;
3575   fWithoutAlpha     := tfBGR12;
3576   fRGBInverted      := tfRGBA12;
3577   fglInternalFormat := GL_RGBA12;
3578 end;
3579
3580 constructor TfdBGRA16.Create;
3581 begin
3582   inherited Create;
3583   fFormat           := tfBGRA16;
3584   fWithAlpha        := tfBGRA16;
3585   fWithoutAlpha     := tfBGR16;
3586   fRGBInverted      := tfRGBA16;
3587   fglInternalFormat := GL_RGBA16;
3588 end;
3589
3590 constructor TfdDepth16.Create;
3591 begin
3592   inherited Create;
3593   fFormat           := tfDepth16;
3594   fWithAlpha        := tfEmpty;
3595   fWithoutAlpha     := tfDepth16;
3596   fglInternalFormat := GL_DEPTH_COMPONENT16;
3597 end;
3598
3599 constructor TfdDepth24.Create;
3600 begin
3601   inherited Create;
3602   fFormat           := tfDepth24;
3603   fWithAlpha        := tfEmpty;
3604   fWithoutAlpha     := tfDepth24;
3605   fglInternalFormat := GL_DEPTH_COMPONENT24;
3606 end;
3607
3608 constructor TfdDepth32.Create;
3609 begin
3610   inherited Create;
3611   fFormat           := tfDepth32;
3612   fWithAlpha        := tfEmpty;
3613   fWithoutAlpha     := tfDepth32;
3614   fglInternalFormat := GL_DEPTH_COMPONENT32;
3615 end;
3616
3617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3618 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3620 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3621 begin
3622   raise EglBitmap.Create('mapping for compressed formats is not supported');
3623 end;
3624
3625 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3626 begin
3627   raise EglBitmap.Create('mapping for compressed formats is not supported');
3628 end;
3629
3630 constructor TfdS3tcDtx1RGBA.Create;
3631 begin
3632   inherited Create;
3633   fFormat           := tfS3tcDtx1RGBA;
3634   fWithAlpha        := tfS3tcDtx1RGBA;
3635   fUncompressed     := tfRGB5A1;
3636   fPixelSize        := 0.5;
3637   fIsCompressed     := true;
3638   fglFormat         := GL_COMPRESSED_RGBA;
3639   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3640   fglDataFormat     := GL_UNSIGNED_BYTE;
3641 end;
3642
3643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3647 begin
3648   raise EglBitmap.Create('mapping for compressed formats is not supported');
3649 end;
3650
3651 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3652 begin
3653   raise EglBitmap.Create('mapping for compressed formats is not supported');
3654 end;
3655
3656 constructor TfdS3tcDtx3RGBA.Create;
3657 begin
3658   inherited Create;
3659   fFormat           := tfS3tcDtx3RGBA;
3660   fWithAlpha        := tfS3tcDtx3RGBA;
3661   fUncompressed     := tfRGBA8;
3662   fPixelSize        := 1.0;
3663   fIsCompressed     := true;
3664   fglFormat         := GL_COMPRESSED_RGBA;
3665   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3666   fglDataFormat     := GL_UNSIGNED_BYTE;
3667 end;
3668
3669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3673 begin
3674   raise EglBitmap.Create('mapping for compressed formats is not supported');
3675 end;
3676
3677 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3678 begin
3679   raise EglBitmap.Create('mapping for compressed formats is not supported');
3680 end;
3681
3682 constructor TfdS3tcDtx5RGBA.Create;
3683 begin
3684   inherited Create;
3685   fFormat           := tfS3tcDtx3RGBA;
3686   fWithAlpha        := tfS3tcDtx3RGBA;
3687   fUncompressed     := tfRGBA8;
3688   fPixelSize        := 1.0;
3689   fIsCompressed     := true;
3690   fglFormat         := GL_COMPRESSED_RGBA;
3691   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3692   fglDataFormat     := GL_UNSIGNED_BYTE;
3693 end;
3694
3695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 class procedure TFormatDescriptor.Init;
3699 begin
3700   if not Assigned(FormatDescriptorCS) then
3701     FormatDescriptorCS := TCriticalSection.Create;
3702 end;
3703
3704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3706 begin
3707   FormatDescriptorCS.Enter;
3708   try
3709     result := FormatDescriptors[aFormat];
3710     if not Assigned(result) then begin
3711       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3712       FormatDescriptors[aFormat] := result;
3713     end;
3714   finally
3715     FormatDescriptorCS.Leave;
3716   end;
3717 end;
3718
3719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3721 begin
3722   result := Get(Get(aFormat).WithAlpha);
3723 end;
3724
3725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 class procedure TFormatDescriptor.Clear;
3727 var
3728   f: TglBitmapFormat;
3729 begin
3730   FormatDescriptorCS.Enter;
3731   try
3732     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3733       FreeAndNil(FormatDescriptors[f]);
3734   finally
3735     FormatDescriptorCS.Leave;
3736   end;
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 class procedure TFormatDescriptor.Finalize;
3741 begin
3742   Clear;
3743   FreeAndNil(FormatDescriptorCS);
3744 end;
3745
3746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3750 begin
3751   Update(aValue, fRange.r, fShift.r);
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3756 begin
3757   Update(aValue, fRange.g, fShift.g);
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3762 begin
3763   Update(aValue, fRange.b, fShift.b);
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3768 begin
3769   Update(aValue, fRange.a, fShift.a);
3770 end;
3771
3772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3773 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3774   aShift: Byte);
3775 begin
3776   aShift := 0;
3777   aRange := 0;
3778   if (aMask = 0) then
3779     exit;
3780   while (aMask > 0) and ((aMask and 1) = 0) do begin
3781     inc(aShift);
3782     aMask := aMask shr 1;
3783   end;
3784   aRange := 1;
3785   while (aMask > 0) do begin
3786     aRange := aRange shl 1;
3787     aMask  := aMask  shr 1;
3788   end;
3789   dec(aRange);
3790
3791   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3796 var
3797   data: QWord;
3798   s: Integer;
3799 begin
3800   data :=
3801     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3802     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3803     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3804     ((aPixel.Data.a and fRange.a) shl fShift.a);
3805   s := Round(fPixelSize);
3806   case s of
3807     1:           aData^  := data;
3808     2:     PWord(aData)^ := data;
3809     4: PCardinal(aData)^ := data;
3810     8:    PQWord(aData)^ := data;
3811   else
3812     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3813   end;
3814   inc(aData, s);
3815 end;
3816
3817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3818 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3819 var
3820   data: QWord;
3821   s, i: Integer;
3822 begin
3823   s := Round(fPixelSize);
3824   case s of
3825     1: data :=           aData^;
3826     2: data :=     PWord(aData)^;
3827     4: data := PCardinal(aData)^;
3828     8: data :=    PQWord(aData)^;
3829   else
3830     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3831   end;
3832   for i := 0 to 3 do
3833     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3834   inc(aData, s);
3835 end;
3836
3837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3838 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3840 procedure TbmpColorTableFormat.CreateColorTable;
3841 var
3842   i: Integer;
3843 begin
3844   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3845     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3846
3847   if (Format = tfLuminance4) then
3848     SetLength(fColorTable, 16)
3849   else
3850     SetLength(fColorTable, 256);
3851
3852   case Format of
3853     tfLuminance4: begin
3854       for i := 0 to High(fColorTable) do begin
3855         fColorTable[i].r := 16 * i;
3856         fColorTable[i].g := 16 * i;
3857         fColorTable[i].b := 16 * i;
3858         fColorTable[i].a := 0;
3859       end;
3860     end;
3861
3862     tfLuminance8: begin
3863       for i := 0 to High(fColorTable) do begin
3864         fColorTable[i].r := i;
3865         fColorTable[i].g := i;
3866         fColorTable[i].b := i;
3867         fColorTable[i].a := 0;
3868       end;
3869     end;
3870
3871     tfR3G3B2: begin
3872       for i := 0 to High(fColorTable) do begin
3873         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3874         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3875         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3876         fColorTable[i].a := 0;
3877       end;
3878     end;
3879   end;
3880 end;
3881
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3884 var
3885   d: Byte;
3886 begin
3887   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3888     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3889
3890   case Format of
3891     tfLuminance4: begin
3892       if (aMapData = nil) then
3893         aData^ := 0;
3894       d := LuminanceWeight(aPixel) and Range.r;
3895       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3896       inc(PByte(aMapData), 4);
3897       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3898         inc(aData);
3899         aMapData := nil;
3900       end;
3901     end;
3902
3903     tfLuminance8: begin
3904       aData^ := LuminanceWeight(aPixel) and Range.r;
3905       inc(aData);
3906     end;
3907
3908     tfR3G3B2: begin
3909       aData^ := Round(
3910         ((aPixel.Data.r and Range.r) shl Shift.r) or
3911         ((aPixel.Data.g and Range.g) shl Shift.g) or
3912         ((aPixel.Data.b and Range.b) shl Shift.b));
3913       inc(aData);
3914     end;
3915   end;
3916 end;
3917
3918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3919 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3920 var
3921   idx: QWord;
3922   s: Integer;
3923   bits: Byte;
3924   f: Single;
3925 begin
3926   s    := Trunc(fPixelSize);
3927   f    := fPixelSize - s;
3928   bits := Round(8 * f);
3929   case s of
3930     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3931     1: idx :=           aData^;
3932     2: idx :=     PWord(aData)^;
3933     4: idx := PCardinal(aData)^;
3934     8: idx :=    PQWord(aData)^;
3935   else
3936     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3937   end;
3938   if (idx >= Length(fColorTable)) then
3939     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3940   with fColorTable[idx] do begin
3941     aPixel.Data.r := r;
3942     aPixel.Data.g := g;
3943     aPixel.Data.b := b;
3944     aPixel.Data.a := a;
3945   end;
3946   inc(PByte(aMapData), bits);
3947   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3948     inc(aData, 1);
3949     dec(PByte(aMapData), 8);
3950   end;
3951   inc(aData, s);
3952 end;
3953
3954 destructor TbmpColorTableFormat.Destroy;
3955 begin
3956   SetLength(fColorTable, 0);
3957   inherited Destroy;
3958 end;
3959
3960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3961 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3963 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3964 var
3965   i: Integer;
3966 begin
3967   for i := 0 to 3 do begin
3968     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3969       if (aSourceFD.Range.arr[i] > 0) then
3970         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3971       else
3972         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3973     end;
3974   end;
3975 end;
3976
3977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3978 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3979 begin
3980   with aFuncRec do begin
3981     if (Source.Range.r   > 0) then
3982       Dest.Data.r := Source.Data.r;
3983     if (Source.Range.g > 0) then
3984       Dest.Data.g := Source.Data.g;
3985     if (Source.Range.b  > 0) then
3986       Dest.Data.b := Source.Data.b;
3987     if (Source.Range.a > 0) then
3988       Dest.Data.a := Source.Data.a;
3989   end;
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3994 var
3995   i: Integer;
3996 begin
3997   with aFuncRec do begin
3998     for i := 0 to 3 do
3999       if (Source.Range.arr[i] > 0) then
4000         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4001   end;
4002 end;
4003
4004 type
4005   TShiftData = packed record
4006     case Integer of
4007       0: (r, g, b, a: SmallInt);
4008       1: (arr: array[0..3] of SmallInt);
4009   end;
4010   PShiftData = ^TShiftData;
4011
4012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4013 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4014 var
4015   i: Integer;
4016 begin
4017   with aFuncRec do
4018     for i := 0 to 3 do
4019       if (Source.Range.arr[i] > 0) then
4020         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4021 end;
4022
4023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4024 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4025 begin
4026   with aFuncRec do begin
4027     Dest.Data := Source.Data;
4028     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4029       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4030       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4031       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4032     end;
4033     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4034       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4035     end;
4036   end;
4037 end;
4038
4039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4040 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4041 var
4042   i: Integer;
4043 begin
4044   with aFuncRec do begin
4045     for i := 0 to 3 do
4046       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4047   end;
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4052 var
4053   Temp: Single;
4054 begin
4055   with FuncRec do begin
4056     if (FuncRec.Args = nil) then begin //source has no alpha
4057       Temp :=
4058         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4059         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4060         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4061       Dest.Data.a := Round(Dest.Range.a * Temp);
4062     end else
4063       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4064   end;
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4069 type
4070   PglBitmapPixelData = ^TglBitmapPixelData;
4071 begin
4072   with FuncRec do begin
4073     Dest.Data.r := Source.Data.r;
4074     Dest.Data.g := Source.Data.g;
4075     Dest.Data.b := Source.Data.b;
4076
4077     with PglBitmapPixelData(Args)^ do
4078       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4079           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4080           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4081         Dest.Data.a := 0
4082       else
4083         Dest.Data.a := Dest.Range.a;
4084   end;
4085 end;
4086
4087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4088 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4089 begin
4090   with FuncRec do begin
4091     Dest.Data.r := Source.Data.r;
4092     Dest.Data.g := Source.Data.g;
4093     Dest.Data.b := Source.Data.b;
4094     Dest.Data.a := PCardinal(Args)^;
4095   end;
4096 end;
4097
4098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4100 type
4101   PRGBPix = ^TRGBPix;
4102   TRGBPix = array [0..2] of byte;
4103 var
4104   Temp: Byte;
4105 begin
4106   while aWidth > 0 do begin
4107     Temp := PRGBPix(aData)^[0];
4108     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4109     PRGBPix(aData)^[2] := Temp;
4110
4111     if aHasAlpha then
4112       Inc(aData, 4)
4113     else
4114       Inc(aData, 3);
4115     dec(aWidth);
4116   end;
4117 end;
4118
4119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4123 begin
4124   result := TFormatDescriptor.Get(Format);
4125 end;
4126
4127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4128 function TglBitmap.GetWidth: Integer;
4129 begin
4130   if (ffX in fDimension.Fields) then
4131     result := fDimension.X
4132   else
4133     result := -1;
4134 end;
4135
4136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4137 function TglBitmap.GetHeight: Integer;
4138 begin
4139   if (ffY in fDimension.Fields) then
4140     result := fDimension.Y
4141   else
4142     result := -1;
4143 end;
4144
4145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 function TglBitmap.GetFileWidth: Integer;
4147 begin
4148   result := Max(1, Width);
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 function TglBitmap.GetFileHeight: Integer;
4153 begin
4154   result := Max(1, Height);
4155 end;
4156
4157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4158 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4159 begin
4160   if fCustomData = aValue then
4161     exit;
4162   fCustomData := aValue;
4163 end;
4164
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 procedure TglBitmap.SetCustomName(const aValue: String);
4167 begin
4168   if fCustomName = aValue then
4169     exit;
4170   fCustomName := aValue;
4171 end;
4172
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4175 begin
4176   if fCustomNameW = aValue then
4177     exit;
4178   fCustomNameW := aValue;
4179 end;
4180
4181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4182 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4183 begin
4184   if fFreeDataOnDestroy = aValue then
4185     exit;
4186   fFreeDataOnDestroy := aValue;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4191 begin
4192   if fDeleteTextureOnFree = aValue then
4193     exit;
4194   fDeleteTextureOnFree := aValue;
4195 end;
4196
4197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4198 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4199 begin
4200   if fFormat = aValue then
4201     exit;
4202   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4203     raise EglBitmapUnsupportedFormat.Create(Format);
4204   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4205 end;
4206
4207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4208 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4209 begin
4210   if fFreeDataAfterGenTexture = aValue then
4211     exit;
4212   fFreeDataAfterGenTexture := aValue;
4213 end;
4214
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 procedure TglBitmap.SetID(const aValue: Cardinal);
4217 begin
4218   if fID = aValue then
4219     exit;
4220   fID := aValue;
4221 end;
4222
4223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4224 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4225 begin
4226   if fMipMap = aValue then
4227     exit;
4228   fMipMap := aValue;
4229 end;
4230
4231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4232 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4233 begin
4234   if fTarget = aValue then
4235     exit;
4236   fTarget := aValue;
4237 end;
4238
4239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4240 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4241 var
4242   MaxAnisotropic: Integer;
4243 begin
4244   fAnisotropic := aValue;
4245   if (ID > 0) then begin
4246     if GL_EXT_texture_filter_anisotropic then begin
4247       if fAnisotropic > 0 then begin
4248         Bind(false);
4249         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4250         if aValue > MaxAnisotropic then
4251           fAnisotropic := MaxAnisotropic;
4252         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4253       end;
4254     end else begin
4255       fAnisotropic := 0;
4256     end;
4257   end;
4258 end;
4259
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 procedure TglBitmap.CreateID;
4262 begin
4263   if (ID <> 0) then
4264     glDeleteTextures(1, @fID);
4265   glGenTextures(1, @fID);
4266   Bind(false);
4267 end;
4268
4269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4270 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4271 begin
4272   // Set Up Parameters
4273   SetWrap(fWrapS, fWrapT, fWrapR);
4274   SetFilter(fFilterMin, fFilterMag);
4275   SetAnisotropic(fAnisotropic);
4276   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4277
4278   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4279     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4280
4281   // Mip Maps Generation Mode
4282   aBuildWithGlu := false;
4283   if (MipMap = mmMipmap) then begin
4284     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4285       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4286     else
4287       aBuildWithGlu := true;
4288   end else if (MipMap = mmMipmapGlu) then
4289     aBuildWithGlu := true;
4290 end;
4291
4292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4293 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4294   const aWidth: Integer; const aHeight: Integer);
4295 var
4296   s: Single;
4297 begin
4298   if (Data <> aData) then begin
4299     if (Assigned(Data)) then
4300       FreeMem(Data);
4301     fData := aData;
4302   end;
4303
4304   if not Assigned(fData) then begin
4305     fPixelSize := 0;
4306     fRowSize   := 0;
4307   end else begin
4308     FillChar(fDimension, SizeOf(fDimension), 0);
4309     if aWidth <> -1 then begin
4310       fDimension.Fields := fDimension.Fields + [ffX];
4311       fDimension.X := aWidth;
4312     end;
4313
4314     if aHeight <> -1 then begin
4315       fDimension.Fields := fDimension.Fields + [ffY];
4316       fDimension.Y := aHeight;
4317     end;
4318
4319     s := TFormatDescriptor.Get(aFormat).PixelSize;
4320     fFormat    := aFormat;
4321     fPixelSize := Ceil(s);
4322     fRowSize   := Ceil(s * aWidth);
4323   end;
4324 end;
4325
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 function TglBitmap.FlipHorz: Boolean;
4328 begin
4329   result := false;
4330 end;
4331
4332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4333 function TglBitmap.FlipVert: Boolean;
4334 begin
4335   result := false;
4336 end;
4337
4338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4339 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4341 procedure TglBitmap.AfterConstruction;
4342 begin
4343   inherited AfterConstruction;
4344
4345   fID         := 0;
4346   fTarget     := 0;
4347   fIsResident := false;
4348
4349   fMipMap                  := glBitmapDefaultMipmap;
4350   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4351   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4352
4353   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4354   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4355   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4356 end;
4357
4358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4359 procedure TglBitmap.BeforeDestruction;
4360 var
4361   NewData: PByte;
4362 begin
4363   if fFreeDataOnDestroy then begin
4364     NewData := nil;
4365     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4366   end;
4367   if (fID > 0) and fDeleteTextureOnFree then
4368     glDeleteTextures(1, @fID);
4369   inherited BeforeDestruction;
4370 end;
4371
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4374 var
4375   TempPos: Integer;
4376 begin
4377   if not Assigned(aResType) then begin
4378     TempPos   := Pos('.', aResource);
4379     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4380     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4381   end;
4382 end;
4383
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure TglBitmap.LoadFromFile(const aFilename: String);
4386 var
4387   fs: TFileStream;
4388 begin
4389   if not FileExists(aFilename) then
4390     raise EglBitmap.Create('file does not exist: ' + aFilename);
4391   fFilename := aFilename;
4392   fs := TFileStream.Create(fFilename, fmOpenRead);
4393   try
4394     fs.Position := 0;
4395     LoadFromStream(fs);
4396   finally
4397     fs.Free;
4398   end;
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4403 begin
4404   {$IFDEF GLB_SUPPORT_PNG_READ}
4405   if not LoadPNG(aStream) then
4406   {$ENDIF}
4407   {$IFDEF GLB_SUPPORT_JPEG_READ}
4408   if not LoadJPEG(aStream) then
4409   {$ENDIF}
4410   if not LoadDDS(aStream) then
4411   if not LoadTGA(aStream) then
4412   if not LoadBMP(aStream) then
4413     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4418   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4419 var
4420   tmpData: PByte;
4421   size: Integer;
4422 begin
4423   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4424   GetMem(tmpData, size);
4425   try
4426     FillChar(tmpData^, size, #$FF);
4427     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4428   except
4429     if Assigned(tmpData) then
4430       FreeMem(tmpData);
4431     raise;
4432   end;
4433   AddFunc(Self, aFunc, false, aFormat, aArgs);
4434 end;
4435
4436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4437 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4438 var
4439   rs: TResourceStream;
4440 begin
4441   PrepareResType(aResource, aResType);
4442   rs := TResourceStream.Create(aInstance, aResource, aResType);
4443   try
4444     LoadFromStream(rs);
4445   finally
4446     rs.Free;
4447   end;
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4452 var
4453   rs: TResourceStream;
4454 begin
4455   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4456   try
4457     LoadFromStream(rs);
4458   finally
4459     rs.Free;
4460   end;
4461 end;
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4465 var
4466   fs: TFileStream;
4467 begin
4468   fs := TFileStream.Create(aFileName, fmCreate);
4469   try
4470     fs.Position := 0;
4471     SaveToStream(fs, aFileType);
4472   finally
4473     fs.Free;
4474   end;
4475 end;
4476
4477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4478 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4479 begin
4480   case aFileType of
4481     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4482     ftPNG:  SavePNG(aStream);
4483     {$ENDIF}
4484     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4485     ftJPEG: SaveJPEG(aStream);
4486     {$ENDIF}
4487     ftDDS:  SaveDDS(aStream);
4488     ftTGA:  SaveTGA(aStream);
4489     ftBMP:  SaveBMP(aStream);
4490   end;
4491 end;
4492
4493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4494 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4495 begin
4496   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4497 end;
4498
4499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4500 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4501   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4502 var
4503   DestData, TmpData, SourceData: pByte;
4504   TempHeight, TempWidth: Integer;
4505   SourceFD, DestFD: TFormatDescriptor;
4506   SourceMD, DestMD: Pointer;
4507
4508   FuncRec: TglBitmapFunctionRec;
4509 begin
4510   Assert(Assigned(Data));
4511   Assert(Assigned(aSource));
4512   Assert(Assigned(aSource.Data));
4513
4514   result := false;
4515   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4516     SourceFD := TFormatDescriptor.Get(aSource.Format);
4517     DestFD   := TFormatDescriptor.Get(aFormat);
4518
4519     if (SourceFD.IsCompressed) then
4520       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4521     if (DestFD.IsCompressed) then
4522       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4523
4524     // inkompatible Formats so CreateTemp
4525     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4526       aCreateTemp := true;
4527
4528     // Values
4529     TempHeight := Max(1, aSource.Height);
4530     TempWidth  := Max(1, aSource.Width);
4531
4532     FuncRec.Sender := Self;
4533     FuncRec.Args   := aArgs;
4534
4535     TmpData := nil;
4536     if aCreateTemp then begin
4537       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4538       DestData := TmpData;
4539     end else
4540       DestData := Data;
4541
4542     try
4543       SourceFD.PreparePixel(FuncRec.Source);
4544       DestFD.PreparePixel  (FuncRec.Dest);
4545
4546       SourceMD := SourceFD.CreateMappingData;
4547       DestMD   := DestFD.CreateMappingData;
4548
4549       FuncRec.Size            := aSource.Dimension;
4550       FuncRec.Position.Fields := FuncRec.Size.Fields;
4551
4552       try
4553         SourceData := aSource.Data;
4554         FuncRec.Position.Y := 0;
4555         while FuncRec.Position.Y < TempHeight do begin
4556           FuncRec.Position.X := 0;
4557           while FuncRec.Position.X < TempWidth do begin
4558             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4559             aFunc(FuncRec);
4560             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4561             inc(FuncRec.Position.X);
4562           end;
4563           inc(FuncRec.Position.Y);
4564         end;
4565
4566         // Updating Image or InternalFormat
4567         if aCreateTemp then
4568           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4569         else if (aFormat <> fFormat) then
4570           Format := aFormat;
4571
4572         result := true;
4573       finally
4574         SourceFD.FreeMappingData(SourceMD);
4575         DestFD.FreeMappingData(DestMD);
4576       end;
4577     except
4578       if aCreateTemp and Assigned(TmpData) then
4579         FreeMem(TmpData);
4580       raise;
4581     end;
4582   end;
4583 end;
4584
4585 {$IFDEF GLB_SDL}
4586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4587 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4588 var
4589   Row, RowSize: Integer;
4590   SourceData, TmpData: PByte;
4591   TempDepth: Integer;
4592   FormatDesc: TFormatDescriptor;
4593
4594   function GetRowPointer(Row: Integer): pByte;
4595   begin
4596     result := aSurface.pixels;
4597     Inc(result, Row * RowSize);
4598   end;
4599
4600 begin
4601   result := false;
4602
4603   FormatDesc := TFormatDescriptor.Get(Format);
4604   if FormatDesc.IsCompressed then
4605     raise EglBitmapUnsupportedFormat.Create(Format);
4606
4607   if Assigned(Data) then begin
4608     case Trunc(FormatDesc.PixelSize) of
4609       1: TempDepth :=  8;
4610       2: TempDepth := 16;
4611       3: TempDepth := 24;
4612       4: TempDepth := 32;
4613     else
4614       raise EglBitmapUnsupportedFormat.Create(Format);
4615     end;
4616
4617     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4618       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4619     SourceData := Data;
4620     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4621
4622     for Row := 0 to FileHeight-1 do begin
4623       TmpData := GetRowPointer(Row);
4624       if Assigned(TmpData) then begin
4625         Move(SourceData^, TmpData^, RowSize);
4626         inc(SourceData, RowSize);
4627       end;
4628     end;
4629     result := true;
4630   end;
4631 end;
4632
4633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4634 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4635 var
4636   pSource, pData, pTempData: PByte;
4637   Row, RowSize, TempWidth, TempHeight: Integer;
4638   IntFormat: TglBitmapFormat;
4639   FormatDesc: TFormatDescriptor;
4640
4641   function GetRowPointer(Row: Integer): pByte;
4642   begin
4643     result := aSurface^.pixels;
4644     Inc(result, Row * RowSize);
4645   end;
4646
4647 begin
4648   result := false;
4649   if (Assigned(aSurface)) then begin
4650     with aSurface^.format^ do begin
4651       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4652         FormatDesc := TFormatDescriptor.Get(IntFormat);
4653         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4654           break;
4655       end;
4656       if (IntFormat = tfEmpty) then
4657         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4658     end;
4659
4660     TempWidth  := aSurface^.w;
4661     TempHeight := aSurface^.h;
4662     RowSize := FormatDesc.GetSize(TempWidth, 1);
4663     GetMem(pData, TempHeight * RowSize);
4664     try
4665       pTempData := pData;
4666       for Row := 0 to TempHeight -1 do begin
4667         pSource := GetRowPointer(Row);
4668         if (Assigned(pSource)) then begin
4669           Move(pSource^, pTempData^, RowSize);
4670           Inc(pTempData, RowSize);
4671         end;
4672       end;
4673       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4674       result := true;
4675     except
4676       if Assigned(pData) then
4677         FreeMem(pData);
4678       raise;
4679     end;
4680   end;
4681 end;
4682
4683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4684 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4685 var
4686   Row, Col, AlphaInterleave: Integer;
4687   pSource, pDest: PByte;
4688
4689   function GetRowPointer(Row: Integer): pByte;
4690   begin
4691     result := aSurface.pixels;
4692     Inc(result, Row * Width);
4693   end;
4694
4695 begin
4696   result := false;
4697   if Assigned(Data) then begin
4698     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4699       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4700
4701       AlphaInterleave := 0;
4702       case Format of
4703         tfLuminance8Alpha8:
4704           AlphaInterleave := 1;
4705         tfBGRA8, tfRGBA8:
4706           AlphaInterleave := 3;
4707       end;
4708
4709       pSource := Data;
4710       for Row := 0 to Height -1 do begin
4711         pDest := GetRowPointer(Row);
4712         if Assigned(pDest) then begin
4713           for Col := 0 to Width -1 do begin
4714             Inc(pSource, AlphaInterleave);
4715             pDest^ := pSource^;
4716             Inc(pDest);
4717             Inc(pSource);
4718           end;
4719         end;
4720       end;
4721       result := true;
4722     end;
4723   end;
4724 end;
4725
4726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4727 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4728 var
4729   bmp: TglBitmap2D;
4730 begin
4731   bmp := TglBitmap2D.Create;
4732   try
4733     bmp.AssignFromSurface(aSurface);
4734     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4735   finally
4736     bmp.Free;
4737   end;
4738 end;
4739 {$ENDIF}
4740
4741 {$IFDEF GLB_DELPHI}
4742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4743 function CreateGrayPalette: HPALETTE;
4744 var
4745   Idx: Integer;
4746   Pal: PLogPalette;
4747 begin
4748   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4749
4750   Pal.palVersion := $300;
4751   Pal.palNumEntries := 256;
4752
4753   for Idx := 0 to Pal.palNumEntries - 1 do begin
4754     Pal.palPalEntry[Idx].peRed   := Idx;
4755     Pal.palPalEntry[Idx].peGreen := Idx;
4756     Pal.palPalEntry[Idx].peBlue  := Idx;
4757     Pal.palPalEntry[Idx].peFlags := 0;
4758   end;
4759   Result := CreatePalette(Pal^);
4760   FreeMem(Pal);
4761 end;
4762
4763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4764 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4765 var
4766   Row: Integer;
4767   pSource, pData: PByte;
4768 begin
4769   result := false;
4770   if Assigned(Data) then begin
4771     if Assigned(aBitmap) then begin
4772       aBitmap.Width  := Width;
4773       aBitmap.Height := Height;
4774
4775       case Format of
4776         tfAlpha8, tfLuminance8: begin
4777           aBitmap.PixelFormat := pf8bit;
4778           aBitmap.Palette     := CreateGrayPalette;
4779         end;
4780         tfRGB5A1:
4781           aBitmap.PixelFormat := pf15bit;
4782         tfR5G6B5:
4783           aBitmap.PixelFormat := pf16bit;
4784         tfRGB8, tfBGR8:
4785           aBitmap.PixelFormat := pf24bit;
4786         tfRGBA8, tfBGRA8:
4787           aBitmap.PixelFormat := pf32bit;
4788       else
4789         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4790       end;
4791
4792       pSource := Data;
4793       for Row := 0 to FileHeight -1 do begin
4794         pData := aBitmap.Scanline[Row];
4795         Move(pSource^, pData^, fRowSize);
4796         Inc(pSource, fRowSize);
4797         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4798           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4799       end;
4800       result := true;
4801     end;
4802   end;
4803 end;
4804
4805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4806 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4807 var
4808   pSource, pData, pTempData: PByte;
4809   Row, RowSize, TempWidth, TempHeight: Integer;
4810   IntFormat: TglBitmapFormat;
4811 begin
4812   result := false;
4813
4814   if (Assigned(aBitmap)) then begin
4815     case aBitmap.PixelFormat of
4816       pf8bit:
4817         IntFormat := tfLuminance8;
4818       pf15bit:
4819         IntFormat := tfRGB5A1;
4820       pf16bit:
4821         IntFormat := tfR5G6B5;
4822       pf24bit:
4823         IntFormat := tfBGR8;
4824       pf32bit:
4825         IntFormat := tfBGRA8;
4826     else
4827       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4828     end;
4829
4830     TempWidth  := aBitmap.Width;
4831     TempHeight := aBitmap.Height;
4832     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4833     GetMem(pData, TempHeight * RowSize);
4834     try
4835       pTempData := pData;
4836       for Row := 0 to TempHeight -1 do begin
4837         pSource := aBitmap.Scanline[Row];
4838         if (Assigned(pSource)) then begin
4839           Move(pSource^, pTempData^, RowSize);
4840           Inc(pTempData, RowSize);
4841         end;
4842       end;
4843       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4844       result := true;
4845     except
4846       if Assigned(pData) then
4847         FreeMem(pData);
4848       raise;
4849     end;
4850   end;
4851 end;
4852
4853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4854 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4855 var
4856   Row, Col, AlphaInterleave: Integer;
4857   pSource, pDest: PByte;
4858 begin
4859   result := false;
4860
4861   if Assigned(Data) then begin
4862     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4863       if Assigned(aBitmap) then begin
4864         aBitmap.PixelFormat := pf8bit;
4865         aBitmap.Palette     := CreateGrayPalette;
4866         aBitmap.Width       := Width;
4867         aBitmap.Height      := Height;
4868
4869         case Format of
4870           tfLuminance8Alpha8:
4871             AlphaInterleave := 1;
4872           tfRGBA8, tfBGRA8:
4873             AlphaInterleave := 3;
4874           else
4875             AlphaInterleave := 0;
4876         end;
4877
4878         // Copy Data
4879         pSource := Data;
4880
4881         for Row := 0 to Height -1 do begin
4882           pDest := aBitmap.Scanline[Row];
4883           if Assigned(pDest) then begin
4884             for Col := 0 to Width -1 do begin
4885               Inc(pSource, AlphaInterleave);
4886               pDest^ := pSource^;
4887               Inc(pDest);
4888               Inc(pSource);
4889             end;
4890           end;
4891         end;
4892         result := true;
4893       end;
4894     end;
4895   end;
4896 end;
4897
4898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4899 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4900 var
4901   tex: TglBitmap2D;
4902 begin
4903   tex := TglBitmap2D.Create;
4904   try
4905     tex.AssignFromBitmap(ABitmap);
4906     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4907   finally
4908     tex.Free;
4909   end;
4910 end;
4911 {$ENDIF}
4912
4913 {$IFDEF GLB_LAZARUS}
4914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4915 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4916 var
4917   rid: TRawImageDescription;
4918   FormatDesc: TFormatDescriptor;
4919 begin
4920   result := false;
4921   if not Assigned(aImage) or (Format = tfEmpty) then
4922     exit;
4923   FormatDesc := TFormatDescriptor.Get(Format);
4924   if FormatDesc.IsCompressed then
4925     exit;
4926
4927   FillChar(rid{%H-}, SizeOf(rid), 0);
4928   if (Format in [
4929        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4930        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4931        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4932     rid.Format := ricfGray
4933   else
4934     rid.Format := ricfRGBA;
4935
4936   rid.Width        := Width;
4937   rid.Height       := Height;
4938   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4939   rid.BitOrder     := riboBitsInOrder;
4940   rid.ByteOrder    := riboLSBFirst;
4941   rid.LineOrder    := riloTopToBottom;
4942   rid.LineEnd      := rileTight;
4943   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4944   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4945   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4946   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4947   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4948   rid.RedShift     := FormatDesc.Shift.r;
4949   rid.GreenShift   := FormatDesc.Shift.g;
4950   rid.BlueShift    := FormatDesc.Shift.b;
4951   rid.AlphaShift   := FormatDesc.Shift.a;
4952
4953   rid.MaskBitsPerPixel  := 0;
4954   rid.PaletteColorCount := 0;
4955
4956   aImage.DataDescription := rid;
4957   aImage.CreateData;
4958
4959   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4960
4961   result := true;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4966 var
4967   f: TglBitmapFormat;
4968   FormatDesc: TFormatDescriptor;
4969   ImageData: PByte;
4970   ImageSize: Integer;
4971   CanCopy: Boolean;
4972
4973   procedure CopyConvert;
4974   var
4975     bfFormat: TbmpBitfieldFormat;
4976     pSourceLine, pDestLine: PByte;
4977     pSourceMD, pDestMD: Pointer;
4978     x, y: Integer;
4979     pixel: TglBitmapPixelData;
4980   begin
4981     bfFormat  := TbmpBitfieldFormat.Create;
4982     with aImage.DataDescription do begin
4983       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
4984       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
4985       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
4986       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
4987       bfFormat.PixelSize := BitsPerPixel / 8;
4988     end;
4989     pSourceMD := bfFormat.CreateMappingData;
4990     pDestMD   := FormatDesc.CreateMappingData;
4991     try
4992       for y := 0 to aImage.Height-1 do begin
4993         pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
4994         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
4995         for x := 0 to aImage.Width-1 do begin
4996           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
4997           FormatDesc.Map(pixel, pDestLine, pDestMD);
4998         end;
4999       end;
5000     finally
5001       FormatDesc.FreeMappingData(pDestMD);
5002       bfFormat.FreeMappingData(pSourceMD);
5003       bfFormat.Free;
5004     end;
5005   end;
5006
5007 begin
5008   result := false;
5009   if not Assigned(aImage) then
5010     exit;
5011   for f := High(f) downto Low(f) do begin
5012     FormatDesc := TFormatDescriptor.Get(f);
5013     with aImage.DataDescription do
5014       if FormatDesc.MaskMatch(
5015         (QWord(1 shl RedPrec  )-1) shl RedShift,
5016         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5017         (QWord(1 shl BluePrec )-1) shl BlueShift,
5018         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5019         break;
5020   end;
5021
5022   if (f = tfEmpty) then
5023     exit;
5024
5025   CanCopy :=
5026     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5027     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5028
5029   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5030   ImageData := GetMem(ImageSize);
5031   try
5032     if CanCopy then
5033       Move(aImage.PixelData^, ImageData^, ImageSize)
5034     else
5035       CopyConvert;
5036     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5037   except
5038     if Assigned(ImageData) then
5039       FreeMem(ImageData);
5040     raise;
5041   end;
5042
5043   result := true;
5044 end;
5045
5046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5047 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5048 var
5049   rid: TRawImageDescription;
5050   FormatDesc: TFormatDescriptor;
5051   Pixel: TglBitmapPixelData;
5052   x, y: Integer;
5053   srcMD: Pointer;
5054   src, dst: PByte;
5055 begin
5056   result := false;
5057   if not Assigned(aImage) or (Format = tfEmpty) then
5058     exit;
5059   FormatDesc := TFormatDescriptor.Get(Format);
5060   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5061     exit;
5062
5063   FillChar(rid{%H-}, SizeOf(rid), 0);
5064   rid.Format       := ricfGray;
5065   rid.Width        := Width;
5066   rid.Height       := Height;
5067   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5068   rid.BitOrder     := riboBitsInOrder;
5069   rid.ByteOrder    := riboLSBFirst;
5070   rid.LineOrder    := riloTopToBottom;
5071   rid.LineEnd      := rileTight;
5072   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5073   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5074   rid.GreenPrec    := 0;
5075   rid.BluePrec     := 0;
5076   rid.AlphaPrec    := 0;
5077   rid.RedShift     := 0;
5078   rid.GreenShift   := 0;
5079   rid.BlueShift    := 0;
5080   rid.AlphaShift   := 0;
5081
5082   rid.MaskBitsPerPixel  := 0;
5083   rid.PaletteColorCount := 0;
5084
5085   aImage.DataDescription := rid;
5086   aImage.CreateData;
5087
5088   srcMD := FormatDesc.CreateMappingData;
5089   try
5090     FormatDesc.PreparePixel(Pixel);
5091     src := Data;
5092     dst := aImage.PixelData;
5093     for y := 0 to Height-1 do
5094       for x := 0 to Width-1 do begin
5095         FormatDesc.Unmap(src, Pixel, srcMD);
5096         case rid.BitsPerPixel of
5097            8: begin
5098             dst^ := Pixel.Data.a;
5099             inc(dst);
5100           end;
5101           16: begin
5102             PWord(dst)^ := Pixel.Data.a;
5103             inc(dst, 2);
5104           end;
5105           24: begin
5106             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5107             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5108             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5109             inc(dst, 3);
5110           end;
5111           32: begin
5112             PCardinal(dst)^ := Pixel.Data.a;
5113             inc(dst, 4);
5114           end;
5115         else
5116           raise EglBitmapUnsupportedFormat.Create(Format);
5117         end;
5118       end;
5119   finally
5120     FormatDesc.FreeMappingData(srcMD);
5121   end;
5122   result := true;
5123 end;
5124
5125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5126 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5127 var
5128   tex: TglBitmap2D;
5129 begin
5130   tex := TglBitmap2D.Create;
5131   try
5132     tex.AssignFromLazIntfImage(aImage);
5133     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5134   finally
5135     tex.Free;
5136   end;
5137 end;
5138 {$ENDIF}
5139
5140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5141 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5142   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5143 var
5144   rs: TResourceStream;
5145 begin
5146   PrepareResType(aResource, aResType);
5147   rs := TResourceStream.Create(aInstance, aResource, aResType);
5148   try
5149     result := AddAlphaFromStream(rs, aFunc, aArgs);
5150   finally
5151     rs.Free;
5152   end;
5153 end;
5154
5155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5156 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5157   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5158 var
5159   rs: TResourceStream;
5160 begin
5161   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5162   try
5163     result := AddAlphaFromStream(rs, aFunc, aArgs);
5164   finally
5165     rs.Free;
5166   end;
5167 end;
5168
5169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5170 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5171 begin
5172   if TFormatDescriptor.Get(Format).IsCompressed then
5173     raise EglBitmapUnsupportedFormat.Create(Format);
5174   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5175 end;
5176
5177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5178 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5179 var
5180   FS: TFileStream;
5181 begin
5182   FS := TFileStream.Create(aFileName, fmOpenRead);
5183   try
5184     result := AddAlphaFromStream(FS, aFunc, aArgs);
5185   finally
5186     FS.Free;
5187   end;
5188 end;
5189
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5192 var
5193   tex: TglBitmap2D;
5194 begin
5195   tex := TglBitmap2D.Create(aStream);
5196   try
5197     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5198   finally
5199     tex.Free;
5200   end;
5201 end;
5202
5203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5204 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5205 var
5206   DestData, DestData2, SourceData: pByte;
5207   TempHeight, TempWidth: Integer;
5208   SourceFD, DestFD: TFormatDescriptor;
5209   SourceMD, DestMD, DestMD2: Pointer;
5210
5211   FuncRec: TglBitmapFunctionRec;
5212 begin
5213   result := false;
5214
5215   Assert(Assigned(Data));
5216   Assert(Assigned(aBitmap));
5217   Assert(Assigned(aBitmap.Data));
5218
5219   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5220     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5221
5222     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5223     DestFD   := TFormatDescriptor.Get(Format);
5224
5225     if not Assigned(aFunc) then begin
5226       aFunc        := glBitmapAlphaFunc;
5227       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5228     end else
5229       FuncRec.Args := aArgs;
5230
5231     // Values
5232     TempHeight := aBitmap.FileHeight;
5233     TempWidth  := aBitmap.FileWidth;
5234
5235     FuncRec.Sender          := Self;
5236     FuncRec.Size            := Dimension;
5237     FuncRec.Position.Fields := FuncRec.Size.Fields;
5238
5239     DestData   := Data;
5240     DestData2  := Data;
5241     SourceData := aBitmap.Data;
5242
5243     // Mapping
5244     SourceFD.PreparePixel(FuncRec.Source);
5245     DestFD.PreparePixel  (FuncRec.Dest);
5246
5247     SourceMD := SourceFD.CreateMappingData;
5248     DestMD   := DestFD.CreateMappingData;
5249     DestMD2  := DestFD.CreateMappingData;
5250     try
5251       FuncRec.Position.Y := 0;
5252       while FuncRec.Position.Y < TempHeight do begin
5253         FuncRec.Position.X := 0;
5254         while FuncRec.Position.X < TempWidth do begin
5255           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5256           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5257           aFunc(FuncRec);
5258           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5259           inc(FuncRec.Position.X);
5260         end;
5261         inc(FuncRec.Position.Y);
5262       end;
5263     finally
5264       SourceFD.FreeMappingData(SourceMD);
5265       DestFD.FreeMappingData(DestMD);
5266       DestFD.FreeMappingData(DestMD2);
5267     end;
5268   end;
5269 end;
5270
5271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5272 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5273 begin
5274   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5275 end;
5276
5277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5278 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5279 var
5280   PixelData: TglBitmapPixelData;
5281 begin
5282   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5283   result := AddAlphaFromColorKeyFloat(
5284     aRed   / PixelData.Range.r,
5285     aGreen / PixelData.Range.g,
5286     aBlue  / PixelData.Range.b,
5287     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5288 end;
5289
5290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5291 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5292 var
5293   values: array[0..2] of Single;
5294   tmp: Cardinal;
5295   i: Integer;
5296   PixelData: TglBitmapPixelData;
5297 begin
5298   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5299   with PixelData do begin
5300     values[0] := aRed;
5301     values[1] := aGreen;
5302     values[2] := aBlue;
5303
5304     for i := 0 to 2 do begin
5305       tmp          := Trunc(Range.arr[i] * aDeviation);
5306       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5307       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5308     end;
5309     Data.a  := 0;
5310     Range.a := 0;
5311   end;
5312   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5313 end;
5314
5315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5316 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5317 begin
5318   result := AddAlphaFromValueFloat(aAlpha / $FF);
5319 end;
5320
5321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5322 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5323 var
5324   PixelData: TglBitmapPixelData;
5325 begin
5326   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5327   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5328 end;
5329
5330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5331 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5332 var
5333   PixelData: TglBitmapPixelData;
5334 begin
5335   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5336   with PixelData do
5337     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5338   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5339 end;
5340
5341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5342 function TglBitmap.RemoveAlpha: Boolean;
5343 var
5344   FormatDesc: TFormatDescriptor;
5345 begin
5346   result := false;
5347   FormatDesc := TFormatDescriptor.Get(Format);
5348   if Assigned(Data) then begin
5349     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5350       raise EglBitmapUnsupportedFormat.Create(Format);
5351     result := ConvertTo(FormatDesc.WithoutAlpha);
5352   end;
5353 end;
5354
5355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5356 function TglBitmap.Clone: TglBitmap;
5357 var
5358   Temp: TglBitmap;
5359   TempPtr: PByte;
5360   Size: Integer;
5361 begin
5362   result := nil;
5363   Temp := (ClassType.Create as TglBitmap);
5364   try
5365     // copy texture data if assigned
5366     if Assigned(Data) then begin
5367       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5368       GetMem(TempPtr, Size);
5369       try
5370         Move(Data^, TempPtr^, Size);
5371         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5372       except
5373         if Assigned(TempPtr) then
5374           FreeMem(TempPtr);
5375         raise;
5376       end;
5377     end else begin
5378       TempPtr := nil;
5379       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5380     end;
5381
5382         // copy properties
5383     Temp.fID                      := ID;
5384     Temp.fTarget                  := Target;
5385     Temp.fFormat                  := Format;
5386     Temp.fMipMap                  := MipMap;
5387     Temp.fAnisotropic             := Anisotropic;
5388     Temp.fBorderColor             := fBorderColor;
5389     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5390     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5391     Temp.fFilterMin               := fFilterMin;
5392     Temp.fFilterMag               := fFilterMag;
5393     Temp.fWrapS                   := fWrapS;
5394     Temp.fWrapT                   := fWrapT;
5395     Temp.fWrapR                   := fWrapR;
5396     Temp.fFilename                := fFilename;
5397     Temp.fCustomName              := fCustomName;
5398     Temp.fCustomNameW             := fCustomNameW;
5399     Temp.fCustomData              := fCustomData;
5400
5401     result := Temp;
5402   except
5403     FreeAndNil(Temp);
5404     raise;
5405   end;
5406 end;
5407
5408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5409 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5410 var
5411   SourceFD, DestFD: TFormatDescriptor;
5412   SourcePD, DestPD: TglBitmapPixelData;
5413   ShiftData: TShiftData;
5414
5415   function CanCopyDirect: Boolean;
5416   begin
5417     result :=
5418       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5419       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5420       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5421       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5422   end;
5423
5424   function CanShift: Boolean;
5425   begin
5426     result :=
5427       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5428       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5429       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5430       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5431   end;
5432
5433   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5434   begin
5435     result := 0;
5436     while (aSource > aDest) and (aSource > 0) do begin
5437       inc(result);
5438       aSource := aSource shr 1;
5439     end;
5440   end;
5441
5442 begin
5443   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5444     SourceFD := TFormatDescriptor.Get(Format);
5445     DestFD   := TFormatDescriptor.Get(aFormat);
5446
5447     SourceFD.PreparePixel(SourcePD);
5448     DestFD.PreparePixel  (DestPD);
5449
5450     if CanCopyDirect then
5451       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5452     else if CanShift then begin
5453       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5454       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5455       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5456       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5457       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5458     end else
5459       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5460   end else
5461     result := true;
5462 end;
5463
5464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5465 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5466 begin
5467   if aUseRGB or aUseAlpha then
5468     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5469       ((Byte(aUseAlpha) and 1) shl 1) or
5470        (Byte(aUseRGB)   and 1)      ));
5471 end;
5472
5473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5474 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5475 begin
5476   fBorderColor[0] := aRed;
5477   fBorderColor[1] := aGreen;
5478   fBorderColor[2] := aBlue;
5479   fBorderColor[3] := aAlpha;
5480   if (ID > 0) then begin
5481     Bind(false);
5482     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5483   end;
5484 end;
5485
5486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5487 procedure TglBitmap.FreeData;
5488 var
5489   TempPtr: PByte;
5490 begin
5491   TempPtr := nil;
5492   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5493 end;
5494
5495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5496 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5497   const aAlpha: Byte);
5498 begin
5499   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5500 end;
5501
5502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5503 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5504 var
5505   PixelData: TglBitmapPixelData;
5506 begin
5507   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5508   FillWithColorFloat(
5509     aRed   / PixelData.Range.r,
5510     aGreen / PixelData.Range.g,
5511     aBlue  / PixelData.Range.b,
5512     aAlpha / PixelData.Range.a);
5513 end;
5514
5515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5516 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5517 var
5518   PixelData: TglBitmapPixelData;
5519 begin
5520   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5521   with PixelData do begin
5522     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5523     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5524     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5525     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5526   end;
5527   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5528 end;
5529
5530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5531 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5532 begin
5533   //check MIN filter
5534   case aMin of
5535     GL_NEAREST:
5536       fFilterMin := GL_NEAREST;
5537     GL_LINEAR:
5538       fFilterMin := GL_LINEAR;
5539     GL_NEAREST_MIPMAP_NEAREST:
5540       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5541     GL_LINEAR_MIPMAP_NEAREST:
5542       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5543     GL_NEAREST_MIPMAP_LINEAR:
5544       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5545     GL_LINEAR_MIPMAP_LINEAR:
5546       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5547     else
5548       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5549   end;
5550
5551   //check MAG filter
5552   case aMag of
5553     GL_NEAREST:
5554       fFilterMag := GL_NEAREST;
5555     GL_LINEAR:
5556       fFilterMag := GL_LINEAR;
5557     else
5558       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5559   end;
5560
5561   //apply filter
5562   if (ID > 0) then begin
5563     Bind(false);
5564     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5565
5566     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5567       case fFilterMin of
5568         GL_NEAREST, GL_LINEAR:
5569           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5570         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5571           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5572         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5573           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5574       end;
5575     end else
5576       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5577   end;
5578 end;
5579
5580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5581 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5582
5583   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5584   begin
5585     case aValue of
5586       GL_CLAMP:
5587         aTarget := GL_CLAMP;
5588
5589       GL_REPEAT:
5590         aTarget := GL_REPEAT;
5591
5592       GL_CLAMP_TO_EDGE: begin
5593         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5594           aTarget := GL_CLAMP_TO_EDGE
5595         else
5596           aTarget := GL_CLAMP;
5597       end;
5598
5599       GL_CLAMP_TO_BORDER: begin
5600         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5601           aTarget := GL_CLAMP_TO_BORDER
5602         else
5603           aTarget := GL_CLAMP;
5604       end;
5605
5606       GL_MIRRORED_REPEAT: begin
5607         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5608           aTarget := GL_MIRRORED_REPEAT
5609         else
5610           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5611       end;
5612     else
5613       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5614     end;
5615   end;
5616
5617 begin
5618   CheckAndSetWrap(S, fWrapS);
5619   CheckAndSetWrap(T, fWrapT);
5620   CheckAndSetWrap(R, fWrapR);
5621
5622   if (ID > 0) then begin
5623     Bind(false);
5624     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5625     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5626     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5627   end;
5628 end;
5629
5630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5631 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5632
5633   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5634   begin
5635     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5636        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5637       fSwizzle[aIndex] := aValue
5638     else
5639       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5640   end;
5641
5642 begin
5643   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5644     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5645   CheckAndSetValue(r, 0);
5646   CheckAndSetValue(g, 1);
5647   CheckAndSetValue(b, 2);
5648   CheckAndSetValue(a, 3);
5649
5650   if (ID > 0) then begin
5651     Bind(false);
5652     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5653   end;
5654 end;
5655
5656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5657 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5658 begin
5659   if aEnableTextureUnit then
5660     glEnable(Target);
5661   if (ID > 0) then
5662     glBindTexture(Target, ID);
5663 end;
5664
5665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5666 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5667 begin
5668   if aDisableTextureUnit then
5669     glDisable(Target);
5670   glBindTexture(Target, 0);
5671 end;
5672
5673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5674 constructor TglBitmap.Create;
5675 begin
5676   if (ClassType = TglBitmap) then
5677     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5678 {$IFDEF GLB_NATIVE_OGL}
5679   glbReadOpenGLExtensions;
5680 {$ENDIF}
5681   inherited Create;
5682   fFormat            := glBitmapGetDefaultFormat;
5683   fFreeDataOnDestroy := true;
5684 end;
5685
5686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5687 constructor TglBitmap.Create(const aFileName: String);
5688 begin
5689   Create;
5690   LoadFromFile(aFileName);
5691 end;
5692
5693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5694 constructor TglBitmap.Create(const aStream: TStream);
5695 begin
5696   Create;
5697   LoadFromStream(aStream);
5698 end;
5699
5700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5701 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5702 var
5703   ImageSize: Integer;
5704 begin
5705   Create;
5706   if not Assigned(aData) then begin
5707     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5708     GetMem(aData, ImageSize);
5709     try
5710       FillChar(aData^, ImageSize, #$FF);
5711       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5712     except
5713       if Assigned(aData) then
5714         FreeMem(aData);
5715       raise;
5716     end;
5717   end else begin
5718     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5719     fFreeDataOnDestroy := false;
5720   end;
5721 end;
5722
5723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5724 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5725 begin
5726   Create;
5727   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5728 end;
5729
5730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5731 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5732 begin
5733   Create;
5734   LoadFromResource(aInstance, aResource, aResType);
5735 end;
5736
5737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5738 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5739 begin
5740   Create;
5741   LoadFromResourceID(aInstance, aResourceID, aResType);
5742 end;
5743
5744 {$IFDEF GLB_SUPPORT_PNG_READ}
5745 {$IF DEFINED(GLB_LAZ_PNG)}
5746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5747 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5749 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5750 const
5751   MAGIC_LEN = 8;
5752   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5753 var
5754   png: TPortableNetworkGraphic;
5755   intf: TLazIntfImage;
5756   StreamPos: Int64;
5757   magic: String[MAGIC_LEN];
5758 begin
5759   result := true;
5760   StreamPos := aStream.Position;
5761
5762   SetLength(magic, MAGIC_LEN);
5763   aStream.Read(magic[1], MAGIC_LEN);
5764   aStream.Position := StreamPos;
5765   if (magic <> PNG_MAGIC) then begin
5766     result := false;
5767     exit;
5768   end;
5769
5770   png := TPortableNetworkGraphic.Create;
5771   try try
5772     png.LoadFromStream(aStream);
5773     intf := png.CreateIntfImage;
5774     try try
5775       AssignFromLazIntfImage(intf);
5776     except
5777       result := false;
5778       aStream.Position := StreamPos;
5779       exit;
5780     end;
5781     finally
5782       intf.Free;
5783     end;
5784   except
5785     result := false;
5786     aStream.Position := StreamPos;
5787     exit;
5788   end;
5789   finally
5790     png.Free;
5791   end;
5792 end;
5793
5794 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5796 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5797 var
5798   Surface: PSDL_Surface;
5799   RWops: PSDL_RWops;
5800 begin
5801   result := false;
5802   RWops := glBitmapCreateRWops(aStream);
5803   try
5804     if IMG_isPNG(RWops) > 0 then begin
5805       Surface := IMG_LoadPNG_RW(RWops);
5806       try
5807         AssignFromSurface(Surface);
5808         result := true;
5809       finally
5810         SDL_FreeSurface(Surface);
5811       end;
5812     end;
5813   finally
5814     SDL_FreeRW(RWops);
5815   end;
5816 end;
5817
5818 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5820 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5821 begin
5822   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5823 end;
5824
5825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5826 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5827 var
5828   StreamPos: Int64;
5829   signature: array [0..7] of byte;
5830   png: png_structp;
5831   png_info: png_infop;
5832
5833   TempHeight, TempWidth: Integer;
5834   Format: TglBitmapFormat;
5835
5836   png_data: pByte;
5837   png_rows: array of pByte;
5838   Row, LineSize: Integer;
5839 begin
5840   result := false;
5841
5842   if not init_libPNG then
5843     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5844
5845   try
5846     // signature
5847     StreamPos := aStream.Position;
5848     aStream.Read(signature{%H-}, 8);
5849     aStream.Position := StreamPos;
5850
5851     if png_check_sig(@signature, 8) <> 0 then begin
5852       // png read struct
5853       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5854       if png = nil then
5855         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5856
5857       // png info
5858       png_info := png_create_info_struct(png);
5859       if png_info = nil then begin
5860         png_destroy_read_struct(@png, nil, nil);
5861         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5862       end;
5863
5864       // set read callback
5865       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5866
5867       // read informations
5868       png_read_info(png, png_info);
5869
5870       // size
5871       TempHeight := png_get_image_height(png, png_info);
5872       TempWidth := png_get_image_width(png, png_info);
5873
5874       // format
5875       case png_get_color_type(png, png_info) of
5876         PNG_COLOR_TYPE_GRAY:
5877           Format := tfLuminance8;
5878         PNG_COLOR_TYPE_GRAY_ALPHA:
5879           Format := tfLuminance8Alpha8;
5880         PNG_COLOR_TYPE_RGB:
5881           Format := tfRGB8;
5882         PNG_COLOR_TYPE_RGB_ALPHA:
5883           Format := tfRGBA8;
5884         else
5885           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5886       end;
5887
5888       // cut upper 8 bit from 16 bit formats
5889       if png_get_bit_depth(png, png_info) > 8 then
5890         png_set_strip_16(png);
5891
5892       // expand bitdepth smaller than 8
5893       if png_get_bit_depth(png, png_info) < 8 then
5894         png_set_expand(png);
5895
5896       // allocating mem for scanlines
5897       LineSize := png_get_rowbytes(png, png_info);
5898       GetMem(png_data, TempHeight * LineSize);
5899       try
5900         SetLength(png_rows, TempHeight);
5901         for Row := Low(png_rows) to High(png_rows) do begin
5902           png_rows[Row] := png_data;
5903           Inc(png_rows[Row], Row * LineSize);
5904         end;
5905
5906         // read complete image into scanlines
5907         png_read_image(png, @png_rows[0]);
5908
5909         // read end
5910         png_read_end(png, png_info);
5911
5912         // destroy read struct
5913         png_destroy_read_struct(@png, @png_info, nil);
5914
5915         SetLength(png_rows, 0);
5916
5917         // set new data
5918         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5919
5920         result := true;
5921       except
5922         if Assigned(png_data) then
5923           FreeMem(png_data);
5924         raise;
5925       end;
5926     end;
5927   finally
5928     quit_libPNG;
5929   end;
5930 end;
5931
5932 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5934 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5935 var
5936   StreamPos: Int64;
5937   Png: TPNGObject;
5938   Header: String[8];
5939   Row, Col, PixSize, LineSize: Integer;
5940   NewImage, pSource, pDest, pAlpha: pByte;
5941   PngFormat: TglBitmapFormat;
5942   FormatDesc: TFormatDescriptor;
5943
5944 const
5945   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5946
5947 begin
5948   result := false;
5949
5950   StreamPos := aStream.Position;
5951   aStream.Read(Header[0], SizeOf(Header));
5952   aStream.Position := StreamPos;
5953
5954   {Test if the header matches}
5955   if Header = PngHeader then begin
5956     Png := TPNGObject.Create;
5957     try
5958       Png.LoadFromStream(aStream);
5959
5960       case Png.Header.ColorType of
5961         COLOR_GRAYSCALE:
5962           PngFormat := tfLuminance8;
5963         COLOR_GRAYSCALEALPHA:
5964           PngFormat := tfLuminance8Alpha8;
5965         COLOR_RGB:
5966           PngFormat := tfBGR8;
5967         COLOR_RGBALPHA:
5968           PngFormat := tfBGRA8;
5969         else
5970           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5971       end;
5972
5973       FormatDesc := TFormatDescriptor.Get(PngFormat);
5974       PixSize    := Round(FormatDesc.PixelSize);
5975       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5976
5977       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5978       try
5979         pDest := NewImage;
5980
5981         case Png.Header.ColorType of
5982           COLOR_RGB, COLOR_GRAYSCALE:
5983             begin
5984               for Row := 0 to Png.Height -1 do begin
5985                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5986                 Inc(pDest, LineSize);
5987               end;
5988             end;
5989           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5990             begin
5991               PixSize := PixSize -1;
5992
5993               for Row := 0 to Png.Height -1 do begin
5994                 pSource := Png.Scanline[Row];
5995                 pAlpha := pByte(Png.AlphaScanline[Row]);
5996
5997                 for Col := 0 to Png.Width -1 do begin
5998                   Move (pSource^, pDest^, PixSize);
5999                   Inc(pSource, PixSize);
6000                   Inc(pDest, PixSize);
6001
6002                   pDest^ := pAlpha^;
6003                   inc(pAlpha);
6004                   Inc(pDest);
6005                 end;
6006               end;
6007             end;
6008           else
6009             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6010         end;
6011
6012         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6013
6014         result := true;
6015       except
6016         if Assigned(NewImage) then
6017           FreeMem(NewImage);
6018         raise;
6019       end;
6020     finally
6021       Png.Free;
6022     end;
6023   end;
6024 end;
6025 {$IFEND}
6026 {$ENDIF}
6027
6028 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6029 {$IFDEF GLB_LIB_PNG}
6030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6031 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6032 begin
6033   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6034 end;
6035 {$ENDIF}
6036
6037 {$IF DEFINED(GLB_LAZ_PNG)}
6038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6039 procedure TglBitmap.SavePNG(const aStream: TStream);
6040 var
6041   png: TPortableNetworkGraphic;
6042   intf: TLazIntfImage;
6043   raw: TRawImage;
6044 begin
6045   png  := TPortableNetworkGraphic.Create;
6046   intf := TLazIntfImage.Create(0, 0);
6047   try
6048     if not AssignToLazIntfImage(intf) then
6049       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6050     intf.GetRawImage(raw);
6051     png.LoadFromRawImage(raw, false);
6052     png.SaveToStream(aStream);
6053   finally
6054     png.Free;
6055     intf.Free;
6056   end;
6057 end;
6058
6059 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6061 procedure TglBitmap.SavePNG(const aStream: TStream);
6062 var
6063   png: png_structp;
6064   png_info: png_infop;
6065   png_rows: array of pByte;
6066   LineSize: Integer;
6067   ColorType: Integer;
6068   Row: Integer;
6069   FormatDesc: TFormatDescriptor;
6070 begin
6071   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6072     raise EglBitmapUnsupportedFormat.Create(Format);
6073
6074   if not init_libPNG then
6075     raise Exception.Create('unable to initialize libPNG.');
6076
6077   try
6078     case Format of
6079       tfAlpha8, tfLuminance8:
6080         ColorType := PNG_COLOR_TYPE_GRAY;
6081       tfLuminance8Alpha8:
6082         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6083       tfBGR8, tfRGB8:
6084         ColorType := PNG_COLOR_TYPE_RGB;
6085       tfBGRA8, tfRGBA8:
6086         ColorType := PNG_COLOR_TYPE_RGBA;
6087       else
6088         raise EglBitmapUnsupportedFormat.Create(Format);
6089     end;
6090
6091     FormatDesc := TFormatDescriptor.Get(Format);
6092     LineSize := FormatDesc.GetSize(Width, 1);
6093
6094     // creating array for scanline
6095     SetLength(png_rows, Height);
6096     try
6097       for Row := 0 to Height - 1 do begin
6098         png_rows[Row] := Data;
6099         Inc(png_rows[Row], Row * LineSize)
6100       end;
6101
6102       // write struct
6103       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6104       if png = nil then
6105         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6106
6107       // create png info
6108       png_info := png_create_info_struct(png);
6109       if png_info = nil then begin
6110         png_destroy_write_struct(@png, nil);
6111         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6112       end;
6113
6114       // set read callback
6115       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6116
6117       // set compression
6118       png_set_compression_level(png, 6);
6119
6120       if Format in [tfBGR8, tfBGRA8] then
6121         png_set_bgr(png);
6122
6123       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6124       png_write_info(png, png_info);
6125       png_write_image(png, @png_rows[0]);
6126       png_write_end(png, png_info);
6127       png_destroy_write_struct(@png, @png_info);
6128     finally
6129       SetLength(png_rows, 0);
6130     end;
6131   finally
6132     quit_libPNG;
6133   end;
6134 end;
6135
6136 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6138 procedure TglBitmap.SavePNG(const aStream: TStream);
6139 var
6140   Png: TPNGObject;
6141
6142   pSource, pDest: pByte;
6143   X, Y, PixSize: Integer;
6144   ColorType: Cardinal;
6145   Alpha: Boolean;
6146
6147   pTemp: pByte;
6148   Temp: Byte;
6149 begin
6150   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6151     raise EglBitmapUnsupportedFormat.Create(Format);
6152
6153   case Format of
6154     tfAlpha8, tfLuminance8: begin
6155       ColorType := COLOR_GRAYSCALE;
6156       PixSize   := 1;
6157       Alpha     := false;
6158     end;
6159     tfLuminance8Alpha8: begin
6160       ColorType := COLOR_GRAYSCALEALPHA;
6161       PixSize   := 1;
6162       Alpha     := true;
6163     end;
6164     tfBGR8, tfRGB8: begin
6165       ColorType := COLOR_RGB;
6166       PixSize   := 3;
6167       Alpha     := false;
6168     end;
6169     tfBGRA8, tfRGBA8: begin
6170       ColorType := COLOR_RGBALPHA;
6171       PixSize   := 3;
6172       Alpha     := true
6173     end;
6174   else
6175     raise EglBitmapUnsupportedFormat.Create(Format);
6176   end;
6177
6178   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6179   try
6180     // Copy ImageData
6181     pSource := Data;
6182     for Y := 0 to Height -1 do begin
6183       pDest := png.ScanLine[Y];
6184       for X := 0 to Width -1 do begin
6185         Move(pSource^, pDest^, PixSize);
6186         Inc(pDest, PixSize);
6187         Inc(pSource, PixSize);
6188         if Alpha then begin
6189           png.AlphaScanline[Y]^[X] := pSource^;
6190           Inc(pSource);
6191         end;
6192       end;
6193
6194       // convert RGB line to BGR
6195       if Format in [tfRGB8, tfRGBA8] then begin
6196         pTemp := png.ScanLine[Y];
6197         for X := 0 to Width -1 do begin
6198           Temp := pByteArray(pTemp)^[0];
6199           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6200           pByteArray(pTemp)^[2] := Temp;
6201           Inc(pTemp, 3);
6202         end;
6203       end;
6204     end;
6205
6206     // Save to Stream
6207     Png.CompressionLevel := 6;
6208     Png.SaveToStream(aStream);
6209   finally
6210     FreeAndNil(Png);
6211   end;
6212 end;
6213 {$IFEND}
6214 {$ENDIF}
6215
6216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6217 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6219 {$IFDEF GLB_LIB_JPEG}
6220 type
6221   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6222   glBitmap_libJPEG_source_mgr = record
6223     pub: jpeg_source_mgr;
6224
6225     SrcStream: TStream;
6226     SrcBuffer: array [1..4096] of byte;
6227   end;
6228
6229   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6230   glBitmap_libJPEG_dest_mgr = record
6231     pub: jpeg_destination_mgr;
6232
6233     DestStream: TStream;
6234     DestBuffer: array [1..4096] of byte;
6235   end;
6236
6237 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6238 begin
6239   //DUMMY
6240 end;
6241
6242
6243 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6244 begin
6245   //DUMMY
6246 end;
6247
6248
6249 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6250 begin
6251   //DUMMY
6252 end;
6253
6254 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6255 begin
6256   //DUMMY
6257 end;
6258
6259
6260 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6261 begin
6262   //DUMMY
6263 end;
6264
6265
6266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6267 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6268 var
6269   src: glBitmap_libJPEG_source_mgr_ptr;
6270   bytes: integer;
6271 begin
6272   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6273
6274   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6275         if (bytes <= 0) then begin
6276                 src^.SrcBuffer[1] := $FF;
6277                 src^.SrcBuffer[2] := JPEG_EOI;
6278                 bytes := 2;
6279         end;
6280
6281         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6282         src^.pub.bytes_in_buffer := bytes;
6283
6284   result := true;
6285 end;
6286
6287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6288 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6289 var
6290   src: glBitmap_libJPEG_source_mgr_ptr;
6291 begin
6292   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6293
6294   if num_bytes > 0 then begin
6295     // wanted byte isn't in buffer so set stream position and read buffer
6296     if num_bytes > src^.pub.bytes_in_buffer then begin
6297       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6298       src^.pub.fill_input_buffer(cinfo);
6299     end else begin
6300       // wanted byte is in buffer so only skip
6301                 inc(src^.pub.next_input_byte, num_bytes);
6302                 dec(src^.pub.bytes_in_buffer, num_bytes);
6303     end;
6304   end;
6305 end;
6306
6307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6308 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6309 var
6310   dest: glBitmap_libJPEG_dest_mgr_ptr;
6311 begin
6312   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6313
6314   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6315     // write complete buffer
6316     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6317
6318     // reset buffer
6319     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6320     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6321   end;
6322
6323   result := true;
6324 end;
6325
6326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6327 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6328 var
6329   Idx: Integer;
6330   dest: glBitmap_libJPEG_dest_mgr_ptr;
6331 begin
6332   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6333
6334   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6335     // check for endblock
6336     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6337       // write endblock
6338       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6339
6340       // leave
6341       break;
6342     end else
6343       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6344   end;
6345 end;
6346 {$ENDIF}
6347
6348 {$IFDEF GLB_SUPPORT_JPEG_READ}
6349 {$IF DEFINED(GLB_LAZ_JPEG)}
6350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6351 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6352 const
6353   MAGIC_LEN = 2;
6354   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6355 var
6356   jpeg: TJPEGImage;
6357   intf: TLazIntfImage;
6358   StreamPos: Int64;
6359   magic: String[MAGIC_LEN];
6360 begin
6361   result := true;
6362   StreamPos := aStream.Position;
6363
6364   SetLength(magic, MAGIC_LEN);
6365   aStream.Read(magic[1], MAGIC_LEN);
6366   aStream.Position := StreamPos;
6367   if (magic <> JPEG_MAGIC) then begin
6368     result := false;
6369     exit;
6370   end;
6371
6372   jpeg := TJPEGImage.Create;
6373   try try
6374     jpeg.LoadFromStream(aStream);
6375     intf := TLazIntfImage.Create(0, 0);
6376     try try
6377       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6378       AssignFromLazIntfImage(intf);
6379     except
6380       result := false;
6381       aStream.Position := StreamPos;
6382       exit;
6383     end;
6384     finally
6385       intf.Free;
6386     end;
6387   except
6388     result := false;
6389     aStream.Position := StreamPos;
6390     exit;
6391   end;
6392   finally
6393     jpeg.Free;
6394   end;
6395 end;
6396
6397 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6399 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6400 var
6401   Surface: PSDL_Surface;
6402   RWops: PSDL_RWops;
6403 begin
6404   result := false;
6405
6406   RWops := glBitmapCreateRWops(aStream);
6407   try
6408     if IMG_isJPG(RWops) > 0 then begin
6409       Surface := IMG_LoadJPG_RW(RWops);
6410       try
6411         AssignFromSurface(Surface);
6412         result := true;
6413       finally
6414         SDL_FreeSurface(Surface);
6415       end;
6416     end;
6417   finally
6418     SDL_FreeRW(RWops);
6419   end;
6420 end;
6421
6422 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6424 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6425 var
6426   StreamPos: Int64;
6427   Temp: array[0..1]of Byte;
6428
6429   jpeg: jpeg_decompress_struct;
6430   jpeg_err: jpeg_error_mgr;
6431
6432   IntFormat: TglBitmapFormat;
6433   pImage: pByte;
6434   TempHeight, TempWidth: Integer;
6435
6436   pTemp: pByte;
6437   Row: Integer;
6438
6439   FormatDesc: TFormatDescriptor;
6440 begin
6441   result := false;
6442
6443   if not init_libJPEG then
6444     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6445
6446   try
6447     // reading first two bytes to test file and set cursor back to begin
6448     StreamPos := aStream.Position;
6449     aStream.Read({%H-}Temp[0], 2);
6450     aStream.Position := StreamPos;
6451
6452     // if Bitmap then read file.
6453     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6454       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6455       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6456
6457       // error managment
6458       jpeg.err := jpeg_std_error(@jpeg_err);
6459       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6460       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6461
6462       // decompression struct
6463       jpeg_create_decompress(@jpeg);
6464
6465       // allocation space for streaming methods
6466       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6467
6468       // seeting up custom functions
6469       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6470         pub.init_source       := glBitmap_libJPEG_init_source;
6471         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6472         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6473         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6474         pub.term_source       := glBitmap_libJPEG_term_source;
6475
6476         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6477         pub.next_input_byte := nil;   // until buffer loaded
6478
6479         SrcStream := aStream;
6480       end;
6481
6482       // set global decoding state
6483       jpeg.global_state := DSTATE_START;
6484
6485       // read header of jpeg
6486       jpeg_read_header(@jpeg, false);
6487
6488       // setting output parameter
6489       case jpeg.jpeg_color_space of
6490         JCS_GRAYSCALE:
6491           begin
6492             jpeg.out_color_space := JCS_GRAYSCALE;
6493             IntFormat := tfLuminance8;
6494           end;
6495         else
6496           jpeg.out_color_space := JCS_RGB;
6497           IntFormat := tfRGB8;
6498       end;
6499
6500       // reading image
6501       jpeg_start_decompress(@jpeg);
6502
6503       TempHeight := jpeg.output_height;
6504       TempWidth := jpeg.output_width;
6505
6506       FormatDesc := TFormatDescriptor.Get(IntFormat);
6507
6508       // creating new image
6509       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6510       try
6511         pTemp := pImage;
6512
6513         for Row := 0 to TempHeight -1 do begin
6514           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6515           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6516         end;
6517
6518         // finish decompression
6519         jpeg_finish_decompress(@jpeg);
6520
6521         // destroy decompression
6522         jpeg_destroy_decompress(@jpeg);
6523
6524         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6525
6526         result := true;
6527       except
6528         if Assigned(pImage) then
6529           FreeMem(pImage);
6530         raise;
6531       end;
6532     end;
6533   finally
6534     quit_libJPEG;
6535   end;
6536 end;
6537
6538 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6540 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6541 var
6542   bmp: TBitmap;
6543   jpg: TJPEGImage;
6544   StreamPos: Int64;
6545   Temp: array[0..1]of Byte;
6546 begin
6547   result := false;
6548
6549   // reading first two bytes to test file and set cursor back to begin
6550   StreamPos := aStream.Position;
6551   aStream.Read(Temp[0], 2);
6552   aStream.Position := StreamPos;
6553
6554   // if Bitmap then read file.
6555   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6556     bmp := TBitmap.Create;
6557     try
6558       jpg := TJPEGImage.Create;
6559       try
6560         jpg.LoadFromStream(aStream);
6561         bmp.Assign(jpg);
6562         result := AssignFromBitmap(bmp);
6563       finally
6564         jpg.Free;
6565       end;
6566     finally
6567       bmp.Free;
6568     end;
6569   end;
6570 end;
6571 {$IFEND}
6572 {$ENDIF}
6573
6574 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6575 {$IF DEFINED(GLB_LAZ_JPEG)}
6576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6577 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6578 var
6579   jpeg: TJPEGImage;
6580   intf: TLazIntfImage;
6581   raw: TRawImage;
6582 begin
6583   jpeg := TJPEGImage.Create;
6584   intf := TLazIntfImage.Create(0, 0);
6585   try
6586     if not AssignToLazIntfImage(intf) then
6587       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6588     intf.GetRawImage(raw);
6589     jpeg.LoadFromRawImage(raw, false);
6590     jpeg.SaveToStream(aStream);
6591   finally
6592     intf.Free;
6593     jpeg.Free;
6594   end;
6595 end;
6596
6597 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6599 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6600 var
6601   jpeg: jpeg_compress_struct;
6602   jpeg_err: jpeg_error_mgr;
6603   Row: Integer;
6604   pTemp, pTemp2: pByte;
6605
6606   procedure CopyRow(pDest, pSource: pByte);
6607   var
6608     X: Integer;
6609   begin
6610     for X := 0 to Width - 1 do begin
6611       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6612       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6613       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6614       Inc(pDest, 3);
6615       Inc(pSource, 3);
6616     end;
6617   end;
6618
6619 begin
6620   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6621     raise EglBitmapUnsupportedFormat.Create(Format);
6622
6623   if not init_libJPEG then
6624     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6625
6626   try
6627     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6628     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6629
6630     // error managment
6631     jpeg.err := jpeg_std_error(@jpeg_err);
6632     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6633     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6634
6635     // compression struct
6636     jpeg_create_compress(@jpeg);
6637
6638     // allocation space for streaming methods
6639     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6640
6641     // seeting up custom functions
6642     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6643       pub.init_destination    := glBitmap_libJPEG_init_destination;
6644       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6645       pub.term_destination    := glBitmap_libJPEG_term_destination;
6646
6647       pub.next_output_byte  := @DestBuffer[1];
6648       pub.free_in_buffer    := Length(DestBuffer);
6649
6650       DestStream := aStream;
6651     end;
6652
6653     // very important state
6654     jpeg.global_state := CSTATE_START;
6655     jpeg.image_width  := Width;
6656     jpeg.image_height := Height;
6657     case Format of
6658       tfAlpha8, tfLuminance8: begin
6659         jpeg.input_components := 1;
6660         jpeg.in_color_space   := JCS_GRAYSCALE;
6661       end;
6662       tfRGB8, tfBGR8: begin
6663         jpeg.input_components := 3;
6664         jpeg.in_color_space   := JCS_RGB;
6665       end;
6666     end;
6667
6668     jpeg_set_defaults(@jpeg);
6669     jpeg_set_quality(@jpeg, 95, true);
6670     jpeg_start_compress(@jpeg, true);
6671     pTemp := Data;
6672
6673     if Format = tfBGR8 then
6674       GetMem(pTemp2, fRowSize)
6675     else
6676       pTemp2 := pTemp;
6677
6678     try
6679       for Row := 0 to jpeg.image_height -1 do begin
6680         // prepare row
6681         if Format = tfBGR8 then
6682           CopyRow(pTemp2, pTemp)
6683         else
6684           pTemp2 := pTemp;
6685
6686         // write row
6687         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6688         inc(pTemp, fRowSize);
6689       end;
6690     finally
6691       // free memory
6692       if Format = tfBGR8 then
6693         FreeMem(pTemp2);
6694     end;
6695     jpeg_finish_compress(@jpeg);
6696     jpeg_destroy_compress(@jpeg);
6697   finally
6698     quit_libJPEG;
6699   end;
6700 end;
6701
6702 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6704 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6705 var
6706   Bmp: TBitmap;
6707   Jpg: TJPEGImage;
6708 begin
6709   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6710     raise EglBitmapUnsupportedFormat.Create(Format);
6711
6712   Bmp := TBitmap.Create;
6713   try
6714     Jpg := TJPEGImage.Create;
6715     try
6716       AssignToBitmap(Bmp);
6717       if (Format in [tfAlpha8, tfLuminance8]) then begin
6718         Jpg.Grayscale   := true;
6719         Jpg.PixelFormat := jf8Bit;
6720       end;
6721       Jpg.Assign(Bmp);
6722       Jpg.SaveToStream(aStream);
6723     finally
6724       FreeAndNil(Jpg);
6725     end;
6726   finally
6727     FreeAndNil(Bmp);
6728   end;
6729 end;
6730 {$IFEND}
6731 {$ENDIF}
6732
6733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6734 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6736 const
6737   BMP_MAGIC          = $4D42;
6738
6739   BMP_COMP_RGB       = 0;
6740   BMP_COMP_RLE8      = 1;
6741   BMP_COMP_RLE4      = 2;
6742   BMP_COMP_BITFIELDS = 3;
6743
6744 type
6745   TBMPHeader = packed record
6746     bfType: Word;
6747     bfSize: Cardinal;
6748     bfReserved1: Word;
6749     bfReserved2: Word;
6750     bfOffBits: Cardinal;
6751   end;
6752
6753   TBMPInfo = packed record
6754     biSize: Cardinal;
6755     biWidth: Longint;
6756     biHeight: Longint;
6757     biPlanes: Word;
6758     biBitCount: Word;
6759     biCompression: Cardinal;
6760     biSizeImage: Cardinal;
6761     biXPelsPerMeter: Longint;
6762     biYPelsPerMeter: Longint;
6763     biClrUsed: Cardinal;
6764     biClrImportant: Cardinal;
6765   end;
6766
6767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6768 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6769
6770   //////////////////////////////////////////////////////////////////////////////////////////////////
6771   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6772   begin
6773     result := tfEmpty;
6774     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6775     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6776
6777     //Read Compression
6778     case aInfo.biCompression of
6779       BMP_COMP_RLE4,
6780       BMP_COMP_RLE8: begin
6781         raise EglBitmap.Create('RLE compression is not supported');
6782       end;
6783       BMP_COMP_BITFIELDS: begin
6784         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6785           aStream.Read(aMask.r, SizeOf(aMask.r));
6786           aStream.Read(aMask.g, SizeOf(aMask.g));
6787           aStream.Read(aMask.b, SizeOf(aMask.b));
6788           aStream.Read(aMask.a, SizeOf(aMask.a));
6789         end else
6790           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6791       end;
6792     end;
6793
6794     //get suitable format
6795     case aInfo.biBitCount of
6796        8: result := tfLuminance8;
6797       16: result := tfBGR5;
6798       24: result := tfBGR8;
6799       32: result := tfBGRA8;
6800     end;
6801   end;
6802
6803   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6804   var
6805     i, c: Integer;
6806     ColorTable: TbmpColorTable;
6807   begin
6808     result := nil;
6809     if (aInfo.biBitCount >= 16) then
6810       exit;
6811     aFormat := tfLuminance8;
6812     c := aInfo.biClrUsed;
6813     if (c = 0) then
6814       c := 1 shl aInfo.biBitCount;
6815     SetLength(ColorTable, c);
6816     for i := 0 to c-1 do begin
6817       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6818       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6819         aFormat := tfRGB8;
6820     end;
6821
6822     result := TbmpColorTableFormat.Create;
6823     result.PixelSize  := aInfo.biBitCount / 8;
6824     result.ColorTable := ColorTable;
6825     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6826   end;
6827
6828   //////////////////////////////////////////////////////////////////////////////////////////////////
6829   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6830     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6831   var
6832     TmpFormat: TglBitmapFormat;
6833     FormatDesc: TFormatDescriptor;
6834   begin
6835     result := nil;
6836     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6837       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6838         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6839         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6840           aFormat := FormatDesc.Format;
6841           exit;
6842         end;
6843       end;
6844
6845       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6846         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6847       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6848         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6849
6850       result := TbmpBitfieldFormat.Create;
6851       result.PixelSize := aInfo.biBitCount / 8;
6852       result.RedMask   := aMask.r;
6853       result.GreenMask := aMask.g;
6854       result.BlueMask  := aMask.b;
6855       result.AlphaMask := aMask.a;
6856     end;
6857   end;
6858
6859 var
6860   //simple types
6861   StartPos: Int64;
6862   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6863   PaddingBuff: Cardinal;
6864   LineBuf, ImageData, TmpData: PByte;
6865   SourceMD, DestMD: Pointer;
6866   BmpFormat: TglBitmapFormat;
6867
6868   //records
6869   Mask: TglBitmapColorRec;
6870   Header: TBMPHeader;
6871   Info: TBMPInfo;
6872
6873   //classes
6874   SpecialFormat: TFormatDescriptor;
6875   FormatDesc: TFormatDescriptor;
6876
6877   //////////////////////////////////////////////////////////////////////////////////////////////////
6878   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6879   var
6880     i: Integer;
6881     Pixel: TglBitmapPixelData;
6882   begin
6883     aStream.Read(aLineBuf^, rbLineSize);
6884     SpecialFormat.PreparePixel(Pixel);
6885     for i := 0 to Info.biWidth-1 do begin
6886       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6887       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6888       FormatDesc.Map(Pixel, aData, DestMD);
6889     end;
6890   end;
6891
6892 begin
6893   result        := false;
6894   BmpFormat     := tfEmpty;
6895   SpecialFormat := nil;
6896   LineBuf       := nil;
6897   SourceMD      := nil;
6898   DestMD        := nil;
6899
6900   // Header
6901   StartPos := aStream.Position;
6902   aStream.Read(Header{%H-}, SizeOf(Header));
6903
6904   if Header.bfType = BMP_MAGIC then begin
6905     try try
6906       BmpFormat        := ReadInfo(Info, Mask);
6907       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6908       if not Assigned(SpecialFormat) then
6909         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6910       aStream.Position := StartPos + Header.bfOffBits;
6911
6912       if (BmpFormat <> tfEmpty) then begin
6913         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6914         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6915         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6916         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6917
6918         //get Memory
6919         DestMD    := FormatDesc.CreateMappingData;
6920         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6921         GetMem(ImageData, ImageSize);
6922         if Assigned(SpecialFormat) then begin
6923           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6924           SourceMD := SpecialFormat.CreateMappingData;
6925         end;
6926
6927         //read Data
6928         try try
6929           FillChar(ImageData^, ImageSize, $FF);
6930           TmpData := ImageData;
6931           if (Info.biHeight > 0) then
6932             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6933           for i := 0 to Abs(Info.biHeight)-1 do begin
6934             if Assigned(SpecialFormat) then
6935               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6936             else
6937               aStream.Read(TmpData^, wbLineSize);   //else only read data
6938             if (Info.biHeight > 0) then
6939               dec(TmpData, wbLineSize)
6940             else
6941               inc(TmpData, wbLineSize);
6942             aStream.Read(PaddingBuff{%H-}, Padding);
6943           end;
6944           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6945           result := true;
6946         finally
6947           if Assigned(LineBuf) then
6948             FreeMem(LineBuf);
6949           if Assigned(SourceMD) then
6950             SpecialFormat.FreeMappingData(SourceMD);
6951           FormatDesc.FreeMappingData(DestMD);
6952         end;
6953         except
6954           if Assigned(ImageData) then
6955             FreeMem(ImageData);
6956           raise;
6957         end;
6958       end else
6959         raise EglBitmap.Create('LoadBMP - No suitable format found');
6960     except
6961       aStream.Position := StartPos;
6962       raise;
6963     end;
6964     finally
6965       FreeAndNil(SpecialFormat);
6966     end;
6967   end
6968     else aStream.Position := StartPos;
6969 end;
6970
6971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6972 procedure TglBitmap.SaveBMP(const aStream: TStream);
6973 var
6974   Header: TBMPHeader;
6975   Info: TBMPInfo;
6976   Converter: TFormatDescriptor;
6977   FormatDesc: TFormatDescriptor;
6978   SourceFD, DestFD: Pointer;
6979   pData, srcData, dstData, ConvertBuffer: pByte;
6980
6981   Pixel: TglBitmapPixelData;
6982   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6983   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6984
6985   PaddingBuff: Cardinal;
6986
6987   function GetLineWidth : Integer;
6988   begin
6989     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6990   end;
6991
6992 begin
6993   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6994     raise EglBitmapUnsupportedFormat.Create(Format);
6995
6996   Converter  := nil;
6997   FormatDesc := TFormatDescriptor.Get(Format);
6998   ImageSize  := FormatDesc.GetSize(Dimension);
6999
7000   FillChar(Header{%H-}, SizeOf(Header), 0);
7001   Header.bfType      := BMP_MAGIC;
7002   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7003   Header.bfReserved1 := 0;
7004   Header.bfReserved2 := 0;
7005   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7006
7007   FillChar(Info{%H-}, SizeOf(Info), 0);
7008   Info.biSize        := SizeOf(Info);
7009   Info.biWidth       := Width;
7010   Info.biHeight      := Height;
7011   Info.biPlanes      := 1;
7012   Info.biCompression := BMP_COMP_RGB;
7013   Info.biSizeImage   := ImageSize;
7014
7015   try
7016     case Format of
7017       tfLuminance4: begin
7018         Info.biBitCount  := 4;
7019         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7020         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7021         Converter := TbmpColorTableFormat.Create;
7022         with (Converter as TbmpColorTableFormat) do begin
7023           PixelSize := 0.5;
7024           Format    := Format;
7025           Range     := glBitmapColorRec($F, $F, $F, $0);
7026           CreateColorTable;
7027         end;
7028       end;
7029
7030       tfR3G3B2, tfLuminance8: begin
7031         Info.biBitCount  :=  8;
7032         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7033         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7034         Converter := TbmpColorTableFormat.Create;
7035         with (Converter as TbmpColorTableFormat) do begin
7036           PixelSize := 1;
7037           Format    := Format;
7038           if (Format = tfR3G3B2) then begin
7039             Range := glBitmapColorRec($7, $7, $3, $0);
7040             Shift := glBitmapShiftRec(0, 3, 6, 0);
7041           end else
7042             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7043           CreateColorTable;
7044         end;
7045       end;
7046
7047       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7048       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7049         Info.biBitCount    := 16;
7050         Info.biCompression := BMP_COMP_BITFIELDS;
7051       end;
7052
7053       tfBGR8, tfRGB8: begin
7054         Info.biBitCount := 24;
7055         if (Format = tfRGB8) then
7056           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7057       end;
7058
7059       tfRGB10, tfRGB10A2, tfRGBA8,
7060       tfBGR10, tfBGR10A2, tfBGRA8: begin
7061         Info.biBitCount    := 32;
7062         Info.biCompression := BMP_COMP_BITFIELDS;
7063       end;
7064     else
7065       raise EglBitmapUnsupportedFormat.Create(Format);
7066     end;
7067     Info.biXPelsPerMeter := 2835;
7068     Info.biYPelsPerMeter := 2835;
7069
7070     // prepare bitmasks
7071     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7072       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7073       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7074
7075       RedMask    := FormatDesc.RedMask;
7076       GreenMask  := FormatDesc.GreenMask;
7077       BlueMask   := FormatDesc.BlueMask;
7078       AlphaMask  := FormatDesc.AlphaMask;
7079     end;
7080
7081     // headers
7082     aStream.Write(Header, SizeOf(Header));
7083     aStream.Write(Info, SizeOf(Info));
7084
7085     // colortable
7086     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7087       with (Converter as TbmpColorTableFormat) do
7088         aStream.Write(ColorTable[0].b,
7089           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7090
7091     // bitmasks
7092     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7093       aStream.Write(RedMask,   SizeOf(Cardinal));
7094       aStream.Write(GreenMask, SizeOf(Cardinal));
7095       aStream.Write(BlueMask,  SizeOf(Cardinal));
7096       aStream.Write(AlphaMask, SizeOf(Cardinal));
7097     end;
7098
7099     // image data
7100     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7101     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7102     Padding     := GetLineWidth - wbLineSize;
7103     PaddingBuff := 0;
7104
7105     pData := Data;
7106     inc(pData, (Height-1) * rbLineSize);
7107
7108     // prepare row buffer. But only for RGB because RGBA supports color masks
7109     // so it's possible to change color within the image.
7110     if Assigned(Converter) then begin
7111       FormatDesc.PreparePixel(Pixel);
7112       GetMem(ConvertBuffer, wbLineSize);
7113       SourceFD := FormatDesc.CreateMappingData;
7114       DestFD   := Converter.CreateMappingData;
7115     end else
7116       ConvertBuffer := nil;
7117
7118     try
7119       for LineIdx := 0 to Height - 1 do begin
7120         // preparing row
7121         if Assigned(Converter) then begin
7122           srcData := pData;
7123           dstData := ConvertBuffer;
7124           for PixelIdx := 0 to Info.biWidth-1 do begin
7125             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7126             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7127             Converter.Map(Pixel, dstData, DestFD);
7128           end;
7129           aStream.Write(ConvertBuffer^, wbLineSize);
7130         end else begin
7131           aStream.Write(pData^, rbLineSize);
7132         end;
7133         dec(pData, rbLineSize);
7134         if (Padding > 0) then
7135           aStream.Write(PaddingBuff, Padding);
7136       end;
7137     finally
7138       // destroy row buffer
7139       if Assigned(ConvertBuffer) then begin
7140         FormatDesc.FreeMappingData(SourceFD);
7141         Converter.FreeMappingData(DestFD);
7142         FreeMem(ConvertBuffer);
7143       end;
7144     end;
7145   finally
7146     if Assigned(Converter) then
7147       Converter.Free;
7148   end;
7149 end;
7150
7151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7152 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7154 type
7155   TTGAHeader = packed record
7156     ImageID: Byte;
7157     ColorMapType: Byte;
7158     ImageType: Byte;
7159     //ColorMapSpec: Array[0..4] of Byte;
7160     ColorMapStart: Word;
7161     ColorMapLength: Word;
7162     ColorMapEntrySize: Byte;
7163     OrigX: Word;
7164     OrigY: Word;
7165     Width: Word;
7166     Height: Word;
7167     Bpp: Byte;
7168     ImageDesc: Byte;
7169   end;
7170
7171 const
7172   TGA_UNCOMPRESSED_RGB  =  2;
7173   TGA_UNCOMPRESSED_GRAY =  3;
7174   TGA_COMPRESSED_RGB    = 10;
7175   TGA_COMPRESSED_GRAY   = 11;
7176
7177   TGA_NONE_COLOR_TABLE  = 0;
7178
7179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7180 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7181 var
7182   Header: TTGAHeader;
7183   ImageData: System.PByte;
7184   StartPosition: Int64;
7185   PixelSize, LineSize: Integer;
7186   tgaFormat: TglBitmapFormat;
7187   FormatDesc: TFormatDescriptor;
7188   Counter: packed record
7189     X, Y: packed record
7190       low, high, dir: Integer;
7191     end;
7192   end;
7193
7194 const
7195   CACHE_SIZE = $4000;
7196
7197   ////////////////////////////////////////////////////////////////////////////////////////
7198   procedure ReadUncompressed;
7199   var
7200     i, j: Integer;
7201     buf, tmp1, tmp2: System.PByte;
7202   begin
7203     buf := nil;
7204     if (Counter.X.dir < 0) then
7205       GetMem(buf, LineSize);
7206     try
7207       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7208         tmp1 := ImageData;
7209         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7210         if (Counter.X.dir < 0) then begin               //flip X
7211           aStream.Read(buf^, LineSize);
7212           tmp2 := buf;
7213           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7214           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7215             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7216               tmp1^ := tmp2^;
7217               inc(tmp1);
7218               inc(tmp2);
7219             end;
7220             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7221           end;
7222         end else
7223           aStream.Read(tmp1^, LineSize);
7224         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7225       end;
7226     finally
7227       if Assigned(buf) then
7228         FreeMem(buf);
7229     end;
7230   end;
7231
7232   ////////////////////////////////////////////////////////////////////////////////////////
7233   procedure ReadCompressed;
7234
7235     /////////////////////////////////////////////////////////////////
7236     var
7237       TmpData: System.PByte;
7238       LinePixelsRead: Integer;
7239     procedure CheckLine;
7240     begin
7241       if (LinePixelsRead >= Header.Width) then begin
7242         LinePixelsRead := 0;
7243         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7244         TmpData := ImageData;
7245         inc(TmpData, Counter.Y.low * LineSize);           //set line
7246         if (Counter.X.dir < 0) then                       //if x flipped then
7247           inc(TmpData, LineSize - PixelSize);             //set last pixel
7248       end;
7249     end;
7250
7251     /////////////////////////////////////////////////////////////////
7252     var
7253       Cache: PByte;
7254       CacheSize, CachePos: Integer;
7255     procedure CachedRead(out Buffer; Count: Integer);
7256     var
7257       BytesRead: Integer;
7258     begin
7259       if (CachePos + Count > CacheSize) then begin
7260         //if buffer overflow save non read bytes
7261         BytesRead := 0;
7262         if (CacheSize - CachePos > 0) then begin
7263           BytesRead := CacheSize - CachePos;
7264           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7265           inc(CachePos, BytesRead);
7266         end;
7267
7268         //load cache from file
7269         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7270         aStream.Read(Cache^, CacheSize);
7271         CachePos := 0;
7272
7273         //read rest of requested bytes
7274         if (Count - BytesRead > 0) then begin
7275           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7276           inc(CachePos, Count - BytesRead);
7277         end;
7278       end else begin
7279         //if no buffer overflow just read the data
7280         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7281         inc(CachePos, Count);
7282       end;
7283     end;
7284
7285     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7286     begin
7287       case PixelSize of
7288         1: begin
7289           aBuffer^ := aData^;
7290           inc(aBuffer, Counter.X.dir);
7291         end;
7292         2: begin
7293           PWord(aBuffer)^ := PWord(aData)^;
7294           inc(aBuffer, 2 * Counter.X.dir);
7295         end;
7296         3: begin
7297           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7298           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7299           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7300           inc(aBuffer, 3 * Counter.X.dir);
7301         end;
7302         4: begin
7303           PCardinal(aBuffer)^ := PCardinal(aData)^;
7304           inc(aBuffer, 4 * Counter.X.dir);
7305         end;
7306       end;
7307     end;
7308
7309   var
7310     TotalPixelsToRead, TotalPixelsRead: Integer;
7311     Temp: Byte;
7312     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7313     PixelRepeat: Boolean;
7314     PixelsToRead, PixelCount: Integer;
7315   begin
7316     CacheSize := 0;
7317     CachePos  := 0;
7318
7319     TotalPixelsToRead := Header.Width * Header.Height;
7320     TotalPixelsRead   := 0;
7321     LinePixelsRead    := 0;
7322
7323     GetMem(Cache, CACHE_SIZE);
7324     try
7325       TmpData := ImageData;
7326       inc(TmpData, Counter.Y.low * LineSize);           //set line
7327       if (Counter.X.dir < 0) then                       //if x flipped then
7328         inc(TmpData, LineSize - PixelSize);             //set last pixel
7329
7330       repeat
7331         //read CommandByte
7332         CachedRead(Temp, 1);
7333         PixelRepeat  := (Temp and $80) > 0;
7334         PixelsToRead := (Temp and $7F) + 1;
7335         inc(TotalPixelsRead, PixelsToRead);
7336
7337         if PixelRepeat then
7338           CachedRead(buf[0], PixelSize);
7339         while (PixelsToRead > 0) do begin
7340           CheckLine;
7341           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7342           while (PixelCount > 0) do begin
7343             if not PixelRepeat then
7344               CachedRead(buf[0], PixelSize);
7345             PixelToBuffer(@buf[0], TmpData);
7346             inc(LinePixelsRead);
7347             dec(PixelsToRead);
7348             dec(PixelCount);
7349           end;
7350         end;
7351       until (TotalPixelsRead >= TotalPixelsToRead);
7352     finally
7353       FreeMem(Cache);
7354     end;
7355   end;
7356
7357   function IsGrayFormat: Boolean;
7358   begin
7359     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7360   end;
7361
7362 begin
7363   result := false;
7364
7365   // reading header to test file and set cursor back to begin
7366   StartPosition := aStream.Position;
7367   aStream.Read(Header{%H-}, SizeOf(Header));
7368
7369   // no colormapped files
7370   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7371     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7372   begin
7373     try
7374       if Header.ImageID <> 0 then       // skip image ID
7375         aStream.Position := aStream.Position + Header.ImageID;
7376
7377       tgaFormat := tfEmpty;
7378       case Header.Bpp of
7379          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7380                0: tgaFormat := tfLuminance8;
7381                8: tgaFormat := tfAlpha8;
7382             end;
7383
7384         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7385                0: tgaFormat := tfLuminance16;
7386                8: tgaFormat := tfLuminance8Alpha8;
7387             end else case (Header.ImageDesc and $F) of
7388                0: tgaFormat := tfBGR5;
7389                1: tgaFormat := tfBGR5A1;
7390                4: tgaFormat := tfBGRA4;
7391             end;
7392
7393         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7394                0: tgaFormat := tfBGR8;
7395             end;
7396
7397         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7398                2: tgaFormat := tfBGR10A2;
7399                8: tgaFormat := tfBGRA8;
7400             end;
7401       end;
7402
7403       if (tgaFormat = tfEmpty) then
7404         raise EglBitmap.Create('LoadTga - unsupported format');
7405
7406       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7407       PixelSize  := FormatDesc.GetSize(1, 1);
7408       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7409
7410       GetMem(ImageData, LineSize * Header.Height);
7411       try
7412         //column direction
7413         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7414           Counter.X.low  := Header.Height-1;;
7415           Counter.X.high := 0;
7416           Counter.X.dir  := -1;
7417         end else begin
7418           Counter.X.low  := 0;
7419           Counter.X.high := Header.Height-1;
7420           Counter.X.dir  := 1;
7421         end;
7422
7423         // Row direction
7424         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7425           Counter.Y.low  := 0;
7426           Counter.Y.high := Header.Height-1;
7427           Counter.Y.dir  := 1;
7428         end else begin
7429           Counter.Y.low  := Header.Height-1;;
7430           Counter.Y.high := 0;
7431           Counter.Y.dir  := -1;
7432         end;
7433
7434         // Read Image
7435         case Header.ImageType of
7436           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7437             ReadUncompressed;
7438           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7439             ReadCompressed;
7440         end;
7441
7442         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7443         result := true;
7444       except
7445         if Assigned(ImageData) then
7446           FreeMem(ImageData);
7447         raise;
7448       end;
7449     finally
7450       aStream.Position := StartPosition;
7451     end;
7452   end
7453     else aStream.Position := StartPosition;
7454 end;
7455
7456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7457 procedure TglBitmap.SaveTGA(const aStream: TStream);
7458 var
7459   Header: TTGAHeader;
7460   LineSize, Size, x, y: Integer;
7461   Pixel: TglBitmapPixelData;
7462   LineBuf, SourceData, DestData: PByte;
7463   SourceMD, DestMD: Pointer;
7464   FormatDesc: TFormatDescriptor;
7465   Converter: TFormatDescriptor;
7466 begin
7467   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7468     raise EglBitmapUnsupportedFormat.Create(Format);
7469
7470   //prepare header
7471   FillChar(Header{%H-}, SizeOf(Header), 0);
7472
7473   //set ImageType
7474   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7475                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7476     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7477   else
7478     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7479
7480   //set BitsPerPixel
7481   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7482     Header.Bpp := 8
7483   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7484                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7485     Header.Bpp := 16
7486   else if (Format in [tfBGR8, tfRGB8]) then
7487     Header.Bpp := 24
7488   else
7489     Header.Bpp := 32;
7490
7491   //set AlphaBitCount
7492   case Format of
7493     tfRGB5A1, tfBGR5A1:
7494       Header.ImageDesc := 1 and $F;
7495     tfRGB10A2, tfBGR10A2:
7496       Header.ImageDesc := 2 and $F;
7497     tfRGBA4, tfBGRA4:
7498       Header.ImageDesc := 4 and $F;
7499     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7500       Header.ImageDesc := 8 and $F;
7501   end;
7502
7503   Header.Width     := Width;
7504   Header.Height    := Height;
7505   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7506   aStream.Write(Header, SizeOf(Header));
7507
7508   // convert RGB(A) to BGR(A)
7509   Converter  := nil;
7510   FormatDesc := TFormatDescriptor.Get(Format);
7511   Size       := FormatDesc.GetSize(Dimension);
7512   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7513     if (FormatDesc.RGBInverted = tfEmpty) then
7514       raise EglBitmap.Create('inverted RGB format is empty');
7515     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7516     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7517        (Converter.PixelSize <> FormatDesc.PixelSize) then
7518       raise EglBitmap.Create('invalid inverted RGB format');
7519   end;
7520
7521   if Assigned(Converter) then begin
7522     LineSize := FormatDesc.GetSize(Width, 1);
7523     GetMem(LineBuf, LineSize);
7524     SourceMD := FormatDesc.CreateMappingData;
7525     DestMD   := Converter.CreateMappingData;
7526     try
7527       SourceData := Data;
7528       for y := 0 to Height-1 do begin
7529         DestData := LineBuf;
7530         for x := 0 to Width-1 do begin
7531           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7532           Converter.Map(Pixel, DestData, DestMD);
7533         end;
7534         aStream.Write(LineBuf^, LineSize);
7535       end;
7536     finally
7537       FreeMem(LineBuf);
7538       FormatDesc.FreeMappingData(SourceMD);
7539       FormatDesc.FreeMappingData(DestMD);
7540     end;
7541   end else
7542     aStream.Write(Data^, Size);
7543 end;
7544
7545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7546 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7548 const
7549   DDS_MAGIC: Cardinal         = $20534444;
7550
7551   // DDS_header.dwFlags
7552   DDSD_CAPS                   = $00000001;
7553   DDSD_HEIGHT                 = $00000002;
7554   DDSD_WIDTH                  = $00000004;
7555   DDSD_PIXELFORMAT            = $00001000;
7556
7557   // DDS_header.sPixelFormat.dwFlags
7558   DDPF_ALPHAPIXELS            = $00000001;
7559   DDPF_ALPHA                  = $00000002;
7560   DDPF_FOURCC                 = $00000004;
7561   DDPF_RGB                    = $00000040;
7562   DDPF_LUMINANCE              = $00020000;
7563
7564   // DDS_header.sCaps.dwCaps1
7565   DDSCAPS_TEXTURE             = $00001000;
7566
7567   // DDS_header.sCaps.dwCaps2
7568   DDSCAPS2_CUBEMAP            = $00000200;
7569
7570   D3DFMT_DXT1                 = $31545844;
7571   D3DFMT_DXT3                 = $33545844;
7572   D3DFMT_DXT5                 = $35545844;
7573
7574 type
7575   TDDSPixelFormat = packed record
7576     dwSize: Cardinal;
7577     dwFlags: Cardinal;
7578     dwFourCC: Cardinal;
7579     dwRGBBitCount: Cardinal;
7580     dwRBitMask: Cardinal;
7581     dwGBitMask: Cardinal;
7582     dwBBitMask: Cardinal;
7583     dwABitMask: Cardinal;
7584   end;
7585
7586   TDDSCaps = packed record
7587     dwCaps1: Cardinal;
7588     dwCaps2: Cardinal;
7589     dwDDSX: Cardinal;
7590     dwReserved: Cardinal;
7591   end;
7592
7593   TDDSHeader = packed record
7594     dwSize: Cardinal;
7595     dwFlags: Cardinal;
7596     dwHeight: Cardinal;
7597     dwWidth: Cardinal;
7598     dwPitchOrLinearSize: Cardinal;
7599     dwDepth: Cardinal;
7600     dwMipMapCount: Cardinal;
7601     dwReserved: array[0..10] of Cardinal;
7602     PixelFormat: TDDSPixelFormat;
7603     Caps: TDDSCaps;
7604     dwReserved2: Cardinal;
7605   end;
7606
7607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7608 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7609 var
7610   Header: TDDSHeader;
7611   Converter: TbmpBitfieldFormat;
7612
7613   function GetDDSFormat: TglBitmapFormat;
7614   var
7615     fd: TFormatDescriptor;
7616     i: Integer;
7617     Range: TglBitmapColorRec;
7618     match: Boolean;
7619   begin
7620     result := tfEmpty;
7621     with Header.PixelFormat do begin
7622       // Compresses
7623       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7624         case Header.PixelFormat.dwFourCC of
7625           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7626           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7627           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7628         end;
7629       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7630
7631         //find matching format
7632         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7633           fd := TFormatDescriptor.Get(result);
7634           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7635              (8 * fd.PixelSize = dwRGBBitCount) then
7636             exit;
7637         end;
7638
7639         //find format with same Range
7640         Range.r := dwRBitMask;
7641         Range.g := dwGBitMask;
7642         Range.b := dwBBitMask;
7643         Range.a := dwABitMask;
7644         for i := 0 to 3 do begin
7645           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7646             Range.arr[i] := Range.arr[i] shr 1;
7647         end;
7648         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7649           fd := TFormatDescriptor.Get(result);
7650           match := true;
7651           for i := 0 to 3 do
7652             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7653               match := false;
7654               break;
7655             end;
7656           if match then
7657             break;
7658         end;
7659
7660         //no format with same range found -> use default
7661         if (result = tfEmpty) then begin
7662           if (dwABitMask > 0) then
7663             result := tfBGRA8
7664           else
7665             result := tfBGR8;
7666         end;
7667
7668         Converter := TbmpBitfieldFormat.Create;
7669         Converter.RedMask   := dwRBitMask;
7670         Converter.GreenMask := dwGBitMask;
7671         Converter.BlueMask  := dwBBitMask;
7672         Converter.AlphaMask := dwABitMask;
7673         Converter.PixelSize := dwRGBBitCount / 8;
7674       end;
7675     end;
7676   end;
7677
7678 var
7679   StreamPos: Int64;
7680   x, y, LineSize, RowSize, Magic: Cardinal;
7681   NewImage, TmpData, RowData, SrcData: System.PByte;
7682   SourceMD, DestMD: Pointer;
7683   Pixel: TglBitmapPixelData;
7684   ddsFormat: TglBitmapFormat;
7685   FormatDesc: TFormatDescriptor;
7686
7687 begin
7688   result    := false;
7689   Converter := nil;
7690   StreamPos := aStream.Position;
7691
7692   // Magic
7693   aStream.Read(Magic{%H-}, sizeof(Magic));
7694   if (Magic <> DDS_MAGIC) then begin
7695     aStream.Position := StreamPos;
7696     exit;
7697   end;
7698
7699   //Header
7700   aStream.Read(Header{%H-}, sizeof(Header));
7701   if (Header.dwSize <> SizeOf(Header)) or
7702      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7703         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7704   begin
7705     aStream.Position := StreamPos;
7706     exit;
7707   end;
7708
7709   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7710     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7711
7712   ddsFormat := GetDDSFormat;
7713   try
7714     if (ddsFormat = tfEmpty) then
7715       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7716
7717     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7718     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7719     GetMem(NewImage, Header.dwHeight * LineSize);
7720     try
7721       TmpData := NewImage;
7722
7723       //Converter needed
7724       if Assigned(Converter) then begin
7725         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7726         GetMem(RowData, RowSize);
7727         SourceMD := Converter.CreateMappingData;
7728         DestMD   := FormatDesc.CreateMappingData;
7729         try
7730           for y := 0 to Header.dwHeight-1 do begin
7731             TmpData := NewImage;
7732             inc(TmpData, y * LineSize);
7733             SrcData := RowData;
7734             aStream.Read(SrcData^, RowSize);
7735             for x := 0 to Header.dwWidth-1 do begin
7736               Converter.Unmap(SrcData, Pixel, SourceMD);
7737               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7738               FormatDesc.Map(Pixel, TmpData, DestMD);
7739             end;
7740           end;
7741         finally
7742           Converter.FreeMappingData(SourceMD);
7743           FormatDesc.FreeMappingData(DestMD);
7744           FreeMem(RowData);
7745         end;
7746       end else
7747
7748       // Compressed
7749       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7750         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7751         for Y := 0 to Header.dwHeight-1 do begin
7752           aStream.Read(TmpData^, RowSize);
7753           Inc(TmpData, LineSize);
7754         end;
7755       end else
7756
7757       // Uncompressed
7758       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7759         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7760         for Y := 0 to Header.dwHeight-1 do begin
7761           aStream.Read(TmpData^, RowSize);
7762           Inc(TmpData, LineSize);
7763         end;
7764       end else
7765         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7766
7767       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7768       result := true;
7769     except
7770       if Assigned(NewImage) then
7771         FreeMem(NewImage);
7772       raise;
7773     end;
7774   finally
7775     FreeAndNil(Converter);
7776   end;
7777 end;
7778
7779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7780 procedure TglBitmap.SaveDDS(const aStream: TStream);
7781 var
7782   Header: TDDSHeader;
7783   FormatDesc: TFormatDescriptor;
7784 begin
7785   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7786     raise EglBitmapUnsupportedFormat.Create(Format);
7787
7788   FormatDesc := TFormatDescriptor.Get(Format);
7789
7790   // Generell
7791   FillChar(Header{%H-}, SizeOf(Header), 0);
7792   Header.dwSize  := SizeOf(Header);
7793   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7794
7795   Header.dwWidth  := Max(1, Width);
7796   Header.dwHeight := Max(1, Height);
7797
7798   // Caps
7799   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7800
7801   // Pixelformat
7802   Header.PixelFormat.dwSize := sizeof(Header);
7803   if (FormatDesc.IsCompressed) then begin
7804     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7805     case Format of
7806       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7807       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7808       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7809     end;
7810   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7811     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7812     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7813     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7814   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7815     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7816     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7817     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7818     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7819   end else begin
7820     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7821     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7822     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7823     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7824     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7825     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7826   end;
7827
7828   if (FormatDesc.HasAlpha) then
7829     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7830
7831   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7832   aStream.Write(Header, SizeOf(Header));
7833   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7834 end;
7835
7836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7837 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7839 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7840   const aWidth: Integer; const aHeight: Integer);
7841 var
7842   pTemp: pByte;
7843   Size: Integer;
7844 begin
7845   if (aHeight > 1) then begin
7846     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7847     GetMem(pTemp, Size);
7848     try
7849       Move(aData^, pTemp^, Size);
7850       FreeMem(aData);
7851       aData := nil;
7852     except
7853       FreeMem(pTemp);
7854       raise;
7855     end;
7856   end else
7857     pTemp := aData;
7858   inherited SetDataPointer(pTemp, aFormat, aWidth);
7859 end;
7860
7861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7862 function TglBitmap1D.FlipHorz: Boolean;
7863 var
7864   Col: Integer;
7865   pTempDest, pDest, pSource: PByte;
7866 begin
7867   result := inherited FlipHorz;
7868   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7869     pSource := Data;
7870     GetMem(pDest, fRowSize);
7871     try
7872       pTempDest := pDest;
7873       Inc(pTempDest, fRowSize);
7874       for Col := 0 to Width-1 do begin
7875         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7876         Move(pSource^, pTempDest^, fPixelSize);
7877         Inc(pSource, fPixelSize);
7878       end;
7879       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7880       result := true;
7881     except
7882       if Assigned(pDest) then
7883         FreeMem(pDest);
7884       raise;
7885     end;
7886   end;
7887 end;
7888
7889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7890 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7891 var
7892   FormatDesc: TFormatDescriptor;
7893 begin
7894   // Upload data
7895   FormatDesc := TFormatDescriptor.Get(Format);
7896   if FormatDesc.IsCompressed then begin
7897     if not Assigned(glCompressedTexImage1D) then
7898       raise EglBitmap.Create('compressed formats not supported by video adapter');
7899     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7900   end else if aBuildWithGlu then
7901     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7902   else
7903     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7904
7905   // Free Data
7906   if (FreeDataAfterGenTexture) then
7907     FreeData;
7908 end;
7909
7910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7911 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7912 var
7913   BuildWithGlu, TexRec: Boolean;
7914   TexSize: Integer;
7915 begin
7916   if Assigned(Data) then begin
7917     // Check Texture Size
7918     if (aTestTextureSize) then begin
7919       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7920
7921       if (Width > TexSize) then
7922         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7923
7924       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7925                 (Target = GL_TEXTURE_RECTANGLE);
7926       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7927         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7928     end;
7929
7930     CreateId;
7931     SetupParameters(BuildWithGlu);
7932     UploadData(BuildWithGlu);
7933     glAreTexturesResident(1, @fID, @fIsResident);
7934   end;
7935 end;
7936
7937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7938 procedure TglBitmap1D.AfterConstruction;
7939 begin
7940   inherited;
7941   Target := GL_TEXTURE_1D;
7942 end;
7943
7944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7945 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7947 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7948 begin
7949   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7950     result := fLines[aIndex]
7951   else
7952     result := nil;
7953 end;
7954
7955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7956 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7957   const aWidth: Integer; const aHeight: Integer);
7958 var
7959   Idx, LineWidth: Integer;
7960 begin
7961   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7962
7963   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7964     // Assigning Data
7965     if Assigned(Data) then begin
7966       SetLength(fLines, GetHeight);
7967       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7968
7969       for Idx := 0 to GetHeight-1 do begin
7970         fLines[Idx] := Data;
7971         Inc(fLines[Idx], Idx * LineWidth);
7972       end;
7973     end
7974       else SetLength(fLines, 0);
7975   end else begin
7976     SetLength(fLines, 0);
7977   end;
7978 end;
7979
7980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7981 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7982 var
7983   FormatDesc: TFormatDescriptor;
7984 begin
7985   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7986
7987   FormatDesc := TFormatDescriptor.Get(Format);
7988   if FormatDesc.IsCompressed then begin
7989     if not Assigned(glCompressedTexImage2D) then
7990       raise EglBitmap.Create('compressed formats not supported by video adapter');
7991     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7992   end else if aBuildWithGlu then begin
7993     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7994       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7995   end else begin
7996     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7997       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7998   end;
7999
8000   // Freigeben
8001   if (FreeDataAfterGenTexture) then
8002     FreeData;
8003 end;
8004
8005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8006 procedure TglBitmap2D.AfterConstruction;
8007 begin
8008   inherited;
8009   Target := GL_TEXTURE_2D;
8010 end;
8011
8012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8013 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8014 var
8015   Temp: pByte;
8016   Size, w, h: Integer;
8017   FormatDesc: TFormatDescriptor;
8018 begin
8019   FormatDesc := TFormatDescriptor.Get(aFormat);
8020   if FormatDesc.IsCompressed then
8021     raise EglBitmapUnsupportedFormat.Create(aFormat);
8022
8023   w    := aRight  - aLeft;
8024   h    := aBottom - aTop;
8025   Size := FormatDesc.GetSize(w, h);
8026   GetMem(Temp, Size);
8027   try
8028     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8029     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8030     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8031     FlipVert;
8032   except
8033     if Assigned(Temp) then
8034       FreeMem(Temp);
8035     raise;
8036   end;
8037 end;
8038
8039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8040 procedure TglBitmap2D.GetDataFromTexture;
8041 var
8042   Temp: PByte;
8043   TempWidth, TempHeight: Integer;
8044   TempIntFormat: Cardinal;
8045   IntFormat, f: TglBitmapFormat;
8046   FormatDesc: TFormatDescriptor;
8047 begin
8048   Bind;
8049
8050   // Request Data
8051   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8052   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8053   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8054
8055   IntFormat := tfEmpty;
8056   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8057     FormatDesc := TFormatDescriptor.Get(f);
8058     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8059       IntFormat := FormatDesc.Format;
8060       break;
8061     end;
8062   end;
8063
8064   // Getting data from OpenGL
8065   FormatDesc := TFormatDescriptor.Get(IntFormat);
8066   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8067   try
8068     if FormatDesc.IsCompressed then begin
8069       if not Assigned(glGetCompressedTexImage) then
8070         raise EglBitmap.Create('compressed formats not supported by video adapter');
8071       glGetCompressedTexImage(Target, 0, Temp)
8072     end else
8073       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8074     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8075   except
8076     if Assigned(Temp) then
8077       FreeMem(Temp);
8078     raise;
8079   end;
8080 end;
8081
8082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8083 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8084 var
8085   BuildWithGlu, PotTex, TexRec: Boolean;
8086   TexSize: Integer;
8087 begin
8088   if Assigned(Data) then begin
8089     // Check Texture Size
8090     if (aTestTextureSize) then begin
8091       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8092
8093       if ((Height > TexSize) or (Width > TexSize)) then
8094         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8095
8096       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8097       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8098       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8099         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8100     end;
8101
8102     CreateId;
8103     SetupParameters(BuildWithGlu);
8104     UploadData(Target, BuildWithGlu);
8105     glAreTexturesResident(1, @fID, @fIsResident);
8106   end;
8107 end;
8108
8109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8110 function TglBitmap2D.FlipHorz: Boolean;
8111 var
8112   Col, Row: Integer;
8113   TempDestData, DestData, SourceData: PByte;
8114   ImgSize: Integer;
8115 begin
8116   result := inherited FlipHorz;
8117   if Assigned(Data) then begin
8118     SourceData := Data;
8119     ImgSize := Height * fRowSize;
8120     GetMem(DestData, ImgSize);
8121     try
8122       TempDestData := DestData;
8123       Dec(TempDestData, fRowSize + fPixelSize);
8124       for Row := 0 to Height -1 do begin
8125         Inc(TempDestData, fRowSize * 2);
8126         for Col := 0 to Width -1 do begin
8127           Move(SourceData^, TempDestData^, fPixelSize);
8128           Inc(SourceData, fPixelSize);
8129           Dec(TempDestData, fPixelSize);
8130         end;
8131       end;
8132       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8133       result := true;
8134     except
8135       if Assigned(DestData) then
8136         FreeMem(DestData);
8137       raise;
8138     end;
8139   end;
8140 end;
8141
8142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8143 function TglBitmap2D.FlipVert: Boolean;
8144 var
8145   Row: Integer;
8146   TempDestData, DestData, SourceData: PByte;
8147 begin
8148   result := inherited FlipVert;
8149   if Assigned(Data) then begin
8150     SourceData := Data;
8151     GetMem(DestData, Height * fRowSize);
8152     try
8153       TempDestData := DestData;
8154       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8155       for Row := 0 to Height -1 do begin
8156         Move(SourceData^, TempDestData^, fRowSize);
8157         Dec(TempDestData, fRowSize);
8158         Inc(SourceData, fRowSize);
8159       end;
8160       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8161       result := true;
8162     except
8163       if Assigned(DestData) then
8164         FreeMem(DestData);
8165       raise;
8166     end;
8167   end;
8168 end;
8169
8170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8171 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8173 type
8174   TMatrixItem = record
8175     X, Y: Integer;
8176     W: Single;
8177   end;
8178
8179   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8180   TglBitmapToNormalMapRec = Record
8181     Scale: Single;
8182     Heights: array of Single;
8183     MatrixU : array of TMatrixItem;
8184     MatrixV : array of TMatrixItem;
8185   end;
8186
8187 const
8188   ONE_OVER_255 = 1 / 255;
8189
8190   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8191 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8192 var
8193   Val: Single;
8194 begin
8195   with FuncRec do begin
8196     Val :=
8197       Source.Data.r * LUMINANCE_WEIGHT_R +
8198       Source.Data.g * LUMINANCE_WEIGHT_G +
8199       Source.Data.b * LUMINANCE_WEIGHT_B;
8200     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8201   end;
8202 end;
8203
8204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8205 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8206 begin
8207   with FuncRec do
8208     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8209 end;
8210
8211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8212 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8213 type
8214   TVec = Array[0..2] of Single;
8215 var
8216   Idx: Integer;
8217   du, dv: Double;
8218   Len: Single;
8219   Vec: TVec;
8220
8221   function GetHeight(X, Y: Integer): Single;
8222   begin
8223     with FuncRec do begin
8224       X := Max(0, Min(Size.X -1, X));
8225       Y := Max(0, Min(Size.Y -1, Y));
8226       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8227     end;
8228   end;
8229
8230 begin
8231   with FuncRec do begin
8232     with PglBitmapToNormalMapRec(Args)^ do begin
8233       du := 0;
8234       for Idx := Low(MatrixU) to High(MatrixU) do
8235         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8236
8237       dv := 0;
8238       for Idx := Low(MatrixU) to High(MatrixU) do
8239         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8240
8241       Vec[0] := -du * Scale;
8242       Vec[1] := -dv * Scale;
8243       Vec[2] := 1;
8244     end;
8245
8246     // Normalize
8247     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8248     if Len <> 0 then begin
8249       Vec[0] := Vec[0] * Len;
8250       Vec[1] := Vec[1] * Len;
8251       Vec[2] := Vec[2] * Len;
8252     end;
8253
8254     // Farbe zuweisem
8255     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8256     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8257     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8258   end;
8259 end;
8260
8261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8262 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8263 var
8264   Rec: TglBitmapToNormalMapRec;
8265
8266   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8267   begin
8268     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8269       Matrix[Index].X := X;
8270       Matrix[Index].Y := Y;
8271       Matrix[Index].W := W;
8272     end;
8273   end;
8274
8275 begin
8276   if TFormatDescriptor.Get(Format).IsCompressed then
8277     raise EglBitmapUnsupportedFormat.Create(Format);
8278
8279   if aScale > 100 then
8280     Rec.Scale := 100
8281   else if aScale < -100 then
8282     Rec.Scale := -100
8283   else
8284     Rec.Scale := aScale;
8285
8286   SetLength(Rec.Heights, Width * Height);
8287   try
8288     case aFunc of
8289       nm4Samples: begin
8290         SetLength(Rec.MatrixU, 2);
8291         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8292         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8293
8294         SetLength(Rec.MatrixV, 2);
8295         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8296         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8297       end;
8298
8299       nmSobel: begin
8300         SetLength(Rec.MatrixU, 6);
8301         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8302         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8303         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8304         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8305         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8306         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8307
8308         SetLength(Rec.MatrixV, 6);
8309         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8310         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8311         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8312         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8313         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8314         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8315       end;
8316
8317       nm3x3: begin
8318         SetLength(Rec.MatrixU, 6);
8319         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8320         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8321         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8322         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8323         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8324         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8325
8326         SetLength(Rec.MatrixV, 6);
8327         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8328         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8329         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8330         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8331         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8332         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8333       end;
8334
8335       nm5x5: begin
8336         SetLength(Rec.MatrixU, 20);
8337         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8338         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8339         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8340         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8341         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8342         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8343         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8344         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8345         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8346         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8347         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8348         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8349         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8350         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8351         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8352         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8353         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8354         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8355         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8356         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8357
8358         SetLength(Rec.MatrixV, 20);
8359         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8360         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8361         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8362         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8363         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8364         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8365         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8366         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8367         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8368         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8369         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8370         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8371         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8372         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8373         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8374         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8375         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8376         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8377         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8378         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8379       end;
8380     end;
8381
8382     // Daten Sammeln
8383     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8384       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8385     else
8386       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8387     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8388   finally
8389     SetLength(Rec.Heights, 0);
8390   end;
8391 end;
8392
8393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8394 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8396 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8397 begin
8398   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8399 end;
8400
8401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8402 procedure TglBitmapCubeMap.AfterConstruction;
8403 begin
8404   inherited;
8405
8406   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8407     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8408
8409   SetWrap;
8410   Target   := GL_TEXTURE_CUBE_MAP;
8411   fGenMode := GL_REFLECTION_MAP;
8412 end;
8413
8414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8415 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8416 var
8417   BuildWithGlu: Boolean;
8418   TexSize: Integer;
8419 begin
8420   if (aTestTextureSize) then begin
8421     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8422
8423     if (Height > TexSize) or (Width > TexSize) then
8424       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8425
8426     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8427       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8428   end;
8429
8430   if (ID = 0) then
8431     CreateID;
8432   SetupParameters(BuildWithGlu);
8433   UploadData(aCubeTarget, BuildWithGlu);
8434 end;
8435
8436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8437 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8438 begin
8439   inherited Bind (aEnableTextureUnit);
8440   if aEnableTexCoordsGen then begin
8441     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8442     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8443     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8444     glEnable(GL_TEXTURE_GEN_S);
8445     glEnable(GL_TEXTURE_GEN_T);
8446     glEnable(GL_TEXTURE_GEN_R);
8447   end;
8448 end;
8449
8450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8452 begin
8453   inherited Unbind(aDisableTextureUnit);
8454   if aDisableTexCoordsGen then begin
8455     glDisable(GL_TEXTURE_GEN_S);
8456     glDisable(GL_TEXTURE_GEN_T);
8457     glDisable(GL_TEXTURE_GEN_R);
8458   end;
8459 end;
8460
8461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8464 type
8465   TVec = Array[0..2] of Single;
8466   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8467
8468   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8469   TglBitmapNormalMapRec = record
8470     HalfSize : Integer;
8471     Func: TglBitmapNormalMapGetVectorFunc;
8472   end;
8473
8474   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8476 begin
8477   aVec[0] := aHalfSize;
8478   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8479   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8480 end;
8481
8482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8483 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8484 begin
8485   aVec[0] := - aHalfSize;
8486   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8487   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8488 end;
8489
8490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8491 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8492 begin
8493   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8494   aVec[1] := aHalfSize;
8495   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8496 end;
8497
8498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8499 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8500 begin
8501   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8502   aVec[1] := - aHalfSize;
8503   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8504 end;
8505
8506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8507 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8508 begin
8509   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8510   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8511   aVec[2] := aHalfSize;
8512 end;
8513
8514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8515 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8516 begin
8517   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8518   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8519   aVec[2] := - aHalfSize;
8520 end;
8521
8522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8523 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8524 var
8525   i: Integer;
8526   Vec: TVec;
8527   Len: Single;
8528 begin
8529   with FuncRec do begin
8530     with PglBitmapNormalMapRec(Args)^ do begin
8531       Func(Vec, Position, HalfSize);
8532
8533       // Normalize
8534       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8535       if Len <> 0 then begin
8536         Vec[0] := Vec[0] * Len;
8537         Vec[1] := Vec[1] * Len;
8538         Vec[2] := Vec[2] * Len;
8539       end;
8540
8541       // Scale Vector and AddVectro
8542       Vec[0] := Vec[0] * 0.5 + 0.5;
8543       Vec[1] := Vec[1] * 0.5 + 0.5;
8544       Vec[2] := Vec[2] * 0.5 + 0.5;
8545     end;
8546
8547     // Set Color
8548     for i := 0 to 2 do
8549       Dest.Data.arr[i] := Round(Vec[i] * 255);
8550   end;
8551 end;
8552
8553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8554 procedure TglBitmapNormalMap.AfterConstruction;
8555 begin
8556   inherited;
8557   fGenMode := GL_NORMAL_MAP;
8558 end;
8559
8560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8561 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8562 var
8563   Rec: TglBitmapNormalMapRec;
8564   SizeRec: TglBitmapPixelPosition;
8565 begin
8566   Rec.HalfSize := aSize div 2;
8567   FreeDataAfterGenTexture := false;
8568
8569   SizeRec.Fields := [ffX, ffY];
8570   SizeRec.X := aSize;
8571   SizeRec.Y := aSize;
8572
8573   // Positive X
8574   Rec.Func := glBitmapNormalMapPosX;
8575   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8576   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8577
8578   // Negative X
8579   Rec.Func := glBitmapNormalMapNegX;
8580   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8581   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8582
8583   // Positive Y
8584   Rec.Func := glBitmapNormalMapPosY;
8585   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8586   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8587
8588   // Negative Y
8589   Rec.Func := glBitmapNormalMapNegY;
8590   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8591   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8592
8593   // Positive Z
8594   Rec.Func := glBitmapNormalMapPosZ;
8595   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8596   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8597
8598   // Negative Z
8599   Rec.Func := glBitmapNormalMapNegZ;
8600   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8601   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8602 end;
8603
8604
8605 initialization
8606   glBitmapSetDefaultFormat (tfEmpty);
8607   glBitmapSetDefaultMipmap (mmMipmap);
8608   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8609   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8610   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8611
8612   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8613   glBitmapSetDefaultDeleteTextureOnFree    (true);
8614
8615   TFormatDescriptor.Init;
8616
8617 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8618   OpenGLInitialized := false;
8619   InitOpenGLCS := TCriticalSection.Create;
8620 {$ENDIF}
8621
8622 finalization
8623   TFormatDescriptor.Finalize;
8624
8625 {$IFDEF GLB_NATIVE_OGL}
8626   if Assigned(GL_LibHandle) then
8627     glbFreeLibrary(GL_LibHandle);
8628
8629 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8630   if Assigned(GLU_LibHandle) then
8631     glbFreeLibrary(GLU_LibHandle);
8632   FreeAndNil(InitOpenGLCS);
8633 {$ENDIF}
8634 {$ENDIF}
8635
8636 end.