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   reader: TLazReaderPNG;
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   intf   := TLazIntfImage.Create(0, 0);
5771   reader := TLazReaderPNG.Create;
5772   try try
5773     reader.UpdateDescription := true;
5774     reader.ImageRead(aStream, intf);
5775     AssignFromLazIntfImage(intf);
5776   except
5777     result := false;
5778     aStream.Position := StreamPos;
5779     exit;
5780   end;
5781   finally
5782     reader.Free;
5783     intf.Free;
5784   end;
5785 end;
5786
5787 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5789 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5790 var
5791   Surface: PSDL_Surface;
5792   RWops: PSDL_RWops;
5793 begin
5794   result := false;
5795   RWops := glBitmapCreateRWops(aStream);
5796   try
5797     if IMG_isPNG(RWops) > 0 then begin
5798       Surface := IMG_LoadPNG_RW(RWops);
5799       try
5800         AssignFromSurface(Surface);
5801         result := true;
5802       finally
5803         SDL_FreeSurface(Surface);
5804       end;
5805     end;
5806   finally
5807     SDL_FreeRW(RWops);
5808   end;
5809 end;
5810
5811 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5813 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5814 begin
5815   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5816 end;
5817
5818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5819 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5820 var
5821   StreamPos: Int64;
5822   signature: array [0..7] of byte;
5823   png: png_structp;
5824   png_info: png_infop;
5825
5826   TempHeight, TempWidth: Integer;
5827   Format: TglBitmapFormat;
5828
5829   png_data: pByte;
5830   png_rows: array of pByte;
5831   Row, LineSize: Integer;
5832 begin
5833   result := false;
5834
5835   if not init_libPNG then
5836     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5837
5838   try
5839     // signature
5840     StreamPos := aStream.Position;
5841     aStream.Read(signature{%H-}, 8);
5842     aStream.Position := StreamPos;
5843
5844     if png_check_sig(@signature, 8) <> 0 then begin
5845       // png read struct
5846       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5847       if png = nil then
5848         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5849
5850       // png info
5851       png_info := png_create_info_struct(png);
5852       if png_info = nil then begin
5853         png_destroy_read_struct(@png, nil, nil);
5854         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5855       end;
5856
5857       // set read callback
5858       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5859
5860       // read informations
5861       png_read_info(png, png_info);
5862
5863       // size
5864       TempHeight := png_get_image_height(png, png_info);
5865       TempWidth := png_get_image_width(png, png_info);
5866
5867       // format
5868       case png_get_color_type(png, png_info) of
5869         PNG_COLOR_TYPE_GRAY:
5870           Format := tfLuminance8;
5871         PNG_COLOR_TYPE_GRAY_ALPHA:
5872           Format := tfLuminance8Alpha8;
5873         PNG_COLOR_TYPE_RGB:
5874           Format := tfRGB8;
5875         PNG_COLOR_TYPE_RGB_ALPHA:
5876           Format := tfRGBA8;
5877         else
5878           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5879       end;
5880
5881       // cut upper 8 bit from 16 bit formats
5882       if png_get_bit_depth(png, png_info) > 8 then
5883         png_set_strip_16(png);
5884
5885       // expand bitdepth smaller than 8
5886       if png_get_bit_depth(png, png_info) < 8 then
5887         png_set_expand(png);
5888
5889       // allocating mem for scanlines
5890       LineSize := png_get_rowbytes(png, png_info);
5891       GetMem(png_data, TempHeight * LineSize);
5892       try
5893         SetLength(png_rows, TempHeight);
5894         for Row := Low(png_rows) to High(png_rows) do begin
5895           png_rows[Row] := png_data;
5896           Inc(png_rows[Row], Row * LineSize);
5897         end;
5898
5899         // read complete image into scanlines
5900         png_read_image(png, @png_rows[0]);
5901
5902         // read end
5903         png_read_end(png, png_info);
5904
5905         // destroy read struct
5906         png_destroy_read_struct(@png, @png_info, nil);
5907
5908         SetLength(png_rows, 0);
5909
5910         // set new data
5911         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5912
5913         result := true;
5914       except
5915         if Assigned(png_data) then
5916           FreeMem(png_data);
5917         raise;
5918       end;
5919     end;
5920   finally
5921     quit_libPNG;
5922   end;
5923 end;
5924
5925 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5927 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5928 var
5929   StreamPos: Int64;
5930   Png: TPNGObject;
5931   Header: String[8];
5932   Row, Col, PixSize, LineSize: Integer;
5933   NewImage, pSource, pDest, pAlpha: pByte;
5934   PngFormat: TglBitmapFormat;
5935   FormatDesc: TFormatDescriptor;
5936
5937 const
5938   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5939
5940 begin
5941   result := false;
5942
5943   StreamPos := aStream.Position;
5944   aStream.Read(Header[0], SizeOf(Header));
5945   aStream.Position := StreamPos;
5946
5947   {Test if the header matches}
5948   if Header = PngHeader then begin
5949     Png := TPNGObject.Create;
5950     try
5951       Png.LoadFromStream(aStream);
5952
5953       case Png.Header.ColorType of
5954         COLOR_GRAYSCALE:
5955           PngFormat := tfLuminance8;
5956         COLOR_GRAYSCALEALPHA:
5957           PngFormat := tfLuminance8Alpha8;
5958         COLOR_RGB:
5959           PngFormat := tfBGR8;
5960         COLOR_RGBALPHA:
5961           PngFormat := tfBGRA8;
5962         else
5963           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5964       end;
5965
5966       FormatDesc := TFormatDescriptor.Get(PngFormat);
5967       PixSize    := Round(FormatDesc.PixelSize);
5968       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5969
5970       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5971       try
5972         pDest := NewImage;
5973
5974         case Png.Header.ColorType of
5975           COLOR_RGB, COLOR_GRAYSCALE:
5976             begin
5977               for Row := 0 to Png.Height -1 do begin
5978                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5979                 Inc(pDest, LineSize);
5980               end;
5981             end;
5982           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5983             begin
5984               PixSize := PixSize -1;
5985
5986               for Row := 0 to Png.Height -1 do begin
5987                 pSource := Png.Scanline[Row];
5988                 pAlpha := pByte(Png.AlphaScanline[Row]);
5989
5990                 for Col := 0 to Png.Width -1 do begin
5991                   Move (pSource^, pDest^, PixSize);
5992                   Inc(pSource, PixSize);
5993                   Inc(pDest, PixSize);
5994
5995                   pDest^ := pAlpha^;
5996                   inc(pAlpha);
5997                   Inc(pDest);
5998                 end;
5999               end;
6000             end;
6001           else
6002             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6003         end;
6004
6005         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6006
6007         result := true;
6008       except
6009         if Assigned(NewImage) then
6010           FreeMem(NewImage);
6011         raise;
6012       end;
6013     finally
6014       Png.Free;
6015     end;
6016   end;
6017 end;
6018 {$IFEND}
6019 {$ENDIF}
6020
6021 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6022 {$IFDEF GLB_LIB_PNG}
6023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6024 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6025 begin
6026   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6027 end;
6028 {$ENDIF}
6029
6030 {$IF DEFINED(GLB_LAZ_PNG)}
6031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6032 procedure TglBitmap.SavePNG(const aStream: TStream);
6033 var
6034   png: TPortableNetworkGraphic;
6035   intf: TLazIntfImage;
6036   raw: TRawImage;
6037 begin
6038   png  := TPortableNetworkGraphic.Create;
6039   intf := TLazIntfImage.Create(0, 0);
6040   try
6041     if not AssignToLazIntfImage(intf) then
6042       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6043     intf.GetRawImage(raw);
6044     png.LoadFromRawImage(raw, false);
6045     png.SaveToStream(aStream);
6046   finally
6047     png.Free;
6048     intf.Free;
6049   end;
6050 end;
6051
6052 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6054 procedure TglBitmap.SavePNG(const aStream: TStream);
6055 var
6056   png: png_structp;
6057   png_info: png_infop;
6058   png_rows: array of pByte;
6059   LineSize: Integer;
6060   ColorType: Integer;
6061   Row: Integer;
6062   FormatDesc: TFormatDescriptor;
6063 begin
6064   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6065     raise EglBitmapUnsupportedFormat.Create(Format);
6066
6067   if not init_libPNG then
6068     raise Exception.Create('unable to initialize libPNG.');
6069
6070   try
6071     case Format of
6072       tfAlpha8, tfLuminance8:
6073         ColorType := PNG_COLOR_TYPE_GRAY;
6074       tfLuminance8Alpha8:
6075         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6076       tfBGR8, tfRGB8:
6077         ColorType := PNG_COLOR_TYPE_RGB;
6078       tfBGRA8, tfRGBA8:
6079         ColorType := PNG_COLOR_TYPE_RGBA;
6080       else
6081         raise EglBitmapUnsupportedFormat.Create(Format);
6082     end;
6083
6084     FormatDesc := TFormatDescriptor.Get(Format);
6085     LineSize := FormatDesc.GetSize(Width, 1);
6086
6087     // creating array for scanline
6088     SetLength(png_rows, Height);
6089     try
6090       for Row := 0 to Height - 1 do begin
6091         png_rows[Row] := Data;
6092         Inc(png_rows[Row], Row * LineSize)
6093       end;
6094
6095       // write struct
6096       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6097       if png = nil then
6098         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6099
6100       // create png info
6101       png_info := png_create_info_struct(png);
6102       if png_info = nil then begin
6103         png_destroy_write_struct(@png, nil);
6104         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6105       end;
6106
6107       // set read callback
6108       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6109
6110       // set compression
6111       png_set_compression_level(png, 6);
6112
6113       if Format in [tfBGR8, tfBGRA8] then
6114         png_set_bgr(png);
6115
6116       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6117       png_write_info(png, png_info);
6118       png_write_image(png, @png_rows[0]);
6119       png_write_end(png, png_info);
6120       png_destroy_write_struct(@png, @png_info);
6121     finally
6122       SetLength(png_rows, 0);
6123     end;
6124   finally
6125     quit_libPNG;
6126   end;
6127 end;
6128
6129 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6131 procedure TglBitmap.SavePNG(const aStream: TStream);
6132 var
6133   Png: TPNGObject;
6134
6135   pSource, pDest: pByte;
6136   X, Y, PixSize: Integer;
6137   ColorType: Cardinal;
6138   Alpha: Boolean;
6139
6140   pTemp: pByte;
6141   Temp: Byte;
6142 begin
6143   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6144     raise EglBitmapUnsupportedFormat.Create(Format);
6145
6146   case Format of
6147     tfAlpha8, tfLuminance8: begin
6148       ColorType := COLOR_GRAYSCALE;
6149       PixSize   := 1;
6150       Alpha     := false;
6151     end;
6152     tfLuminance8Alpha8: begin
6153       ColorType := COLOR_GRAYSCALEALPHA;
6154       PixSize   := 1;
6155       Alpha     := true;
6156     end;
6157     tfBGR8, tfRGB8: begin
6158       ColorType := COLOR_RGB;
6159       PixSize   := 3;
6160       Alpha     := false;
6161     end;
6162     tfBGRA8, tfRGBA8: begin
6163       ColorType := COLOR_RGBALPHA;
6164       PixSize   := 3;
6165       Alpha     := true
6166     end;
6167   else
6168     raise EglBitmapUnsupportedFormat.Create(Format);
6169   end;
6170
6171   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6172   try
6173     // Copy ImageData
6174     pSource := Data;
6175     for Y := 0 to Height -1 do begin
6176       pDest := png.ScanLine[Y];
6177       for X := 0 to Width -1 do begin
6178         Move(pSource^, pDest^, PixSize);
6179         Inc(pDest, PixSize);
6180         Inc(pSource, PixSize);
6181         if Alpha then begin
6182           png.AlphaScanline[Y]^[X] := pSource^;
6183           Inc(pSource);
6184         end;
6185       end;
6186
6187       // convert RGB line to BGR
6188       if Format in [tfRGB8, tfRGBA8] then begin
6189         pTemp := png.ScanLine[Y];
6190         for X := 0 to Width -1 do begin
6191           Temp := pByteArray(pTemp)^[0];
6192           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6193           pByteArray(pTemp)^[2] := Temp;
6194           Inc(pTemp, 3);
6195         end;
6196       end;
6197     end;
6198
6199     // Save to Stream
6200     Png.CompressionLevel := 6;
6201     Png.SaveToStream(aStream);
6202   finally
6203     FreeAndNil(Png);
6204   end;
6205 end;
6206 {$IFEND}
6207 {$ENDIF}
6208
6209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6210 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6212 {$IFDEF GLB_LIB_JPEG}
6213 type
6214   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6215   glBitmap_libJPEG_source_mgr = record
6216     pub: jpeg_source_mgr;
6217
6218     SrcStream: TStream;
6219     SrcBuffer: array [1..4096] of byte;
6220   end;
6221
6222   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6223   glBitmap_libJPEG_dest_mgr = record
6224     pub: jpeg_destination_mgr;
6225
6226     DestStream: TStream;
6227     DestBuffer: array [1..4096] of byte;
6228   end;
6229
6230 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6231 begin
6232   //DUMMY
6233 end;
6234
6235
6236 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6237 begin
6238   //DUMMY
6239 end;
6240
6241
6242 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6243 begin
6244   //DUMMY
6245 end;
6246
6247 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6248 begin
6249   //DUMMY
6250 end;
6251
6252
6253 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6254 begin
6255   //DUMMY
6256 end;
6257
6258
6259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6260 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6261 var
6262   src: glBitmap_libJPEG_source_mgr_ptr;
6263   bytes: integer;
6264 begin
6265   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6266
6267   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6268         if (bytes <= 0) then begin
6269                 src^.SrcBuffer[1] := $FF;
6270                 src^.SrcBuffer[2] := JPEG_EOI;
6271                 bytes := 2;
6272         end;
6273
6274         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6275         src^.pub.bytes_in_buffer := bytes;
6276
6277   result := true;
6278 end;
6279
6280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6281 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6282 var
6283   src: glBitmap_libJPEG_source_mgr_ptr;
6284 begin
6285   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6286
6287   if num_bytes > 0 then begin
6288     // wanted byte isn't in buffer so set stream position and read buffer
6289     if num_bytes > src^.pub.bytes_in_buffer then begin
6290       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6291       src^.pub.fill_input_buffer(cinfo);
6292     end else begin
6293       // wanted byte is in buffer so only skip
6294                 inc(src^.pub.next_input_byte, num_bytes);
6295                 dec(src^.pub.bytes_in_buffer, num_bytes);
6296     end;
6297   end;
6298 end;
6299
6300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6301 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6302 var
6303   dest: glBitmap_libJPEG_dest_mgr_ptr;
6304 begin
6305   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6306
6307   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6308     // write complete buffer
6309     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6310
6311     // reset buffer
6312     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6313     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6314   end;
6315
6316   result := true;
6317 end;
6318
6319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6320 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6321 var
6322   Idx: Integer;
6323   dest: glBitmap_libJPEG_dest_mgr_ptr;
6324 begin
6325   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6326
6327   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6328     // check for endblock
6329     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6330       // write endblock
6331       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6332
6333       // leave
6334       break;
6335     end else
6336       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6337   end;
6338 end;
6339 {$ENDIF}
6340
6341 {$IFDEF GLB_SUPPORT_JPEG_READ}
6342 {$IF DEFINED(GLB_LAZ_JPEG)}
6343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6344 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6345 const
6346   MAGIC_LEN = 2;
6347   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6348 var
6349   jpeg: TJPEGImage;
6350   intf: TLazIntfImage;
6351   StreamPos: Int64;
6352   magic: String[MAGIC_LEN];
6353 begin
6354   result := true;
6355   StreamPos := aStream.Position;
6356
6357   SetLength(magic, MAGIC_LEN);
6358   aStream.Read(magic[1], MAGIC_LEN);
6359   aStream.Position := StreamPos;
6360   if (magic <> JPEG_MAGIC) then begin
6361     result := false;
6362     exit;
6363   end;
6364
6365   jpeg := TJPEGImage.Create;
6366   try try
6367     jpeg.LoadFromStream(aStream);
6368     intf := TLazIntfImage.Create(0, 0);
6369     try try
6370       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6371       AssignFromLazIntfImage(intf);
6372     except
6373       result := false;
6374       aStream.Position := StreamPos;
6375       exit;
6376     end;
6377     finally
6378       intf.Free;
6379     end;
6380   except
6381     result := false;
6382     aStream.Position := StreamPos;
6383     exit;
6384   end;
6385   finally
6386     jpeg.Free;
6387   end;
6388 end;
6389
6390 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6392 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6393 var
6394   Surface: PSDL_Surface;
6395   RWops: PSDL_RWops;
6396 begin
6397   result := false;
6398
6399   RWops := glBitmapCreateRWops(aStream);
6400   try
6401     if IMG_isJPG(RWops) > 0 then begin
6402       Surface := IMG_LoadJPG_RW(RWops);
6403       try
6404         AssignFromSurface(Surface);
6405         result := true;
6406       finally
6407         SDL_FreeSurface(Surface);
6408       end;
6409     end;
6410   finally
6411     SDL_FreeRW(RWops);
6412   end;
6413 end;
6414
6415 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6417 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6418 var
6419   StreamPos: Int64;
6420   Temp: array[0..1]of Byte;
6421
6422   jpeg: jpeg_decompress_struct;
6423   jpeg_err: jpeg_error_mgr;
6424
6425   IntFormat: TglBitmapFormat;
6426   pImage: pByte;
6427   TempHeight, TempWidth: Integer;
6428
6429   pTemp: pByte;
6430   Row: Integer;
6431
6432   FormatDesc: TFormatDescriptor;
6433 begin
6434   result := false;
6435
6436   if not init_libJPEG then
6437     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6438
6439   try
6440     // reading first two bytes to test file and set cursor back to begin
6441     StreamPos := aStream.Position;
6442     aStream.Read({%H-}Temp[0], 2);
6443     aStream.Position := StreamPos;
6444
6445     // if Bitmap then read file.
6446     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6447       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6448       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6449
6450       // error managment
6451       jpeg.err := jpeg_std_error(@jpeg_err);
6452       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6453       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6454
6455       // decompression struct
6456       jpeg_create_decompress(@jpeg);
6457
6458       // allocation space for streaming methods
6459       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6460
6461       // seeting up custom functions
6462       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6463         pub.init_source       := glBitmap_libJPEG_init_source;
6464         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6465         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6466         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6467         pub.term_source       := glBitmap_libJPEG_term_source;
6468
6469         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6470         pub.next_input_byte := nil;   // until buffer loaded
6471
6472         SrcStream := aStream;
6473       end;
6474
6475       // set global decoding state
6476       jpeg.global_state := DSTATE_START;
6477
6478       // read header of jpeg
6479       jpeg_read_header(@jpeg, false);
6480
6481       // setting output parameter
6482       case jpeg.jpeg_color_space of
6483         JCS_GRAYSCALE:
6484           begin
6485             jpeg.out_color_space := JCS_GRAYSCALE;
6486             IntFormat := tfLuminance8;
6487           end;
6488         else
6489           jpeg.out_color_space := JCS_RGB;
6490           IntFormat := tfRGB8;
6491       end;
6492
6493       // reading image
6494       jpeg_start_decompress(@jpeg);
6495
6496       TempHeight := jpeg.output_height;
6497       TempWidth := jpeg.output_width;
6498
6499       FormatDesc := TFormatDescriptor.Get(IntFormat);
6500
6501       // creating new image
6502       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6503       try
6504         pTemp := pImage;
6505
6506         for Row := 0 to TempHeight -1 do begin
6507           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6508           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6509         end;
6510
6511         // finish decompression
6512         jpeg_finish_decompress(@jpeg);
6513
6514         // destroy decompression
6515         jpeg_destroy_decompress(@jpeg);
6516
6517         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6518
6519         result := true;
6520       except
6521         if Assigned(pImage) then
6522           FreeMem(pImage);
6523         raise;
6524       end;
6525     end;
6526   finally
6527     quit_libJPEG;
6528   end;
6529 end;
6530
6531 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6533 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6534 var
6535   bmp: TBitmap;
6536   jpg: TJPEGImage;
6537   StreamPos: Int64;
6538   Temp: array[0..1]of Byte;
6539 begin
6540   result := false;
6541
6542   // reading first two bytes to test file and set cursor back to begin
6543   StreamPos := aStream.Position;
6544   aStream.Read(Temp[0], 2);
6545   aStream.Position := StreamPos;
6546
6547   // if Bitmap then read file.
6548   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6549     bmp := TBitmap.Create;
6550     try
6551       jpg := TJPEGImage.Create;
6552       try
6553         jpg.LoadFromStream(aStream);
6554         bmp.Assign(jpg);
6555         result := AssignFromBitmap(bmp);
6556       finally
6557         jpg.Free;
6558       end;
6559     finally
6560       bmp.Free;
6561     end;
6562   end;
6563 end;
6564 {$IFEND}
6565 {$ENDIF}
6566
6567 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6568 {$IF DEFINED(GLB_LAZ_JPEG)}
6569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6570 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6571 var
6572   jpeg: TJPEGImage;
6573   intf: TLazIntfImage;
6574   raw: TRawImage;
6575 begin
6576   jpeg := TJPEGImage.Create;
6577   intf := TLazIntfImage.Create(0, 0);
6578   try
6579     if not AssignToLazIntfImage(intf) then
6580       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6581     intf.GetRawImage(raw);
6582     jpeg.LoadFromRawImage(raw, false);
6583     jpeg.SaveToStream(aStream);
6584   finally
6585     intf.Free;
6586     jpeg.Free;
6587   end;
6588 end;
6589
6590 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6592 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6593 var
6594   jpeg: jpeg_compress_struct;
6595   jpeg_err: jpeg_error_mgr;
6596   Row: Integer;
6597   pTemp, pTemp2: pByte;
6598
6599   procedure CopyRow(pDest, pSource: pByte);
6600   var
6601     X: Integer;
6602   begin
6603     for X := 0 to Width - 1 do begin
6604       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6605       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6606       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6607       Inc(pDest, 3);
6608       Inc(pSource, 3);
6609     end;
6610   end;
6611
6612 begin
6613   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6614     raise EglBitmapUnsupportedFormat.Create(Format);
6615
6616   if not init_libJPEG then
6617     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6618
6619   try
6620     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6621     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6622
6623     // error managment
6624     jpeg.err := jpeg_std_error(@jpeg_err);
6625     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6626     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6627
6628     // compression struct
6629     jpeg_create_compress(@jpeg);
6630
6631     // allocation space for streaming methods
6632     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6633
6634     // seeting up custom functions
6635     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6636       pub.init_destination    := glBitmap_libJPEG_init_destination;
6637       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6638       pub.term_destination    := glBitmap_libJPEG_term_destination;
6639
6640       pub.next_output_byte  := @DestBuffer[1];
6641       pub.free_in_buffer    := Length(DestBuffer);
6642
6643       DestStream := aStream;
6644     end;
6645
6646     // very important state
6647     jpeg.global_state := CSTATE_START;
6648     jpeg.image_width  := Width;
6649     jpeg.image_height := Height;
6650     case Format of
6651       tfAlpha8, tfLuminance8: begin
6652         jpeg.input_components := 1;
6653         jpeg.in_color_space   := JCS_GRAYSCALE;
6654       end;
6655       tfRGB8, tfBGR8: begin
6656         jpeg.input_components := 3;
6657         jpeg.in_color_space   := JCS_RGB;
6658       end;
6659     end;
6660
6661     jpeg_set_defaults(@jpeg);
6662     jpeg_set_quality(@jpeg, 95, true);
6663     jpeg_start_compress(@jpeg, true);
6664     pTemp := Data;
6665
6666     if Format = tfBGR8 then
6667       GetMem(pTemp2, fRowSize)
6668     else
6669       pTemp2 := pTemp;
6670
6671     try
6672       for Row := 0 to jpeg.image_height -1 do begin
6673         // prepare row
6674         if Format = tfBGR8 then
6675           CopyRow(pTemp2, pTemp)
6676         else
6677           pTemp2 := pTemp;
6678
6679         // write row
6680         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6681         inc(pTemp, fRowSize);
6682       end;
6683     finally
6684       // free memory
6685       if Format = tfBGR8 then
6686         FreeMem(pTemp2);
6687     end;
6688     jpeg_finish_compress(@jpeg);
6689     jpeg_destroy_compress(@jpeg);
6690   finally
6691     quit_libJPEG;
6692   end;
6693 end;
6694
6695 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6697 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6698 var
6699   Bmp: TBitmap;
6700   Jpg: TJPEGImage;
6701 begin
6702   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6703     raise EglBitmapUnsupportedFormat.Create(Format);
6704
6705   Bmp := TBitmap.Create;
6706   try
6707     Jpg := TJPEGImage.Create;
6708     try
6709       AssignToBitmap(Bmp);
6710       if (Format in [tfAlpha8, tfLuminance8]) then begin
6711         Jpg.Grayscale   := true;
6712         Jpg.PixelFormat := jf8Bit;
6713       end;
6714       Jpg.Assign(Bmp);
6715       Jpg.SaveToStream(aStream);
6716     finally
6717       FreeAndNil(Jpg);
6718     end;
6719   finally
6720     FreeAndNil(Bmp);
6721   end;
6722 end;
6723 {$IFEND}
6724 {$ENDIF}
6725
6726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6727 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6729 const
6730   BMP_MAGIC          = $4D42;
6731
6732   BMP_COMP_RGB       = 0;
6733   BMP_COMP_RLE8      = 1;
6734   BMP_COMP_RLE4      = 2;
6735   BMP_COMP_BITFIELDS = 3;
6736
6737 type
6738   TBMPHeader = packed record
6739     bfType: Word;
6740     bfSize: Cardinal;
6741     bfReserved1: Word;
6742     bfReserved2: Word;
6743     bfOffBits: Cardinal;
6744   end;
6745
6746   TBMPInfo = packed record
6747     biSize: Cardinal;
6748     biWidth: Longint;
6749     biHeight: Longint;
6750     biPlanes: Word;
6751     biBitCount: Word;
6752     biCompression: Cardinal;
6753     biSizeImage: Cardinal;
6754     biXPelsPerMeter: Longint;
6755     biYPelsPerMeter: Longint;
6756     biClrUsed: Cardinal;
6757     biClrImportant: Cardinal;
6758   end;
6759
6760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6761 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6762
6763   //////////////////////////////////////////////////////////////////////////////////////////////////
6764   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6765   begin
6766     result := tfEmpty;
6767     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6768     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6769
6770     //Read Compression
6771     case aInfo.biCompression of
6772       BMP_COMP_RLE4,
6773       BMP_COMP_RLE8: begin
6774         raise EglBitmap.Create('RLE compression is not supported');
6775       end;
6776       BMP_COMP_BITFIELDS: begin
6777         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6778           aStream.Read(aMask.r, SizeOf(aMask.r));
6779           aStream.Read(aMask.g, SizeOf(aMask.g));
6780           aStream.Read(aMask.b, SizeOf(aMask.b));
6781           aStream.Read(aMask.a, SizeOf(aMask.a));
6782         end else
6783           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6784       end;
6785     end;
6786
6787     //get suitable format
6788     case aInfo.biBitCount of
6789        8: result := tfLuminance8;
6790       16: result := tfBGR5;
6791       24: result := tfBGR8;
6792       32: result := tfBGRA8;
6793     end;
6794   end;
6795
6796   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6797   var
6798     i, c: Integer;
6799     ColorTable: TbmpColorTable;
6800   begin
6801     result := nil;
6802     if (aInfo.biBitCount >= 16) then
6803       exit;
6804     aFormat := tfLuminance8;
6805     c := aInfo.biClrUsed;
6806     if (c = 0) then
6807       c := 1 shl aInfo.biBitCount;
6808     SetLength(ColorTable, c);
6809     for i := 0 to c-1 do begin
6810       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6811       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6812         aFormat := tfRGB8;
6813     end;
6814
6815     result := TbmpColorTableFormat.Create;
6816     result.PixelSize  := aInfo.biBitCount / 8;
6817     result.ColorTable := ColorTable;
6818     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6819   end;
6820
6821   //////////////////////////////////////////////////////////////////////////////////////////////////
6822   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6823     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6824   var
6825     TmpFormat: TglBitmapFormat;
6826     FormatDesc: TFormatDescriptor;
6827   begin
6828     result := nil;
6829     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6830       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6831         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6832         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6833           aFormat := FormatDesc.Format;
6834           exit;
6835         end;
6836       end;
6837
6838       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6839         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6840       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6841         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6842
6843       result := TbmpBitfieldFormat.Create;
6844       result.PixelSize := aInfo.biBitCount / 8;
6845       result.RedMask   := aMask.r;
6846       result.GreenMask := aMask.g;
6847       result.BlueMask  := aMask.b;
6848       result.AlphaMask := aMask.a;
6849     end;
6850   end;
6851
6852 var
6853   //simple types
6854   StartPos: Int64;
6855   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6856   PaddingBuff: Cardinal;
6857   LineBuf, ImageData, TmpData: PByte;
6858   SourceMD, DestMD: Pointer;
6859   BmpFormat: TglBitmapFormat;
6860
6861   //records
6862   Mask: TglBitmapColorRec;
6863   Header: TBMPHeader;
6864   Info: TBMPInfo;
6865
6866   //classes
6867   SpecialFormat: TFormatDescriptor;
6868   FormatDesc: TFormatDescriptor;
6869
6870   //////////////////////////////////////////////////////////////////////////////////////////////////
6871   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6872   var
6873     i: Integer;
6874     Pixel: TglBitmapPixelData;
6875   begin
6876     aStream.Read(aLineBuf^, rbLineSize);
6877     SpecialFormat.PreparePixel(Pixel);
6878     for i := 0 to Info.biWidth-1 do begin
6879       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6880       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6881       FormatDesc.Map(Pixel, aData, DestMD);
6882     end;
6883   end;
6884
6885 begin
6886   result        := false;
6887   BmpFormat     := tfEmpty;
6888   SpecialFormat := nil;
6889   LineBuf       := nil;
6890   SourceMD      := nil;
6891   DestMD        := nil;
6892
6893   // Header
6894   StartPos := aStream.Position;
6895   aStream.Read(Header{%H-}, SizeOf(Header));
6896
6897   if Header.bfType = BMP_MAGIC then begin
6898     try try
6899       BmpFormat        := ReadInfo(Info, Mask);
6900       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6901       if not Assigned(SpecialFormat) then
6902         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6903       aStream.Position := StartPos + Header.bfOffBits;
6904
6905       if (BmpFormat <> tfEmpty) then begin
6906         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6907         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6908         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6909         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6910
6911         //get Memory
6912         DestMD    := FormatDesc.CreateMappingData;
6913         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6914         GetMem(ImageData, ImageSize);
6915         if Assigned(SpecialFormat) then begin
6916           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6917           SourceMD := SpecialFormat.CreateMappingData;
6918         end;
6919
6920         //read Data
6921         try try
6922           FillChar(ImageData^, ImageSize, $FF);
6923           TmpData := ImageData;
6924           if (Info.biHeight > 0) then
6925             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6926           for i := 0 to Abs(Info.biHeight)-1 do begin
6927             if Assigned(SpecialFormat) then
6928               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6929             else
6930               aStream.Read(TmpData^, wbLineSize);   //else only read data
6931             if (Info.biHeight > 0) then
6932               dec(TmpData, wbLineSize)
6933             else
6934               inc(TmpData, wbLineSize);
6935             aStream.Read(PaddingBuff{%H-}, Padding);
6936           end;
6937           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6938           result := true;
6939         finally
6940           if Assigned(LineBuf) then
6941             FreeMem(LineBuf);
6942           if Assigned(SourceMD) then
6943             SpecialFormat.FreeMappingData(SourceMD);
6944           FormatDesc.FreeMappingData(DestMD);
6945         end;
6946         except
6947           if Assigned(ImageData) then
6948             FreeMem(ImageData);
6949           raise;
6950         end;
6951       end else
6952         raise EglBitmap.Create('LoadBMP - No suitable format found');
6953     except
6954       aStream.Position := StartPos;
6955       raise;
6956     end;
6957     finally
6958       FreeAndNil(SpecialFormat);
6959     end;
6960   end
6961     else aStream.Position := StartPos;
6962 end;
6963
6964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6965 procedure TglBitmap.SaveBMP(const aStream: TStream);
6966 var
6967   Header: TBMPHeader;
6968   Info: TBMPInfo;
6969   Converter: TFormatDescriptor;
6970   FormatDesc: TFormatDescriptor;
6971   SourceFD, DestFD: Pointer;
6972   pData, srcData, dstData, ConvertBuffer: pByte;
6973
6974   Pixel: TglBitmapPixelData;
6975   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6976   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6977
6978   PaddingBuff: Cardinal;
6979
6980   function GetLineWidth : Integer;
6981   begin
6982     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6983   end;
6984
6985 begin
6986   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6987     raise EglBitmapUnsupportedFormat.Create(Format);
6988
6989   Converter  := nil;
6990   FormatDesc := TFormatDescriptor.Get(Format);
6991   ImageSize  := FormatDesc.GetSize(Dimension);
6992
6993   FillChar(Header{%H-}, SizeOf(Header), 0);
6994   Header.bfType      := BMP_MAGIC;
6995   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6996   Header.bfReserved1 := 0;
6997   Header.bfReserved2 := 0;
6998   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6999
7000   FillChar(Info{%H-}, SizeOf(Info), 0);
7001   Info.biSize        := SizeOf(Info);
7002   Info.biWidth       := Width;
7003   Info.biHeight      := Height;
7004   Info.biPlanes      := 1;
7005   Info.biCompression := BMP_COMP_RGB;
7006   Info.biSizeImage   := ImageSize;
7007
7008   try
7009     case Format of
7010       tfLuminance4: begin
7011         Info.biBitCount  := 4;
7012         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7013         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7014         Converter := TbmpColorTableFormat.Create;
7015         with (Converter as TbmpColorTableFormat) do begin
7016           PixelSize := 0.5;
7017           Format    := Format;
7018           Range     := glBitmapColorRec($F, $F, $F, $0);
7019           CreateColorTable;
7020         end;
7021       end;
7022
7023       tfR3G3B2, tfLuminance8: begin
7024         Info.biBitCount  :=  8;
7025         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7026         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7027         Converter := TbmpColorTableFormat.Create;
7028         with (Converter as TbmpColorTableFormat) do begin
7029           PixelSize := 1;
7030           Format    := Format;
7031           if (Format = tfR3G3B2) then begin
7032             Range := glBitmapColorRec($7, $7, $3, $0);
7033             Shift := glBitmapShiftRec(0, 3, 6, 0);
7034           end else
7035             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7036           CreateColorTable;
7037         end;
7038       end;
7039
7040       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7041       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7042         Info.biBitCount    := 16;
7043         Info.biCompression := BMP_COMP_BITFIELDS;
7044       end;
7045
7046       tfBGR8, tfRGB8: begin
7047         Info.biBitCount := 24;
7048         if (Format = tfRGB8) then
7049           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7050       end;
7051
7052       tfRGB10, tfRGB10A2, tfRGBA8,
7053       tfBGR10, tfBGR10A2, tfBGRA8: begin
7054         Info.biBitCount    := 32;
7055         Info.biCompression := BMP_COMP_BITFIELDS;
7056       end;
7057     else
7058       raise EglBitmapUnsupportedFormat.Create(Format);
7059     end;
7060     Info.biXPelsPerMeter := 2835;
7061     Info.biYPelsPerMeter := 2835;
7062
7063     // prepare bitmasks
7064     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7065       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7066       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7067
7068       RedMask    := FormatDesc.RedMask;
7069       GreenMask  := FormatDesc.GreenMask;
7070       BlueMask   := FormatDesc.BlueMask;
7071       AlphaMask  := FormatDesc.AlphaMask;
7072     end;
7073
7074     // headers
7075     aStream.Write(Header, SizeOf(Header));
7076     aStream.Write(Info, SizeOf(Info));
7077
7078     // colortable
7079     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7080       with (Converter as TbmpColorTableFormat) do
7081         aStream.Write(ColorTable[0].b,
7082           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7083
7084     // bitmasks
7085     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7086       aStream.Write(RedMask,   SizeOf(Cardinal));
7087       aStream.Write(GreenMask, SizeOf(Cardinal));
7088       aStream.Write(BlueMask,  SizeOf(Cardinal));
7089       aStream.Write(AlphaMask, SizeOf(Cardinal));
7090     end;
7091
7092     // image data
7093     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7094     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7095     Padding     := GetLineWidth - wbLineSize;
7096     PaddingBuff := 0;
7097
7098     pData := Data;
7099     inc(pData, (Height-1) * rbLineSize);
7100
7101     // prepare row buffer. But only for RGB because RGBA supports color masks
7102     // so it's possible to change color within the image.
7103     if Assigned(Converter) then begin
7104       FormatDesc.PreparePixel(Pixel);
7105       GetMem(ConvertBuffer, wbLineSize);
7106       SourceFD := FormatDesc.CreateMappingData;
7107       DestFD   := Converter.CreateMappingData;
7108     end else
7109       ConvertBuffer := nil;
7110
7111     try
7112       for LineIdx := 0 to Height - 1 do begin
7113         // preparing row
7114         if Assigned(Converter) then begin
7115           srcData := pData;
7116           dstData := ConvertBuffer;
7117           for PixelIdx := 0 to Info.biWidth-1 do begin
7118             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7119             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7120             Converter.Map(Pixel, dstData, DestFD);
7121           end;
7122           aStream.Write(ConvertBuffer^, wbLineSize);
7123         end else begin
7124           aStream.Write(pData^, rbLineSize);
7125         end;
7126         dec(pData, rbLineSize);
7127         if (Padding > 0) then
7128           aStream.Write(PaddingBuff, Padding);
7129       end;
7130     finally
7131       // destroy row buffer
7132       if Assigned(ConvertBuffer) then begin
7133         FormatDesc.FreeMappingData(SourceFD);
7134         Converter.FreeMappingData(DestFD);
7135         FreeMem(ConvertBuffer);
7136       end;
7137     end;
7138   finally
7139     if Assigned(Converter) then
7140       Converter.Free;
7141   end;
7142 end;
7143
7144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7145 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7147 type
7148   TTGAHeader = packed record
7149     ImageID: Byte;
7150     ColorMapType: Byte;
7151     ImageType: Byte;
7152     //ColorMapSpec: Array[0..4] of Byte;
7153     ColorMapStart: Word;
7154     ColorMapLength: Word;
7155     ColorMapEntrySize: Byte;
7156     OrigX: Word;
7157     OrigY: Word;
7158     Width: Word;
7159     Height: Word;
7160     Bpp: Byte;
7161     ImageDesc: Byte;
7162   end;
7163
7164 const
7165   TGA_UNCOMPRESSED_RGB  =  2;
7166   TGA_UNCOMPRESSED_GRAY =  3;
7167   TGA_COMPRESSED_RGB    = 10;
7168   TGA_COMPRESSED_GRAY   = 11;
7169
7170   TGA_NONE_COLOR_TABLE  = 0;
7171
7172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7173 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7174 var
7175   Header: TTGAHeader;
7176   ImageData: System.PByte;
7177   StartPosition: Int64;
7178   PixelSize, LineSize: Integer;
7179   tgaFormat: TglBitmapFormat;
7180   FormatDesc: TFormatDescriptor;
7181   Counter: packed record
7182     X, Y: packed record
7183       low, high, dir: Integer;
7184     end;
7185   end;
7186
7187 const
7188   CACHE_SIZE = $4000;
7189
7190   ////////////////////////////////////////////////////////////////////////////////////////
7191   procedure ReadUncompressed;
7192   var
7193     i, j: Integer;
7194     buf, tmp1, tmp2: System.PByte;
7195   begin
7196     buf := nil;
7197     if (Counter.X.dir < 0) then
7198       GetMem(buf, LineSize);
7199     try
7200       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7201         tmp1 := ImageData;
7202         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7203         if (Counter.X.dir < 0) then begin               //flip X
7204           aStream.Read(buf^, LineSize);
7205           tmp2 := buf;
7206           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7207           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7208             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7209               tmp1^ := tmp2^;
7210               inc(tmp1);
7211               inc(tmp2);
7212             end;
7213             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7214           end;
7215         end else
7216           aStream.Read(tmp1^, LineSize);
7217         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7218       end;
7219     finally
7220       if Assigned(buf) then
7221         FreeMem(buf);
7222     end;
7223   end;
7224
7225   ////////////////////////////////////////////////////////////////////////////////////////
7226   procedure ReadCompressed;
7227
7228     /////////////////////////////////////////////////////////////////
7229     var
7230       TmpData: System.PByte;
7231       LinePixelsRead: Integer;
7232     procedure CheckLine;
7233     begin
7234       if (LinePixelsRead >= Header.Width) then begin
7235         LinePixelsRead := 0;
7236         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7237         TmpData := ImageData;
7238         inc(TmpData, Counter.Y.low * LineSize);           //set line
7239         if (Counter.X.dir < 0) then                       //if x flipped then
7240           inc(TmpData, LineSize - PixelSize);             //set last pixel
7241       end;
7242     end;
7243
7244     /////////////////////////////////////////////////////////////////
7245     var
7246       Cache: PByte;
7247       CacheSize, CachePos: Integer;
7248     procedure CachedRead(out Buffer; Count: Integer);
7249     var
7250       BytesRead: Integer;
7251     begin
7252       if (CachePos + Count > CacheSize) then begin
7253         //if buffer overflow save non read bytes
7254         BytesRead := 0;
7255         if (CacheSize - CachePos > 0) then begin
7256           BytesRead := CacheSize - CachePos;
7257           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7258           inc(CachePos, BytesRead);
7259         end;
7260
7261         //load cache from file
7262         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7263         aStream.Read(Cache^, CacheSize);
7264         CachePos := 0;
7265
7266         //read rest of requested bytes
7267         if (Count - BytesRead > 0) then begin
7268           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7269           inc(CachePos, Count - BytesRead);
7270         end;
7271       end else begin
7272         //if no buffer overflow just read the data
7273         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7274         inc(CachePos, Count);
7275       end;
7276     end;
7277
7278     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7279     begin
7280       case PixelSize of
7281         1: begin
7282           aBuffer^ := aData^;
7283           inc(aBuffer, Counter.X.dir);
7284         end;
7285         2: begin
7286           PWord(aBuffer)^ := PWord(aData)^;
7287           inc(aBuffer, 2 * Counter.X.dir);
7288         end;
7289         3: begin
7290           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7291           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7292           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7293           inc(aBuffer, 3 * Counter.X.dir);
7294         end;
7295         4: begin
7296           PCardinal(aBuffer)^ := PCardinal(aData)^;
7297           inc(aBuffer, 4 * Counter.X.dir);
7298         end;
7299       end;
7300     end;
7301
7302   var
7303     TotalPixelsToRead, TotalPixelsRead: Integer;
7304     Temp: Byte;
7305     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7306     PixelRepeat: Boolean;
7307     PixelsToRead, PixelCount: Integer;
7308   begin
7309     CacheSize := 0;
7310     CachePos  := 0;
7311
7312     TotalPixelsToRead := Header.Width * Header.Height;
7313     TotalPixelsRead   := 0;
7314     LinePixelsRead    := 0;
7315
7316     GetMem(Cache, CACHE_SIZE);
7317     try
7318       TmpData := ImageData;
7319       inc(TmpData, Counter.Y.low * LineSize);           //set line
7320       if (Counter.X.dir < 0) then                       //if x flipped then
7321         inc(TmpData, LineSize - PixelSize);             //set last pixel
7322
7323       repeat
7324         //read CommandByte
7325         CachedRead(Temp, 1);
7326         PixelRepeat  := (Temp and $80) > 0;
7327         PixelsToRead := (Temp and $7F) + 1;
7328         inc(TotalPixelsRead, PixelsToRead);
7329
7330         if PixelRepeat then
7331           CachedRead(buf[0], PixelSize);
7332         while (PixelsToRead > 0) do begin
7333           CheckLine;
7334           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7335           while (PixelCount > 0) do begin
7336             if not PixelRepeat then
7337               CachedRead(buf[0], PixelSize);
7338             PixelToBuffer(@buf[0], TmpData);
7339             inc(LinePixelsRead);
7340             dec(PixelsToRead);
7341             dec(PixelCount);
7342           end;
7343         end;
7344       until (TotalPixelsRead >= TotalPixelsToRead);
7345     finally
7346       FreeMem(Cache);
7347     end;
7348   end;
7349
7350   function IsGrayFormat: Boolean;
7351   begin
7352     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7353   end;
7354
7355 begin
7356   result := false;
7357
7358   // reading header to test file and set cursor back to begin
7359   StartPosition := aStream.Position;
7360   aStream.Read(Header{%H-}, SizeOf(Header));
7361
7362   // no colormapped files
7363   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7364     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7365   begin
7366     try
7367       if Header.ImageID <> 0 then       // skip image ID
7368         aStream.Position := aStream.Position + Header.ImageID;
7369
7370       tgaFormat := tfEmpty;
7371       case Header.Bpp of
7372          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7373                0: tgaFormat := tfLuminance8;
7374                8: tgaFormat := tfAlpha8;
7375             end;
7376
7377         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7378                0: tgaFormat := tfLuminance16;
7379                8: tgaFormat := tfLuminance8Alpha8;
7380             end else case (Header.ImageDesc and $F) of
7381                0: tgaFormat := tfBGR5;
7382                1: tgaFormat := tfBGR5A1;
7383                4: tgaFormat := tfBGRA4;
7384             end;
7385
7386         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7387                0: tgaFormat := tfBGR8;
7388             end;
7389
7390         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7391                2: tgaFormat := tfBGR10A2;
7392                8: tgaFormat := tfBGRA8;
7393             end;
7394       end;
7395
7396       if (tgaFormat = tfEmpty) then
7397         raise EglBitmap.Create('LoadTga - unsupported format');
7398
7399       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7400       PixelSize  := FormatDesc.GetSize(1, 1);
7401       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7402
7403       GetMem(ImageData, LineSize * Header.Height);
7404       try
7405         //column direction
7406         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7407           Counter.X.low  := Header.Height-1;;
7408           Counter.X.high := 0;
7409           Counter.X.dir  := -1;
7410         end else begin
7411           Counter.X.low  := 0;
7412           Counter.X.high := Header.Height-1;
7413           Counter.X.dir  := 1;
7414         end;
7415
7416         // Row direction
7417         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7418           Counter.Y.low  := 0;
7419           Counter.Y.high := Header.Height-1;
7420           Counter.Y.dir  := 1;
7421         end else begin
7422           Counter.Y.low  := Header.Height-1;;
7423           Counter.Y.high := 0;
7424           Counter.Y.dir  := -1;
7425         end;
7426
7427         // Read Image
7428         case Header.ImageType of
7429           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7430             ReadUncompressed;
7431           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7432             ReadCompressed;
7433         end;
7434
7435         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7436         result := true;
7437       except
7438         if Assigned(ImageData) then
7439           FreeMem(ImageData);
7440         raise;
7441       end;
7442     finally
7443       aStream.Position := StartPosition;
7444     end;
7445   end
7446     else aStream.Position := StartPosition;
7447 end;
7448
7449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7450 procedure TglBitmap.SaveTGA(const aStream: TStream);
7451 var
7452   Header: TTGAHeader;
7453   LineSize, Size, x, y: Integer;
7454   Pixel: TglBitmapPixelData;
7455   LineBuf, SourceData, DestData: PByte;
7456   SourceMD, DestMD: Pointer;
7457   FormatDesc: TFormatDescriptor;
7458   Converter: TFormatDescriptor;
7459 begin
7460   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7461     raise EglBitmapUnsupportedFormat.Create(Format);
7462
7463   //prepare header
7464   FillChar(Header{%H-}, SizeOf(Header), 0);
7465
7466   //set ImageType
7467   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7468                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7469     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7470   else
7471     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7472
7473   //set BitsPerPixel
7474   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7475     Header.Bpp := 8
7476   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7477                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7478     Header.Bpp := 16
7479   else if (Format in [tfBGR8, tfRGB8]) then
7480     Header.Bpp := 24
7481   else
7482     Header.Bpp := 32;
7483
7484   //set AlphaBitCount
7485   case Format of
7486     tfRGB5A1, tfBGR5A1:
7487       Header.ImageDesc := 1 and $F;
7488     tfRGB10A2, tfBGR10A2:
7489       Header.ImageDesc := 2 and $F;
7490     tfRGBA4, tfBGRA4:
7491       Header.ImageDesc := 4 and $F;
7492     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7493       Header.ImageDesc := 8 and $F;
7494   end;
7495
7496   Header.Width     := Width;
7497   Header.Height    := Height;
7498   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7499   aStream.Write(Header, SizeOf(Header));
7500
7501   // convert RGB(A) to BGR(A)
7502   Converter  := nil;
7503   FormatDesc := TFormatDescriptor.Get(Format);
7504   Size       := FormatDesc.GetSize(Dimension);
7505   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7506     if (FormatDesc.RGBInverted = tfEmpty) then
7507       raise EglBitmap.Create('inverted RGB format is empty');
7508     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7509     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7510        (Converter.PixelSize <> FormatDesc.PixelSize) then
7511       raise EglBitmap.Create('invalid inverted RGB format');
7512   end;
7513
7514   if Assigned(Converter) then begin
7515     LineSize := FormatDesc.GetSize(Width, 1);
7516     GetMem(LineBuf, LineSize);
7517     SourceMD := FormatDesc.CreateMappingData;
7518     DestMD   := Converter.CreateMappingData;
7519     try
7520       SourceData := Data;
7521       for y := 0 to Height-1 do begin
7522         DestData := LineBuf;
7523         for x := 0 to Width-1 do begin
7524           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7525           Converter.Map(Pixel, DestData, DestMD);
7526         end;
7527         aStream.Write(LineBuf^, LineSize);
7528       end;
7529     finally
7530       FreeMem(LineBuf);
7531       FormatDesc.FreeMappingData(SourceMD);
7532       FormatDesc.FreeMappingData(DestMD);
7533     end;
7534   end else
7535     aStream.Write(Data^, Size);
7536 end;
7537
7538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7539 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7541 const
7542   DDS_MAGIC: Cardinal         = $20534444;
7543
7544   // DDS_header.dwFlags
7545   DDSD_CAPS                   = $00000001;
7546   DDSD_HEIGHT                 = $00000002;
7547   DDSD_WIDTH                  = $00000004;
7548   DDSD_PIXELFORMAT            = $00001000;
7549
7550   // DDS_header.sPixelFormat.dwFlags
7551   DDPF_ALPHAPIXELS            = $00000001;
7552   DDPF_ALPHA                  = $00000002;
7553   DDPF_FOURCC                 = $00000004;
7554   DDPF_RGB                    = $00000040;
7555   DDPF_LUMINANCE              = $00020000;
7556
7557   // DDS_header.sCaps.dwCaps1
7558   DDSCAPS_TEXTURE             = $00001000;
7559
7560   // DDS_header.sCaps.dwCaps2
7561   DDSCAPS2_CUBEMAP            = $00000200;
7562
7563   D3DFMT_DXT1                 = $31545844;
7564   D3DFMT_DXT3                 = $33545844;
7565   D3DFMT_DXT5                 = $35545844;
7566
7567 type
7568   TDDSPixelFormat = packed record
7569     dwSize: Cardinal;
7570     dwFlags: Cardinal;
7571     dwFourCC: Cardinal;
7572     dwRGBBitCount: Cardinal;
7573     dwRBitMask: Cardinal;
7574     dwGBitMask: Cardinal;
7575     dwBBitMask: Cardinal;
7576     dwABitMask: Cardinal;
7577   end;
7578
7579   TDDSCaps = packed record
7580     dwCaps1: Cardinal;
7581     dwCaps2: Cardinal;
7582     dwDDSX: Cardinal;
7583     dwReserved: Cardinal;
7584   end;
7585
7586   TDDSHeader = packed record
7587     dwSize: Cardinal;
7588     dwFlags: Cardinal;
7589     dwHeight: Cardinal;
7590     dwWidth: Cardinal;
7591     dwPitchOrLinearSize: Cardinal;
7592     dwDepth: Cardinal;
7593     dwMipMapCount: Cardinal;
7594     dwReserved: array[0..10] of Cardinal;
7595     PixelFormat: TDDSPixelFormat;
7596     Caps: TDDSCaps;
7597     dwReserved2: Cardinal;
7598   end;
7599
7600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7601 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7602 var
7603   Header: TDDSHeader;
7604   Converter: TbmpBitfieldFormat;
7605
7606   function GetDDSFormat: TglBitmapFormat;
7607   var
7608     fd: TFormatDescriptor;
7609     i: Integer;
7610     Range: TglBitmapColorRec;
7611     match: Boolean;
7612   begin
7613     result := tfEmpty;
7614     with Header.PixelFormat do begin
7615       // Compresses
7616       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7617         case Header.PixelFormat.dwFourCC of
7618           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7619           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7620           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7621         end;
7622       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7623
7624         //find matching format
7625         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7626           fd := TFormatDescriptor.Get(result);
7627           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7628              (8 * fd.PixelSize = dwRGBBitCount) then
7629             exit;
7630         end;
7631
7632         //find format with same Range
7633         Range.r := dwRBitMask;
7634         Range.g := dwGBitMask;
7635         Range.b := dwBBitMask;
7636         Range.a := dwABitMask;
7637         for i := 0 to 3 do begin
7638           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7639             Range.arr[i] := Range.arr[i] shr 1;
7640         end;
7641         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7642           fd := TFormatDescriptor.Get(result);
7643           match := true;
7644           for i := 0 to 3 do
7645             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7646               match := false;
7647               break;
7648             end;
7649           if match then
7650             break;
7651         end;
7652
7653         //no format with same range found -> use default
7654         if (result = tfEmpty) then begin
7655           if (dwABitMask > 0) then
7656             result := tfBGRA8
7657           else
7658             result := tfBGR8;
7659         end;
7660
7661         Converter := TbmpBitfieldFormat.Create;
7662         Converter.RedMask   := dwRBitMask;
7663         Converter.GreenMask := dwGBitMask;
7664         Converter.BlueMask  := dwBBitMask;
7665         Converter.AlphaMask := dwABitMask;
7666         Converter.PixelSize := dwRGBBitCount / 8;
7667       end;
7668     end;
7669   end;
7670
7671 var
7672   StreamPos: Int64;
7673   x, y, LineSize, RowSize, Magic: Cardinal;
7674   NewImage, TmpData, RowData, SrcData: System.PByte;
7675   SourceMD, DestMD: Pointer;
7676   Pixel: TglBitmapPixelData;
7677   ddsFormat: TglBitmapFormat;
7678   FormatDesc: TFormatDescriptor;
7679
7680 begin
7681   result    := false;
7682   Converter := nil;
7683   StreamPos := aStream.Position;
7684
7685   // Magic
7686   aStream.Read(Magic{%H-}, sizeof(Magic));
7687   if (Magic <> DDS_MAGIC) then begin
7688     aStream.Position := StreamPos;
7689     exit;
7690   end;
7691
7692   //Header
7693   aStream.Read(Header{%H-}, sizeof(Header));
7694   if (Header.dwSize <> SizeOf(Header)) or
7695      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7696         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7697   begin
7698     aStream.Position := StreamPos;
7699     exit;
7700   end;
7701
7702   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7703     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7704
7705   ddsFormat := GetDDSFormat;
7706   try
7707     if (ddsFormat = tfEmpty) then
7708       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7709
7710     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7711     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7712     GetMem(NewImage, Header.dwHeight * LineSize);
7713     try
7714       TmpData := NewImage;
7715
7716       //Converter needed
7717       if Assigned(Converter) then begin
7718         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7719         GetMem(RowData, RowSize);
7720         SourceMD := Converter.CreateMappingData;
7721         DestMD   := FormatDesc.CreateMappingData;
7722         try
7723           for y := 0 to Header.dwHeight-1 do begin
7724             TmpData := NewImage;
7725             inc(TmpData, y * LineSize);
7726             SrcData := RowData;
7727             aStream.Read(SrcData^, RowSize);
7728             for x := 0 to Header.dwWidth-1 do begin
7729               Converter.Unmap(SrcData, Pixel, SourceMD);
7730               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7731               FormatDesc.Map(Pixel, TmpData, DestMD);
7732             end;
7733           end;
7734         finally
7735           Converter.FreeMappingData(SourceMD);
7736           FormatDesc.FreeMappingData(DestMD);
7737           FreeMem(RowData);
7738         end;
7739       end else
7740
7741       // Compressed
7742       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7743         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7744         for Y := 0 to Header.dwHeight-1 do begin
7745           aStream.Read(TmpData^, RowSize);
7746           Inc(TmpData, LineSize);
7747         end;
7748       end else
7749
7750       // Uncompressed
7751       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7752         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7753         for Y := 0 to Header.dwHeight-1 do begin
7754           aStream.Read(TmpData^, RowSize);
7755           Inc(TmpData, LineSize);
7756         end;
7757       end else
7758         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7759
7760       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7761       result := true;
7762     except
7763       if Assigned(NewImage) then
7764         FreeMem(NewImage);
7765       raise;
7766     end;
7767   finally
7768     FreeAndNil(Converter);
7769   end;
7770 end;
7771
7772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7773 procedure TglBitmap.SaveDDS(const aStream: TStream);
7774 var
7775   Header: TDDSHeader;
7776   FormatDesc: TFormatDescriptor;
7777 begin
7778   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7779     raise EglBitmapUnsupportedFormat.Create(Format);
7780
7781   FormatDesc := TFormatDescriptor.Get(Format);
7782
7783   // Generell
7784   FillChar(Header{%H-}, SizeOf(Header), 0);
7785   Header.dwSize  := SizeOf(Header);
7786   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7787
7788   Header.dwWidth  := Max(1, Width);
7789   Header.dwHeight := Max(1, Height);
7790
7791   // Caps
7792   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7793
7794   // Pixelformat
7795   Header.PixelFormat.dwSize := sizeof(Header);
7796   if (FormatDesc.IsCompressed) then begin
7797     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7798     case Format of
7799       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7800       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7801       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7802     end;
7803   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7804     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7805     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7806     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7807   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7808     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7809     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7810     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7811     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7812   end else begin
7813     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7814     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7815     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7816     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7817     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7818     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7819   end;
7820
7821   if (FormatDesc.HasAlpha) then
7822     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7823
7824   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7825   aStream.Write(Header, SizeOf(Header));
7826   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7827 end;
7828
7829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7830 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7832 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7833   const aWidth: Integer; const aHeight: Integer);
7834 var
7835   pTemp: pByte;
7836   Size: Integer;
7837 begin
7838   if (aHeight > 1) then begin
7839     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7840     GetMem(pTemp, Size);
7841     try
7842       Move(aData^, pTemp^, Size);
7843       FreeMem(aData);
7844       aData := nil;
7845     except
7846       FreeMem(pTemp);
7847       raise;
7848     end;
7849   end else
7850     pTemp := aData;
7851   inherited SetDataPointer(pTemp, aFormat, aWidth);
7852 end;
7853
7854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7855 function TglBitmap1D.FlipHorz: Boolean;
7856 var
7857   Col: Integer;
7858   pTempDest, pDest, pSource: PByte;
7859 begin
7860   result := inherited FlipHorz;
7861   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7862     pSource := Data;
7863     GetMem(pDest, fRowSize);
7864     try
7865       pTempDest := pDest;
7866       Inc(pTempDest, fRowSize);
7867       for Col := 0 to Width-1 do begin
7868         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7869         Move(pSource^, pTempDest^, fPixelSize);
7870         Inc(pSource, fPixelSize);
7871       end;
7872       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7873       result := true;
7874     except
7875       if Assigned(pDest) then
7876         FreeMem(pDest);
7877       raise;
7878     end;
7879   end;
7880 end;
7881
7882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7883 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7884 var
7885   FormatDesc: TFormatDescriptor;
7886 begin
7887   // Upload data
7888   FormatDesc := TFormatDescriptor.Get(Format);
7889   if FormatDesc.IsCompressed then begin
7890     if not Assigned(glCompressedTexImage1D) then
7891       raise EglBitmap.Create('compressed formats not supported by video adapter');
7892     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7893   end else if aBuildWithGlu then
7894     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7895   else
7896     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7897
7898   // Free Data
7899   if (FreeDataAfterGenTexture) then
7900     FreeData;
7901 end;
7902
7903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7904 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7905 var
7906   BuildWithGlu, TexRec: Boolean;
7907   TexSize: Integer;
7908 begin
7909   if Assigned(Data) then begin
7910     // Check Texture Size
7911     if (aTestTextureSize) then begin
7912       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7913
7914       if (Width > TexSize) then
7915         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7916
7917       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7918                 (Target = GL_TEXTURE_RECTANGLE);
7919       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7920         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7921     end;
7922
7923     CreateId;
7924     SetupParameters(BuildWithGlu);
7925     UploadData(BuildWithGlu);
7926     glAreTexturesResident(1, @fID, @fIsResident);
7927   end;
7928 end;
7929
7930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7931 procedure TglBitmap1D.AfterConstruction;
7932 begin
7933   inherited;
7934   Target := GL_TEXTURE_1D;
7935 end;
7936
7937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7938 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7940 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7941 begin
7942   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7943     result := fLines[aIndex]
7944   else
7945     result := nil;
7946 end;
7947
7948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7949 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7950   const aWidth: Integer; const aHeight: Integer);
7951 var
7952   Idx, LineWidth: Integer;
7953 begin
7954   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7955
7956   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7957     // Assigning Data
7958     if Assigned(Data) then begin
7959       SetLength(fLines, GetHeight);
7960       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7961
7962       for Idx := 0 to GetHeight-1 do begin
7963         fLines[Idx] := Data;
7964         Inc(fLines[Idx], Idx * LineWidth);
7965       end;
7966     end
7967       else SetLength(fLines, 0);
7968   end else begin
7969     SetLength(fLines, 0);
7970   end;
7971 end;
7972
7973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7974 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7975 var
7976   FormatDesc: TFormatDescriptor;
7977 begin
7978   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7979
7980   FormatDesc := TFormatDescriptor.Get(Format);
7981   if FormatDesc.IsCompressed then begin
7982     if not Assigned(glCompressedTexImage2D) then
7983       raise EglBitmap.Create('compressed formats not supported by video adapter');
7984     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7985   end else if aBuildWithGlu then begin
7986     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7987       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7988   end else begin
7989     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7990       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7991   end;
7992
7993   // Freigeben
7994   if (FreeDataAfterGenTexture) then
7995     FreeData;
7996 end;
7997
7998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7999 procedure TglBitmap2D.AfterConstruction;
8000 begin
8001   inherited;
8002   Target := GL_TEXTURE_2D;
8003 end;
8004
8005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8006 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8007 var
8008   Temp: pByte;
8009   Size, w, h: Integer;
8010   FormatDesc: TFormatDescriptor;
8011 begin
8012   FormatDesc := TFormatDescriptor.Get(aFormat);
8013   if FormatDesc.IsCompressed then
8014     raise EglBitmapUnsupportedFormat.Create(aFormat);
8015
8016   w    := aRight  - aLeft;
8017   h    := aBottom - aTop;
8018   Size := FormatDesc.GetSize(w, h);
8019   GetMem(Temp, Size);
8020   try
8021     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8022     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8023     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8024     FlipVert;
8025   except
8026     if Assigned(Temp) then
8027       FreeMem(Temp);
8028     raise;
8029   end;
8030 end;
8031
8032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8033 procedure TglBitmap2D.GetDataFromTexture;
8034 var
8035   Temp: PByte;
8036   TempWidth, TempHeight: Integer;
8037   TempIntFormat: Cardinal;
8038   IntFormat, f: TglBitmapFormat;
8039   FormatDesc: TFormatDescriptor;
8040 begin
8041   Bind;
8042
8043   // Request Data
8044   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8045   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8046   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8047
8048   IntFormat := tfEmpty;
8049   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8050     FormatDesc := TFormatDescriptor.Get(f);
8051     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8052       IntFormat := FormatDesc.Format;
8053       break;
8054     end;
8055   end;
8056
8057   // Getting data from OpenGL
8058   FormatDesc := TFormatDescriptor.Get(IntFormat);
8059   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8060   try
8061     if FormatDesc.IsCompressed then begin
8062       if not Assigned(glGetCompressedTexImage) then
8063         raise EglBitmap.Create('compressed formats not supported by video adapter');
8064       glGetCompressedTexImage(Target, 0, Temp)
8065     end else
8066       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8067     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8068   except
8069     if Assigned(Temp) then
8070       FreeMem(Temp);
8071     raise;
8072   end;
8073 end;
8074
8075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8076 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8077 var
8078   BuildWithGlu, PotTex, TexRec: Boolean;
8079   TexSize: Integer;
8080 begin
8081   if Assigned(Data) then begin
8082     // Check Texture Size
8083     if (aTestTextureSize) then begin
8084       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8085
8086       if ((Height > TexSize) or (Width > TexSize)) then
8087         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8088
8089       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8090       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8091       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8092         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8093     end;
8094
8095     CreateId;
8096     SetupParameters(BuildWithGlu);
8097     UploadData(Target, BuildWithGlu);
8098     glAreTexturesResident(1, @fID, @fIsResident);
8099   end;
8100 end;
8101
8102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8103 function TglBitmap2D.FlipHorz: Boolean;
8104 var
8105   Col, Row: Integer;
8106   TempDestData, DestData, SourceData: PByte;
8107   ImgSize: Integer;
8108 begin
8109   result := inherited FlipHorz;
8110   if Assigned(Data) then begin
8111     SourceData := Data;
8112     ImgSize := Height * fRowSize;
8113     GetMem(DestData, ImgSize);
8114     try
8115       TempDestData := DestData;
8116       Dec(TempDestData, fRowSize + fPixelSize);
8117       for Row := 0 to Height -1 do begin
8118         Inc(TempDestData, fRowSize * 2);
8119         for Col := 0 to Width -1 do begin
8120           Move(SourceData^, TempDestData^, fPixelSize);
8121           Inc(SourceData, fPixelSize);
8122           Dec(TempDestData, fPixelSize);
8123         end;
8124       end;
8125       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8126       result := true;
8127     except
8128       if Assigned(DestData) then
8129         FreeMem(DestData);
8130       raise;
8131     end;
8132   end;
8133 end;
8134
8135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8136 function TglBitmap2D.FlipVert: Boolean;
8137 var
8138   Row: Integer;
8139   TempDestData, DestData, SourceData: PByte;
8140 begin
8141   result := inherited FlipVert;
8142   if Assigned(Data) then begin
8143     SourceData := Data;
8144     GetMem(DestData, Height * fRowSize);
8145     try
8146       TempDestData := DestData;
8147       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8148       for Row := 0 to Height -1 do begin
8149         Move(SourceData^, TempDestData^, fRowSize);
8150         Dec(TempDestData, fRowSize);
8151         Inc(SourceData, fRowSize);
8152       end;
8153       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8154       result := true;
8155     except
8156       if Assigned(DestData) then
8157         FreeMem(DestData);
8158       raise;
8159     end;
8160   end;
8161 end;
8162
8163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8164 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8166 type
8167   TMatrixItem = record
8168     X, Y: Integer;
8169     W: Single;
8170   end;
8171
8172   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8173   TglBitmapToNormalMapRec = Record
8174     Scale: Single;
8175     Heights: array of Single;
8176     MatrixU : array of TMatrixItem;
8177     MatrixV : array of TMatrixItem;
8178   end;
8179
8180 const
8181   ONE_OVER_255 = 1 / 255;
8182
8183   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8184 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8185 var
8186   Val: Single;
8187 begin
8188   with FuncRec do begin
8189     Val :=
8190       Source.Data.r * LUMINANCE_WEIGHT_R +
8191       Source.Data.g * LUMINANCE_WEIGHT_G +
8192       Source.Data.b * LUMINANCE_WEIGHT_B;
8193     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8194   end;
8195 end;
8196
8197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8198 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8199 begin
8200   with FuncRec do
8201     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8202 end;
8203
8204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8205 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8206 type
8207   TVec = Array[0..2] of Single;
8208 var
8209   Idx: Integer;
8210   du, dv: Double;
8211   Len: Single;
8212   Vec: TVec;
8213
8214   function GetHeight(X, Y: Integer): Single;
8215   begin
8216     with FuncRec do begin
8217       X := Max(0, Min(Size.X -1, X));
8218       Y := Max(0, Min(Size.Y -1, Y));
8219       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8220     end;
8221   end;
8222
8223 begin
8224   with FuncRec do begin
8225     with PglBitmapToNormalMapRec(Args)^ do begin
8226       du := 0;
8227       for Idx := Low(MatrixU) to High(MatrixU) do
8228         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8229
8230       dv := 0;
8231       for Idx := Low(MatrixU) to High(MatrixU) do
8232         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8233
8234       Vec[0] := -du * Scale;
8235       Vec[1] := -dv * Scale;
8236       Vec[2] := 1;
8237     end;
8238
8239     // Normalize
8240     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8241     if Len <> 0 then begin
8242       Vec[0] := Vec[0] * Len;
8243       Vec[1] := Vec[1] * Len;
8244       Vec[2] := Vec[2] * Len;
8245     end;
8246
8247     // Farbe zuweisem
8248     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8249     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8250     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8251   end;
8252 end;
8253
8254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8255 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8256 var
8257   Rec: TglBitmapToNormalMapRec;
8258
8259   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8260   begin
8261     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8262       Matrix[Index].X := X;
8263       Matrix[Index].Y := Y;
8264       Matrix[Index].W := W;
8265     end;
8266   end;
8267
8268 begin
8269   if TFormatDescriptor.Get(Format).IsCompressed then
8270     raise EglBitmapUnsupportedFormat.Create(Format);
8271
8272   if aScale > 100 then
8273     Rec.Scale := 100
8274   else if aScale < -100 then
8275     Rec.Scale := -100
8276   else
8277     Rec.Scale := aScale;
8278
8279   SetLength(Rec.Heights, Width * Height);
8280   try
8281     case aFunc of
8282       nm4Samples: begin
8283         SetLength(Rec.MatrixU, 2);
8284         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8285         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8286
8287         SetLength(Rec.MatrixV, 2);
8288         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8289         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8290       end;
8291
8292       nmSobel: begin
8293         SetLength(Rec.MatrixU, 6);
8294         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8295         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8296         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8297         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8298         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8299         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8300
8301         SetLength(Rec.MatrixV, 6);
8302         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8303         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8304         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8305         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8306         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8307         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8308       end;
8309
8310       nm3x3: begin
8311         SetLength(Rec.MatrixU, 6);
8312         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8313         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8314         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8315         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8316         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8317         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8318
8319         SetLength(Rec.MatrixV, 6);
8320         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8321         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8322         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8323         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8324         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8325         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8326       end;
8327
8328       nm5x5: begin
8329         SetLength(Rec.MatrixU, 20);
8330         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8331         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8332         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8333         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8334         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8335         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8336         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8337         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8338         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8339         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8340         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8341         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8342         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8343         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8344         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8345         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8346         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8347         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8348         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8349         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8350
8351         SetLength(Rec.MatrixV, 20);
8352         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8353         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8354         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8355         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8356         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8357         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8358         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8359         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8360         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8361         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8362         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8363         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8364         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8365         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8366         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8367         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8368         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8369         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8370         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8371         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8372       end;
8373     end;
8374
8375     // Daten Sammeln
8376     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8377       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8378     else
8379       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8380     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8381   finally
8382     SetLength(Rec.Heights, 0);
8383   end;
8384 end;
8385
8386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8387 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8389 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8390 begin
8391   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8392 end;
8393
8394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8395 procedure TglBitmapCubeMap.AfterConstruction;
8396 begin
8397   inherited;
8398
8399   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8400     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8401
8402   SetWrap;
8403   Target   := GL_TEXTURE_CUBE_MAP;
8404   fGenMode := GL_REFLECTION_MAP;
8405 end;
8406
8407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8408 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8409 var
8410   BuildWithGlu: Boolean;
8411   TexSize: Integer;
8412 begin
8413   if (aTestTextureSize) then begin
8414     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8415
8416     if (Height > TexSize) or (Width > TexSize) then
8417       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8418
8419     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8420       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8421   end;
8422
8423   if (ID = 0) then
8424     CreateID;
8425   SetupParameters(BuildWithGlu);
8426   UploadData(aCubeTarget, BuildWithGlu);
8427 end;
8428
8429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8430 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8431 begin
8432   inherited Bind (aEnableTextureUnit);
8433   if aEnableTexCoordsGen then begin
8434     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8435     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8436     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8437     glEnable(GL_TEXTURE_GEN_S);
8438     glEnable(GL_TEXTURE_GEN_T);
8439     glEnable(GL_TEXTURE_GEN_R);
8440   end;
8441 end;
8442
8443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8444 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8445 begin
8446   inherited Unbind(aDisableTextureUnit);
8447   if aDisableTexCoordsGen then begin
8448     glDisable(GL_TEXTURE_GEN_S);
8449     glDisable(GL_TEXTURE_GEN_T);
8450     glDisable(GL_TEXTURE_GEN_R);
8451   end;
8452 end;
8453
8454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8455 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8457 type
8458   TVec = Array[0..2] of Single;
8459   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8460
8461   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8462   TglBitmapNormalMapRec = record
8463     HalfSize : Integer;
8464     Func: TglBitmapNormalMapGetVectorFunc;
8465   end;
8466
8467   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8468 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8469 begin
8470   aVec[0] := aHalfSize;
8471   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8472   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8473 end;
8474
8475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8476 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8477 begin
8478   aVec[0] := - aHalfSize;
8479   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8480   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8481 end;
8482
8483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8484 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8485 begin
8486   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8487   aVec[1] := aHalfSize;
8488   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8489 end;
8490
8491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8492 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8493 begin
8494   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8495   aVec[1] := - aHalfSize;
8496   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8497 end;
8498
8499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8500 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8501 begin
8502   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8503   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8504   aVec[2] := aHalfSize;
8505 end;
8506
8507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8508 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8509 begin
8510   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8511   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8512   aVec[2] := - aHalfSize;
8513 end;
8514
8515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8516 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8517 var
8518   i: Integer;
8519   Vec: TVec;
8520   Len: Single;
8521 begin
8522   with FuncRec do begin
8523     with PglBitmapNormalMapRec(Args)^ do begin
8524       Func(Vec, Position, HalfSize);
8525
8526       // Normalize
8527       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8528       if Len <> 0 then begin
8529         Vec[0] := Vec[0] * Len;
8530         Vec[1] := Vec[1] * Len;
8531         Vec[2] := Vec[2] * Len;
8532       end;
8533
8534       // Scale Vector and AddVectro
8535       Vec[0] := Vec[0] * 0.5 + 0.5;
8536       Vec[1] := Vec[1] * 0.5 + 0.5;
8537       Vec[2] := Vec[2] * 0.5 + 0.5;
8538     end;
8539
8540     // Set Color
8541     for i := 0 to 2 do
8542       Dest.Data.arr[i] := Round(Vec[i] * 255);
8543   end;
8544 end;
8545
8546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8547 procedure TglBitmapNormalMap.AfterConstruction;
8548 begin
8549   inherited;
8550   fGenMode := GL_NORMAL_MAP;
8551 end;
8552
8553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8554 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8555 var
8556   Rec: TglBitmapNormalMapRec;
8557   SizeRec: TglBitmapPixelPosition;
8558 begin
8559   Rec.HalfSize := aSize div 2;
8560   FreeDataAfterGenTexture := false;
8561
8562   SizeRec.Fields := [ffX, ffY];
8563   SizeRec.X := aSize;
8564   SizeRec.Y := aSize;
8565
8566   // Positive X
8567   Rec.Func := glBitmapNormalMapPosX;
8568   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8569   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8570
8571   // Negative X
8572   Rec.Func := glBitmapNormalMapNegX;
8573   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8574   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8575
8576   // Positive Y
8577   Rec.Func := glBitmapNormalMapPosY;
8578   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8579   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8580
8581   // Negative Y
8582   Rec.Func := glBitmapNormalMapNegY;
8583   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8584   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8585
8586   // Positive Z
8587   Rec.Func := glBitmapNormalMapPosZ;
8588   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8589   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8590
8591   // Negative Z
8592   Rec.Func := glBitmapNormalMapNegZ;
8593   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8594   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8595 end;
8596
8597
8598 initialization
8599   glBitmapSetDefaultFormat (tfEmpty);
8600   glBitmapSetDefaultMipmap (mmMipmap);
8601   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8602   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8603   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8604
8605   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8606   glBitmapSetDefaultDeleteTextureOnFree    (true);
8607
8608   TFormatDescriptor.Init;
8609
8610 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8611   OpenGLInitialized := false;
8612   InitOpenGLCS := TCriticalSection.Create;
8613 {$ENDIF}
8614
8615 finalization
8616   TFormatDescriptor.Finalize;
8617
8618 {$IFDEF GLB_NATIVE_OGL}
8619   if Assigned(GL_LibHandle) then
8620     glbFreeLibrary(GL_LibHandle);
8621
8622 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8623   if Assigned(GLU_LibHandle) then
8624     glbFreeLibrary(GLU_LibHandle);
8625   FreeAndNil(InitOpenGLCS);
8626 {$ENDIF}
8627 {$ENDIF}
8628
8629 end.