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   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1235
1236 type
1237 {$IFNDEF fpc}
1238   QWord   = System.UInt64;
1239   PQWord  = ^QWord;
1240
1241   PtrInt  = Longint;
1242   PtrUInt = DWord;
1243 {$ENDIF}
1244
1245 ////////////////////////////////////////////////////////////////////////////////////////////////////
1246   TShiftRec = packed record
1247   case Integer of
1248     0: (r, g, b, a: Byte);
1249     1: (arr: array[0..3] of Byte);
1250   end;
1251
1252   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1253   private
1254     function GetRedMask: QWord;
1255     function GetGreenMask: QWord;
1256     function GetBlueMask: QWord;
1257     function GetAlphaMask: QWord;
1258   protected
1259     fFormat: TglBitmapFormat;
1260     fWithAlpha: TglBitmapFormat;
1261     fWithoutAlpha: TglBitmapFormat;
1262     fRGBInverted: TglBitmapFormat;
1263     fUncompressed: TglBitmapFormat;
1264     fPixelSize: Single;
1265     fIsCompressed: Boolean;
1266
1267     fRange: TglBitmapColorRec;
1268     fShift: TShiftRec;
1269
1270     fglFormat:         GLenum;
1271     fglInternalFormat: GLenum;
1272     fglDataFormat:     GLenum;
1273
1274     function GetIsCompressed: Boolean; override;
1275     function GetHasAlpha: Boolean; override;
1276
1277     function GetglFormat: GLenum; override;
1278     function GetglInternalFormat: GLenum; override;
1279     function GetglDataFormat: GLenum; override;
1280
1281     function GetComponents: Integer; virtual;
1282   public
1283     property Format:       TglBitmapFormat read fFormat;
1284     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1285     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1286     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1287     property Components:   Integer         read GetComponents;
1288     property PixelSize:    Single          read fPixelSize;
1289
1290     property Range: TglBitmapColorRec read fRange;
1291     property Shift: TShiftRec         read fShift;
1292
1293     property RedMask:   QWord read GetRedMask;
1294     property GreenMask: QWord read GetGreenMask;
1295     property BlueMask:  QWord read GetBlueMask;
1296     property AlphaMask: QWord read GetAlphaMask;
1297
1298     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1299     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1300
1301     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1302     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1303
1304     function CreateMappingData: Pointer; virtual;
1305     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1306
1307     function IsEmpty:  Boolean; virtual;
1308     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1309
1310     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1311
1312     constructor Create; virtual;
1313   public
1314     class procedure Init;
1315     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1316     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1317     class procedure Clear;
1318     class procedure Finalize;
1319   end;
1320   TFormatDescriptorClass = class of TFormatDescriptor;
1321
1322   TfdEmpty = class(TFormatDescriptor);
1323
1324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1325   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1326     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1327     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1328     constructor Create; override;
1329   end;
1330
1331   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1332     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1333     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1334     constructor Create; override;
1335   end;
1336
1337   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1338     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1339     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1340     constructor Create; override;
1341   end;
1342
1343   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1344     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1345     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1346     constructor Create; override;
1347   end;
1348
1349   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1350     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1351     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1352     constructor Create; override;
1353   end;
1354
1355   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1356     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1357     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1358     constructor Create; override;
1359   end;
1360
1361   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1362     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1363     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1364     constructor Create; override;
1365   end;
1366
1367   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370     constructor Create; override;
1371   end;
1372
1373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1374   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1375     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1376     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1377     constructor Create; override;
1378   end;
1379
1380   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1381     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1382     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1383     constructor Create; override;
1384   end;
1385
1386   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1387     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1388     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1389     constructor Create; override;
1390   end;
1391
1392   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395     constructor Create; override;
1396   end;
1397
1398   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1399     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1400     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1401     constructor Create; override;
1402   end;
1403
1404   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1405     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1406     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1407     constructor Create; override;
1408   end;
1409
1410   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1411     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1412     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1413     constructor Create; override;
1414   end;
1415
1416   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1417     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1418     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1419     constructor Create; override;
1420   end;
1421
1422   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425     constructor Create; override;
1426   end;
1427
1428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1429   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1430     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1431     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1432     constructor Create; override;
1433   end;
1434
1435   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1436     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1437     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1438     constructor Create; override;
1439   end;
1440
1441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1442   TfdAlpha4 = class(TfdAlpha_UB1)
1443     constructor Create; override;
1444   end;
1445
1446   TfdAlpha8 = class(TfdAlpha_UB1)
1447     constructor Create; override;
1448   end;
1449
1450   TfdAlpha12 = class(TfdAlpha_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdAlpha16 = class(TfdAlpha_US1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdLuminance4 = class(TfdLuminance_UB1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdLuminance8 = class(TfdLuminance_UB1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdLuminance12 = class(TfdLuminance_US1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdLuminance16 = class(TfdLuminance_US1)
1471     constructor Create; override;
1472   end;
1473
1474   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1475     constructor Create; override;
1476   end;
1477
1478   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1479     constructor Create; override;
1480   end;
1481
1482   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1483     constructor Create; override;
1484   end;
1485
1486   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1487     constructor Create; override;
1488   end;
1489
1490   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1491     constructor Create; override;
1492   end;
1493
1494   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1495     constructor Create; override;
1496   end;
1497
1498   TfdR3G3B2 = class(TfdUniversal_UB1)
1499     constructor Create; override;
1500   end;
1501
1502   TfdRGB4 = class(TfdUniversal_US1)
1503     constructor Create; override;
1504   end;
1505
1506   TfdR5G6B5 = class(TfdUniversal_US1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdRGB5 = class(TfdUniversal_US1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdRGB8 = class(TfdRGB_UB3)
1515     constructor Create; override;
1516   end;
1517
1518   TfdRGB10 = class(TfdUniversal_UI1)
1519     constructor Create; override;
1520   end;
1521
1522   TfdRGB12 = class(TfdRGB_US3)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGB16 = class(TfdRGB_US3)
1527     constructor Create; override;
1528   end;
1529
1530   TfdRGBA2 = class(TfdRGBA_UB4)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGBA4 = class(TfdUniversal_US1)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGB5A1 = class(TfdUniversal_US1)
1539     constructor Create; override;
1540   end;
1541
1542   TfdRGBA8 = class(TfdRGBA_UB4)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGB10A2 = class(TfdUniversal_UI1)
1547     constructor Create; override;
1548   end;
1549
1550   TfdRGBA12 = class(TfdRGBA_US4)
1551     constructor Create; override;
1552   end;
1553
1554   TfdRGBA16 = class(TfdRGBA_US4)
1555     constructor Create; override;
1556   end;
1557
1558   TfdBGR4 = class(TfdUniversal_US1)
1559     constructor Create; override;
1560   end;
1561
1562   TfdB5G6R5 = class(TfdUniversal_US1)
1563     constructor Create; override;
1564   end;
1565
1566   TfdBGR5 = class(TfdUniversal_US1)
1567     constructor Create; override;
1568   end;
1569
1570   TfdBGR8 = class(TfdBGR_UB3)
1571     constructor Create; override;
1572   end;
1573
1574   TfdBGR10 = class(TfdUniversal_UI1)
1575     constructor Create; override;
1576   end;
1577
1578   TfdBGR12 = class(TfdBGR_US3)
1579     constructor Create; override;
1580   end;
1581
1582   TfdBGR16 = class(TfdBGR_US3)
1583     constructor Create; override;
1584   end;
1585
1586   TfdBGRA2 = class(TfdBGRA_UB4)
1587     constructor Create; override;
1588   end;
1589
1590   TfdBGRA4 = class(TfdUniversal_US1)
1591     constructor Create; override;
1592   end;
1593
1594   TfdBGR5A1 = class(TfdUniversal_US1)
1595     constructor Create; override;
1596   end;
1597
1598   TfdBGRA8 = class(TfdBGRA_UB4)
1599     constructor Create; override;
1600   end;
1601
1602   TfdBGR10A2 = class(TfdUniversal_UI1)
1603     constructor Create; override;
1604   end;
1605
1606   TfdBGRA12 = class(TfdBGRA_US4)
1607     constructor Create; override;
1608   end;
1609
1610   TfdBGRA16 = class(TfdBGRA_US4)
1611     constructor Create; override;
1612   end;
1613
1614   TfdDepth16 = class(TfdDepth_US1)
1615     constructor Create; override;
1616   end;
1617
1618   TfdDepth24 = class(TfdDepth_UI1)
1619     constructor Create; override;
1620   end;
1621
1622   TfdDepth32 = class(TfdDepth_UI1)
1623     constructor Create; override;
1624   end;
1625
1626   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1627     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1628     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1629     constructor Create; override;
1630   end;
1631
1632   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1633     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1634     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1635     constructor Create; override;
1636   end;
1637
1638   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1639     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1640     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1641     constructor Create; override;
1642   end;
1643
1644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1645   TbmpBitfieldFormat = class(TFormatDescriptor)
1646   private
1647     procedure SetRedMask  (const aValue: QWord);
1648     procedure SetGreenMask(const aValue: QWord);
1649     procedure SetBlueMask (const aValue: QWord);
1650     procedure SetAlphaMask(const aValue: QWord);
1651
1652     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1653   public
1654     property RedMask:   QWord read GetRedMask   write SetRedMask;
1655     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1656     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1657     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1658
1659     property PixelSize: Single read fPixelSize write fPixelSize;
1660
1661     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1662     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1663   end;
1664
1665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1666   TbmpColorTableEnty = packed record
1667     b, g, r, a: Byte;
1668   end;
1669   TbmpColorTable = array of TbmpColorTableEnty;
1670   TbmpColorTableFormat = class(TFormatDescriptor)
1671   private
1672     fColorTable: TbmpColorTable;
1673   public
1674     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1675     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1676     property Range:      TglBitmapColorRec read fRange      write fRange;
1677     property Shift:      TShiftRec         read fShift      write fShift;
1678     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1679
1680     procedure CreateColorTable;
1681
1682     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1683     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1684     destructor Destroy; override;
1685   end;
1686
1687 const
1688   LUMINANCE_WEIGHT_R = 0.30;
1689   LUMINANCE_WEIGHT_G = 0.59;
1690   LUMINANCE_WEIGHT_B = 0.11;
1691
1692   ALPHA_WEIGHT_R = 0.30;
1693   ALPHA_WEIGHT_G = 0.59;
1694   ALPHA_WEIGHT_B = 0.11;
1695
1696   DEPTH_WEIGHT_R = 0.333333333;
1697   DEPTH_WEIGHT_G = 0.333333333;
1698   DEPTH_WEIGHT_B = 0.333333333;
1699
1700   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1701
1702   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1703     TfdEmpty,
1704
1705     TfdAlpha4,
1706     TfdAlpha8,
1707     TfdAlpha12,
1708     TfdAlpha16,
1709
1710     TfdLuminance4,
1711     TfdLuminance8,
1712     TfdLuminance12,
1713     TfdLuminance16,
1714
1715     TfdLuminance4Alpha4,
1716     TfdLuminance6Alpha2,
1717     TfdLuminance8Alpha8,
1718     TfdLuminance12Alpha4,
1719     TfdLuminance12Alpha12,
1720     TfdLuminance16Alpha16,
1721
1722     TfdR3G3B2,
1723     TfdRGB4,
1724     TfdR5G6B5,
1725     TfdRGB5,
1726     TfdRGB8,
1727     TfdRGB10,
1728     TfdRGB12,
1729     TfdRGB16,
1730
1731     TfdRGBA2,
1732     TfdRGBA4,
1733     TfdRGB5A1,
1734     TfdRGBA8,
1735     TfdRGB10A2,
1736     TfdRGBA12,
1737     TfdRGBA16,
1738
1739     TfdBGR4,
1740     TfdB5G6R5,
1741     TfdBGR5,
1742     TfdBGR8,
1743     TfdBGR10,
1744     TfdBGR12,
1745     TfdBGR16,
1746
1747     TfdBGRA2,
1748     TfdBGRA4,
1749     TfdBGR5A1,
1750     TfdBGRA8,
1751     TfdBGR10A2,
1752     TfdBGRA12,
1753     TfdBGRA16,
1754
1755     TfdDepth16,
1756     TfdDepth24,
1757     TfdDepth32,
1758
1759     TfdS3tcDtx1RGBA,
1760     TfdS3tcDtx3RGBA,
1761     TfdS3tcDtx5RGBA
1762   );
1763
1764 var
1765   FormatDescriptorCS: TCriticalSection;
1766   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1767
1768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1769 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1770 begin
1771   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1772 end;
1773
1774 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1775 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1776 begin
1777   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1778 end;
1779
1780 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1781 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1782 begin
1783   result.Fields := [];
1784
1785   if X >= 0 then
1786     result.Fields := result.Fields + [ffX];
1787   if Y >= 0 then
1788     result.Fields := result.Fields + [ffY];
1789
1790   result.X := Max(0, X);
1791   result.Y := Max(0, Y);
1792 end;
1793
1794 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1795 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1796 begin
1797   result.r := r;
1798   result.g := g;
1799   result.b := b;
1800   result.a := a;
1801 end;
1802
1803 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1804 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1805 var
1806   i: Integer;
1807 begin
1808   result := false;
1809   for i := 0 to high(r1.arr) do
1810     if (r1.arr[i] <> r2.arr[i]) then
1811       exit;
1812   result := true;
1813 end;
1814
1815 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1817 begin
1818   result.r := r;
1819   result.g := g;
1820   result.b := b;
1821   result.a := a;
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1826 begin
1827   result := [];
1828
1829   if (aFormat in [
1830         //4 bbp
1831         tfLuminance4,
1832
1833         //8bpp
1834         tfR3G3B2, tfLuminance8,
1835
1836         //16bpp
1837         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1838         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1839
1840         //24bpp
1841         tfBGR8, tfRGB8,
1842
1843         //32bpp
1844         tfRGB10, tfRGB10A2, tfRGBA8,
1845         tfBGR10, tfBGR10A2, tfBGRA8]) then
1846     result := result + [ftBMP];
1847
1848   if (aFormat in [
1849         //8 bpp
1850         tfLuminance8, tfAlpha8,
1851
1852         //16 bpp
1853         tfLuminance16, tfLuminance8Alpha8,
1854         tfRGB5, tfRGB5A1, tfRGBA4,
1855         tfBGR5, tfBGR5A1, tfBGRA4,
1856
1857         //24 bpp
1858         tfRGB8, tfBGR8,
1859
1860         //32 bpp
1861         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1862     result := result + [ftTGA];
1863
1864   if (aFormat in [
1865         //8 bpp
1866         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1867         tfR3G3B2, tfRGBA2, tfBGRA2,
1868
1869         //16 bpp
1870         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1871         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1872         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1873
1874         //24 bpp
1875         tfRGB8, tfBGR8,
1876
1877         //32 bbp
1878         tfLuminance16Alpha16,
1879         tfRGBA8, tfRGB10A2,
1880         tfBGRA8, tfBGR10A2,
1881
1882         //compressed
1883         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1884     result := result + [ftDDS];
1885
1886   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1887   if aFormat in [
1888       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1889       tfRGB8, tfRGBA8,
1890       tfBGR8, tfBGRA8] then
1891     result := result + [ftPNG];
1892   {$ENDIF}
1893
1894   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1895   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1896     result := result + [ftJPEG];
1897   {$ENDIF}
1898 end;
1899
1900 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1901 function IsPowerOfTwo(aNumber: Integer): Boolean;
1902 begin
1903   while (aNumber and 1) = 0 do
1904     aNumber := aNumber shr 1;
1905   result := aNumber = 1;
1906 end;
1907
1908 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1909 function GetTopMostBit(aBitSet: QWord): Integer;
1910 begin
1911   result := 0;
1912   while aBitSet > 0 do begin
1913     inc(result);
1914     aBitSet := aBitSet shr 1;
1915   end;
1916 end;
1917
1918 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1919 function CountSetBits(aBitSet: QWord): Integer;
1920 begin
1921   result := 0;
1922   while aBitSet > 0 do begin
1923     if (aBitSet and 1) = 1 then
1924       inc(result);
1925     aBitSet := aBitSet shr 1;
1926   end;
1927 end;
1928
1929 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1930 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1931 begin
1932   result := Trunc(
1933     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1934     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1935     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1936 end;
1937
1938 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1939 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1940 begin
1941   result := Trunc(
1942     DEPTH_WEIGHT_R * aPixel.Data.r +
1943     DEPTH_WEIGHT_G * aPixel.Data.g +
1944     DEPTH_WEIGHT_B * aPixel.Data.b);
1945 end;
1946
1947 {$IFDEF GLB_NATIVE_OGL}
1948 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1950 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1951 var
1952   GL_LibHandle: Pointer = nil;
1953
1954 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1955 begin
1956   if not Assigned(aLibHandle) then
1957     aLibHandle := GL_LibHandle;
1958
1959 {$IF DEFINED(GLB_WIN)}
1960   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1961   if Assigned(result) then
1962     exit;
1963
1964   if Assigned(wglGetProcAddress) then
1965     result := wglGetProcAddress(aProcName);
1966 {$ELSEIF DEFINED(GLB_LINUX)}
1967   if Assigned(glXGetProcAddress) then begin
1968     result := glXGetProcAddress(aProcName);
1969     if Assigned(result) then
1970       exit;
1971   end;
1972
1973   if Assigned(glXGetProcAddressARB) then begin
1974     result := glXGetProcAddressARB(aProcName);
1975     if Assigned(result) then
1976       exit;
1977   end;
1978
1979   result := dlsym(aLibHandle, aProcName);
1980 {$IFEND}
1981   if not Assigned(result) and aRaiseOnErr then
1982     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1983 end;
1984
1985 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1986 var
1987   GLU_LibHandle: Pointer = nil;
1988   OpenGLInitialized: Boolean;
1989   InitOpenGLCS: TCriticalSection;
1990
1991 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1992 procedure glbInitOpenGL;
1993
1994   ////////////////////////////////////////////////////////////////////////////////
1995   function glbLoadLibrary(const aName: PChar): Pointer;
1996   begin
1997     {$IF DEFINED(GLB_WIN)}
1998     result := {%H-}Pointer(LoadLibrary(aName));
1999     {$ELSEIF DEFINED(GLB_LINUX)}
2000     result := dlopen(Name, RTLD_LAZY);
2001     {$ELSE}
2002     result := nil;
2003     {$IFEND}
2004   end;
2005
2006   ////////////////////////////////////////////////////////////////////////////////
2007   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2008   begin
2009     result := false;
2010     if not Assigned(aLibHandle) then
2011       exit;
2012
2013     {$IF DEFINED(GLB_WIN)}
2014     Result := FreeLibrary({%H-}HINST(aLibHandle));
2015     {$ELSEIF DEFINED(GLB_LINUX)}
2016     Result := dlclose(aLibHandle) = 0;
2017     {$IFEND}
2018   end;
2019
2020 begin
2021   if Assigned(GL_LibHandle) then
2022     glbFreeLibrary(GL_LibHandle);
2023
2024   if Assigned(GLU_LibHandle) then
2025     glbFreeLibrary(GLU_LibHandle);
2026
2027   GL_LibHandle := glbLoadLibrary(libopengl);
2028   if not Assigned(GL_LibHandle) then
2029     raise EglBitmap.Create('unable to load library: ' + libopengl);
2030
2031   GLU_LibHandle := glbLoadLibrary(libglu);
2032   if not Assigned(GLU_LibHandle) then
2033     raise EglBitmap.Create('unable to load library: ' + libglu);
2034
2035 {$IF DEFINED(GLB_WIN)}
2036   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2037 {$ELSEIF DEFINED(GLB_LINUX)}
2038   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2039   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2040 {$IFEND}
2041
2042   glEnable := glbGetProcAddress('glEnable');
2043   glDisable := glbGetProcAddress('glDisable');
2044   glGetString := glbGetProcAddress('glGetString');
2045   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2046   glTexParameteri := glbGetProcAddress('glTexParameteri');
2047   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2048   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2049   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2050   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2051   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2052   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2053   glTexGeni := glbGetProcAddress('glTexGeni');
2054   glGenTextures := glbGetProcAddress('glGenTextures');
2055   glBindTexture := glbGetProcAddress('glBindTexture');
2056   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2057   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2058   glReadPixels := glbGetProcAddress('glReadPixels');
2059   glPixelStorei := glbGetProcAddress('glPixelStorei');
2060   glTexImage1D := glbGetProcAddress('glTexImage1D');
2061   glTexImage2D := glbGetProcAddress('glTexImage2D');
2062   glGetTexImage := glbGetProcAddress('glGetTexImage');
2063
2064   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2065   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2066 end;
2067 {$ENDIF}
2068
2069 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2070 procedure glbReadOpenGLExtensions;
2071 var
2072   Buffer: AnsiString;
2073   MajorVersion, MinorVersion: Integer;
2074
2075   ///////////////////////////////////////////////////////////////////////////////////////////
2076   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2077   var
2078     Separator: Integer;
2079   begin
2080     aMinor := 0;
2081     aMajor := 0;
2082
2083     Separator := Pos(AnsiString('.'), aBuffer);
2084     if (Separator > 1) and (Separator < Length(aBuffer)) and
2085        (aBuffer[Separator - 1] in ['0'..'9']) and
2086        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2087
2088       Dec(Separator);
2089       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2090         Dec(Separator);
2091
2092       Delete(aBuffer, 1, Separator);
2093       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2094
2095       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2096         Inc(Separator);
2097
2098       Delete(aBuffer, Separator, 255);
2099       Separator := Pos(AnsiString('.'), aBuffer);
2100
2101       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2102       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2103     end;
2104   end;
2105
2106   ///////////////////////////////////////////////////////////////////////////////////////////
2107   function CheckExtension(const Extension: AnsiString): Boolean;
2108   var
2109     ExtPos: Integer;
2110   begin
2111     ExtPos := Pos(Extension, Buffer);
2112     result := ExtPos > 0;
2113     if result then
2114       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2115   end;
2116
2117   ///////////////////////////////////////////////////////////////////////////////////////////
2118   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2119   begin
2120     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2121   end;
2122
2123 begin
2124 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2125   InitOpenGLCS.Enter;
2126   try
2127     if not OpenGLInitialized then begin
2128       glbInitOpenGL;
2129       OpenGLInitialized := true;
2130     end;
2131   finally
2132     InitOpenGLCS.Leave;
2133   end;
2134 {$ENDIF}
2135
2136   // Version
2137   Buffer := glGetString(GL_VERSION);
2138   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2139
2140   GL_VERSION_1_2 := CheckVersion(1, 2);
2141   GL_VERSION_1_3 := CheckVersion(1, 3);
2142   GL_VERSION_1_4 := CheckVersion(1, 4);
2143   GL_VERSION_2_0 := CheckVersion(2, 0);
2144   GL_VERSION_3_3 := CheckVersion(3, 3);
2145
2146   // Extensions
2147   Buffer := glGetString(GL_EXTENSIONS);
2148   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2149   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2150   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2151   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2152   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2153   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2154   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2155   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2156   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2157   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2158   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2159   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2160   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2161   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2162
2163   if GL_VERSION_1_3 then begin
2164     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2165     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2166     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2167   end else begin
2168     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2169     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2170     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2171   end;
2172 end;
2173 {$ENDIF}
2174
2175 {$IFDEF GLB_SDL_IMAGE}
2176 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2177 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2178 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2180 begin
2181   result := TStream(context^.unknown.data1).Seek(offset, whence);
2182 end;
2183
2184 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2185 begin
2186   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2187 end;
2188
2189 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2190 begin
2191   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2192 end;
2193
2194 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2195 begin
2196   result := 0;
2197 end;
2198
2199 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2200 begin
2201   result := SDL_AllocRW;
2202
2203   if result = nil then
2204     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2205
2206   result^.seek := glBitmapRWseek;
2207   result^.read := glBitmapRWread;
2208   result^.write := glBitmapRWwrite;
2209   result^.close := glBitmapRWclose;
2210   result^.unknown.data1 := Stream;
2211 end;
2212 {$ENDIF}
2213
2214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2215 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2216 begin
2217   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2218 end;
2219
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2222 begin
2223   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2224 end;
2225
2226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2227 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2228 begin
2229   glBitmapDefaultMipmap := aValue;
2230 end;
2231
2232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2233 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2234 begin
2235   glBitmapDefaultFormat := aFormat;
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2240 begin
2241   glBitmapDefaultFilterMin := aMin;
2242   glBitmapDefaultFilterMag := aMag;
2243 end;
2244
2245 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2246 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2247 begin
2248   glBitmapDefaultWrapS := S;
2249   glBitmapDefaultWrapT := T;
2250   glBitmapDefaultWrapR := R;
2251 end;
2252
2253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2254 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2255 begin
2256   glDefaultSwizzle[0] := r;
2257   glDefaultSwizzle[1] := g;
2258   glDefaultSwizzle[2] := b;
2259   glDefaultSwizzle[3] := a;
2260 end;
2261
2262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2263 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2264 begin
2265   result := glBitmapDefaultDeleteTextureOnFree;
2266 end;
2267
2268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2269 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2270 begin
2271   result := glBitmapDefaultFreeDataAfterGenTextures;
2272 end;
2273
2274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2275 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2276 begin
2277   result := glBitmapDefaultMipmap;
2278 end;
2279
2280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2281 function glBitmapGetDefaultFormat: TglBitmapFormat;
2282 begin
2283   result := glBitmapDefaultFormat;
2284 end;
2285
2286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2287 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2288 begin
2289   aMin := glBitmapDefaultFilterMin;
2290   aMag := glBitmapDefaultFilterMag;
2291 end;
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2295 begin
2296   S := glBitmapDefaultWrapS;
2297   T := glBitmapDefaultWrapT;
2298   R := glBitmapDefaultWrapR;
2299 end;
2300
2301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2302 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2303 begin
2304   r := glDefaultSwizzle[0];
2305   g := glDefaultSwizzle[1];
2306   b := glDefaultSwizzle[2];
2307   a := glDefaultSwizzle[3];
2308 end;
2309
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2313 function TFormatDescriptor.GetRedMask: QWord;
2314 begin
2315   result := fRange.r shl fShift.r;
2316 end;
2317
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 function TFormatDescriptor.GetGreenMask: QWord;
2320 begin
2321   result := fRange.g shl fShift.g;
2322 end;
2323
2324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2325 function TFormatDescriptor.GetBlueMask: QWord;
2326 begin
2327   result := fRange.b shl fShift.b;
2328 end;
2329
2330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2331 function TFormatDescriptor.GetAlphaMask: QWord;
2332 begin
2333   result := fRange.a shl fShift.a;
2334 end;
2335
2336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2337 function TFormatDescriptor.GetIsCompressed: Boolean;
2338 begin
2339   result := fIsCompressed;
2340 end;
2341
2342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2343 function TFormatDescriptor.GetHasAlpha: Boolean;
2344 begin
2345   result := (fRange.a > 0);
2346 end;
2347
2348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2349 function TFormatDescriptor.GetglFormat: GLenum;
2350 begin
2351   result := fglFormat;
2352 end;
2353
2354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2355 function TFormatDescriptor.GetglInternalFormat: GLenum;
2356 begin
2357   result := fglInternalFormat;
2358 end;
2359
2360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2361 function TFormatDescriptor.GetglDataFormat: GLenum;
2362 begin
2363   result := fglDataFormat;
2364 end;
2365
2366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 function TFormatDescriptor.GetComponents: Integer;
2368 var
2369   i: Integer;
2370 begin
2371   result := 0;
2372   for i := 0 to 3 do
2373     if (fRange.arr[i] > 0) then
2374       inc(result);
2375 end;
2376
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2379 var
2380   w, h: Integer;
2381 begin
2382   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2383     w := Max(1, aSize.X);
2384     h := Max(1, aSize.Y);
2385     result := GetSize(w, h);
2386   end else
2387     result := 0;
2388 end;
2389
2390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2391 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2392 begin
2393   result := 0;
2394   if (aWidth <= 0) or (aHeight <= 0) then
2395     exit;
2396   result := Ceil(aWidth * aHeight * fPixelSize);
2397 end;
2398
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 function TFormatDescriptor.CreateMappingData: Pointer;
2401 begin
2402   result := nil;
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2407 begin
2408   //DUMMY
2409 end;
2410
2411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2412 function TFormatDescriptor.IsEmpty: Boolean;
2413 begin
2414   result := (fFormat = tfEmpty);
2415 end;
2416
2417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2418 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2419 begin
2420   result := false;
2421   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2422     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2423   if (aRedMask   <> RedMask) then
2424     exit;
2425   if (aGreenMask <> GreenMask) then
2426     exit;
2427   if (aBlueMask  <> BlueMask) then
2428     exit;
2429   if (aAlphaMask <> AlphaMask) then
2430     exit;
2431   result := true;
2432 end;
2433
2434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2435 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2436 begin
2437   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2438   aPixel.Data   := fRange;
2439   aPixel.Range  := fRange;
2440   aPixel.Format := fFormat;
2441 end;
2442
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 constructor TFormatDescriptor.Create;
2445 begin
2446   inherited Create;
2447
2448   fFormat       := tfEmpty;
2449   fWithAlpha    := tfEmpty;
2450   fWithoutAlpha := tfEmpty;
2451   fRGBInverted  := tfEmpty;
2452   fUncompressed := tfEmpty;
2453   fPixelSize    := 0.0;
2454   fIsCompressed := false;
2455
2456   fglFormat         := 0;
2457   fglInternalFormat := 0;
2458   fglDataFormat     := 0;
2459
2460   FillChar(fRange, 0, SizeOf(fRange));
2461   FillChar(fShift, 0, SizeOf(fShift));
2462 end;
2463
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2467 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2468 begin
2469   aData^ := aPixel.Data.a;
2470   inc(aData);
2471 end;
2472
2473 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2474 begin
2475   aPixel.Data.r := 0;
2476   aPixel.Data.g := 0;
2477   aPixel.Data.b := 0;
2478   aPixel.Data.a := aData^;
2479   inc(aData);
2480 end;
2481
2482 constructor TfdAlpha_UB1.Create;
2483 begin
2484   inherited Create;
2485   fPixelSize        := 1.0;
2486   fRange.a          := $FF;
2487   fglFormat         := GL_ALPHA;
2488   fglDataFormat     := GL_UNSIGNED_BYTE;
2489 end;
2490
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2495 begin
2496   aData^ := LuminanceWeight(aPixel);
2497   inc(aData);
2498 end;
2499
2500 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2501 begin
2502   aPixel.Data.r := aData^;
2503   aPixel.Data.g := aData^;
2504   aPixel.Data.b := aData^;
2505   aPixel.Data.a := 0;
2506   inc(aData);
2507 end;
2508
2509 constructor TfdLuminance_UB1.Create;
2510 begin
2511   inherited Create;
2512   fPixelSize        := 1.0;
2513   fRange.r          := $FF;
2514   fRange.g          := $FF;
2515   fRange.b          := $FF;
2516   fglFormat         := GL_LUMINANCE;
2517   fglDataFormat     := GL_UNSIGNED_BYTE;
2518 end;
2519
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2523 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2524 var
2525   i: Integer;
2526 begin
2527   aData^ := 0;
2528   for i := 0 to 3 do
2529     if (fRange.arr[i] > 0) then
2530       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2531   inc(aData);
2532 end;
2533
2534 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2535 var
2536   i: Integer;
2537 begin
2538   for i := 0 to 3 do
2539     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2540   inc(aData);
2541 end;
2542
2543 constructor TfdUniversal_UB1.Create;
2544 begin
2545   inherited Create;
2546   fPixelSize := 1.0;
2547 end;
2548
2549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2552 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2553 begin
2554   inherited Map(aPixel, aData, aMapData);
2555   aData^ := aPixel.Data.a;
2556   inc(aData);
2557 end;
2558
2559 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2560 begin
2561   inherited Unmap(aData, aPixel, aMapData);
2562   aPixel.Data.a := aData^;
2563   inc(aData);
2564 end;
2565
2566 constructor TfdLuminanceAlpha_UB2.Create;
2567 begin
2568   inherited Create;
2569   fPixelSize        := 2.0;
2570   fRange.a          := $FF;
2571   fShift.a          :=   8;
2572   fglFormat         := GL_LUMINANCE_ALPHA;
2573   fglDataFormat     := GL_UNSIGNED_BYTE;
2574 end;
2575
2576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2580 begin
2581   aData^ := aPixel.Data.r;
2582   inc(aData);
2583   aData^ := aPixel.Data.g;
2584   inc(aData);
2585   aData^ := aPixel.Data.b;
2586   inc(aData);
2587 end;
2588
2589 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2590 begin
2591   aPixel.Data.r := aData^;
2592   inc(aData);
2593   aPixel.Data.g := aData^;
2594   inc(aData);
2595   aPixel.Data.b := aData^;
2596   inc(aData);
2597   aPixel.Data.a := 0;
2598 end;
2599
2600 constructor TfdRGB_UB3.Create;
2601 begin
2602   inherited Create;
2603   fPixelSize        := 3.0;
2604   fRange.r          := $FF;
2605   fRange.g          := $FF;
2606   fRange.b          := $FF;
2607   fShift.r          :=   0;
2608   fShift.g          :=   8;
2609   fShift.b          :=  16;
2610   fglFormat         := GL_RGB;
2611   fglDataFormat     := GL_UNSIGNED_BYTE;
2612 end;
2613
2614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2617 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2618 begin
2619   aData^ := aPixel.Data.b;
2620   inc(aData);
2621   aData^ := aPixel.Data.g;
2622   inc(aData);
2623   aData^ := aPixel.Data.r;
2624   inc(aData);
2625 end;
2626
2627 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2628 begin
2629   aPixel.Data.b := aData^;
2630   inc(aData);
2631   aPixel.Data.g := aData^;
2632   inc(aData);
2633   aPixel.Data.r := aData^;
2634   inc(aData);
2635   aPixel.Data.a := 0;
2636 end;
2637
2638 constructor TfdBGR_UB3.Create;
2639 begin
2640   fPixelSize        := 3.0;
2641   fRange.r          := $FF;
2642   fRange.g          := $FF;
2643   fRange.b          := $FF;
2644   fShift.r          :=  16;
2645   fShift.g          :=   8;
2646   fShift.b          :=   0;
2647   fglFormat         := GL_BGR;
2648   fglDataFormat     := GL_UNSIGNED_BYTE;
2649 end;
2650
2651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2654 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2655 begin
2656   inherited Map(aPixel, aData, aMapData);
2657   aData^ := aPixel.Data.a;
2658   inc(aData);
2659 end;
2660
2661 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2662 begin
2663   inherited Unmap(aData, aPixel, aMapData);
2664   aPixel.Data.a := aData^;
2665   inc(aData);
2666 end;
2667
2668 constructor TfdRGBA_UB4.Create;
2669 begin
2670   inherited Create;
2671   fPixelSize        := 4.0;
2672   fRange.a          := $FF;
2673   fShift.a          :=  24;
2674   fglFormat         := GL_RGBA;
2675   fglDataFormat     := GL_UNSIGNED_BYTE;
2676 end;
2677
2678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2682 begin
2683   inherited Map(aPixel, aData, aMapData);
2684   aData^ := aPixel.Data.a;
2685   inc(aData);
2686 end;
2687
2688 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2689 begin
2690   inherited Unmap(aData, aPixel, aMapData);
2691   aPixel.Data.a := aData^;
2692   inc(aData);
2693 end;
2694
2695 constructor TfdBGRA_UB4.Create;
2696 begin
2697   inherited Create;
2698   fPixelSize        := 4.0;
2699   fRange.a          := $FF;
2700   fShift.a          :=  24;
2701   fglFormat         := GL_BGRA;
2702   fglDataFormat     := GL_UNSIGNED_BYTE;
2703 end;
2704
2705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2709 begin
2710   PWord(aData)^ := aPixel.Data.a;
2711   inc(aData, 2);
2712 end;
2713
2714 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2715 begin
2716   aPixel.Data.r := 0;
2717   aPixel.Data.g := 0;
2718   aPixel.Data.b := 0;
2719   aPixel.Data.a := PWord(aData)^;
2720   inc(aData, 2);
2721 end;
2722
2723 constructor TfdAlpha_US1.Create;
2724 begin
2725   inherited Create;
2726   fPixelSize        := 2.0;
2727   fRange.a          := $FFFF;
2728   fglFormat         := GL_ALPHA;
2729   fglDataFormat     := GL_UNSIGNED_SHORT;
2730 end;
2731
2732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2736 begin
2737   PWord(aData)^ := LuminanceWeight(aPixel);
2738   inc(aData, 2);
2739 end;
2740
2741 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2742 begin
2743   aPixel.Data.r := PWord(aData)^;
2744   aPixel.Data.g := PWord(aData)^;
2745   aPixel.Data.b := PWord(aData)^;
2746   aPixel.Data.a := 0;
2747   inc(aData, 2);
2748 end;
2749
2750 constructor TfdLuminance_US1.Create;
2751 begin
2752   inherited Create;
2753   fPixelSize        := 2.0;
2754   fRange.r          := $FFFF;
2755   fRange.g          := $FFFF;
2756   fRange.b          := $FFFF;
2757   fglFormat         := GL_LUMINANCE;
2758   fglDataFormat     := GL_UNSIGNED_SHORT;
2759 end;
2760
2761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2764 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2765 var
2766   i: Integer;
2767 begin
2768   PWord(aData)^ := 0;
2769   for i := 0 to 3 do
2770     if (fRange.arr[i] > 0) then
2771       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2772   inc(aData, 2);
2773 end;
2774
2775 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2776 var
2777   i: Integer;
2778 begin
2779   for i := 0 to 3 do
2780     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2781   inc(aData, 2);
2782 end;
2783
2784 constructor TfdUniversal_US1.Create;
2785 begin
2786   inherited Create;
2787   fPixelSize := 2.0;
2788 end;
2789
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2793 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2794 begin
2795   PWord(aData)^ := DepthWeight(aPixel);
2796   inc(aData, 2);
2797 end;
2798
2799 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2800 begin
2801   aPixel.Data.r := PWord(aData)^;
2802   aPixel.Data.g := PWord(aData)^;
2803   aPixel.Data.b := PWord(aData)^;
2804   aPixel.Data.a := 0;
2805   inc(aData, 2);
2806 end;
2807
2808 constructor TfdDepth_US1.Create;
2809 begin
2810   inherited Create;
2811   fPixelSize        := 2.0;
2812   fRange.r          := $FFFF;
2813   fRange.g          := $FFFF;
2814   fRange.b          := $FFFF;
2815   fglFormat         := GL_DEPTH_COMPONENT;
2816   fglDataFormat     := GL_UNSIGNED_SHORT;
2817 end;
2818
2819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2822 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2823 begin
2824   inherited Map(aPixel, aData, aMapData);
2825   PWord(aData)^ := aPixel.Data.a;
2826   inc(aData, 2);
2827 end;
2828
2829 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2830 begin
2831   inherited Unmap(aData, aPixel, aMapData);
2832   aPixel.Data.a := PWord(aData)^;
2833   inc(aData, 2);
2834 end;
2835
2836 constructor TfdLuminanceAlpha_US2.Create;
2837 begin
2838   inherited Create;
2839   fPixelSize        :=   4.0;
2840   fRange.a          := $FFFF;
2841   fShift.a          :=    16;
2842   fglFormat         := GL_LUMINANCE_ALPHA;
2843   fglDataFormat     := GL_UNSIGNED_SHORT;
2844 end;
2845
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2850 begin
2851   PWord(aData)^ := aPixel.Data.r;
2852   inc(aData, 2);
2853   PWord(aData)^ := aPixel.Data.g;
2854   inc(aData, 2);
2855   PWord(aData)^ := aPixel.Data.b;
2856   inc(aData, 2);
2857 end;
2858
2859 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2860 begin
2861   aPixel.Data.r := PWord(aData)^;
2862   inc(aData, 2);
2863   aPixel.Data.g := PWord(aData)^;
2864   inc(aData, 2);
2865   aPixel.Data.b := PWord(aData)^;
2866   inc(aData, 2);
2867   aPixel.Data.a := 0;
2868 end;
2869
2870 constructor TfdRGB_US3.Create;
2871 begin
2872   inherited Create;
2873   fPixelSize        :=   6.0;
2874   fRange.r          := $FFFF;
2875   fRange.g          := $FFFF;
2876   fRange.b          := $FFFF;
2877   fShift.r          :=     0;
2878   fShift.g          :=    16;
2879   fShift.b          :=    32;
2880   fglFormat         := GL_RGB;
2881   fglDataFormat     := GL_UNSIGNED_SHORT;
2882 end;
2883
2884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2887 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2888 begin
2889   PWord(aData)^ := aPixel.Data.b;
2890   inc(aData, 2);
2891   PWord(aData)^ := aPixel.Data.g;
2892   inc(aData, 2);
2893   PWord(aData)^ := aPixel.Data.r;
2894   inc(aData, 2);
2895 end;
2896
2897 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2898 begin
2899   aPixel.Data.b := PWord(aData)^;
2900   inc(aData, 2);
2901   aPixel.Data.g := PWord(aData)^;
2902   inc(aData, 2);
2903   aPixel.Data.r := PWord(aData)^;
2904   inc(aData, 2);
2905   aPixel.Data.a := 0;
2906 end;
2907
2908 constructor TfdBGR_US3.Create;
2909 begin
2910   inherited Create;
2911   fPixelSize        :=   6.0;
2912   fRange.r          := $FFFF;
2913   fRange.g          := $FFFF;
2914   fRange.b          := $FFFF;
2915   fShift.r          :=    32;
2916   fShift.g          :=    16;
2917   fShift.b          :=     0;
2918   fglFormat         := GL_BGR;
2919   fglDataFormat     := GL_UNSIGNED_SHORT;
2920 end;
2921
2922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2925 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2926 begin
2927   inherited Map(aPixel, aData, aMapData);
2928   PWord(aData)^ := aPixel.Data.a;
2929   inc(aData, 2);
2930 end;
2931
2932 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2933 begin
2934   inherited Unmap(aData, aPixel, aMapData);
2935   aPixel.Data.a := PWord(aData)^;
2936   inc(aData, 2);
2937 end;
2938
2939 constructor TfdRGBA_US4.Create;
2940 begin
2941   inherited Create;
2942   fPixelSize        :=   8.0;
2943   fRange.a          := $FFFF;
2944   fShift.a          :=    48;
2945   fglFormat         := GL_RGBA;
2946   fglDataFormat     := GL_UNSIGNED_SHORT;
2947 end;
2948
2949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2952 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2953 begin
2954   inherited Map(aPixel, aData, aMapData);
2955   PWord(aData)^ := aPixel.Data.a;
2956   inc(aData, 2);
2957 end;
2958
2959 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2960 begin
2961   inherited Unmap(aData, aPixel, aMapData);
2962   aPixel.Data.a := PWord(aData)^;
2963   inc(aData, 2);
2964 end;
2965
2966 constructor TfdBGRA_US4.Create;
2967 begin
2968   inherited Create;
2969   fPixelSize        :=   8.0;
2970   fRange.a          := $FFFF;
2971   fShift.a          :=    48;
2972   fglFormat         := GL_BGRA;
2973   fglDataFormat     := GL_UNSIGNED_SHORT;
2974 end;
2975
2976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2979 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2980 var
2981   i: Integer;
2982 begin
2983   PCardinal(aData)^ := 0;
2984   for i := 0 to 3 do
2985     if (fRange.arr[i] > 0) then
2986       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2987   inc(aData, 4);
2988 end;
2989
2990 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2991 var
2992   i: Integer;
2993 begin
2994   for i := 0 to 3 do
2995     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2996   inc(aData, 2);
2997 end;
2998
2999 constructor TfdUniversal_UI1.Create;
3000 begin
3001   inherited Create;
3002   fPixelSize := 4.0;
3003 end;
3004
3005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3008 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3009 begin
3010   PCardinal(aData)^ := DepthWeight(aPixel);
3011   inc(aData, 4);
3012 end;
3013
3014 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3015 begin
3016   aPixel.Data.r := PCardinal(aData)^;
3017   aPixel.Data.g := PCardinal(aData)^;
3018   aPixel.Data.b := PCardinal(aData)^;
3019   aPixel.Data.a := 0;
3020   inc(aData, 4);
3021 end;
3022
3023 constructor TfdDepth_UI1.Create;
3024 begin
3025   inherited Create;
3026   fPixelSize        := 4.0;
3027   fRange.r          := $FFFFFFFF;
3028   fRange.g          := $FFFFFFFF;
3029   fRange.b          := $FFFFFFFF;
3030   fglFormat         := GL_DEPTH_COMPONENT;
3031   fglDataFormat     := GL_UNSIGNED_INT;
3032 end;
3033
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3037 constructor TfdAlpha4.Create;
3038 begin
3039   inherited Create;
3040   fFormat           := tfAlpha4;
3041   fWithAlpha        := tfAlpha4;
3042   fglInternalFormat := GL_ALPHA4;
3043 end;
3044
3045 constructor TfdAlpha8.Create;
3046 begin
3047   inherited Create;
3048   fFormat           := tfAlpha8;
3049   fWithAlpha        := tfAlpha8;
3050   fglInternalFormat := GL_ALPHA8;
3051 end;
3052
3053 constructor TfdAlpha12.Create;
3054 begin
3055   inherited Create;
3056   fFormat           := tfAlpha12;
3057   fWithAlpha        := tfAlpha12;
3058   fglInternalFormat := GL_ALPHA12;
3059 end;
3060
3061 constructor TfdAlpha16.Create;
3062 begin
3063   inherited Create;
3064   fFormat           := tfAlpha16;
3065   fWithAlpha        := tfAlpha16;
3066   fglInternalFormat := GL_ALPHA16;
3067 end;
3068
3069 constructor TfdLuminance4.Create;
3070 begin
3071   inherited Create;
3072   fFormat           := tfLuminance4;
3073   fWithAlpha        := tfLuminance4Alpha4;
3074   fWithoutAlpha     := tfLuminance4;
3075   fglInternalFormat := GL_LUMINANCE4;
3076 end;
3077
3078 constructor TfdLuminance8.Create;
3079 begin
3080   inherited Create;
3081   fFormat           := tfLuminance8;
3082   fWithAlpha        := tfLuminance8Alpha8;
3083   fWithoutAlpha     := tfLuminance8;
3084   fglInternalFormat := GL_LUMINANCE8;
3085 end;
3086
3087 constructor TfdLuminance12.Create;
3088 begin
3089   inherited Create;
3090   fFormat           := tfLuminance12;
3091   fWithAlpha        := tfLuminance12Alpha12;
3092   fWithoutAlpha     := tfLuminance12;
3093   fglInternalFormat := GL_LUMINANCE12;
3094 end;
3095
3096 constructor TfdLuminance16.Create;
3097 begin
3098   inherited Create;
3099   fFormat           := tfLuminance16;
3100   fWithAlpha        := tfLuminance16Alpha16;
3101   fWithoutAlpha     := tfLuminance16;
3102   fglInternalFormat := GL_LUMINANCE16;
3103 end;
3104
3105 constructor TfdLuminance4Alpha4.Create;
3106 begin
3107   inherited Create;
3108   fFormat           := tfLuminance4Alpha4;
3109   fWithAlpha        := tfLuminance4Alpha4;
3110   fWithoutAlpha     := tfLuminance4;
3111   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3112 end;
3113
3114 constructor TfdLuminance6Alpha2.Create;
3115 begin
3116   inherited Create;
3117   fFormat           := tfLuminance6Alpha2;
3118   fWithAlpha        := tfLuminance6Alpha2;
3119   fWithoutAlpha     := tfLuminance8;
3120   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3121 end;
3122
3123 constructor TfdLuminance8Alpha8.Create;
3124 begin
3125   inherited Create;
3126   fFormat           := tfLuminance8Alpha8;
3127   fWithAlpha        := tfLuminance8Alpha8;
3128   fWithoutAlpha     := tfLuminance8;
3129   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3130 end;
3131
3132 constructor TfdLuminance12Alpha4.Create;
3133 begin
3134   inherited Create;
3135   fFormat           := tfLuminance12Alpha4;
3136   fWithAlpha        := tfLuminance12Alpha4;
3137   fWithoutAlpha     := tfLuminance12;
3138   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3139 end;
3140
3141 constructor TfdLuminance12Alpha12.Create;
3142 begin
3143   inherited Create;
3144   fFormat           := tfLuminance12Alpha12;
3145   fWithAlpha        := tfLuminance12Alpha12;
3146   fWithoutAlpha     := tfLuminance12;
3147   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3148 end;
3149
3150 constructor TfdLuminance16Alpha16.Create;
3151 begin
3152   inherited Create;
3153   fFormat           := tfLuminance16Alpha16;
3154   fWithAlpha        := tfLuminance16Alpha16;
3155   fWithoutAlpha     := tfLuminance16;
3156   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3157 end;
3158
3159 constructor TfdR3G3B2.Create;
3160 begin
3161   inherited Create;
3162   fFormat           := tfR3G3B2;
3163   fWithAlpha        := tfRGBA2;
3164   fWithoutAlpha     := tfR3G3B2;
3165   fRange.r          := $7;
3166   fRange.g          := $7;
3167   fRange.b          := $3;
3168   fShift.r          :=  0;
3169   fShift.g          :=  3;
3170   fShift.b          :=  6;
3171   fglFormat         := GL_RGB;
3172   fglInternalFormat := GL_R3_G3_B2;
3173   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3174 end;
3175
3176 constructor TfdRGB4.Create;
3177 begin
3178   inherited Create;
3179   fFormat           := tfRGB4;
3180   fWithAlpha        := tfRGBA4;
3181   fWithoutAlpha     := tfRGB4;
3182   fRGBInverted      := tfBGR4;
3183   fRange.r          := $F;
3184   fRange.g          := $F;
3185   fRange.b          := $F;
3186   fShift.r          :=  0;
3187   fShift.g          :=  4;
3188   fShift.b          :=  8;
3189   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3190   fglInternalFormat := GL_RGB4;
3191   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3192 end;
3193
3194 constructor TfdR5G6B5.Create;
3195 begin
3196   inherited Create;
3197   fFormat           := tfR5G6B5;
3198   fWithAlpha        := tfRGBA4;
3199   fWithoutAlpha     := tfR5G6B5;
3200   fRGBInverted      := tfB5G6R5;
3201   fRange.r          := $1F;
3202   fRange.g          := $3F;
3203   fRange.b          := $1F;
3204   fShift.r          :=   0;
3205   fShift.g          :=   5;
3206   fShift.b          :=  11;
3207   fglFormat         := GL_RGB;
3208   fglInternalFormat := GL_RGB565;
3209   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3210 end;
3211
3212 constructor TfdRGB5.Create;
3213 begin
3214   inherited Create;
3215   fFormat           := tfRGB5;
3216   fWithAlpha        := tfRGB5A1;
3217   fWithoutAlpha     := tfRGB5;
3218   fRGBInverted      := tfBGR5;
3219   fRange.r          := $1F;
3220   fRange.g          := $1F;
3221   fRange.b          := $1F;
3222   fShift.r          :=   0;
3223   fShift.g          :=   5;
3224   fShift.b          :=  10;
3225   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3226   fglInternalFormat := GL_RGB5;
3227   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3228 end;
3229
3230 constructor TfdRGB8.Create;
3231 begin
3232   inherited Create;
3233   fFormat           := tfRGB8;
3234   fWithAlpha        := tfRGBA8;
3235   fWithoutAlpha     := tfRGB8;
3236   fRGBInverted      := tfBGR8;
3237   fglInternalFormat := GL_RGB8;
3238 end;
3239
3240 constructor TfdRGB10.Create;
3241 begin
3242   inherited Create;
3243   fFormat           := tfRGB10;
3244   fWithAlpha        := tfRGB10A2;
3245   fWithoutAlpha     := tfRGB10;
3246   fRGBInverted      := tfBGR10;
3247   fRange.r          := $3FF;
3248   fRange.g          := $3FF;
3249   fRange.b          := $3FF;
3250   fShift.r          :=    0;
3251   fShift.g          :=   10;
3252   fShift.b          :=   20;
3253   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3254   fglInternalFormat := GL_RGB10;
3255   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3256 end;
3257
3258 constructor TfdRGB12.Create;
3259 begin
3260   inherited Create;
3261   fFormat           := tfRGB12;
3262   fWithAlpha        := tfRGBA12;
3263   fWithoutAlpha     := tfRGB12;
3264   fRGBInverted      := tfBGR12;
3265   fglInternalFormat := GL_RGB12;
3266 end;
3267
3268 constructor TfdRGB16.Create;
3269 begin
3270   inherited Create;
3271   fFormat           := tfRGB16;
3272   fWithAlpha        := tfRGBA16;
3273   fWithoutAlpha     := tfRGB16;
3274   fRGBInverted      := tfBGR16;
3275   fglInternalFormat := GL_RGB16;
3276 end;
3277
3278 constructor TfdRGBA2.Create;
3279 begin
3280   inherited Create;
3281   fFormat           := tfRGBA2;
3282   fWithAlpha        := tfRGBA2;
3283   fWithoutAlpha     := tfR3G3B2;
3284   fRGBInverted      := tfBGRA2;
3285   fglInternalFormat := GL_RGBA2;
3286 end;
3287
3288 constructor TfdRGBA4.Create;
3289 begin
3290   inherited Create;
3291   fFormat           := tfRGBA4;
3292   fWithAlpha        := tfRGBA4;
3293   fWithoutAlpha     := tfRGB4;
3294   fRGBInverted      := tfBGRA4;
3295   fRange.r          := $F;
3296   fRange.g          := $F;
3297   fRange.b          := $F;
3298   fRange.a          := $F;
3299   fShift.r          :=  0;
3300   fShift.g          :=  4;
3301   fShift.b          :=  8;
3302   fShift.a          := 12;
3303   fglFormat         := GL_RGBA;
3304   fglInternalFormat := GL_RGBA4;
3305   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3306 end;
3307
3308 constructor TfdRGB5A1.Create;
3309 begin
3310   inherited Create;
3311   fFormat           := tfRGB5A1;
3312   fWithAlpha        := tfRGB5A1;
3313   fWithoutAlpha     := tfRGB5;
3314   fRGBInverted      := tfBGR5A1;
3315   fRange.r          := $1F;
3316   fRange.g          := $1F;
3317   fRange.b          := $1F;
3318   fRange.a          := $01;
3319   fShift.r          :=   0;
3320   fShift.g          :=   5;
3321   fShift.b          :=  10;
3322   fShift.a          :=  15;
3323   fglFormat         := GL_RGBA;
3324   fglInternalFormat := GL_RGB5_A1;
3325   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3326 end;
3327
3328 constructor TfdRGBA8.Create;
3329 begin
3330   inherited Create;
3331   fFormat           := tfRGBA8;
3332   fWithAlpha        := tfRGBA8;
3333   fWithoutAlpha     := tfRGB8;
3334   fRGBInverted      := tfBGRA8;
3335   fglInternalFormat := GL_RGBA8;
3336 end;
3337
3338 constructor TfdRGB10A2.Create;
3339 begin
3340   inherited Create;
3341   fFormat           := tfRGB10A2;
3342   fWithAlpha        := tfRGB10A2;
3343   fWithoutAlpha     := tfRGB10;
3344   fRGBInverted      := tfBGR10A2;
3345   fRange.r          := $3FF;
3346   fRange.g          := $3FF;
3347   fRange.b          := $3FF;
3348   fRange.a          := $003;
3349   fShift.r          :=    0;
3350   fShift.g          :=   10;
3351   fShift.b          :=   20;
3352   fShift.a          :=   30;
3353   fglFormat         := GL_RGBA;
3354   fglInternalFormat := GL_RGB10_A2;
3355   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3356 end;
3357
3358 constructor TfdRGBA12.Create;
3359 begin
3360   inherited Create;
3361   fFormat           := tfRGBA12;
3362   fWithAlpha        := tfRGBA12;
3363   fWithoutAlpha     := tfRGB12;
3364   fRGBInverted      := tfBGRA12;
3365   fglInternalFormat := GL_RGBA12;
3366 end;
3367
3368 constructor TfdRGBA16.Create;
3369 begin
3370   inherited Create;
3371   fFormat           := tfRGBA16;
3372   fWithAlpha        := tfRGBA16;
3373   fWithoutAlpha     := tfRGB16;
3374   fRGBInverted      := tfBGRA16;
3375   fglInternalFormat := GL_RGBA16;
3376 end;
3377
3378 constructor TfdBGR4.Create;
3379 begin
3380   inherited Create;
3381   fPixelSize        := 2.0;
3382   fFormat           := tfBGR4;
3383   fWithAlpha        := tfBGRA4;
3384   fWithoutAlpha     := tfBGR4;
3385   fRGBInverted      := tfRGB4;
3386   fRange.r          := $F;
3387   fRange.g          := $F;
3388   fRange.b          := $F;
3389   fRange.a          := $0;
3390   fShift.r          :=  8;
3391   fShift.g          :=  4;
3392   fShift.b          :=  0;
3393   fShift.a          :=  0;
3394   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3395   fglInternalFormat := GL_RGB4;
3396   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3397 end;
3398
3399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3402 constructor TfdB5G6R5.Create;
3403 begin
3404   inherited Create;
3405   fFormat           := tfB5G6R5;
3406   fWithAlpha        := tfBGRA4;
3407   fWithoutAlpha     := tfB5G6R5;
3408   fRGBInverted      := tfR5G6B5;
3409   fRange.r          := $1F;
3410   fRange.g          := $3F;
3411   fRange.b          := $1F;
3412   fShift.r          :=  11;
3413   fShift.g          :=   5;
3414   fShift.b          :=   0;
3415   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3416   fglInternalFormat := GL_RGB8;
3417   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3418 end;
3419
3420 constructor TfdBGR5.Create;
3421 begin
3422   inherited Create;
3423   fPixelSize        := 2.0;
3424   fFormat           := tfBGR5;
3425   fWithAlpha        := tfBGR5A1;
3426   fWithoutAlpha     := tfBGR5;
3427   fRGBInverted      := tfRGB5;
3428   fRange.r          := $1F;
3429   fRange.g          := $1F;
3430   fRange.b          := $1F;
3431   fRange.a          := $00;
3432   fShift.r          :=  10;
3433   fShift.g          :=   5;
3434   fShift.b          :=   0;
3435   fShift.a          :=   0;
3436   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3437   fglInternalFormat := GL_RGB5;
3438   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3439 end;
3440
3441 constructor TfdBGR8.Create;
3442 begin
3443   inherited Create;
3444   fFormat           := tfBGR8;
3445   fWithAlpha        := tfBGRA8;
3446   fWithoutAlpha     := tfBGR8;
3447   fRGBInverted      := tfRGB8;
3448   fglInternalFormat := GL_RGB8;
3449 end;
3450
3451 constructor TfdBGR10.Create;
3452 begin
3453   inherited Create;
3454   fFormat           := tfBGR10;
3455   fWithAlpha        := tfBGR10A2;
3456   fWithoutAlpha     := tfBGR10;
3457   fRGBInverted      := tfRGB10;
3458   fRange.r          := $3FF;
3459   fRange.g          := $3FF;
3460   fRange.b          := $3FF;
3461   fRange.a          := $000;
3462   fShift.r          :=   20;
3463   fShift.g          :=   10;
3464   fShift.b          :=    0;
3465   fShift.a          :=    0;
3466   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3467   fglInternalFormat := GL_RGB10;
3468   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3469 end;
3470
3471 constructor TfdBGR12.Create;
3472 begin
3473   inherited Create;
3474   fFormat           := tfBGR12;
3475   fWithAlpha        := tfBGRA12;
3476   fWithoutAlpha     := tfBGR12;
3477   fRGBInverted      := tfRGB12;
3478   fglInternalFormat := GL_RGB12;
3479 end;
3480
3481 constructor TfdBGR16.Create;
3482 begin
3483   inherited Create;
3484   fFormat           := tfBGR16;
3485   fWithAlpha        := tfBGRA16;
3486   fWithoutAlpha     := tfBGR16;
3487   fRGBInverted      := tfRGB16;
3488   fglInternalFormat := GL_RGB16;
3489 end;
3490
3491 constructor TfdBGRA2.Create;
3492 begin
3493   inherited Create;
3494   fFormat           := tfBGRA2;
3495   fWithAlpha        := tfBGRA4;
3496   fWithoutAlpha     := tfBGR4;
3497   fRGBInverted      := tfRGBA2;
3498   fglInternalFormat := GL_RGBA2;
3499 end;
3500
3501 constructor TfdBGRA4.Create;
3502 begin
3503   inherited Create;
3504   fFormat           := tfBGRA4;
3505   fWithAlpha        := tfBGRA4;
3506   fWithoutAlpha     := tfBGR4;
3507   fRGBInverted      := tfRGBA4;
3508   fRange.r          := $F;
3509   fRange.g          := $F;
3510   fRange.b          := $F;
3511   fRange.a          := $F;
3512   fShift.r          :=  8;
3513   fShift.g          :=  4;
3514   fShift.b          :=  0;
3515   fShift.a          := 12;
3516   fglFormat         := GL_BGRA;
3517   fglInternalFormat := GL_RGBA4;
3518   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3519 end;
3520
3521 constructor TfdBGR5A1.Create;
3522 begin
3523   inherited Create;
3524   fFormat           := tfBGR5A1;
3525   fWithAlpha        := tfBGR5A1;
3526   fWithoutAlpha     := tfBGR5;
3527   fRGBInverted      := tfRGB5A1;
3528   fRange.r          := $1F;
3529   fRange.g          := $1F;
3530   fRange.b          := $1F;
3531   fRange.a          := $01;
3532   fShift.r          :=  10;
3533   fShift.g          :=   5;
3534   fShift.b          :=   0;
3535   fShift.a          :=  15;
3536   fglFormat         := GL_BGRA;
3537   fglInternalFormat := GL_RGB5_A1;
3538   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3539 end;
3540
3541 constructor TfdBGRA8.Create;
3542 begin
3543   inherited Create;
3544   fFormat           := tfBGRA8;
3545   fWithAlpha        := tfBGRA8;
3546   fWithoutAlpha     := tfBGR8;
3547   fRGBInverted      := tfRGBA8;
3548   fglInternalFormat := GL_RGBA8;
3549 end;
3550
3551 constructor TfdBGR10A2.Create;
3552 begin
3553   inherited Create;
3554   fFormat           := tfBGR10A2;
3555   fWithAlpha        := tfBGR10A2;
3556   fWithoutAlpha     := tfBGR10;
3557   fRGBInverted      := tfRGB10A2;
3558   fRange.r          := $3FF;
3559   fRange.g          := $3FF;
3560   fRange.b          := $3FF;
3561   fRange.a          := $003;
3562   fShift.r          :=   20;
3563   fShift.g          :=   10;
3564   fShift.b          :=    0;
3565   fShift.a          :=   30;
3566   fglFormat         := GL_BGRA;
3567   fglInternalFormat := GL_RGB10_A2;
3568   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3569 end;
3570
3571 constructor TfdBGRA12.Create;
3572 begin
3573   inherited Create;
3574   fFormat           := tfBGRA12;
3575   fWithAlpha        := tfBGRA12;
3576   fWithoutAlpha     := tfBGR12;
3577   fRGBInverted      := tfRGBA12;
3578   fglInternalFormat := GL_RGBA12;
3579 end;
3580
3581 constructor TfdBGRA16.Create;
3582 begin
3583   inherited Create;
3584   fFormat           := tfBGRA16;
3585   fWithAlpha        := tfBGRA16;
3586   fWithoutAlpha     := tfBGR16;
3587   fRGBInverted      := tfRGBA16;
3588   fglInternalFormat := GL_RGBA16;
3589 end;
3590
3591 constructor TfdDepth16.Create;
3592 begin
3593   inherited Create;
3594   fFormat           := tfDepth16;
3595   fWithAlpha        := tfEmpty;
3596   fWithoutAlpha     := tfDepth16;
3597   fglInternalFormat := GL_DEPTH_COMPONENT16;
3598 end;
3599
3600 constructor TfdDepth24.Create;
3601 begin
3602   inherited Create;
3603   fFormat           := tfDepth24;
3604   fWithAlpha        := tfEmpty;
3605   fWithoutAlpha     := tfDepth24;
3606   fglInternalFormat := GL_DEPTH_COMPONENT24;
3607 end;
3608
3609 constructor TfdDepth32.Create;
3610 begin
3611   inherited Create;
3612   fFormat           := tfDepth32;
3613   fWithAlpha        := tfEmpty;
3614   fWithoutAlpha     := tfDepth32;
3615   fglInternalFormat := GL_DEPTH_COMPONENT32;
3616 end;
3617
3618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3619 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3621 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3622 begin
3623   raise EglBitmap.Create('mapping for compressed formats is not supported');
3624 end;
3625
3626 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3627 begin
3628   raise EglBitmap.Create('mapping for compressed formats is not supported');
3629 end;
3630
3631 constructor TfdS3tcDtx1RGBA.Create;
3632 begin
3633   inherited Create;
3634   fFormat           := tfS3tcDtx1RGBA;
3635   fWithAlpha        := tfS3tcDtx1RGBA;
3636   fUncompressed     := tfRGB5A1;
3637   fPixelSize        := 0.5;
3638   fIsCompressed     := true;
3639   fglFormat         := GL_COMPRESSED_RGBA;
3640   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3641   fglDataFormat     := GL_UNSIGNED_BYTE;
3642 end;
3643
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3648 begin
3649   raise EglBitmap.Create('mapping for compressed formats is not supported');
3650 end;
3651
3652 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3653 begin
3654   raise EglBitmap.Create('mapping for compressed formats is not supported');
3655 end;
3656
3657 constructor TfdS3tcDtx3RGBA.Create;
3658 begin
3659   inherited Create;
3660   fFormat           := tfS3tcDtx3RGBA;
3661   fWithAlpha        := tfS3tcDtx3RGBA;
3662   fUncompressed     := tfRGBA8;
3663   fPixelSize        := 1.0;
3664   fIsCompressed     := true;
3665   fglFormat         := GL_COMPRESSED_RGBA;
3666   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3667   fglDataFormat     := GL_UNSIGNED_BYTE;
3668 end;
3669
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3674 begin
3675   raise EglBitmap.Create('mapping for compressed formats is not supported');
3676 end;
3677
3678 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3679 begin
3680   raise EglBitmap.Create('mapping for compressed formats is not supported');
3681 end;
3682
3683 constructor TfdS3tcDtx5RGBA.Create;
3684 begin
3685   inherited Create;
3686   fFormat           := tfS3tcDtx3RGBA;
3687   fWithAlpha        := tfS3tcDtx3RGBA;
3688   fUncompressed     := tfRGBA8;
3689   fPixelSize        := 1.0;
3690   fIsCompressed     := true;
3691   fglFormat         := GL_COMPRESSED_RGBA;
3692   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3693   fglDataFormat     := GL_UNSIGNED_BYTE;
3694 end;
3695
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 class procedure TFormatDescriptor.Init;
3700 begin
3701   if not Assigned(FormatDescriptorCS) then
3702     FormatDescriptorCS := TCriticalSection.Create;
3703 end;
3704
3705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3706 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3707 begin
3708   FormatDescriptorCS.Enter;
3709   try
3710     result := FormatDescriptors[aFormat];
3711     if not Assigned(result) then begin
3712       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3713       FormatDescriptors[aFormat] := result;
3714     end;
3715   finally
3716     FormatDescriptorCS.Leave;
3717   end;
3718 end;
3719
3720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3721 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3722 begin
3723   result := Get(Get(aFormat).WithAlpha);
3724 end;
3725
3726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3727 class procedure TFormatDescriptor.Clear;
3728 var
3729   f: TglBitmapFormat;
3730 begin
3731   FormatDescriptorCS.Enter;
3732   try
3733     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3734       FreeAndNil(FormatDescriptors[f]);
3735   finally
3736     FormatDescriptorCS.Leave;
3737   end;
3738 end;
3739
3740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 class procedure TFormatDescriptor.Finalize;
3742 begin
3743   Clear;
3744   FreeAndNil(FormatDescriptorCS);
3745 end;
3746
3747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3750 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3751 begin
3752   Update(aValue, fRange.r, fShift.r);
3753 end;
3754
3755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3756 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3757 begin
3758   Update(aValue, fRange.g, fShift.g);
3759 end;
3760
3761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3762 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3763 begin
3764   Update(aValue, fRange.b, fShift.b);
3765 end;
3766
3767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3768 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3769 begin
3770   Update(aValue, fRange.a, fShift.a);
3771 end;
3772
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3775   aShift: Byte);
3776 begin
3777   aShift := 0;
3778   aRange := 0;
3779   if (aMask = 0) then
3780     exit;
3781   while (aMask > 0) and ((aMask and 1) = 0) do begin
3782     inc(aShift);
3783     aMask := aMask shr 1;
3784   end;
3785   aRange := 1;
3786   while (aMask > 0) do begin
3787     aRange := aRange shl 1;
3788     aMask  := aMask  shr 1;
3789   end;
3790   dec(aRange);
3791
3792   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3793 end;
3794
3795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3796 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3797 var
3798   data: QWord;
3799   s: Integer;
3800 begin
3801   data :=
3802     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3803     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3804     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3805     ((aPixel.Data.a and fRange.a) shl fShift.a);
3806   s := Round(fPixelSize);
3807   case s of
3808     1:           aData^  := data;
3809     2:     PWord(aData)^ := data;
3810     4: PCardinal(aData)^ := data;
3811     8:    PQWord(aData)^ := data;
3812   else
3813     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3814   end;
3815   inc(aData, s);
3816 end;
3817
3818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3819 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3820 var
3821   data: QWord;
3822   s, i: Integer;
3823 begin
3824   s := Round(fPixelSize);
3825   case s of
3826     1: data :=           aData^;
3827     2: data :=     PWord(aData)^;
3828     4: data := PCardinal(aData)^;
3829     8: data :=    PQWord(aData)^;
3830   else
3831     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3832   end;
3833   for i := 0 to 3 do
3834     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3835   inc(aData, s);
3836 end;
3837
3838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3841 procedure TbmpColorTableFormat.CreateColorTable;
3842 var
3843   i: Integer;
3844 begin
3845   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3846     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3847
3848   if (Format = tfLuminance4) then
3849     SetLength(fColorTable, 16)
3850   else
3851     SetLength(fColorTable, 256);
3852
3853   case Format of
3854     tfLuminance4: begin
3855       for i := 0 to High(fColorTable) do begin
3856         fColorTable[i].r := 16 * i;
3857         fColorTable[i].g := 16 * i;
3858         fColorTable[i].b := 16 * i;
3859         fColorTable[i].a := 0;
3860       end;
3861     end;
3862
3863     tfLuminance8: begin
3864       for i := 0 to High(fColorTable) do begin
3865         fColorTable[i].r := i;
3866         fColorTable[i].g := i;
3867         fColorTable[i].b := i;
3868         fColorTable[i].a := 0;
3869       end;
3870     end;
3871
3872     tfR3G3B2: begin
3873       for i := 0 to High(fColorTable) do begin
3874         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3875         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3876         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3877         fColorTable[i].a := 0;
3878       end;
3879     end;
3880   end;
3881 end;
3882
3883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3885 var
3886   d: Byte;
3887 begin
3888   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3889     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3890
3891   case Format of
3892     tfLuminance4: begin
3893       if (aMapData = nil) then
3894         aData^ := 0;
3895       d := LuminanceWeight(aPixel) and Range.r;
3896       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3897       inc(PByte(aMapData), 4);
3898       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3899         inc(aData);
3900         aMapData := nil;
3901       end;
3902     end;
3903
3904     tfLuminance8: begin
3905       aData^ := LuminanceWeight(aPixel) and Range.r;
3906       inc(aData);
3907     end;
3908
3909     tfR3G3B2: begin
3910       aData^ := Round(
3911         ((aPixel.Data.r and Range.r) shl Shift.r) or
3912         ((aPixel.Data.g and Range.g) shl Shift.g) or
3913         ((aPixel.Data.b and Range.b) shl Shift.b));
3914       inc(aData);
3915     end;
3916   end;
3917 end;
3918
3919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3920 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3921 var
3922   idx: QWord;
3923   s: Integer;
3924   bits: Byte;
3925   f: Single;
3926 begin
3927   s    := Trunc(fPixelSize);
3928   f    := fPixelSize - s;
3929   bits := Round(8 * f);
3930   case s of
3931     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3932     1: idx :=           aData^;
3933     2: idx :=     PWord(aData)^;
3934     4: idx := PCardinal(aData)^;
3935     8: idx :=    PQWord(aData)^;
3936   else
3937     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3938   end;
3939   if (idx >= Length(fColorTable)) then
3940     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3941   with fColorTable[idx] do begin
3942     aPixel.Data.r := r;
3943     aPixel.Data.g := g;
3944     aPixel.Data.b := b;
3945     aPixel.Data.a := a;
3946   end;
3947   inc(PByte(aMapData), bits);
3948   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3949     inc(aData, 1);
3950     dec(PByte(aMapData), 8);
3951   end;
3952   inc(aData, s);
3953 end;
3954
3955 destructor TbmpColorTableFormat.Destroy;
3956 begin
3957   SetLength(fColorTable, 0);
3958   inherited Destroy;
3959 end;
3960
3961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3962 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3964 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3965 var
3966   i: Integer;
3967 begin
3968   for i := 0 to 3 do begin
3969     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3970       if (aSourceFD.Range.arr[i] > 0) then
3971         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3972       else
3973         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3974     end;
3975   end;
3976 end;
3977
3978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3979 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3980 begin
3981   with aFuncRec do begin
3982     if (Source.Range.r   > 0) then
3983       Dest.Data.r := Source.Data.r;
3984     if (Source.Range.g > 0) then
3985       Dest.Data.g := Source.Data.g;
3986     if (Source.Range.b  > 0) then
3987       Dest.Data.b := Source.Data.b;
3988     if (Source.Range.a > 0) then
3989       Dest.Data.a := Source.Data.a;
3990   end;
3991 end;
3992
3993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3994 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3995 var
3996   i: Integer;
3997 begin
3998   with aFuncRec do begin
3999     for i := 0 to 3 do
4000       if (Source.Range.arr[i] > 0) then
4001         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4002   end;
4003 end;
4004
4005 type
4006   TShiftData = packed record
4007     case Integer of
4008       0: (r, g, b, a: SmallInt);
4009       1: (arr: array[0..3] of SmallInt);
4010   end;
4011   PShiftData = ^TShiftData;
4012
4013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4014 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4015 var
4016   i: Integer;
4017 begin
4018   with aFuncRec do
4019     for i := 0 to 3 do
4020       if (Source.Range.arr[i] > 0) then
4021         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4022 end;
4023
4024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4025 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4026 begin
4027   with aFuncRec do begin
4028     Dest.Data := Source.Data;
4029     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4030       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4031       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4032       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4033     end;
4034     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4035       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4036     end;
4037   end;
4038 end;
4039
4040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4041 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4042 var
4043   i: Integer;
4044 begin
4045   with aFuncRec do begin
4046     for i := 0 to 3 do
4047       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4048   end;
4049 end;
4050
4051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4052 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4053 var
4054   Temp: Single;
4055 begin
4056   with FuncRec do begin
4057     if (FuncRec.Args = nil) then begin //source has no alpha
4058       Temp :=
4059         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4060         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4061         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4062       Dest.Data.a := Round(Dest.Range.a * Temp);
4063     end else
4064       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4065   end;
4066 end;
4067
4068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4069 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4070 type
4071   PglBitmapPixelData = ^TglBitmapPixelData;
4072 begin
4073   with FuncRec do begin
4074     Dest.Data.r := Source.Data.r;
4075     Dest.Data.g := Source.Data.g;
4076     Dest.Data.b := Source.Data.b;
4077
4078     with PglBitmapPixelData(Args)^ do
4079       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4080           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4081           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4082         Dest.Data.a := 0
4083       else
4084         Dest.Data.a := Dest.Range.a;
4085   end;
4086 end;
4087
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4090 begin
4091   with FuncRec do begin
4092     Dest.Data.r := Source.Data.r;
4093     Dest.Data.g := Source.Data.g;
4094     Dest.Data.b := Source.Data.b;
4095     Dest.Data.a := PCardinal(Args)^;
4096   end;
4097 end;
4098
4099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4100 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4101 type
4102   PRGBPix = ^TRGBPix;
4103   TRGBPix = array [0..2] of byte;
4104 var
4105   Temp: Byte;
4106 begin
4107   while aWidth > 0 do begin
4108     Temp := PRGBPix(aData)^[0];
4109     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4110     PRGBPix(aData)^[2] := Temp;
4111
4112     if aHasAlpha then
4113       Inc(aData, 4)
4114     else
4115       Inc(aData, 3);
4116     dec(aWidth);
4117   end;
4118 end;
4119
4120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4121 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4124 begin
4125   result := TFormatDescriptor.Get(Format);
4126 end;
4127
4128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4129 function TglBitmap.GetWidth: Integer;
4130 begin
4131   if (ffX in fDimension.Fields) then
4132     result := fDimension.X
4133   else
4134     result := -1;
4135 end;
4136
4137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4138 function TglBitmap.GetHeight: Integer;
4139 begin
4140   if (ffY in fDimension.Fields) then
4141     result := fDimension.Y
4142   else
4143     result := -1;
4144 end;
4145
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 function TglBitmap.GetFileWidth: Integer;
4148 begin
4149   result := Max(1, Width);
4150 end;
4151
4152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4153 function TglBitmap.GetFileHeight: Integer;
4154 begin
4155   result := Max(1, Height);
4156 end;
4157
4158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4159 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4160 begin
4161   if fCustomData = aValue then
4162     exit;
4163   fCustomData := aValue;
4164 end;
4165
4166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4167 procedure TglBitmap.SetCustomName(const aValue: String);
4168 begin
4169   if fCustomName = aValue then
4170     exit;
4171   fCustomName := aValue;
4172 end;
4173
4174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4175 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4176 begin
4177   if fCustomNameW = aValue then
4178     exit;
4179   fCustomNameW := aValue;
4180 end;
4181
4182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4183 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4184 begin
4185   if fFreeDataOnDestroy = aValue then
4186     exit;
4187   fFreeDataOnDestroy := aValue;
4188 end;
4189
4190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4191 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4192 begin
4193   if fDeleteTextureOnFree = aValue then
4194     exit;
4195   fDeleteTextureOnFree := aValue;
4196 end;
4197
4198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4199 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4200 begin
4201   if fFormat = aValue then
4202     exit;
4203   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4204     raise EglBitmapUnsupportedFormat.Create(Format);
4205   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4210 begin
4211   if fFreeDataAfterGenTexture = aValue then
4212     exit;
4213   fFreeDataAfterGenTexture := aValue;
4214 end;
4215
4216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4217 procedure TglBitmap.SetID(const aValue: Cardinal);
4218 begin
4219   if fID = aValue then
4220     exit;
4221   fID := aValue;
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4226 begin
4227   if fMipMap = aValue then
4228     exit;
4229   fMipMap := aValue;
4230 end;
4231
4232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4233 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4234 begin
4235   if fTarget = aValue then
4236     exit;
4237   fTarget := aValue;
4238 end;
4239
4240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4241 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4242 var
4243   MaxAnisotropic: Integer;
4244 begin
4245   fAnisotropic := aValue;
4246   if (ID > 0) then begin
4247     if GL_EXT_texture_filter_anisotropic then begin
4248       if fAnisotropic > 0 then begin
4249         Bind(false);
4250         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4251         if aValue > MaxAnisotropic then
4252           fAnisotropic := MaxAnisotropic;
4253         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4254       end;
4255     end else begin
4256       fAnisotropic := 0;
4257     end;
4258   end;
4259 end;
4260
4261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4262 procedure TglBitmap.CreateID;
4263 begin
4264   if (ID <> 0) then
4265     glDeleteTextures(1, @fID);
4266   glGenTextures(1, @fID);
4267   Bind(false);
4268 end;
4269
4270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4271 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4272 begin
4273   // Set Up Parameters
4274   SetWrap(fWrapS, fWrapT, fWrapR);
4275   SetFilter(fFilterMin, fFilterMag);
4276   SetAnisotropic(fAnisotropic);
4277   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4278
4279   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4280     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4281
4282   // Mip Maps Generation Mode
4283   aBuildWithGlu := false;
4284   if (MipMap = mmMipmap) then begin
4285     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4286       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4287     else
4288       aBuildWithGlu := true;
4289   end else if (MipMap = mmMipmapGlu) then
4290     aBuildWithGlu := true;
4291 end;
4292
4293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4294 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4295   const aWidth: Integer; const aHeight: Integer);
4296 var
4297   s: Single;
4298 begin
4299   if (Data <> aData) then begin
4300     if (Assigned(Data)) then
4301       FreeMem(Data);
4302     fData := aData;
4303   end;
4304
4305   if not Assigned(fData) then begin
4306     fPixelSize := 0;
4307     fRowSize   := 0;
4308   end else begin
4309     FillChar(fDimension, SizeOf(fDimension), 0);
4310     if aWidth <> -1 then begin
4311       fDimension.Fields := fDimension.Fields + [ffX];
4312       fDimension.X := aWidth;
4313     end;
4314
4315     if aHeight <> -1 then begin
4316       fDimension.Fields := fDimension.Fields + [ffY];
4317       fDimension.Y := aHeight;
4318     end;
4319
4320     s := TFormatDescriptor.Get(aFormat).PixelSize;
4321     fFormat    := aFormat;
4322     fPixelSize := Ceil(s);
4323     fRowSize   := Ceil(s * aWidth);
4324   end;
4325 end;
4326
4327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 function TglBitmap.FlipHorz: Boolean;
4329 begin
4330   result := false;
4331 end;
4332
4333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4334 function TglBitmap.FlipVert: Boolean;
4335 begin
4336   result := false;
4337 end;
4338
4339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4340 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4342 procedure TglBitmap.AfterConstruction;
4343 begin
4344   inherited AfterConstruction;
4345
4346   fID         := 0;
4347   fTarget     := 0;
4348   fIsResident := false;
4349
4350   fMipMap                  := glBitmapDefaultMipmap;
4351   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4352   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4353
4354   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4355   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4356   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 procedure TglBitmap.BeforeDestruction;
4361 var
4362   NewData: PByte;
4363 begin
4364   if fFreeDataOnDestroy then begin
4365     NewData := nil;
4366     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4367   end;
4368   if (fID > 0) and fDeleteTextureOnFree then
4369     glDeleteTextures(1, @fID);
4370   inherited BeforeDestruction;
4371 end;
4372
4373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4374 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4375 var
4376   TempPos: Integer;
4377 begin
4378   if not Assigned(aResType) then begin
4379     TempPos   := Pos('.', aResource);
4380     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4381     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4382   end;
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TglBitmap.LoadFromFile(const aFilename: String);
4387 var
4388   fs: TFileStream;
4389 begin
4390   if not FileExists(aFilename) then
4391     raise EglBitmap.Create('file does not exist: ' + aFilename);
4392   fFilename := aFilename;
4393   fs := TFileStream.Create(fFilename, fmOpenRead);
4394   try
4395     fs.Position := 0;
4396     LoadFromStream(fs);
4397   finally
4398     fs.Free;
4399   end;
4400 end;
4401
4402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4403 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4404 begin
4405   {$IFDEF GLB_SUPPORT_PNG_READ}
4406   if not LoadPNG(aStream) then
4407   {$ENDIF}
4408   {$IFDEF GLB_SUPPORT_JPEG_READ}
4409   if not LoadJPEG(aStream) then
4410   {$ENDIF}
4411   if not LoadDDS(aStream) then
4412   if not LoadTGA(aStream) then
4413   if not LoadBMP(aStream) then
4414     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4415 end;
4416
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4419   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4420 var
4421   tmpData: PByte;
4422   size: Integer;
4423 begin
4424   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4425   GetMem(tmpData, size);
4426   try
4427     FillChar(tmpData^, size, #$FF);
4428     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4429   except
4430     if Assigned(tmpData) then
4431       FreeMem(tmpData);
4432     raise;
4433   end;
4434   AddFunc(Self, aFunc, false, aFormat, aArgs);
4435 end;
4436
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4439 var
4440   rs: TResourceStream;
4441 begin
4442   PrepareResType(aResource, aResType);
4443   rs := TResourceStream.Create(aInstance, aResource, aResType);
4444   try
4445     LoadFromStream(rs);
4446   finally
4447     rs.Free;
4448   end;
4449 end;
4450
4451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4452 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4453 var
4454   rs: TResourceStream;
4455 begin
4456   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4457   try
4458     LoadFromStream(rs);
4459   finally
4460     rs.Free;
4461   end;
4462 end;
4463
4464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4465 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4466 var
4467   fs: TFileStream;
4468 begin
4469   fs := TFileStream.Create(aFileName, fmCreate);
4470   try
4471     fs.Position := 0;
4472     SaveToStream(fs, aFileType);
4473   finally
4474     fs.Free;
4475   end;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4480 begin
4481   case aFileType of
4482     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4483     ftPNG:  SavePNG(aStream);
4484     {$ENDIF}
4485     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4486     ftJPEG: SaveJPEG(aStream);
4487     {$ENDIF}
4488     ftDDS:  SaveDDS(aStream);
4489     ftTGA:  SaveTGA(aStream);
4490     ftBMP:  SaveBMP(aStream);
4491   end;
4492 end;
4493
4494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4495 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4496 begin
4497   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4498 end;
4499
4500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4501 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4502   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4503 var
4504   DestData, TmpData, SourceData: pByte;
4505   TempHeight, TempWidth: Integer;
4506   SourceFD, DestFD: TFormatDescriptor;
4507   SourceMD, DestMD: Pointer;
4508
4509   FuncRec: TglBitmapFunctionRec;
4510 begin
4511   Assert(Assigned(Data));
4512   Assert(Assigned(aSource));
4513   Assert(Assigned(aSource.Data));
4514
4515   result := false;
4516   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4517     SourceFD := TFormatDescriptor.Get(aSource.Format);
4518     DestFD   := TFormatDescriptor.Get(aFormat);
4519
4520     if (SourceFD.IsCompressed) then
4521       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4522     if (DestFD.IsCompressed) then
4523       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4524
4525     // inkompatible Formats so CreateTemp
4526     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4527       aCreateTemp := true;
4528
4529     // Values
4530     TempHeight := Max(1, aSource.Height);
4531     TempWidth  := Max(1, aSource.Width);
4532
4533     FuncRec.Sender := Self;
4534     FuncRec.Args   := aArgs;
4535
4536     TmpData := nil;
4537     if aCreateTemp then begin
4538       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4539       DestData := TmpData;
4540     end else
4541       DestData := Data;
4542
4543     try
4544       SourceFD.PreparePixel(FuncRec.Source);
4545       DestFD.PreparePixel  (FuncRec.Dest);
4546
4547       SourceMD := SourceFD.CreateMappingData;
4548       DestMD   := DestFD.CreateMappingData;
4549
4550       FuncRec.Size            := aSource.Dimension;
4551       FuncRec.Position.Fields := FuncRec.Size.Fields;
4552
4553       try
4554         SourceData := aSource.Data;
4555         FuncRec.Position.Y := 0;
4556         while FuncRec.Position.Y < TempHeight do begin
4557           FuncRec.Position.X := 0;
4558           while FuncRec.Position.X < TempWidth do begin
4559             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4560             aFunc(FuncRec);
4561             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4562             inc(FuncRec.Position.X);
4563           end;
4564           inc(FuncRec.Position.Y);
4565         end;
4566
4567         // Updating Image or InternalFormat
4568         if aCreateTemp then
4569           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4570         else if (aFormat <> fFormat) then
4571           Format := aFormat;
4572
4573         result := true;
4574       finally
4575         SourceFD.FreeMappingData(SourceMD);
4576         DestFD.FreeMappingData(DestMD);
4577       end;
4578     except
4579       if aCreateTemp and Assigned(TmpData) then
4580         FreeMem(TmpData);
4581       raise;
4582     end;
4583   end;
4584 end;
4585
4586 {$IFDEF GLB_SDL}
4587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4588 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4589 var
4590   Row, RowSize: Integer;
4591   SourceData, TmpData: PByte;
4592   TempDepth: Integer;
4593   FormatDesc: TFormatDescriptor;
4594
4595   function GetRowPointer(Row: Integer): pByte;
4596   begin
4597     result := aSurface.pixels;
4598     Inc(result, Row * RowSize);
4599   end;
4600
4601 begin
4602   result := false;
4603
4604   FormatDesc := TFormatDescriptor.Get(Format);
4605   if FormatDesc.IsCompressed then
4606     raise EglBitmapUnsupportedFormat.Create(Format);
4607
4608   if Assigned(Data) then begin
4609     case Trunc(FormatDesc.PixelSize) of
4610       1: TempDepth :=  8;
4611       2: TempDepth := 16;
4612       3: TempDepth := 24;
4613       4: TempDepth := 32;
4614     else
4615       raise EglBitmapUnsupportedFormat.Create(Format);
4616     end;
4617
4618     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4619       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4620     SourceData := Data;
4621     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4622
4623     for Row := 0 to FileHeight-1 do begin
4624       TmpData := GetRowPointer(Row);
4625       if Assigned(TmpData) then begin
4626         Move(SourceData^, TmpData^, RowSize);
4627         inc(SourceData, RowSize);
4628       end;
4629     end;
4630     result := true;
4631   end;
4632 end;
4633
4634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4635 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4636 var
4637   pSource, pData, pTempData: PByte;
4638   Row, RowSize, TempWidth, TempHeight: Integer;
4639   IntFormat: TglBitmapFormat;
4640   FormatDesc: TFormatDescriptor;
4641
4642   function GetRowPointer(Row: Integer): pByte;
4643   begin
4644     result := aSurface^.pixels;
4645     Inc(result, Row * RowSize);
4646   end;
4647
4648 begin
4649   result := false;
4650   if (Assigned(aSurface)) then begin
4651     with aSurface^.format^ do begin
4652       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4653         FormatDesc := TFormatDescriptor.Get(IntFormat);
4654         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4655           break;
4656       end;
4657       if (IntFormat = tfEmpty) then
4658         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4659     end;
4660
4661     TempWidth  := aSurface^.w;
4662     TempHeight := aSurface^.h;
4663     RowSize := FormatDesc.GetSize(TempWidth, 1);
4664     GetMem(pData, TempHeight * RowSize);
4665     try
4666       pTempData := pData;
4667       for Row := 0 to TempHeight -1 do begin
4668         pSource := GetRowPointer(Row);
4669         if (Assigned(pSource)) then begin
4670           Move(pSource^, pTempData^, RowSize);
4671           Inc(pTempData, RowSize);
4672         end;
4673       end;
4674       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4675       result := true;
4676     except
4677       if Assigned(pData) then
4678         FreeMem(pData);
4679       raise;
4680     end;
4681   end;
4682 end;
4683
4684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4685 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4686 var
4687   Row, Col, AlphaInterleave: Integer;
4688   pSource, pDest: PByte;
4689
4690   function GetRowPointer(Row: Integer): pByte;
4691   begin
4692     result := aSurface.pixels;
4693     Inc(result, Row * Width);
4694   end;
4695
4696 begin
4697   result := false;
4698   if Assigned(Data) then begin
4699     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4700       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4701
4702       AlphaInterleave := 0;
4703       case Format of
4704         tfLuminance8Alpha8:
4705           AlphaInterleave := 1;
4706         tfBGRA8, tfRGBA8:
4707           AlphaInterleave := 3;
4708       end;
4709
4710       pSource := Data;
4711       for Row := 0 to Height -1 do begin
4712         pDest := GetRowPointer(Row);
4713         if Assigned(pDest) then begin
4714           for Col := 0 to Width -1 do begin
4715             Inc(pSource, AlphaInterleave);
4716             pDest^ := pSource^;
4717             Inc(pDest);
4718             Inc(pSource);
4719           end;
4720         end;
4721       end;
4722       result := true;
4723     end;
4724   end;
4725 end;
4726
4727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4728 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4729 var
4730   bmp: TglBitmap2D;
4731 begin
4732   bmp := TglBitmap2D.Create;
4733   try
4734     bmp.AssignFromSurface(aSurface);
4735     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4736   finally
4737     bmp.Free;
4738   end;
4739 end;
4740 {$ENDIF}
4741
4742 {$IFDEF GLB_DELPHI}
4743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4744 function CreateGrayPalette: HPALETTE;
4745 var
4746   Idx: Integer;
4747   Pal: PLogPalette;
4748 begin
4749   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4750
4751   Pal.palVersion := $300;
4752   Pal.palNumEntries := 256;
4753
4754   for Idx := 0 to Pal.palNumEntries - 1 do begin
4755     Pal.palPalEntry[Idx].peRed   := Idx;
4756     Pal.palPalEntry[Idx].peGreen := Idx;
4757     Pal.palPalEntry[Idx].peBlue  := Idx;
4758     Pal.palPalEntry[Idx].peFlags := 0;
4759   end;
4760   Result := CreatePalette(Pal^);
4761   FreeMem(Pal);
4762 end;
4763
4764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4765 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4766 var
4767   Row: Integer;
4768   pSource, pData: PByte;
4769 begin
4770   result := false;
4771   if Assigned(Data) then begin
4772     if Assigned(aBitmap) then begin
4773       aBitmap.Width  := Width;
4774       aBitmap.Height := Height;
4775
4776       case Format of
4777         tfAlpha8, tfLuminance8: begin
4778           aBitmap.PixelFormat := pf8bit;
4779           aBitmap.Palette     := CreateGrayPalette;
4780         end;
4781         tfRGB5A1:
4782           aBitmap.PixelFormat := pf15bit;
4783         tfR5G6B5:
4784           aBitmap.PixelFormat := pf16bit;
4785         tfRGB8, tfBGR8:
4786           aBitmap.PixelFormat := pf24bit;
4787         tfRGBA8, tfBGRA8:
4788           aBitmap.PixelFormat := pf32bit;
4789       else
4790         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4791       end;
4792
4793       pSource := Data;
4794       for Row := 0 to FileHeight -1 do begin
4795         pData := aBitmap.Scanline[Row];
4796         Move(pSource^, pData^, fRowSize);
4797         Inc(pSource, fRowSize);
4798         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4799           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4800       end;
4801       result := true;
4802     end;
4803   end;
4804 end;
4805
4806 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4807 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4808 var
4809   pSource, pData, pTempData: PByte;
4810   Row, RowSize, TempWidth, TempHeight: Integer;
4811   IntFormat: TglBitmapFormat;
4812 begin
4813   result := false;
4814
4815   if (Assigned(aBitmap)) then begin
4816     case aBitmap.PixelFormat of
4817       pf8bit:
4818         IntFormat := tfLuminance8;
4819       pf15bit:
4820         IntFormat := tfRGB5A1;
4821       pf16bit:
4822         IntFormat := tfR5G6B5;
4823       pf24bit:
4824         IntFormat := tfBGR8;
4825       pf32bit:
4826         IntFormat := tfBGRA8;
4827     else
4828       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4829     end;
4830
4831     TempWidth  := aBitmap.Width;
4832     TempHeight := aBitmap.Height;
4833     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4834     GetMem(pData, TempHeight * RowSize);
4835     try
4836       pTempData := pData;
4837       for Row := 0 to TempHeight -1 do begin
4838         pSource := aBitmap.Scanline[Row];
4839         if (Assigned(pSource)) then begin
4840           Move(pSource^, pTempData^, RowSize);
4841           Inc(pTempData, RowSize);
4842         end;
4843       end;
4844       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4845       result := true;
4846     except
4847       if Assigned(pData) then
4848         FreeMem(pData);
4849       raise;
4850     end;
4851   end;
4852 end;
4853
4854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4855 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4856 var
4857   Row, Col, AlphaInterleave: Integer;
4858   pSource, pDest: PByte;
4859 begin
4860   result := false;
4861
4862   if Assigned(Data) then begin
4863     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4864       if Assigned(aBitmap) then begin
4865         aBitmap.PixelFormat := pf8bit;
4866         aBitmap.Palette     := CreateGrayPalette;
4867         aBitmap.Width       := Width;
4868         aBitmap.Height      := Height;
4869
4870         case Format of
4871           tfLuminance8Alpha8:
4872             AlphaInterleave := 1;
4873           tfRGBA8, tfBGRA8:
4874             AlphaInterleave := 3;
4875           else
4876             AlphaInterleave := 0;
4877         end;
4878
4879         // Copy Data
4880         pSource := Data;
4881
4882         for Row := 0 to Height -1 do begin
4883           pDest := aBitmap.Scanline[Row];
4884           if Assigned(pDest) then begin
4885             for Col := 0 to Width -1 do begin
4886               Inc(pSource, AlphaInterleave);
4887               pDest^ := pSource^;
4888               Inc(pDest);
4889               Inc(pSource);
4890             end;
4891           end;
4892         end;
4893         result := true;
4894       end;
4895     end;
4896   end;
4897 end;
4898
4899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4900 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4901 var
4902   tex: TglBitmap2D;
4903 begin
4904   tex := TglBitmap2D.Create;
4905   try
4906     tex.AssignFromBitmap(ABitmap);
4907     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4908   finally
4909     tex.Free;
4910   end;
4911 end;
4912 {$ENDIF}
4913
4914 {$IFDEF GLB_LAZARUS}
4915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4916 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4917 var
4918   rid: TRawImageDescription;
4919   FormatDesc: TFormatDescriptor;
4920 begin
4921   result := false;
4922   if not Assigned(aImage) or (Format = tfEmpty) then
4923     exit;
4924   FormatDesc := TFormatDescriptor.Get(Format);
4925   if FormatDesc.IsCompressed then
4926     exit;
4927
4928   FillChar(rid{%H-}, SizeOf(rid), 0);
4929   if (Format in [
4930        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4931        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4932        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4933     rid.Format := ricfGray
4934   else
4935     rid.Format := ricfRGBA;
4936
4937   rid.Width        := Width;
4938   rid.Height       := Height;
4939   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4940   rid.BitOrder     := riboBitsInOrder;
4941   rid.ByteOrder    := riboLSBFirst;
4942   rid.LineOrder    := riloTopToBottom;
4943   rid.LineEnd      := rileTight;
4944   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4945   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4946   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4947   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4948   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4949   rid.RedShift     := FormatDesc.Shift.r;
4950   rid.GreenShift   := FormatDesc.Shift.g;
4951   rid.BlueShift    := FormatDesc.Shift.b;
4952   rid.AlphaShift   := FormatDesc.Shift.a;
4953
4954   rid.MaskBitsPerPixel  := 0;
4955   rid.PaletteColorCount := 0;
4956
4957   aImage.DataDescription := rid;
4958   aImage.CreateData;
4959
4960   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4961
4962   result := true;
4963 end;
4964
4965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4966 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4967 var
4968   f: TglBitmapFormat;
4969   FormatDesc: TFormatDescriptor;
4970   ImageData: PByte;
4971   ImageSize: Integer;
4972   CanCopy: Boolean;
4973
4974   procedure CopyConvert;
4975   var
4976     bfFormat: TbmpBitfieldFormat;
4977     pSourceLine, pDestLine: PByte;
4978     pSourceMD, pDestMD: Pointer;
4979     x, y: Integer;
4980     pixel: TglBitmapPixelData;
4981   begin
4982     bfFormat  := TbmpBitfieldFormat.Create;
4983     with aImage.DataDescription do begin
4984       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
4985       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
4986       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
4987       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
4988       bfFormat.PixelSize := BitsPerPixel / 8;
4989     end;
4990     pSourceMD := bfFormat.CreateMappingData;
4991     pDestMD   := FormatDesc.CreateMappingData;
4992     try
4993       for y := 0 to aImage.Height-1 do begin
4994         pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
4995         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
4996         for x := 0 to aImage.Width-1 do begin
4997           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
4998           FormatDesc.Map(pixel, pDestLine, pDestMD);
4999         end;
5000       end;
5001     finally
5002       FormatDesc.FreeMappingData(pDestMD);
5003       bfFormat.FreeMappingData(pSourceMD);
5004       bfFormat.Free;
5005     end;
5006   end;
5007
5008 begin
5009   result := false;
5010   if not Assigned(aImage) then
5011     exit;
5012   for f := High(f) downto Low(f) do begin
5013     FormatDesc := TFormatDescriptor.Get(f);
5014     with aImage.DataDescription do
5015       if FormatDesc.MaskMatch(
5016         (QWord(1 shl RedPrec  )-1) shl RedShift,
5017         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5018         (QWord(1 shl BluePrec )-1) shl BlueShift,
5019         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5020         break;
5021   end;
5022
5023   if (f = tfEmpty) then
5024     exit;
5025
5026   CanCopy :=
5027     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5028     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5029
5030   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5031   ImageData := GetMem(ImageSize);
5032   try
5033     if CanCopy then
5034       Move(aImage.PixelData^, ImageData^, ImageSize)
5035     else
5036       CopyConvert;
5037     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5038   except
5039     if Assigned(ImageData) then
5040       FreeMem(ImageData);
5041     raise;
5042   end;
5043
5044   result := true;
5045 end;
5046
5047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5048 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5049 var
5050   rid: TRawImageDescription;
5051   FormatDesc: TFormatDescriptor;
5052   Pixel: TglBitmapPixelData;
5053   x, y: Integer;
5054   srcMD: Pointer;
5055   src, dst: PByte;
5056 begin
5057   result := false;
5058   if not Assigned(aImage) or (Format = tfEmpty) then
5059     exit;
5060   FormatDesc := TFormatDescriptor.Get(Format);
5061   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5062     exit;
5063
5064   FillChar(rid{%H-}, SizeOf(rid), 0);
5065   rid.Format       := ricfGray;
5066   rid.Width        := Width;
5067   rid.Height       := Height;
5068   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5069   rid.BitOrder     := riboBitsInOrder;
5070   rid.ByteOrder    := riboLSBFirst;
5071   rid.LineOrder    := riloTopToBottom;
5072   rid.LineEnd      := rileTight;
5073   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5074   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5075   rid.GreenPrec    := 0;
5076   rid.BluePrec     := 0;
5077   rid.AlphaPrec    := 0;
5078   rid.RedShift     := 0;
5079   rid.GreenShift   := 0;
5080   rid.BlueShift    := 0;
5081   rid.AlphaShift   := 0;
5082
5083   rid.MaskBitsPerPixel  := 0;
5084   rid.PaletteColorCount := 0;
5085
5086   aImage.DataDescription := rid;
5087   aImage.CreateData;
5088
5089   srcMD := FormatDesc.CreateMappingData;
5090   try
5091     FormatDesc.PreparePixel(Pixel);
5092     src := Data;
5093     dst := aImage.PixelData;
5094     for y := 0 to Height-1 do
5095       for x := 0 to Width-1 do begin
5096         FormatDesc.Unmap(src, Pixel, srcMD);
5097         case rid.BitsPerPixel of
5098            8: begin
5099             dst^ := Pixel.Data.a;
5100             inc(dst);
5101           end;
5102           16: begin
5103             PWord(dst)^ := Pixel.Data.a;
5104             inc(dst, 2);
5105           end;
5106           24: begin
5107             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5108             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5109             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5110             inc(dst, 3);
5111           end;
5112           32: begin
5113             PCardinal(dst)^ := Pixel.Data.a;
5114             inc(dst, 4);
5115           end;
5116         else
5117           raise EglBitmapUnsupportedFormat.Create(Format);
5118         end;
5119       end;
5120   finally
5121     FormatDesc.FreeMappingData(srcMD);
5122   end;
5123   result := true;
5124 end;
5125
5126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5127 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5128 var
5129   tex: TglBitmap2D;
5130 begin
5131   tex := TglBitmap2D.Create;
5132   try
5133     tex.AssignFromLazIntfImage(aImage);
5134     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5135   finally
5136     tex.Free;
5137   end;
5138 end;
5139 {$ENDIF}
5140
5141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5142 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5143   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5144 var
5145   rs: TResourceStream;
5146 begin
5147   PrepareResType(aResource, aResType);
5148   rs := TResourceStream.Create(aInstance, aResource, aResType);
5149   try
5150     result := AddAlphaFromStream(rs, aFunc, aArgs);
5151   finally
5152     rs.Free;
5153   end;
5154 end;
5155
5156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5157 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5158   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5159 var
5160   rs: TResourceStream;
5161 begin
5162   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5163   try
5164     result := AddAlphaFromStream(rs, aFunc, aArgs);
5165   finally
5166     rs.Free;
5167   end;
5168 end;
5169
5170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5171 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5172 begin
5173   if TFormatDescriptor.Get(Format).IsCompressed then
5174     raise EglBitmapUnsupportedFormat.Create(Format);
5175   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5176 end;
5177
5178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5179 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5180 var
5181   FS: TFileStream;
5182 begin
5183   FS := TFileStream.Create(aFileName, fmOpenRead);
5184   try
5185     result := AddAlphaFromStream(FS, aFunc, aArgs);
5186   finally
5187     FS.Free;
5188   end;
5189 end;
5190
5191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5192 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5193 var
5194   tex: TglBitmap2D;
5195 begin
5196   tex := TglBitmap2D.Create(aStream);
5197   try
5198     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5199   finally
5200     tex.Free;
5201   end;
5202 end;
5203
5204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5205 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5206 var
5207   DestData, DestData2, SourceData: pByte;
5208   TempHeight, TempWidth: Integer;
5209   SourceFD, DestFD: TFormatDescriptor;
5210   SourceMD, DestMD, DestMD2: Pointer;
5211
5212   FuncRec: TglBitmapFunctionRec;
5213 begin
5214   result := false;
5215
5216   Assert(Assigned(Data));
5217   Assert(Assigned(aBitmap));
5218   Assert(Assigned(aBitmap.Data));
5219
5220   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5221     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5222
5223     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5224     DestFD   := TFormatDescriptor.Get(Format);
5225
5226     if not Assigned(aFunc) then begin
5227       aFunc        := glBitmapAlphaFunc;
5228       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5229     end else
5230       FuncRec.Args := aArgs;
5231
5232     // Values
5233     TempHeight := aBitmap.FileHeight;
5234     TempWidth  := aBitmap.FileWidth;
5235
5236     FuncRec.Sender          := Self;
5237     FuncRec.Size            := Dimension;
5238     FuncRec.Position.Fields := FuncRec.Size.Fields;
5239
5240     DestData   := Data;
5241     DestData2  := Data;
5242     SourceData := aBitmap.Data;
5243
5244     // Mapping
5245     SourceFD.PreparePixel(FuncRec.Source);
5246     DestFD.PreparePixel  (FuncRec.Dest);
5247
5248     SourceMD := SourceFD.CreateMappingData;
5249     DestMD   := DestFD.CreateMappingData;
5250     DestMD2  := DestFD.CreateMappingData;
5251     try
5252       FuncRec.Position.Y := 0;
5253       while FuncRec.Position.Y < TempHeight do begin
5254         FuncRec.Position.X := 0;
5255         while FuncRec.Position.X < TempWidth do begin
5256           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5257           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5258           aFunc(FuncRec);
5259           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5260           inc(FuncRec.Position.X);
5261         end;
5262         inc(FuncRec.Position.Y);
5263       end;
5264     finally
5265       SourceFD.FreeMappingData(SourceMD);
5266       DestFD.FreeMappingData(DestMD);
5267       DestFD.FreeMappingData(DestMD2);
5268     end;
5269   end;
5270 end;
5271
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5274 begin
5275   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5276 end;
5277
5278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5279 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5280 var
5281   PixelData: TglBitmapPixelData;
5282 begin
5283   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5284   result := AddAlphaFromColorKeyFloat(
5285     aRed   / PixelData.Range.r,
5286     aGreen / PixelData.Range.g,
5287     aBlue  / PixelData.Range.b,
5288     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5289 end;
5290
5291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5292 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5293 var
5294   values: array[0..2] of Single;
5295   tmp: Cardinal;
5296   i: Integer;
5297   PixelData: TglBitmapPixelData;
5298 begin
5299   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5300   with PixelData do begin
5301     values[0] := aRed;
5302     values[1] := aGreen;
5303     values[2] := aBlue;
5304
5305     for i := 0 to 2 do begin
5306       tmp          := Trunc(Range.arr[i] * aDeviation);
5307       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5308       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5309     end;
5310     Data.a  := 0;
5311     Range.a := 0;
5312   end;
5313   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5314 end;
5315
5316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5317 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5318 begin
5319   result := AddAlphaFromValueFloat(aAlpha / $FF);
5320 end;
5321
5322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5323 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5324 var
5325   PixelData: TglBitmapPixelData;
5326 begin
5327   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5328   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5329 end;
5330
5331 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5332 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5333 var
5334   PixelData: TglBitmapPixelData;
5335 begin
5336   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5337   with PixelData do
5338     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5339   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5340 end;
5341
5342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5343 function TglBitmap.RemoveAlpha: Boolean;
5344 var
5345   FormatDesc: TFormatDescriptor;
5346 begin
5347   result := false;
5348   FormatDesc := TFormatDescriptor.Get(Format);
5349   if Assigned(Data) then begin
5350     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5351       raise EglBitmapUnsupportedFormat.Create(Format);
5352     result := ConvertTo(FormatDesc.WithoutAlpha);
5353   end;
5354 end;
5355
5356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5357 function TglBitmap.Clone: TglBitmap;
5358 var
5359   Temp: TglBitmap;
5360   TempPtr: PByte;
5361   Size: Integer;
5362 begin
5363   result := nil;
5364   Temp := (ClassType.Create as TglBitmap);
5365   try
5366     // copy texture data if assigned
5367     if Assigned(Data) then begin
5368       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5369       GetMem(TempPtr, Size);
5370       try
5371         Move(Data^, TempPtr^, Size);
5372         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5373       except
5374         if Assigned(TempPtr) then
5375           FreeMem(TempPtr);
5376         raise;
5377       end;
5378     end else begin
5379       TempPtr := nil;
5380       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5381     end;
5382
5383         // copy properties
5384     Temp.fID                      := ID;
5385     Temp.fTarget                  := Target;
5386     Temp.fFormat                  := Format;
5387     Temp.fMipMap                  := MipMap;
5388     Temp.fAnisotropic             := Anisotropic;
5389     Temp.fBorderColor             := fBorderColor;
5390     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5391     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5392     Temp.fFilterMin               := fFilterMin;
5393     Temp.fFilterMag               := fFilterMag;
5394     Temp.fWrapS                   := fWrapS;
5395     Temp.fWrapT                   := fWrapT;
5396     Temp.fWrapR                   := fWrapR;
5397     Temp.fFilename                := fFilename;
5398     Temp.fCustomName              := fCustomName;
5399     Temp.fCustomNameW             := fCustomNameW;
5400     Temp.fCustomData              := fCustomData;
5401
5402     result := Temp;
5403   except
5404     FreeAndNil(Temp);
5405     raise;
5406   end;
5407 end;
5408
5409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5410 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5411 var
5412   SourceFD, DestFD: TFormatDescriptor;
5413   SourcePD, DestPD: TglBitmapPixelData;
5414   ShiftData: TShiftData;
5415
5416   function CanCopyDirect: Boolean;
5417   begin
5418     result :=
5419       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5420       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5421       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5422       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5423   end;
5424
5425   function CanShift: Boolean;
5426   begin
5427     result :=
5428       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5429       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5430       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5431       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5432   end;
5433
5434   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5435   begin
5436     result := 0;
5437     while (aSource > aDest) and (aSource > 0) do begin
5438       inc(result);
5439       aSource := aSource shr 1;
5440     end;
5441   end;
5442
5443 begin
5444   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5445     SourceFD := TFormatDescriptor.Get(Format);
5446     DestFD   := TFormatDescriptor.Get(aFormat);
5447
5448     SourceFD.PreparePixel(SourcePD);
5449     DestFD.PreparePixel  (DestPD);
5450
5451     if CanCopyDirect then
5452       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5453     else if CanShift then begin
5454       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5455       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5456       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5457       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5458       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5459     end else
5460       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5461   end else
5462     result := true;
5463 end;
5464
5465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5466 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5467 begin
5468   if aUseRGB or aUseAlpha then
5469     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5470       ((Byte(aUseAlpha) and 1) shl 1) or
5471        (Byte(aUseRGB)   and 1)      ));
5472 end;
5473
5474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5475 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5476 begin
5477   fBorderColor[0] := aRed;
5478   fBorderColor[1] := aGreen;
5479   fBorderColor[2] := aBlue;
5480   fBorderColor[3] := aAlpha;
5481   if (ID > 0) then begin
5482     Bind(false);
5483     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5484   end;
5485 end;
5486
5487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5488 procedure TglBitmap.FreeData;
5489 var
5490   TempPtr: PByte;
5491 begin
5492   TempPtr := nil;
5493   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5494 end;
5495
5496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5497 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5498   const aAlpha: Byte);
5499 begin
5500   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5501 end;
5502
5503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5504 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5505 var
5506   PixelData: TglBitmapPixelData;
5507 begin
5508   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5509   FillWithColorFloat(
5510     aRed   / PixelData.Range.r,
5511     aGreen / PixelData.Range.g,
5512     aBlue  / PixelData.Range.b,
5513     aAlpha / PixelData.Range.a);
5514 end;
5515
5516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5517 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5518 var
5519   PixelData: TglBitmapPixelData;
5520 begin
5521   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5522   with PixelData do begin
5523     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5524     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5525     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5526     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5527   end;
5528   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5529 end;
5530
5531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5532 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5533 begin
5534   //check MIN filter
5535   case aMin of
5536     GL_NEAREST:
5537       fFilterMin := GL_NEAREST;
5538     GL_LINEAR:
5539       fFilterMin := GL_LINEAR;
5540     GL_NEAREST_MIPMAP_NEAREST:
5541       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5542     GL_LINEAR_MIPMAP_NEAREST:
5543       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5544     GL_NEAREST_MIPMAP_LINEAR:
5545       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5546     GL_LINEAR_MIPMAP_LINEAR:
5547       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5548     else
5549       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5550   end;
5551
5552   //check MAG filter
5553   case aMag of
5554     GL_NEAREST:
5555       fFilterMag := GL_NEAREST;
5556     GL_LINEAR:
5557       fFilterMag := GL_LINEAR;
5558     else
5559       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5560   end;
5561
5562   //apply filter
5563   if (ID > 0) then begin
5564     Bind(false);
5565     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5566
5567     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5568       case fFilterMin of
5569         GL_NEAREST, GL_LINEAR:
5570           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5571         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5572           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5573         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5574           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5575       end;
5576     end else
5577       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5578   end;
5579 end;
5580
5581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5582 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5583
5584   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5585   begin
5586     case aValue of
5587       GL_CLAMP:
5588         aTarget := GL_CLAMP;
5589
5590       GL_REPEAT:
5591         aTarget := GL_REPEAT;
5592
5593       GL_CLAMP_TO_EDGE: begin
5594         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5595           aTarget := GL_CLAMP_TO_EDGE
5596         else
5597           aTarget := GL_CLAMP;
5598       end;
5599
5600       GL_CLAMP_TO_BORDER: begin
5601         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5602           aTarget := GL_CLAMP_TO_BORDER
5603         else
5604           aTarget := GL_CLAMP;
5605       end;
5606
5607       GL_MIRRORED_REPEAT: begin
5608         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5609           aTarget := GL_MIRRORED_REPEAT
5610         else
5611           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5612       end;
5613     else
5614       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5615     end;
5616   end;
5617
5618 begin
5619   CheckAndSetWrap(S, fWrapS);
5620   CheckAndSetWrap(T, fWrapT);
5621   CheckAndSetWrap(R, fWrapR);
5622
5623   if (ID > 0) then begin
5624     Bind(false);
5625     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5626     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5627     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5628   end;
5629 end;
5630
5631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5632 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5633
5634   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5635   begin
5636     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5637        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5638       fSwizzle[aIndex] := aValue
5639     else
5640       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5641   end;
5642
5643 begin
5644   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5645     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5646   CheckAndSetValue(r, 0);
5647   CheckAndSetValue(g, 1);
5648   CheckAndSetValue(b, 2);
5649   CheckAndSetValue(a, 3);
5650
5651   if (ID > 0) then begin
5652     Bind(false);
5653     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5654   end;
5655 end;
5656
5657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5658 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5659 begin
5660   if aEnableTextureUnit then
5661     glEnable(Target);
5662   if (ID > 0) then
5663     glBindTexture(Target, ID);
5664 end;
5665
5666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5667 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5668 begin
5669   if aDisableTextureUnit then
5670     glDisable(Target);
5671   glBindTexture(Target, 0);
5672 end;
5673
5674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5675 constructor TglBitmap.Create;
5676 begin
5677   if (ClassType = TglBitmap) then
5678     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5679 {$IFDEF GLB_NATIVE_OGL}
5680   glbReadOpenGLExtensions;
5681 {$ENDIF}
5682   inherited Create;
5683   fFormat            := glBitmapGetDefaultFormat;
5684   fFreeDataOnDestroy := true;
5685 end;
5686
5687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5688 constructor TglBitmap.Create(const aFileName: String);
5689 begin
5690   Create;
5691   LoadFromFile(aFileName);
5692 end;
5693
5694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5695 constructor TglBitmap.Create(const aStream: TStream);
5696 begin
5697   Create;
5698   LoadFromStream(aStream);
5699 end;
5700
5701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5702 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5703 var
5704   ImageSize: Integer;
5705 begin
5706   Create;
5707   if not Assigned(aData) then begin
5708     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5709     GetMem(aData, ImageSize);
5710     try
5711       FillChar(aData^, ImageSize, #$FF);
5712       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5713     except
5714       if Assigned(aData) then
5715         FreeMem(aData);
5716       raise;
5717     end;
5718   end else begin
5719     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5720     fFreeDataOnDestroy := false;
5721   end;
5722 end;
5723
5724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5725 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5726 begin
5727   Create;
5728   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5729 end;
5730
5731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5732 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5733 begin
5734   Create;
5735   LoadFromResource(aInstance, aResource, aResType);
5736 end;
5737
5738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5739 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5740 begin
5741   Create;
5742   LoadFromResourceID(aInstance, aResourceID, aResType);
5743 end;
5744
5745 {$IFDEF GLB_SUPPORT_PNG_READ}
5746 {$IF DEFINED(GLB_LAZ_PNG)}
5747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5748 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5750 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5751 const
5752   MAGIC_LEN = 8;
5753   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5754 var
5755   reader: TLazReaderPNG;
5756   intf: TLazIntfImage;
5757   StreamPos: Int64;
5758   magic: String[MAGIC_LEN];
5759 begin
5760   result := true;
5761   StreamPos := aStream.Position;
5762
5763   SetLength(magic, MAGIC_LEN);
5764   aStream.Read(magic[1], MAGIC_LEN);
5765   aStream.Position := StreamPos;
5766   if (magic <> PNG_MAGIC) then begin
5767     result := false;
5768     exit;
5769   end;
5770
5771   intf   := TLazIntfImage.Create(0, 0);
5772   reader := TLazReaderPNG.Create;
5773   try try
5774     reader.UpdateDescription := true;
5775     reader.ImageRead(aStream, intf);
5776     AssignFromLazIntfImage(intf);
5777   except
5778     result := false;
5779     aStream.Position := StreamPos;
5780     exit;
5781   end;
5782   finally
5783     reader.Free;
5784     intf.Free;
5785   end;
5786 end;
5787
5788 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5790 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5791 var
5792   Surface: PSDL_Surface;
5793   RWops: PSDL_RWops;
5794 begin
5795   result := false;
5796   RWops := glBitmapCreateRWops(aStream);
5797   try
5798     if IMG_isPNG(RWops) > 0 then begin
5799       Surface := IMG_LoadPNG_RW(RWops);
5800       try
5801         AssignFromSurface(Surface);
5802         result := true;
5803       finally
5804         SDL_FreeSurface(Surface);
5805       end;
5806     end;
5807   finally
5808     SDL_FreeRW(RWops);
5809   end;
5810 end;
5811
5812 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5814 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5815 begin
5816   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5817 end;
5818
5819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5820 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5821 var
5822   StreamPos: Int64;
5823   signature: array [0..7] of byte;
5824   png: png_structp;
5825   png_info: png_infop;
5826
5827   TempHeight, TempWidth: Integer;
5828   Format: TglBitmapFormat;
5829
5830   png_data: pByte;
5831   png_rows: array of pByte;
5832   Row, LineSize: Integer;
5833 begin
5834   result := false;
5835
5836   if not init_libPNG then
5837     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5838
5839   try
5840     // signature
5841     StreamPos := aStream.Position;
5842     aStream.Read(signature{%H-}, 8);
5843     aStream.Position := StreamPos;
5844
5845     if png_check_sig(@signature, 8) <> 0 then begin
5846       // png read struct
5847       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5848       if png = nil then
5849         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5850
5851       // png info
5852       png_info := png_create_info_struct(png);
5853       if png_info = nil then begin
5854         png_destroy_read_struct(@png, nil, nil);
5855         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5856       end;
5857
5858       // set read callback
5859       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5860
5861       // read informations
5862       png_read_info(png, png_info);
5863
5864       // size
5865       TempHeight := png_get_image_height(png, png_info);
5866       TempWidth := png_get_image_width(png, png_info);
5867
5868       // format
5869       case png_get_color_type(png, png_info) of
5870         PNG_COLOR_TYPE_GRAY:
5871           Format := tfLuminance8;
5872         PNG_COLOR_TYPE_GRAY_ALPHA:
5873           Format := tfLuminance8Alpha8;
5874         PNG_COLOR_TYPE_RGB:
5875           Format := tfRGB8;
5876         PNG_COLOR_TYPE_RGB_ALPHA:
5877           Format := tfRGBA8;
5878         else
5879           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5880       end;
5881
5882       // cut upper 8 bit from 16 bit formats
5883       if png_get_bit_depth(png, png_info) > 8 then
5884         png_set_strip_16(png);
5885
5886       // expand bitdepth smaller than 8
5887       if png_get_bit_depth(png, png_info) < 8 then
5888         png_set_expand(png);
5889
5890       // allocating mem for scanlines
5891       LineSize := png_get_rowbytes(png, png_info);
5892       GetMem(png_data, TempHeight * LineSize);
5893       try
5894         SetLength(png_rows, TempHeight);
5895         for Row := Low(png_rows) to High(png_rows) do begin
5896           png_rows[Row] := png_data;
5897           Inc(png_rows[Row], Row * LineSize);
5898         end;
5899
5900         // read complete image into scanlines
5901         png_read_image(png, @png_rows[0]);
5902
5903         // read end
5904         png_read_end(png, png_info);
5905
5906         // destroy read struct
5907         png_destroy_read_struct(@png, @png_info, nil);
5908
5909         SetLength(png_rows, 0);
5910
5911         // set new data
5912         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5913
5914         result := true;
5915       except
5916         if Assigned(png_data) then
5917           FreeMem(png_data);
5918         raise;
5919       end;
5920     end;
5921   finally
5922     quit_libPNG;
5923   end;
5924 end;
5925
5926 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5928 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5929 var
5930   StreamPos: Int64;
5931   Png: TPNGObject;
5932   Header: String[8];
5933   Row, Col, PixSize, LineSize: Integer;
5934   NewImage, pSource, pDest, pAlpha: pByte;
5935   PngFormat: TglBitmapFormat;
5936   FormatDesc: TFormatDescriptor;
5937
5938 const
5939   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5940
5941 begin
5942   result := false;
5943
5944   StreamPos := aStream.Position;
5945   aStream.Read(Header[0], SizeOf(Header));
5946   aStream.Position := StreamPos;
5947
5948   {Test if the header matches}
5949   if Header = PngHeader then begin
5950     Png := TPNGObject.Create;
5951     try
5952       Png.LoadFromStream(aStream);
5953
5954       case Png.Header.ColorType of
5955         COLOR_GRAYSCALE:
5956           PngFormat := tfLuminance8;
5957         COLOR_GRAYSCALEALPHA:
5958           PngFormat := tfLuminance8Alpha8;
5959         COLOR_RGB:
5960           PngFormat := tfBGR8;
5961         COLOR_RGBALPHA:
5962           PngFormat := tfBGRA8;
5963         else
5964           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5965       end;
5966
5967       FormatDesc := TFormatDescriptor.Get(PngFormat);
5968       PixSize    := Round(FormatDesc.PixelSize);
5969       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5970
5971       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5972       try
5973         pDest := NewImage;
5974
5975         case Png.Header.ColorType of
5976           COLOR_RGB, COLOR_GRAYSCALE:
5977             begin
5978               for Row := 0 to Png.Height -1 do begin
5979                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5980                 Inc(pDest, LineSize);
5981               end;
5982             end;
5983           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5984             begin
5985               PixSize := PixSize -1;
5986
5987               for Row := 0 to Png.Height -1 do begin
5988                 pSource := Png.Scanline[Row];
5989                 pAlpha := pByte(Png.AlphaScanline[Row]);
5990
5991                 for Col := 0 to Png.Width -1 do begin
5992                   Move (pSource^, pDest^, PixSize);
5993                   Inc(pSource, PixSize);
5994                   Inc(pDest, PixSize);
5995
5996                   pDest^ := pAlpha^;
5997                   inc(pAlpha);
5998                   Inc(pDest);
5999                 end;
6000               end;
6001             end;
6002           else
6003             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6004         end;
6005
6006         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6007
6008         result := true;
6009       except
6010         if Assigned(NewImage) then
6011           FreeMem(NewImage);
6012         raise;
6013       end;
6014     finally
6015       Png.Free;
6016     end;
6017   end;
6018 end;
6019 {$IFEND}
6020 {$ENDIF}
6021
6022 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6023 {$IFDEF GLB_LIB_PNG}
6024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6025 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6026 begin
6027   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6028 end;
6029 {$ENDIF}
6030
6031 {$IF DEFINED(GLB_LAZ_PNG)}
6032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6033 procedure TglBitmap.SavePNG(const aStream: TStream);
6034 var
6035   png: TPortableNetworkGraphic;
6036   intf: TLazIntfImage;
6037   raw: TRawImage;
6038 begin
6039   png  := TPortableNetworkGraphic.Create;
6040   intf := TLazIntfImage.Create(0, 0);
6041   try
6042     if not AssignToLazIntfImage(intf) then
6043       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6044     intf.GetRawImage(raw);
6045     png.LoadFromRawImage(raw, false);
6046     png.SaveToStream(aStream);
6047   finally
6048     png.Free;
6049     intf.Free;
6050   end;
6051 end;
6052
6053 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6055 procedure TglBitmap.SavePNG(const aStream: TStream);
6056 var
6057   png: png_structp;
6058   png_info: png_infop;
6059   png_rows: array of pByte;
6060   LineSize: Integer;
6061   ColorType: Integer;
6062   Row: Integer;
6063   FormatDesc: TFormatDescriptor;
6064 begin
6065   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6066     raise EglBitmapUnsupportedFormat.Create(Format);
6067
6068   if not init_libPNG then
6069     raise Exception.Create('unable to initialize libPNG.');
6070
6071   try
6072     case Format of
6073       tfAlpha8, tfLuminance8:
6074         ColorType := PNG_COLOR_TYPE_GRAY;
6075       tfLuminance8Alpha8:
6076         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6077       tfBGR8, tfRGB8:
6078         ColorType := PNG_COLOR_TYPE_RGB;
6079       tfBGRA8, tfRGBA8:
6080         ColorType := PNG_COLOR_TYPE_RGBA;
6081       else
6082         raise EglBitmapUnsupportedFormat.Create(Format);
6083     end;
6084
6085     FormatDesc := TFormatDescriptor.Get(Format);
6086     LineSize := FormatDesc.GetSize(Width, 1);
6087
6088     // creating array for scanline
6089     SetLength(png_rows, Height);
6090     try
6091       for Row := 0 to Height - 1 do begin
6092         png_rows[Row] := Data;
6093         Inc(png_rows[Row], Row * LineSize)
6094       end;
6095
6096       // write struct
6097       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6098       if png = nil then
6099         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6100
6101       // create png info
6102       png_info := png_create_info_struct(png);
6103       if png_info = nil then begin
6104         png_destroy_write_struct(@png, nil);
6105         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6106       end;
6107
6108       // set read callback
6109       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6110
6111       // set compression
6112       png_set_compression_level(png, 6);
6113
6114       if Format in [tfBGR8, tfBGRA8] then
6115         png_set_bgr(png);
6116
6117       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6118       png_write_info(png, png_info);
6119       png_write_image(png, @png_rows[0]);
6120       png_write_end(png, png_info);
6121       png_destroy_write_struct(@png, @png_info);
6122     finally
6123       SetLength(png_rows, 0);
6124     end;
6125   finally
6126     quit_libPNG;
6127   end;
6128 end;
6129
6130 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6132 procedure TglBitmap.SavePNG(const aStream: TStream);
6133 var
6134   Png: TPNGObject;
6135
6136   pSource, pDest: pByte;
6137   X, Y, PixSize: Integer;
6138   ColorType: Cardinal;
6139   Alpha: Boolean;
6140
6141   pTemp: pByte;
6142   Temp: Byte;
6143 begin
6144   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6145     raise EglBitmapUnsupportedFormat.Create(Format);
6146
6147   case Format of
6148     tfAlpha8, tfLuminance8: begin
6149       ColorType := COLOR_GRAYSCALE;
6150       PixSize   := 1;
6151       Alpha     := false;
6152     end;
6153     tfLuminance8Alpha8: begin
6154       ColorType := COLOR_GRAYSCALEALPHA;
6155       PixSize   := 1;
6156       Alpha     := true;
6157     end;
6158     tfBGR8, tfRGB8: begin
6159       ColorType := COLOR_RGB;
6160       PixSize   := 3;
6161       Alpha     := false;
6162     end;
6163     tfBGRA8, tfRGBA8: begin
6164       ColorType := COLOR_RGBALPHA;
6165       PixSize   := 3;
6166       Alpha     := true
6167     end;
6168   else
6169     raise EglBitmapUnsupportedFormat.Create(Format);
6170   end;
6171
6172   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6173   try
6174     // Copy ImageData
6175     pSource := Data;
6176     for Y := 0 to Height -1 do begin
6177       pDest := png.ScanLine[Y];
6178       for X := 0 to Width -1 do begin
6179         Move(pSource^, pDest^, PixSize);
6180         Inc(pDest, PixSize);
6181         Inc(pSource, PixSize);
6182         if Alpha then begin
6183           png.AlphaScanline[Y]^[X] := pSource^;
6184           Inc(pSource);
6185         end;
6186       end;
6187
6188       // convert RGB line to BGR
6189       if Format in [tfRGB8, tfRGBA8] then begin
6190         pTemp := png.ScanLine[Y];
6191         for X := 0 to Width -1 do begin
6192           Temp := pByteArray(pTemp)^[0];
6193           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6194           pByteArray(pTemp)^[2] := Temp;
6195           Inc(pTemp, 3);
6196         end;
6197       end;
6198     end;
6199
6200     // Save to Stream
6201     Png.CompressionLevel := 6;
6202     Png.SaveToStream(aStream);
6203   finally
6204     FreeAndNil(Png);
6205   end;
6206 end;
6207 {$IFEND}
6208 {$ENDIF}
6209
6210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6211 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6213 {$IFDEF GLB_LIB_JPEG}
6214 type
6215   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6216   glBitmap_libJPEG_source_mgr = record
6217     pub: jpeg_source_mgr;
6218
6219     SrcStream: TStream;
6220     SrcBuffer: array [1..4096] of byte;
6221   end;
6222
6223   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6224   glBitmap_libJPEG_dest_mgr = record
6225     pub: jpeg_destination_mgr;
6226
6227     DestStream: TStream;
6228     DestBuffer: array [1..4096] of byte;
6229   end;
6230
6231 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6232 begin
6233   //DUMMY
6234 end;
6235
6236
6237 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6238 begin
6239   //DUMMY
6240 end;
6241
6242
6243 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6244 begin
6245   //DUMMY
6246 end;
6247
6248 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6249 begin
6250   //DUMMY
6251 end;
6252
6253
6254 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6255 begin
6256   //DUMMY
6257 end;
6258
6259
6260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6261 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6262 var
6263   src: glBitmap_libJPEG_source_mgr_ptr;
6264   bytes: integer;
6265 begin
6266   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6267
6268   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6269         if (bytes <= 0) then begin
6270                 src^.SrcBuffer[1] := $FF;
6271                 src^.SrcBuffer[2] := JPEG_EOI;
6272                 bytes := 2;
6273         end;
6274
6275         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6276         src^.pub.bytes_in_buffer := bytes;
6277
6278   result := true;
6279 end;
6280
6281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6282 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6283 var
6284   src: glBitmap_libJPEG_source_mgr_ptr;
6285 begin
6286   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6287
6288   if num_bytes > 0 then begin
6289     // wanted byte isn't in buffer so set stream position and read buffer
6290     if num_bytes > src^.pub.bytes_in_buffer then begin
6291       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6292       src^.pub.fill_input_buffer(cinfo);
6293     end else begin
6294       // wanted byte is in buffer so only skip
6295                 inc(src^.pub.next_input_byte, num_bytes);
6296                 dec(src^.pub.bytes_in_buffer, num_bytes);
6297     end;
6298   end;
6299 end;
6300
6301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6302 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6303 var
6304   dest: glBitmap_libJPEG_dest_mgr_ptr;
6305 begin
6306   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6307
6308   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6309     // write complete buffer
6310     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6311
6312     // reset buffer
6313     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6314     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6315   end;
6316
6317   result := true;
6318 end;
6319
6320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6321 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6322 var
6323   Idx: Integer;
6324   dest: glBitmap_libJPEG_dest_mgr_ptr;
6325 begin
6326   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6327
6328   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6329     // check for endblock
6330     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6331       // write endblock
6332       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6333
6334       // leave
6335       break;
6336     end else
6337       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6338   end;
6339 end;
6340 {$ENDIF}
6341
6342 {$IFDEF GLB_SUPPORT_JPEG_READ}
6343 {$IF DEFINED(GLB_LAZ_JPEG)}
6344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6345 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6346 const
6347   MAGIC_LEN = 2;
6348   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6349 var
6350   jpeg: TJPEGImage;
6351   intf: TLazIntfImage;
6352   reader: TFPReaderJPEG;
6353   StreamPos: Int64;
6354   magic: String[MAGIC_LEN];
6355 begin
6356   result := true;
6357   StreamPos := aStream.Position;
6358
6359   SetLength(magic, MAGIC_LEN);
6360   aStream.Read(magic[1], MAGIC_LEN);
6361   aStream.Position := StreamPos;
6362   if (magic <> JPEG_MAGIC) then begin
6363     result := false;
6364     exit;
6365   end;
6366
6367   reader := TFPReaderJPEG.Create;
6368   intf := TLazIntfImage.Create(0, 0);
6369   try try
6370     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6371     reader.ImageRead(aStream, intf);
6372     AssignFromLazIntfImage(intf);
6373   except
6374     result := false;
6375     aStream.Position := StreamPos;
6376     exit;
6377   end;
6378   finally
6379     reader.Free;
6380     intf.Free;
6381   end;
6382 end;
6383
6384 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6386 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6387 var
6388   Surface: PSDL_Surface;
6389   RWops: PSDL_RWops;
6390 begin
6391   result := false;
6392
6393   RWops := glBitmapCreateRWops(aStream);
6394   try
6395     if IMG_isJPG(RWops) > 0 then begin
6396       Surface := IMG_LoadJPG_RW(RWops);
6397       try
6398         AssignFromSurface(Surface);
6399         result := true;
6400       finally
6401         SDL_FreeSurface(Surface);
6402       end;
6403     end;
6404   finally
6405     SDL_FreeRW(RWops);
6406   end;
6407 end;
6408
6409 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6411 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6412 var
6413   StreamPos: Int64;
6414   Temp: array[0..1]of Byte;
6415
6416   jpeg: jpeg_decompress_struct;
6417   jpeg_err: jpeg_error_mgr;
6418
6419   IntFormat: TglBitmapFormat;
6420   pImage: pByte;
6421   TempHeight, TempWidth: Integer;
6422
6423   pTemp: pByte;
6424   Row: Integer;
6425
6426   FormatDesc: TFormatDescriptor;
6427 begin
6428   result := false;
6429
6430   if not init_libJPEG then
6431     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6432
6433   try
6434     // reading first two bytes to test file and set cursor back to begin
6435     StreamPos := aStream.Position;
6436     aStream.Read({%H-}Temp[0], 2);
6437     aStream.Position := StreamPos;
6438
6439     // if Bitmap then read file.
6440     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6441       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6442       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6443
6444       // error managment
6445       jpeg.err := jpeg_std_error(@jpeg_err);
6446       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6447       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6448
6449       // decompression struct
6450       jpeg_create_decompress(@jpeg);
6451
6452       // allocation space for streaming methods
6453       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6454
6455       // seeting up custom functions
6456       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6457         pub.init_source       := glBitmap_libJPEG_init_source;
6458         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6459         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6460         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6461         pub.term_source       := glBitmap_libJPEG_term_source;
6462
6463         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6464         pub.next_input_byte := nil;   // until buffer loaded
6465
6466         SrcStream := aStream;
6467       end;
6468
6469       // set global decoding state
6470       jpeg.global_state := DSTATE_START;
6471
6472       // read header of jpeg
6473       jpeg_read_header(@jpeg, false);
6474
6475       // setting output parameter
6476       case jpeg.jpeg_color_space of
6477         JCS_GRAYSCALE:
6478           begin
6479             jpeg.out_color_space := JCS_GRAYSCALE;
6480             IntFormat := tfLuminance8;
6481           end;
6482         else
6483           jpeg.out_color_space := JCS_RGB;
6484           IntFormat := tfRGB8;
6485       end;
6486
6487       // reading image
6488       jpeg_start_decompress(@jpeg);
6489
6490       TempHeight := jpeg.output_height;
6491       TempWidth := jpeg.output_width;
6492
6493       FormatDesc := TFormatDescriptor.Get(IntFormat);
6494
6495       // creating new image
6496       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6497       try
6498         pTemp := pImage;
6499
6500         for Row := 0 to TempHeight -1 do begin
6501           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6502           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6503         end;
6504
6505         // finish decompression
6506         jpeg_finish_decompress(@jpeg);
6507
6508         // destroy decompression
6509         jpeg_destroy_decompress(@jpeg);
6510
6511         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6512
6513         result := true;
6514       except
6515         if Assigned(pImage) then
6516           FreeMem(pImage);
6517         raise;
6518       end;
6519     end;
6520   finally
6521     quit_libJPEG;
6522   end;
6523 end;
6524
6525 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6527 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6528 var
6529   bmp: TBitmap;
6530   jpg: TJPEGImage;
6531   StreamPos: Int64;
6532   Temp: array[0..1]of Byte;
6533 begin
6534   result := false;
6535
6536   // reading first two bytes to test file and set cursor back to begin
6537   StreamPos := aStream.Position;
6538   aStream.Read(Temp[0], 2);
6539   aStream.Position := StreamPos;
6540
6541   // if Bitmap then read file.
6542   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6543     bmp := TBitmap.Create;
6544     try
6545       jpg := TJPEGImage.Create;
6546       try
6547         jpg.LoadFromStream(aStream);
6548         bmp.Assign(jpg);
6549         result := AssignFromBitmap(bmp);
6550       finally
6551         jpg.Free;
6552       end;
6553     finally
6554       bmp.Free;
6555     end;
6556   end;
6557 end;
6558 {$IFEND}
6559 {$ENDIF}
6560
6561 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6562 {$IF DEFINED(GLB_LAZ_JPEG)}
6563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6564 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6565 var
6566   jpeg: TJPEGImage;
6567   intf: TLazIntfImage;
6568   raw: TRawImage;
6569 begin
6570   jpeg := TJPEGImage.Create;
6571   intf := TLazIntfImage.Create(0, 0);
6572   try
6573     if not AssignToLazIntfImage(intf) then
6574       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6575     intf.GetRawImage(raw);
6576     jpeg.LoadFromRawImage(raw, false);
6577     jpeg.SaveToStream(aStream);
6578   finally
6579     intf.Free;
6580     jpeg.Free;
6581   end;
6582 end;
6583
6584 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6586 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6587 var
6588   jpeg: jpeg_compress_struct;
6589   jpeg_err: jpeg_error_mgr;
6590   Row: Integer;
6591   pTemp, pTemp2: pByte;
6592
6593   procedure CopyRow(pDest, pSource: pByte);
6594   var
6595     X: Integer;
6596   begin
6597     for X := 0 to Width - 1 do begin
6598       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6599       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6600       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6601       Inc(pDest, 3);
6602       Inc(pSource, 3);
6603     end;
6604   end;
6605
6606 begin
6607   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6608     raise EglBitmapUnsupportedFormat.Create(Format);
6609
6610   if not init_libJPEG then
6611     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6612
6613   try
6614     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6615     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6616
6617     // error managment
6618     jpeg.err := jpeg_std_error(@jpeg_err);
6619     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6620     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6621
6622     // compression struct
6623     jpeg_create_compress(@jpeg);
6624
6625     // allocation space for streaming methods
6626     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6627
6628     // seeting up custom functions
6629     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6630       pub.init_destination    := glBitmap_libJPEG_init_destination;
6631       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6632       pub.term_destination    := glBitmap_libJPEG_term_destination;
6633
6634       pub.next_output_byte  := @DestBuffer[1];
6635       pub.free_in_buffer    := Length(DestBuffer);
6636
6637       DestStream := aStream;
6638     end;
6639
6640     // very important state
6641     jpeg.global_state := CSTATE_START;
6642     jpeg.image_width  := Width;
6643     jpeg.image_height := Height;
6644     case Format of
6645       tfAlpha8, tfLuminance8: begin
6646         jpeg.input_components := 1;
6647         jpeg.in_color_space   := JCS_GRAYSCALE;
6648       end;
6649       tfRGB8, tfBGR8: begin
6650         jpeg.input_components := 3;
6651         jpeg.in_color_space   := JCS_RGB;
6652       end;
6653     end;
6654
6655     jpeg_set_defaults(@jpeg);
6656     jpeg_set_quality(@jpeg, 95, true);
6657     jpeg_start_compress(@jpeg, true);
6658     pTemp := Data;
6659
6660     if Format = tfBGR8 then
6661       GetMem(pTemp2, fRowSize)
6662     else
6663       pTemp2 := pTemp;
6664
6665     try
6666       for Row := 0 to jpeg.image_height -1 do begin
6667         // prepare row
6668         if Format = tfBGR8 then
6669           CopyRow(pTemp2, pTemp)
6670         else
6671           pTemp2 := pTemp;
6672
6673         // write row
6674         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6675         inc(pTemp, fRowSize);
6676       end;
6677     finally
6678       // free memory
6679       if Format = tfBGR8 then
6680         FreeMem(pTemp2);
6681     end;
6682     jpeg_finish_compress(@jpeg);
6683     jpeg_destroy_compress(@jpeg);
6684   finally
6685     quit_libJPEG;
6686   end;
6687 end;
6688
6689 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6691 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6692 var
6693   Bmp: TBitmap;
6694   Jpg: TJPEGImage;
6695 begin
6696   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6697     raise EglBitmapUnsupportedFormat.Create(Format);
6698
6699   Bmp := TBitmap.Create;
6700   try
6701     Jpg := TJPEGImage.Create;
6702     try
6703       AssignToBitmap(Bmp);
6704       if (Format in [tfAlpha8, tfLuminance8]) then begin
6705         Jpg.Grayscale   := true;
6706         Jpg.PixelFormat := jf8Bit;
6707       end;
6708       Jpg.Assign(Bmp);
6709       Jpg.SaveToStream(aStream);
6710     finally
6711       FreeAndNil(Jpg);
6712     end;
6713   finally
6714     FreeAndNil(Bmp);
6715   end;
6716 end;
6717 {$IFEND}
6718 {$ENDIF}
6719
6720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6721 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6723 const
6724   BMP_MAGIC          = $4D42;
6725
6726   BMP_COMP_RGB       = 0;
6727   BMP_COMP_RLE8      = 1;
6728   BMP_COMP_RLE4      = 2;
6729   BMP_COMP_BITFIELDS = 3;
6730
6731 type
6732   TBMPHeader = packed record
6733     bfType: Word;
6734     bfSize: Cardinal;
6735     bfReserved1: Word;
6736     bfReserved2: Word;
6737     bfOffBits: Cardinal;
6738   end;
6739
6740   TBMPInfo = packed record
6741     biSize: Cardinal;
6742     biWidth: Longint;
6743     biHeight: Longint;
6744     biPlanes: Word;
6745     biBitCount: Word;
6746     biCompression: Cardinal;
6747     biSizeImage: Cardinal;
6748     biXPelsPerMeter: Longint;
6749     biYPelsPerMeter: Longint;
6750     biClrUsed: Cardinal;
6751     biClrImportant: Cardinal;
6752   end;
6753
6754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6755 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6756
6757   //////////////////////////////////////////////////////////////////////////////////////////////////
6758   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6759   begin
6760     result := tfEmpty;
6761     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6762     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6763
6764     //Read Compression
6765     case aInfo.biCompression of
6766       BMP_COMP_RLE4,
6767       BMP_COMP_RLE8: begin
6768         raise EglBitmap.Create('RLE compression is not supported');
6769       end;
6770       BMP_COMP_BITFIELDS: begin
6771         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6772           aStream.Read(aMask.r, SizeOf(aMask.r));
6773           aStream.Read(aMask.g, SizeOf(aMask.g));
6774           aStream.Read(aMask.b, SizeOf(aMask.b));
6775           aStream.Read(aMask.a, SizeOf(aMask.a));
6776         end else
6777           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6778       end;
6779     end;
6780
6781     //get suitable format
6782     case aInfo.biBitCount of
6783        8: result := tfLuminance8;
6784       16: result := tfBGR5;
6785       24: result := tfBGR8;
6786       32: result := tfBGRA8;
6787     end;
6788   end;
6789
6790   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6791   var
6792     i, c: Integer;
6793     ColorTable: TbmpColorTable;
6794   begin
6795     result := nil;
6796     if (aInfo.biBitCount >= 16) then
6797       exit;
6798     aFormat := tfLuminance8;
6799     c := aInfo.biClrUsed;
6800     if (c = 0) then
6801       c := 1 shl aInfo.biBitCount;
6802     SetLength(ColorTable, c);
6803     for i := 0 to c-1 do begin
6804       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6805       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6806         aFormat := tfRGB8;
6807     end;
6808
6809     result := TbmpColorTableFormat.Create;
6810     result.PixelSize  := aInfo.biBitCount / 8;
6811     result.ColorTable := ColorTable;
6812     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6813   end;
6814
6815   //////////////////////////////////////////////////////////////////////////////////////////////////
6816   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6817     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6818   var
6819     TmpFormat: TglBitmapFormat;
6820     FormatDesc: TFormatDescriptor;
6821   begin
6822     result := nil;
6823     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6824       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6825         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6826         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6827           aFormat := FormatDesc.Format;
6828           exit;
6829         end;
6830       end;
6831
6832       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6833         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6834       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6835         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6836
6837       result := TbmpBitfieldFormat.Create;
6838       result.PixelSize := aInfo.biBitCount / 8;
6839       result.RedMask   := aMask.r;
6840       result.GreenMask := aMask.g;
6841       result.BlueMask  := aMask.b;
6842       result.AlphaMask := aMask.a;
6843     end;
6844   end;
6845
6846 var
6847   //simple types
6848   StartPos: Int64;
6849   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6850   PaddingBuff: Cardinal;
6851   LineBuf, ImageData, TmpData: PByte;
6852   SourceMD, DestMD: Pointer;
6853   BmpFormat: TglBitmapFormat;
6854
6855   //records
6856   Mask: TglBitmapColorRec;
6857   Header: TBMPHeader;
6858   Info: TBMPInfo;
6859
6860   //classes
6861   SpecialFormat: TFormatDescriptor;
6862   FormatDesc: TFormatDescriptor;
6863
6864   //////////////////////////////////////////////////////////////////////////////////////////////////
6865   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6866   var
6867     i: Integer;
6868     Pixel: TglBitmapPixelData;
6869   begin
6870     aStream.Read(aLineBuf^, rbLineSize);
6871     SpecialFormat.PreparePixel(Pixel);
6872     for i := 0 to Info.biWidth-1 do begin
6873       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6874       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6875       FormatDesc.Map(Pixel, aData, DestMD);
6876     end;
6877   end;
6878
6879 begin
6880   result        := false;
6881   BmpFormat     := tfEmpty;
6882   SpecialFormat := nil;
6883   LineBuf       := nil;
6884   SourceMD      := nil;
6885   DestMD        := nil;
6886
6887   // Header
6888   StartPos := aStream.Position;
6889   aStream.Read(Header{%H-}, SizeOf(Header));
6890
6891   if Header.bfType = BMP_MAGIC then begin
6892     try try
6893       BmpFormat        := ReadInfo(Info, Mask);
6894       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6895       if not Assigned(SpecialFormat) then
6896         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6897       aStream.Position := StartPos + Header.bfOffBits;
6898
6899       if (BmpFormat <> tfEmpty) then begin
6900         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6901         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6902         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6903         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6904
6905         //get Memory
6906         DestMD    := FormatDesc.CreateMappingData;
6907         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6908         GetMem(ImageData, ImageSize);
6909         if Assigned(SpecialFormat) then begin
6910           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6911           SourceMD := SpecialFormat.CreateMappingData;
6912         end;
6913
6914         //read Data
6915         try try
6916           FillChar(ImageData^, ImageSize, $FF);
6917           TmpData := ImageData;
6918           if (Info.biHeight > 0) then
6919             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6920           for i := 0 to Abs(Info.biHeight)-1 do begin
6921             if Assigned(SpecialFormat) then
6922               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6923             else
6924               aStream.Read(TmpData^, wbLineSize);   //else only read data
6925             if (Info.biHeight > 0) then
6926               dec(TmpData, wbLineSize)
6927             else
6928               inc(TmpData, wbLineSize);
6929             aStream.Read(PaddingBuff{%H-}, Padding);
6930           end;
6931           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6932           result := true;
6933         finally
6934           if Assigned(LineBuf) then
6935             FreeMem(LineBuf);
6936           if Assigned(SourceMD) then
6937             SpecialFormat.FreeMappingData(SourceMD);
6938           FormatDesc.FreeMappingData(DestMD);
6939         end;
6940         except
6941           if Assigned(ImageData) then
6942             FreeMem(ImageData);
6943           raise;
6944         end;
6945       end else
6946         raise EglBitmap.Create('LoadBMP - No suitable format found');
6947     except
6948       aStream.Position := StartPos;
6949       raise;
6950     end;
6951     finally
6952       FreeAndNil(SpecialFormat);
6953     end;
6954   end
6955     else aStream.Position := StartPos;
6956 end;
6957
6958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6959 procedure TglBitmap.SaveBMP(const aStream: TStream);
6960 var
6961   Header: TBMPHeader;
6962   Info: TBMPInfo;
6963   Converter: TFormatDescriptor;
6964   FormatDesc: TFormatDescriptor;
6965   SourceFD, DestFD: Pointer;
6966   pData, srcData, dstData, ConvertBuffer: pByte;
6967
6968   Pixel: TglBitmapPixelData;
6969   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6970   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6971
6972   PaddingBuff: Cardinal;
6973
6974   function GetLineWidth : Integer;
6975   begin
6976     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6977   end;
6978
6979 begin
6980   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6981     raise EglBitmapUnsupportedFormat.Create(Format);
6982
6983   Converter  := nil;
6984   FormatDesc := TFormatDescriptor.Get(Format);
6985   ImageSize  := FormatDesc.GetSize(Dimension);
6986
6987   FillChar(Header{%H-}, SizeOf(Header), 0);
6988   Header.bfType      := BMP_MAGIC;
6989   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6990   Header.bfReserved1 := 0;
6991   Header.bfReserved2 := 0;
6992   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6993
6994   FillChar(Info{%H-}, SizeOf(Info), 0);
6995   Info.biSize        := SizeOf(Info);
6996   Info.biWidth       := Width;
6997   Info.biHeight      := Height;
6998   Info.biPlanes      := 1;
6999   Info.biCompression := BMP_COMP_RGB;
7000   Info.biSizeImage   := ImageSize;
7001
7002   try
7003     case Format of
7004       tfLuminance4: begin
7005         Info.biBitCount  := 4;
7006         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7007         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7008         Converter := TbmpColorTableFormat.Create;
7009         with (Converter as TbmpColorTableFormat) do begin
7010           PixelSize := 0.5;
7011           Format    := Format;
7012           Range     := glBitmapColorRec($F, $F, $F, $0);
7013           CreateColorTable;
7014         end;
7015       end;
7016
7017       tfR3G3B2, tfLuminance8: begin
7018         Info.biBitCount  :=  8;
7019         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7020         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7021         Converter := TbmpColorTableFormat.Create;
7022         with (Converter as TbmpColorTableFormat) do begin
7023           PixelSize := 1;
7024           Format    := Format;
7025           if (Format = tfR3G3B2) then begin
7026             Range := glBitmapColorRec($7, $7, $3, $0);
7027             Shift := glBitmapShiftRec(0, 3, 6, 0);
7028           end else
7029             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7030           CreateColorTable;
7031         end;
7032       end;
7033
7034       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7035       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7036         Info.biBitCount    := 16;
7037         Info.biCompression := BMP_COMP_BITFIELDS;
7038       end;
7039
7040       tfBGR8, tfRGB8: begin
7041         Info.biBitCount := 24;
7042         if (Format = tfRGB8) then
7043           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7044       end;
7045
7046       tfRGB10, tfRGB10A2, tfRGBA8,
7047       tfBGR10, tfBGR10A2, tfBGRA8: begin
7048         Info.biBitCount    := 32;
7049         Info.biCompression := BMP_COMP_BITFIELDS;
7050       end;
7051     else
7052       raise EglBitmapUnsupportedFormat.Create(Format);
7053     end;
7054     Info.biXPelsPerMeter := 2835;
7055     Info.biYPelsPerMeter := 2835;
7056
7057     // prepare bitmasks
7058     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7059       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7060       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7061
7062       RedMask    := FormatDesc.RedMask;
7063       GreenMask  := FormatDesc.GreenMask;
7064       BlueMask   := FormatDesc.BlueMask;
7065       AlphaMask  := FormatDesc.AlphaMask;
7066     end;
7067
7068     // headers
7069     aStream.Write(Header, SizeOf(Header));
7070     aStream.Write(Info, SizeOf(Info));
7071
7072     // colortable
7073     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7074       with (Converter as TbmpColorTableFormat) do
7075         aStream.Write(ColorTable[0].b,
7076           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7077
7078     // bitmasks
7079     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7080       aStream.Write(RedMask,   SizeOf(Cardinal));
7081       aStream.Write(GreenMask, SizeOf(Cardinal));
7082       aStream.Write(BlueMask,  SizeOf(Cardinal));
7083       aStream.Write(AlphaMask, SizeOf(Cardinal));
7084     end;
7085
7086     // image data
7087     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7088     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7089     Padding     := GetLineWidth - wbLineSize;
7090     PaddingBuff := 0;
7091
7092     pData := Data;
7093     inc(pData, (Height-1) * rbLineSize);
7094
7095     // prepare row buffer. But only for RGB because RGBA supports color masks
7096     // so it's possible to change color within the image.
7097     if Assigned(Converter) then begin
7098       FormatDesc.PreparePixel(Pixel);
7099       GetMem(ConvertBuffer, wbLineSize);
7100       SourceFD := FormatDesc.CreateMappingData;
7101       DestFD   := Converter.CreateMappingData;
7102     end else
7103       ConvertBuffer := nil;
7104
7105     try
7106       for LineIdx := 0 to Height - 1 do begin
7107         // preparing row
7108         if Assigned(Converter) then begin
7109           srcData := pData;
7110           dstData := ConvertBuffer;
7111           for PixelIdx := 0 to Info.biWidth-1 do begin
7112             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7113             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7114             Converter.Map(Pixel, dstData, DestFD);
7115           end;
7116           aStream.Write(ConvertBuffer^, wbLineSize);
7117         end else begin
7118           aStream.Write(pData^, rbLineSize);
7119         end;
7120         dec(pData, rbLineSize);
7121         if (Padding > 0) then
7122           aStream.Write(PaddingBuff, Padding);
7123       end;
7124     finally
7125       // destroy row buffer
7126       if Assigned(ConvertBuffer) then begin
7127         FormatDesc.FreeMappingData(SourceFD);
7128         Converter.FreeMappingData(DestFD);
7129         FreeMem(ConvertBuffer);
7130       end;
7131     end;
7132   finally
7133     if Assigned(Converter) then
7134       Converter.Free;
7135   end;
7136 end;
7137
7138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7139 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7141 type
7142   TTGAHeader = packed record
7143     ImageID: Byte;
7144     ColorMapType: Byte;
7145     ImageType: Byte;
7146     //ColorMapSpec: Array[0..4] of Byte;
7147     ColorMapStart: Word;
7148     ColorMapLength: Word;
7149     ColorMapEntrySize: Byte;
7150     OrigX: Word;
7151     OrigY: Word;
7152     Width: Word;
7153     Height: Word;
7154     Bpp: Byte;
7155     ImageDesc: Byte;
7156   end;
7157
7158 const
7159   TGA_UNCOMPRESSED_RGB  =  2;
7160   TGA_UNCOMPRESSED_GRAY =  3;
7161   TGA_COMPRESSED_RGB    = 10;
7162   TGA_COMPRESSED_GRAY   = 11;
7163
7164   TGA_NONE_COLOR_TABLE  = 0;
7165
7166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7167 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7168 var
7169   Header: TTGAHeader;
7170   ImageData: System.PByte;
7171   StartPosition: Int64;
7172   PixelSize, LineSize: Integer;
7173   tgaFormat: TglBitmapFormat;
7174   FormatDesc: TFormatDescriptor;
7175   Counter: packed record
7176     X, Y: packed record
7177       low, high, dir: Integer;
7178     end;
7179   end;
7180
7181 const
7182   CACHE_SIZE = $4000;
7183
7184   ////////////////////////////////////////////////////////////////////////////////////////
7185   procedure ReadUncompressed;
7186   var
7187     i, j: Integer;
7188     buf, tmp1, tmp2: System.PByte;
7189   begin
7190     buf := nil;
7191     if (Counter.X.dir < 0) then
7192       GetMem(buf, LineSize);
7193     try
7194       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7195         tmp1 := ImageData;
7196         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7197         if (Counter.X.dir < 0) then begin               //flip X
7198           aStream.Read(buf^, LineSize);
7199           tmp2 := buf;
7200           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7201           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7202             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7203               tmp1^ := tmp2^;
7204               inc(tmp1);
7205               inc(tmp2);
7206             end;
7207             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7208           end;
7209         end else
7210           aStream.Read(tmp1^, LineSize);
7211         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7212       end;
7213     finally
7214       if Assigned(buf) then
7215         FreeMem(buf);
7216     end;
7217   end;
7218
7219   ////////////////////////////////////////////////////////////////////////////////////////
7220   procedure ReadCompressed;
7221
7222     /////////////////////////////////////////////////////////////////
7223     var
7224       TmpData: System.PByte;
7225       LinePixelsRead: Integer;
7226     procedure CheckLine;
7227     begin
7228       if (LinePixelsRead >= Header.Width) then begin
7229         LinePixelsRead := 0;
7230         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7231         TmpData := ImageData;
7232         inc(TmpData, Counter.Y.low * LineSize);           //set line
7233         if (Counter.X.dir < 0) then                       //if x flipped then
7234           inc(TmpData, LineSize - PixelSize);             //set last pixel
7235       end;
7236     end;
7237
7238     /////////////////////////////////////////////////////////////////
7239     var
7240       Cache: PByte;
7241       CacheSize, CachePos: Integer;
7242     procedure CachedRead(out Buffer; Count: Integer);
7243     var
7244       BytesRead: Integer;
7245     begin
7246       if (CachePos + Count > CacheSize) then begin
7247         //if buffer overflow save non read bytes
7248         BytesRead := 0;
7249         if (CacheSize - CachePos > 0) then begin
7250           BytesRead := CacheSize - CachePos;
7251           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7252           inc(CachePos, BytesRead);
7253         end;
7254
7255         //load cache from file
7256         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7257         aStream.Read(Cache^, CacheSize);
7258         CachePos := 0;
7259
7260         //read rest of requested bytes
7261         if (Count - BytesRead > 0) then begin
7262           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7263           inc(CachePos, Count - BytesRead);
7264         end;
7265       end else begin
7266         //if no buffer overflow just read the data
7267         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7268         inc(CachePos, Count);
7269       end;
7270     end;
7271
7272     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7273     begin
7274       case PixelSize of
7275         1: begin
7276           aBuffer^ := aData^;
7277           inc(aBuffer, Counter.X.dir);
7278         end;
7279         2: begin
7280           PWord(aBuffer)^ := PWord(aData)^;
7281           inc(aBuffer, 2 * Counter.X.dir);
7282         end;
7283         3: begin
7284           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7285           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7286           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7287           inc(aBuffer, 3 * Counter.X.dir);
7288         end;
7289         4: begin
7290           PCardinal(aBuffer)^ := PCardinal(aData)^;
7291           inc(aBuffer, 4 * Counter.X.dir);
7292         end;
7293       end;
7294     end;
7295
7296   var
7297     TotalPixelsToRead, TotalPixelsRead: Integer;
7298     Temp: Byte;
7299     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7300     PixelRepeat: Boolean;
7301     PixelsToRead, PixelCount: Integer;
7302   begin
7303     CacheSize := 0;
7304     CachePos  := 0;
7305
7306     TotalPixelsToRead := Header.Width * Header.Height;
7307     TotalPixelsRead   := 0;
7308     LinePixelsRead    := 0;
7309
7310     GetMem(Cache, CACHE_SIZE);
7311     try
7312       TmpData := ImageData;
7313       inc(TmpData, Counter.Y.low * LineSize);           //set line
7314       if (Counter.X.dir < 0) then                       //if x flipped then
7315         inc(TmpData, LineSize - PixelSize);             //set last pixel
7316
7317       repeat
7318         //read CommandByte
7319         CachedRead(Temp, 1);
7320         PixelRepeat  := (Temp and $80) > 0;
7321         PixelsToRead := (Temp and $7F) + 1;
7322         inc(TotalPixelsRead, PixelsToRead);
7323
7324         if PixelRepeat then
7325           CachedRead(buf[0], PixelSize);
7326         while (PixelsToRead > 0) do begin
7327           CheckLine;
7328           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7329           while (PixelCount > 0) do begin
7330             if not PixelRepeat then
7331               CachedRead(buf[0], PixelSize);
7332             PixelToBuffer(@buf[0], TmpData);
7333             inc(LinePixelsRead);
7334             dec(PixelsToRead);
7335             dec(PixelCount);
7336           end;
7337         end;
7338       until (TotalPixelsRead >= TotalPixelsToRead);
7339     finally
7340       FreeMem(Cache);
7341     end;
7342   end;
7343
7344   function IsGrayFormat: Boolean;
7345   begin
7346     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7347   end;
7348
7349 begin
7350   result := false;
7351
7352   // reading header to test file and set cursor back to begin
7353   StartPosition := aStream.Position;
7354   aStream.Read(Header{%H-}, SizeOf(Header));
7355
7356   // no colormapped files
7357   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7358     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7359   begin
7360     try
7361       if Header.ImageID <> 0 then       // skip image ID
7362         aStream.Position := aStream.Position + Header.ImageID;
7363
7364       tgaFormat := tfEmpty;
7365       case Header.Bpp of
7366          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7367                0: tgaFormat := tfLuminance8;
7368                8: tgaFormat := tfAlpha8;
7369             end;
7370
7371         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7372                0: tgaFormat := tfLuminance16;
7373                8: tgaFormat := tfLuminance8Alpha8;
7374             end else case (Header.ImageDesc and $F) of
7375                0: tgaFormat := tfBGR5;
7376                1: tgaFormat := tfBGR5A1;
7377                4: tgaFormat := tfBGRA4;
7378             end;
7379
7380         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7381                0: tgaFormat := tfBGR8;
7382             end;
7383
7384         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7385                2: tgaFormat := tfBGR10A2;
7386                8: tgaFormat := tfBGRA8;
7387             end;
7388       end;
7389
7390       if (tgaFormat = tfEmpty) then
7391         raise EglBitmap.Create('LoadTga - unsupported format');
7392
7393       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7394       PixelSize  := FormatDesc.GetSize(1, 1);
7395       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7396
7397       GetMem(ImageData, LineSize * Header.Height);
7398       try
7399         //column direction
7400         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7401           Counter.X.low  := Header.Height-1;;
7402           Counter.X.high := 0;
7403           Counter.X.dir  := -1;
7404         end else begin
7405           Counter.X.low  := 0;
7406           Counter.X.high := Header.Height-1;
7407           Counter.X.dir  := 1;
7408         end;
7409
7410         // Row direction
7411         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7412           Counter.Y.low  := 0;
7413           Counter.Y.high := Header.Height-1;
7414           Counter.Y.dir  := 1;
7415         end else begin
7416           Counter.Y.low  := Header.Height-1;;
7417           Counter.Y.high := 0;
7418           Counter.Y.dir  := -1;
7419         end;
7420
7421         // Read Image
7422         case Header.ImageType of
7423           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7424             ReadUncompressed;
7425           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7426             ReadCompressed;
7427         end;
7428
7429         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7430         result := true;
7431       except
7432         if Assigned(ImageData) then
7433           FreeMem(ImageData);
7434         raise;
7435       end;
7436     finally
7437       aStream.Position := StartPosition;
7438     end;
7439   end
7440     else aStream.Position := StartPosition;
7441 end;
7442
7443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7444 procedure TglBitmap.SaveTGA(const aStream: TStream);
7445 var
7446   Header: TTGAHeader;
7447   LineSize, Size, x, y: Integer;
7448   Pixel: TglBitmapPixelData;
7449   LineBuf, SourceData, DestData: PByte;
7450   SourceMD, DestMD: Pointer;
7451   FormatDesc: TFormatDescriptor;
7452   Converter: TFormatDescriptor;
7453 begin
7454   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7455     raise EglBitmapUnsupportedFormat.Create(Format);
7456
7457   //prepare header
7458   FillChar(Header{%H-}, SizeOf(Header), 0);
7459
7460   //set ImageType
7461   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7462                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7463     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7464   else
7465     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7466
7467   //set BitsPerPixel
7468   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7469     Header.Bpp := 8
7470   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7471                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7472     Header.Bpp := 16
7473   else if (Format in [tfBGR8, tfRGB8]) then
7474     Header.Bpp := 24
7475   else
7476     Header.Bpp := 32;
7477
7478   //set AlphaBitCount
7479   case Format of
7480     tfRGB5A1, tfBGR5A1:
7481       Header.ImageDesc := 1 and $F;
7482     tfRGB10A2, tfBGR10A2:
7483       Header.ImageDesc := 2 and $F;
7484     tfRGBA4, tfBGRA4:
7485       Header.ImageDesc := 4 and $F;
7486     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7487       Header.ImageDesc := 8 and $F;
7488   end;
7489
7490   Header.Width     := Width;
7491   Header.Height    := Height;
7492   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7493   aStream.Write(Header, SizeOf(Header));
7494
7495   // convert RGB(A) to BGR(A)
7496   Converter  := nil;
7497   FormatDesc := TFormatDescriptor.Get(Format);
7498   Size       := FormatDesc.GetSize(Dimension);
7499   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7500     if (FormatDesc.RGBInverted = tfEmpty) then
7501       raise EglBitmap.Create('inverted RGB format is empty');
7502     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7503     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7504        (Converter.PixelSize <> FormatDesc.PixelSize) then
7505       raise EglBitmap.Create('invalid inverted RGB format');
7506   end;
7507
7508   if Assigned(Converter) then begin
7509     LineSize := FormatDesc.GetSize(Width, 1);
7510     GetMem(LineBuf, LineSize);
7511     SourceMD := FormatDesc.CreateMappingData;
7512     DestMD   := Converter.CreateMappingData;
7513     try
7514       SourceData := Data;
7515       for y := 0 to Height-1 do begin
7516         DestData := LineBuf;
7517         for x := 0 to Width-1 do begin
7518           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7519           Converter.Map(Pixel, DestData, DestMD);
7520         end;
7521         aStream.Write(LineBuf^, LineSize);
7522       end;
7523     finally
7524       FreeMem(LineBuf);
7525       FormatDesc.FreeMappingData(SourceMD);
7526       FormatDesc.FreeMappingData(DestMD);
7527     end;
7528   end else
7529     aStream.Write(Data^, Size);
7530 end;
7531
7532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7533 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7535 const
7536   DDS_MAGIC: Cardinal         = $20534444;
7537
7538   // DDS_header.dwFlags
7539   DDSD_CAPS                   = $00000001;
7540   DDSD_HEIGHT                 = $00000002;
7541   DDSD_WIDTH                  = $00000004;
7542   DDSD_PIXELFORMAT            = $00001000;
7543
7544   // DDS_header.sPixelFormat.dwFlags
7545   DDPF_ALPHAPIXELS            = $00000001;
7546   DDPF_ALPHA                  = $00000002;
7547   DDPF_FOURCC                 = $00000004;
7548   DDPF_RGB                    = $00000040;
7549   DDPF_LUMINANCE              = $00020000;
7550
7551   // DDS_header.sCaps.dwCaps1
7552   DDSCAPS_TEXTURE             = $00001000;
7553
7554   // DDS_header.sCaps.dwCaps2
7555   DDSCAPS2_CUBEMAP            = $00000200;
7556
7557   D3DFMT_DXT1                 = $31545844;
7558   D3DFMT_DXT3                 = $33545844;
7559   D3DFMT_DXT5                 = $35545844;
7560
7561 type
7562   TDDSPixelFormat = packed record
7563     dwSize: Cardinal;
7564     dwFlags: Cardinal;
7565     dwFourCC: Cardinal;
7566     dwRGBBitCount: Cardinal;
7567     dwRBitMask: Cardinal;
7568     dwGBitMask: Cardinal;
7569     dwBBitMask: Cardinal;
7570     dwABitMask: Cardinal;
7571   end;
7572
7573   TDDSCaps = packed record
7574     dwCaps1: Cardinal;
7575     dwCaps2: Cardinal;
7576     dwDDSX: Cardinal;
7577     dwReserved: Cardinal;
7578   end;
7579
7580   TDDSHeader = packed record
7581     dwSize: Cardinal;
7582     dwFlags: Cardinal;
7583     dwHeight: Cardinal;
7584     dwWidth: Cardinal;
7585     dwPitchOrLinearSize: Cardinal;
7586     dwDepth: Cardinal;
7587     dwMipMapCount: Cardinal;
7588     dwReserved: array[0..10] of Cardinal;
7589     PixelFormat: TDDSPixelFormat;
7590     Caps: TDDSCaps;
7591     dwReserved2: Cardinal;
7592   end;
7593
7594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7595 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7596 var
7597   Header: TDDSHeader;
7598   Converter: TbmpBitfieldFormat;
7599
7600   function GetDDSFormat: TglBitmapFormat;
7601   var
7602     fd: TFormatDescriptor;
7603     i: Integer;
7604     Range: TglBitmapColorRec;
7605     match: Boolean;
7606   begin
7607     result := tfEmpty;
7608     with Header.PixelFormat do begin
7609       // Compresses
7610       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7611         case Header.PixelFormat.dwFourCC of
7612           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7613           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7614           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7615         end;
7616       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7617
7618         //find matching format
7619         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7620           fd := TFormatDescriptor.Get(result);
7621           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7622              (8 * fd.PixelSize = dwRGBBitCount) then
7623             exit;
7624         end;
7625
7626         //find format with same Range
7627         Range.r := dwRBitMask;
7628         Range.g := dwGBitMask;
7629         Range.b := dwBBitMask;
7630         Range.a := dwABitMask;
7631         for i := 0 to 3 do begin
7632           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7633             Range.arr[i] := Range.arr[i] shr 1;
7634         end;
7635         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7636           fd := TFormatDescriptor.Get(result);
7637           match := true;
7638           for i := 0 to 3 do
7639             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7640               match := false;
7641               break;
7642             end;
7643           if match then
7644             break;
7645         end;
7646
7647         //no format with same range found -> use default
7648         if (result = tfEmpty) then begin
7649           if (dwABitMask > 0) then
7650             result := tfBGRA8
7651           else
7652             result := tfBGR8;
7653         end;
7654
7655         Converter := TbmpBitfieldFormat.Create;
7656         Converter.RedMask   := dwRBitMask;
7657         Converter.GreenMask := dwGBitMask;
7658         Converter.BlueMask  := dwBBitMask;
7659         Converter.AlphaMask := dwABitMask;
7660         Converter.PixelSize := dwRGBBitCount / 8;
7661       end;
7662     end;
7663   end;
7664
7665 var
7666   StreamPos: Int64;
7667   x, y, LineSize, RowSize, Magic: Cardinal;
7668   NewImage, TmpData, RowData, SrcData: System.PByte;
7669   SourceMD, DestMD: Pointer;
7670   Pixel: TglBitmapPixelData;
7671   ddsFormat: TglBitmapFormat;
7672   FormatDesc: TFormatDescriptor;
7673
7674 begin
7675   result    := false;
7676   Converter := nil;
7677   StreamPos := aStream.Position;
7678
7679   // Magic
7680   aStream.Read(Magic{%H-}, sizeof(Magic));
7681   if (Magic <> DDS_MAGIC) then begin
7682     aStream.Position := StreamPos;
7683     exit;
7684   end;
7685
7686   //Header
7687   aStream.Read(Header{%H-}, sizeof(Header));
7688   if (Header.dwSize <> SizeOf(Header)) or
7689      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7690         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7691   begin
7692     aStream.Position := StreamPos;
7693     exit;
7694   end;
7695
7696   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7697     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7698
7699   ddsFormat := GetDDSFormat;
7700   try
7701     if (ddsFormat = tfEmpty) then
7702       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7703
7704     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7705     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7706     GetMem(NewImage, Header.dwHeight * LineSize);
7707     try
7708       TmpData := NewImage;
7709
7710       //Converter needed
7711       if Assigned(Converter) then begin
7712         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7713         GetMem(RowData, RowSize);
7714         SourceMD := Converter.CreateMappingData;
7715         DestMD   := FormatDesc.CreateMappingData;
7716         try
7717           for y := 0 to Header.dwHeight-1 do begin
7718             TmpData := NewImage;
7719             inc(TmpData, y * LineSize);
7720             SrcData := RowData;
7721             aStream.Read(SrcData^, RowSize);
7722             for x := 0 to Header.dwWidth-1 do begin
7723               Converter.Unmap(SrcData, Pixel, SourceMD);
7724               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7725               FormatDesc.Map(Pixel, TmpData, DestMD);
7726             end;
7727           end;
7728         finally
7729           Converter.FreeMappingData(SourceMD);
7730           FormatDesc.FreeMappingData(DestMD);
7731           FreeMem(RowData);
7732         end;
7733       end else
7734
7735       // Compressed
7736       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7737         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7738         for Y := 0 to Header.dwHeight-1 do begin
7739           aStream.Read(TmpData^, RowSize);
7740           Inc(TmpData, LineSize);
7741         end;
7742       end else
7743
7744       // Uncompressed
7745       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7746         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7747         for Y := 0 to Header.dwHeight-1 do begin
7748           aStream.Read(TmpData^, RowSize);
7749           Inc(TmpData, LineSize);
7750         end;
7751       end else
7752         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7753
7754       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7755       result := true;
7756     except
7757       if Assigned(NewImage) then
7758         FreeMem(NewImage);
7759       raise;
7760     end;
7761   finally
7762     FreeAndNil(Converter);
7763   end;
7764 end;
7765
7766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7767 procedure TglBitmap.SaveDDS(const aStream: TStream);
7768 var
7769   Header: TDDSHeader;
7770   FormatDesc: TFormatDescriptor;
7771 begin
7772   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7773     raise EglBitmapUnsupportedFormat.Create(Format);
7774
7775   FormatDesc := TFormatDescriptor.Get(Format);
7776
7777   // Generell
7778   FillChar(Header{%H-}, SizeOf(Header), 0);
7779   Header.dwSize  := SizeOf(Header);
7780   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7781
7782   Header.dwWidth  := Max(1, Width);
7783   Header.dwHeight := Max(1, Height);
7784
7785   // Caps
7786   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7787
7788   // Pixelformat
7789   Header.PixelFormat.dwSize := sizeof(Header);
7790   if (FormatDesc.IsCompressed) then begin
7791     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7792     case Format of
7793       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7794       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7795       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7796     end;
7797   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7798     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7799     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7800     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7801   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7802     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7803     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7804     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7805     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7806   end else begin
7807     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7808     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7809     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7810     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7811     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7812     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7813   end;
7814
7815   if (FormatDesc.HasAlpha) then
7816     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7817
7818   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7819   aStream.Write(Header, SizeOf(Header));
7820   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7821 end;
7822
7823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7824 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7826 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7827   const aWidth: Integer; const aHeight: Integer);
7828 var
7829   pTemp: pByte;
7830   Size: Integer;
7831 begin
7832   if (aHeight > 1) then begin
7833     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7834     GetMem(pTemp, Size);
7835     try
7836       Move(aData^, pTemp^, Size);
7837       FreeMem(aData);
7838       aData := nil;
7839     except
7840       FreeMem(pTemp);
7841       raise;
7842     end;
7843   end else
7844     pTemp := aData;
7845   inherited SetDataPointer(pTemp, aFormat, aWidth);
7846 end;
7847
7848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7849 function TglBitmap1D.FlipHorz: Boolean;
7850 var
7851   Col: Integer;
7852   pTempDest, pDest, pSource: PByte;
7853 begin
7854   result := inherited FlipHorz;
7855   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7856     pSource := Data;
7857     GetMem(pDest, fRowSize);
7858     try
7859       pTempDest := pDest;
7860       Inc(pTempDest, fRowSize);
7861       for Col := 0 to Width-1 do begin
7862         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7863         Move(pSource^, pTempDest^, fPixelSize);
7864         Inc(pSource, fPixelSize);
7865       end;
7866       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7867       result := true;
7868     except
7869       if Assigned(pDest) then
7870         FreeMem(pDest);
7871       raise;
7872     end;
7873   end;
7874 end;
7875
7876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7877 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7878 var
7879   FormatDesc: TFormatDescriptor;
7880 begin
7881   // Upload data
7882   FormatDesc := TFormatDescriptor.Get(Format);
7883   if FormatDesc.IsCompressed then begin
7884     if not Assigned(glCompressedTexImage1D) then
7885       raise EglBitmap.Create('compressed formats not supported by video adapter');
7886     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7887   end else if aBuildWithGlu then
7888     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7889   else
7890     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7891
7892   // Free Data
7893   if (FreeDataAfterGenTexture) then
7894     FreeData;
7895 end;
7896
7897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7898 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7899 var
7900   BuildWithGlu, TexRec: Boolean;
7901   TexSize: Integer;
7902 begin
7903   if Assigned(Data) then begin
7904     // Check Texture Size
7905     if (aTestTextureSize) then begin
7906       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7907
7908       if (Width > TexSize) then
7909         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7910
7911       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7912                 (Target = GL_TEXTURE_RECTANGLE);
7913       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7914         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7915     end;
7916
7917     CreateId;
7918     SetupParameters(BuildWithGlu);
7919     UploadData(BuildWithGlu);
7920     glAreTexturesResident(1, @fID, @fIsResident);
7921   end;
7922 end;
7923
7924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7925 procedure TglBitmap1D.AfterConstruction;
7926 begin
7927   inherited;
7928   Target := GL_TEXTURE_1D;
7929 end;
7930
7931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7932 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7934 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7935 begin
7936   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7937     result := fLines[aIndex]
7938   else
7939     result := nil;
7940 end;
7941
7942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7943 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7944   const aWidth: Integer; const aHeight: Integer);
7945 var
7946   Idx, LineWidth: Integer;
7947 begin
7948   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7949
7950   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7951     // Assigning Data
7952     if Assigned(Data) then begin
7953       SetLength(fLines, GetHeight);
7954       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7955
7956       for Idx := 0 to GetHeight-1 do begin
7957         fLines[Idx] := Data;
7958         Inc(fLines[Idx], Idx * LineWidth);
7959       end;
7960     end
7961       else SetLength(fLines, 0);
7962   end else begin
7963     SetLength(fLines, 0);
7964   end;
7965 end;
7966
7967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7968 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7969 var
7970   FormatDesc: TFormatDescriptor;
7971 begin
7972   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7973
7974   FormatDesc := TFormatDescriptor.Get(Format);
7975   if FormatDesc.IsCompressed then begin
7976     if not Assigned(glCompressedTexImage2D) then
7977       raise EglBitmap.Create('compressed formats not supported by video adapter');
7978     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7979   end else if aBuildWithGlu then begin
7980     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7981       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7982   end else begin
7983     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7984       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7985   end;
7986
7987   // Freigeben
7988   if (FreeDataAfterGenTexture) then
7989     FreeData;
7990 end;
7991
7992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7993 procedure TglBitmap2D.AfterConstruction;
7994 begin
7995   inherited;
7996   Target := GL_TEXTURE_2D;
7997 end;
7998
7999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8000 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8001 var
8002   Temp: pByte;
8003   Size, w, h: Integer;
8004   FormatDesc: TFormatDescriptor;
8005 begin
8006   FormatDesc := TFormatDescriptor.Get(aFormat);
8007   if FormatDesc.IsCompressed then
8008     raise EglBitmapUnsupportedFormat.Create(aFormat);
8009
8010   w    := aRight  - aLeft;
8011   h    := aBottom - aTop;
8012   Size := FormatDesc.GetSize(w, h);
8013   GetMem(Temp, Size);
8014   try
8015     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8016     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8017     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8018     FlipVert;
8019   except
8020     if Assigned(Temp) then
8021       FreeMem(Temp);
8022     raise;
8023   end;
8024 end;
8025
8026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8027 procedure TglBitmap2D.GetDataFromTexture;
8028 var
8029   Temp: PByte;
8030   TempWidth, TempHeight: Integer;
8031   TempIntFormat: Cardinal;
8032   IntFormat, f: TglBitmapFormat;
8033   FormatDesc: TFormatDescriptor;
8034 begin
8035   Bind;
8036
8037   // Request Data
8038   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8039   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8040   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8041
8042   IntFormat := tfEmpty;
8043   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8044     FormatDesc := TFormatDescriptor.Get(f);
8045     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8046       IntFormat := FormatDesc.Format;
8047       break;
8048     end;
8049   end;
8050
8051   // Getting data from OpenGL
8052   FormatDesc := TFormatDescriptor.Get(IntFormat);
8053   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8054   try
8055     if FormatDesc.IsCompressed then begin
8056       if not Assigned(glGetCompressedTexImage) then
8057         raise EglBitmap.Create('compressed formats not supported by video adapter');
8058       glGetCompressedTexImage(Target, 0, Temp)
8059     end else
8060       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8061     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8062   except
8063     if Assigned(Temp) then
8064       FreeMem(Temp);
8065     raise;
8066   end;
8067 end;
8068
8069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8070 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8071 var
8072   BuildWithGlu, PotTex, TexRec: Boolean;
8073   TexSize: Integer;
8074 begin
8075   if Assigned(Data) then begin
8076     // Check Texture Size
8077     if (aTestTextureSize) then begin
8078       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8079
8080       if ((Height > TexSize) or (Width > TexSize)) then
8081         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8082
8083       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8084       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8085       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8086         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8087     end;
8088
8089     CreateId;
8090     SetupParameters(BuildWithGlu);
8091     UploadData(Target, BuildWithGlu);
8092     glAreTexturesResident(1, @fID, @fIsResident);
8093   end;
8094 end;
8095
8096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8097 function TglBitmap2D.FlipHorz: Boolean;
8098 var
8099   Col, Row: Integer;
8100   TempDestData, DestData, SourceData: PByte;
8101   ImgSize: Integer;
8102 begin
8103   result := inherited FlipHorz;
8104   if Assigned(Data) then begin
8105     SourceData := Data;
8106     ImgSize := Height * fRowSize;
8107     GetMem(DestData, ImgSize);
8108     try
8109       TempDestData := DestData;
8110       Dec(TempDestData, fRowSize + fPixelSize);
8111       for Row := 0 to Height -1 do begin
8112         Inc(TempDestData, fRowSize * 2);
8113         for Col := 0 to Width -1 do begin
8114           Move(SourceData^, TempDestData^, fPixelSize);
8115           Inc(SourceData, fPixelSize);
8116           Dec(TempDestData, fPixelSize);
8117         end;
8118       end;
8119       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8120       result := true;
8121     except
8122       if Assigned(DestData) then
8123         FreeMem(DestData);
8124       raise;
8125     end;
8126   end;
8127 end;
8128
8129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8130 function TglBitmap2D.FlipVert: Boolean;
8131 var
8132   Row: Integer;
8133   TempDestData, DestData, SourceData: PByte;
8134 begin
8135   result := inherited FlipVert;
8136   if Assigned(Data) then begin
8137     SourceData := Data;
8138     GetMem(DestData, Height * fRowSize);
8139     try
8140       TempDestData := DestData;
8141       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8142       for Row := 0 to Height -1 do begin
8143         Move(SourceData^, TempDestData^, fRowSize);
8144         Dec(TempDestData, fRowSize);
8145         Inc(SourceData, fRowSize);
8146       end;
8147       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8148       result := true;
8149     except
8150       if Assigned(DestData) then
8151         FreeMem(DestData);
8152       raise;
8153     end;
8154   end;
8155 end;
8156
8157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8158 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8160 type
8161   TMatrixItem = record
8162     X, Y: Integer;
8163     W: Single;
8164   end;
8165
8166   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8167   TglBitmapToNormalMapRec = Record
8168     Scale: Single;
8169     Heights: array of Single;
8170     MatrixU : array of TMatrixItem;
8171     MatrixV : array of TMatrixItem;
8172   end;
8173
8174 const
8175   ONE_OVER_255 = 1 / 255;
8176
8177   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8178 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8179 var
8180   Val: Single;
8181 begin
8182   with FuncRec do begin
8183     Val :=
8184       Source.Data.r * LUMINANCE_WEIGHT_R +
8185       Source.Data.g * LUMINANCE_WEIGHT_G +
8186       Source.Data.b * LUMINANCE_WEIGHT_B;
8187     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8188   end;
8189 end;
8190
8191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8192 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8193 begin
8194   with FuncRec do
8195     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8196 end;
8197
8198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8199 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8200 type
8201   TVec = Array[0..2] of Single;
8202 var
8203   Idx: Integer;
8204   du, dv: Double;
8205   Len: Single;
8206   Vec: TVec;
8207
8208   function GetHeight(X, Y: Integer): Single;
8209   begin
8210     with FuncRec do begin
8211       X := Max(0, Min(Size.X -1, X));
8212       Y := Max(0, Min(Size.Y -1, Y));
8213       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8214     end;
8215   end;
8216
8217 begin
8218   with FuncRec do begin
8219     with PglBitmapToNormalMapRec(Args)^ do begin
8220       du := 0;
8221       for Idx := Low(MatrixU) to High(MatrixU) do
8222         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8223
8224       dv := 0;
8225       for Idx := Low(MatrixU) to High(MatrixU) do
8226         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8227
8228       Vec[0] := -du * Scale;
8229       Vec[1] := -dv * Scale;
8230       Vec[2] := 1;
8231     end;
8232
8233     // Normalize
8234     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8235     if Len <> 0 then begin
8236       Vec[0] := Vec[0] * Len;
8237       Vec[1] := Vec[1] * Len;
8238       Vec[2] := Vec[2] * Len;
8239     end;
8240
8241     // Farbe zuweisem
8242     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8243     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8244     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8245   end;
8246 end;
8247
8248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8249 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8250 var
8251   Rec: TglBitmapToNormalMapRec;
8252
8253   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8254   begin
8255     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8256       Matrix[Index].X := X;
8257       Matrix[Index].Y := Y;
8258       Matrix[Index].W := W;
8259     end;
8260   end;
8261
8262 begin
8263   if TFormatDescriptor.Get(Format).IsCompressed then
8264     raise EglBitmapUnsupportedFormat.Create(Format);
8265
8266   if aScale > 100 then
8267     Rec.Scale := 100
8268   else if aScale < -100 then
8269     Rec.Scale := -100
8270   else
8271     Rec.Scale := aScale;
8272
8273   SetLength(Rec.Heights, Width * Height);
8274   try
8275     case aFunc of
8276       nm4Samples: begin
8277         SetLength(Rec.MatrixU, 2);
8278         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8279         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8280
8281         SetLength(Rec.MatrixV, 2);
8282         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8283         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8284       end;
8285
8286       nmSobel: begin
8287         SetLength(Rec.MatrixU, 6);
8288         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8289         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8290         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8291         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8292         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8293         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8294
8295         SetLength(Rec.MatrixV, 6);
8296         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8297         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8298         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8299         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8300         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8301         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8302       end;
8303
8304       nm3x3: begin
8305         SetLength(Rec.MatrixU, 6);
8306         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8307         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8308         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8309         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8310         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8311         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8312
8313         SetLength(Rec.MatrixV, 6);
8314         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8315         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8316         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8317         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8318         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8319         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8320       end;
8321
8322       nm5x5: begin
8323         SetLength(Rec.MatrixU, 20);
8324         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8325         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8326         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8327         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8328         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8329         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8330         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8331         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8332         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8333         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8334         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8335         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8336         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8337         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8338         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8339         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8340         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8341         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8342         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8343         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8344
8345         SetLength(Rec.MatrixV, 20);
8346         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8347         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8348         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8349         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8350         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8351         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8352         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8353         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8354         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8355         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8356         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8357         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8358         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8359         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8360         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8361         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8362         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8363         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8364         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8365         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8366       end;
8367     end;
8368
8369     // Daten Sammeln
8370     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8371       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8372     else
8373       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8374     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8375   finally
8376     SetLength(Rec.Heights, 0);
8377   end;
8378 end;
8379
8380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8381 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8383 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8384 begin
8385   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8386 end;
8387
8388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8389 procedure TglBitmapCubeMap.AfterConstruction;
8390 begin
8391   inherited;
8392
8393   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8394     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8395
8396   SetWrap;
8397   Target   := GL_TEXTURE_CUBE_MAP;
8398   fGenMode := GL_REFLECTION_MAP;
8399 end;
8400
8401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8402 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8403 var
8404   BuildWithGlu: Boolean;
8405   TexSize: Integer;
8406 begin
8407   if (aTestTextureSize) then begin
8408     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8409
8410     if (Height > TexSize) or (Width > TexSize) then
8411       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8412
8413     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8414       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8415   end;
8416
8417   if (ID = 0) then
8418     CreateID;
8419   SetupParameters(BuildWithGlu);
8420   UploadData(aCubeTarget, BuildWithGlu);
8421 end;
8422
8423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8424 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8425 begin
8426   inherited Bind (aEnableTextureUnit);
8427   if aEnableTexCoordsGen then begin
8428     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8429     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8430     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8431     glEnable(GL_TEXTURE_GEN_S);
8432     glEnable(GL_TEXTURE_GEN_T);
8433     glEnable(GL_TEXTURE_GEN_R);
8434   end;
8435 end;
8436
8437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8438 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8439 begin
8440   inherited Unbind(aDisableTextureUnit);
8441   if aDisableTexCoordsGen then begin
8442     glDisable(GL_TEXTURE_GEN_S);
8443     glDisable(GL_TEXTURE_GEN_T);
8444     glDisable(GL_TEXTURE_GEN_R);
8445   end;
8446 end;
8447
8448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8449 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 type
8452   TVec = Array[0..2] of Single;
8453   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8454
8455   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8456   TglBitmapNormalMapRec = record
8457     HalfSize : Integer;
8458     Func: TglBitmapNormalMapGetVectorFunc;
8459   end;
8460
8461   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8463 begin
8464   aVec[0] := aHalfSize;
8465   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8466   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8467 end;
8468
8469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8470 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8471 begin
8472   aVec[0] := - aHalfSize;
8473   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8474   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8475 end;
8476
8477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8478 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8479 begin
8480   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8481   aVec[1] := aHalfSize;
8482   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8483 end;
8484
8485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8486 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8487 begin
8488   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8489   aVec[1] := - aHalfSize;
8490   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8491 end;
8492
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8495 begin
8496   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8497   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8498   aVec[2] := aHalfSize;
8499 end;
8500
8501 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8502 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8503 begin
8504   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8505   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8506   aVec[2] := - aHalfSize;
8507 end;
8508
8509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8510 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8511 var
8512   i: Integer;
8513   Vec: TVec;
8514   Len: Single;
8515 begin
8516   with FuncRec do begin
8517     with PglBitmapNormalMapRec(Args)^ do begin
8518       Func(Vec, Position, HalfSize);
8519
8520       // Normalize
8521       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8522       if Len <> 0 then begin
8523         Vec[0] := Vec[0] * Len;
8524         Vec[1] := Vec[1] * Len;
8525         Vec[2] := Vec[2] * Len;
8526       end;
8527
8528       // Scale Vector and AddVectro
8529       Vec[0] := Vec[0] * 0.5 + 0.5;
8530       Vec[1] := Vec[1] * 0.5 + 0.5;
8531       Vec[2] := Vec[2] * 0.5 + 0.5;
8532     end;
8533
8534     // Set Color
8535     for i := 0 to 2 do
8536       Dest.Data.arr[i] := Round(Vec[i] * 255);
8537   end;
8538 end;
8539
8540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8541 procedure TglBitmapNormalMap.AfterConstruction;
8542 begin
8543   inherited;
8544   fGenMode := GL_NORMAL_MAP;
8545 end;
8546
8547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8548 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8549 var
8550   Rec: TglBitmapNormalMapRec;
8551   SizeRec: TglBitmapPixelPosition;
8552 begin
8553   Rec.HalfSize := aSize div 2;
8554   FreeDataAfterGenTexture := false;
8555
8556   SizeRec.Fields := [ffX, ffY];
8557   SizeRec.X := aSize;
8558   SizeRec.Y := aSize;
8559
8560   // Positive X
8561   Rec.Func := glBitmapNormalMapPosX;
8562   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8563   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8564
8565   // Negative X
8566   Rec.Func := glBitmapNormalMapNegX;
8567   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8568   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8569
8570   // Positive Y
8571   Rec.Func := glBitmapNormalMapPosY;
8572   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8573   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8574
8575   // Negative Y
8576   Rec.Func := glBitmapNormalMapNegY;
8577   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8578   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8579
8580   // Positive Z
8581   Rec.Func := glBitmapNormalMapPosZ;
8582   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8583   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8584
8585   // Negative Z
8586   Rec.Func := glBitmapNormalMapNegZ;
8587   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8588   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8589 end;
8590
8591
8592 initialization
8593   glBitmapSetDefaultFormat (tfEmpty);
8594   glBitmapSetDefaultMipmap (mmMipmap);
8595   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8596   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8597   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8598
8599   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8600   glBitmapSetDefaultDeleteTextureOnFree    (true);
8601
8602   TFormatDescriptor.Init;
8603
8604 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8605   OpenGLInitialized := false;
8606   InitOpenGLCS := TCriticalSection.Create;
8607 {$ENDIF}
8608
8609 finalization
8610   TFormatDescriptor.Finalize;
8611
8612 {$IFDEF GLB_NATIVE_OGL}
8613   if Assigned(GL_LibHandle) then
8614     glbFreeLibrary(GL_LibHandle);
8615
8616 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8617   if Assigned(GLU_LibHandle) then
8618     glbFreeLibrary(GLU_LibHandle);
8619   FreeAndNil(InitOpenGLCS);
8620 {$ENDIF}
8621 {$ENDIF}
8622
8623 end.