uglcBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.1
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit uglcBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     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 GetHasRed:       Boolean; virtual; abstract;
 893     function GetHasGreen:     Boolean; virtual; abstract;
 894     function GetHasBlue:      Boolean; virtual; abstract;
 895     function GetHasAlpha:     Boolean; virtual; abstract;
 896
 897     function GetglDataFormat:     GLenum;  virtual; abstract;
 898     function GetglFormat:         GLenum;  virtual; abstract;
 899     function GetglInternalFormat: GLenum;  virtual; abstract;
 900   public
 901     property IsCompressed: Boolean read GetIsCompressed;
 902     property HasRed:       Boolean read GetHasRed;
 903     property HasGreen:     Boolean read GetHasGreen;
 904     property HasBlue:      Boolean read GetHasBlue;
 905     property HasAlpha:     Boolean read GetHasAlpha;
 906
 907     property glFormat:         GLenum  read GetglFormat;
 908     property glInternalFormat: GLenum  read GetglInternalFormat;
 909     property glDataFormat:     GLenum  read GetglDataFormat;
 910   public
 911     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 912   end;
 913
 914 ////////////////////////////////////////////////////////////////////////////////////////////////////
 915   TglBitmap = class;
 916   TglBitmapFunctionRec = record
 917     Sender:   TglBitmap;
 918     Size:     TglBitmapPixelPosition;
 919     Position: TglBitmapPixelPosition;
 920     Source:   TglBitmapPixelData;
 921     Dest:     TglBitmapPixelData;
 922     Args:     Pointer;
 923   end;
 924   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 925
 926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 927   TglBitmap = class
 928   private
 929     function GetFormatDesc: TglBitmapFormatDescriptor;
 930   protected
 931     fID: GLuint;
 932     fTarget: GLuint;
 933     fAnisotropic: Integer;
 934     fDeleteTextureOnFree: Boolean;
 935     fFreeDataOnDestroy: Boolean;
 936     fFreeDataAfterGenTexture: Boolean;
 937     fData: PByte;
 938     fIsResident: GLboolean;
 939     fBorderColor: array[0..3] of Single;
 940
 941     fDimension: TglBitmapPixelPosition;
 942     fMipMap: TglBitmapMipMap;
 943     fFormat: TglBitmapFormat;
 944
 945     // Mapping
 946     fPixelSize: Integer;
 947     fRowSize: Integer;
 948
 949     // Filtering
 950     fFilterMin: GLenum;
 951     fFilterMag: GLenum;
 952
 953     // TexturWarp
 954     fWrapS: GLenum;
 955     fWrapT: GLenum;
 956     fWrapR: GLenum;
 957
 958     //Swizzle
 959     fSwizzle: array[0..3] of GLenum;
 960
 961     // CustomData
 962     fFilename: String;
 963     fCustomName: String;
 964     fCustomNameW: WideString;
 965     fCustomData: Pointer;
 966
 967     //Getter
 968     function GetWidth:  Integer; virtual;
 969     function GetHeight: Integer; virtual;
 970
 971     function GetFileWidth:  Integer; virtual;
 972     function GetFileHeight: Integer; virtual;
 973
 974     //Setter
 975     procedure SetCustomData(const aValue: Pointer);
 976     procedure SetCustomName(const aValue: String);
 977     procedure SetCustomNameW(const aValue: WideString);
 978     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 979     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 980     procedure SetFormat(const aValue: TglBitmapFormat);
 981     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 982     procedure SetID(const aValue: Cardinal);
 983     procedure SetMipMap(const aValue: TglBitmapMipMap);
 984     procedure SetTarget(const aValue: Cardinal);
 985     procedure SetAnisotropic(const aValue: Integer);
 986
 987     procedure CreateID;
 988     procedure SetupParameters(out aBuildWithGlu: Boolean);
 989     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 990       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 991     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 992
 993     function FlipHorz: Boolean; virtual;
 994     function FlipVert: Boolean; virtual;
 995
 996     property Width:  Integer read GetWidth;
 997     property Height: Integer read GetHeight;
 998
 999     property FileWidth:  Integer read GetFileWidth;
1000     property FileHeight: Integer read GetFileHeight;
1001   public
1002     //Properties
1003     property ID:           Cardinal        read fID          write SetID;
1004     property Target:       Cardinal        read fTarget      write SetTarget;
1005     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1006     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1007     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1008
1009     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1010
1011     property Filename:    String     read fFilename;
1012     property CustomName:  String     read fCustomName  write SetCustomName;
1013     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1014     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1015
1016     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1017     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1018     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1019
1020     property Dimension:  TglBitmapPixelPosition  read fDimension;
1021     property Data:       PByte                   read fData;
1022     property IsResident: GLboolean               read fIsResident;
1023
1024     procedure AfterConstruction; override;
1025     procedure BeforeDestruction; override;
1026
1027     procedure PrepareResType(var aResource: String; var aResType: PChar);
1028
1029     //Load
1030     procedure LoadFromFile(const aFilename: String);
1031     procedure LoadFromStream(const aStream: TStream); virtual;
1032     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1033       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1034     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1035     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1036
1037     //Save
1038     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1039     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1040
1041     //Convert
1042     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1043     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1044       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1045   public
1046     //Alpha & Co
1047     {$IFDEF GLB_SDL}
1048     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1049     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1050     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1051     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1052       const aArgs: Pointer = nil): Boolean;
1053     {$ENDIF}
1054
1055     {$IFDEF GLB_DELPHI}
1056     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1057     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1058     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1059     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1060       const aArgs: Pointer = nil): Boolean;
1061     {$ENDIF}
1062
1063     {$IFDEF GLB_LAZARUS}
1064     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1065     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1066     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1067     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1068       const aArgs: Pointer = nil): Boolean;
1069     {$ENDIF}
1070
1071     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1072       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1073     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1074       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1075
1076     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1077     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1078     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1079     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1080
1081     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1082     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1083     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1084
1085     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1086     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1087     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1088
1089     function RemoveAlpha: Boolean; virtual;
1090   public
1091     //Common
1092     function Clone: TglBitmap;
1093     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1094     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1095     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1096     procedure FreeData;
1097
1098     //ColorFill
1099     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1100     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1101     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1102
1103     //TexParameters
1104     procedure SetFilter(const aMin, aMag: GLenum);
1105     procedure SetWrap(
1106       const S: GLenum = GL_CLAMP_TO_EDGE;
1107       const T: GLenum = GL_CLAMP_TO_EDGE;
1108       const R: GLenum = GL_CLAMP_TO_EDGE);
1109     procedure SetSwizzle(const r, g, b, a: GLenum);
1110
1111     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1112     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1113
1114     //Constructors
1115     constructor Create; overload;
1116     constructor Create(const aFileName: String); overload;
1117     constructor Create(const aStream: TStream); overload;
1118     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1119     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1120     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1121     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1122   private
1123     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1124     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1125
1126     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1127     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1128
1129     function LoadBMP(const aStream: TStream): Boolean; virtual;
1130     procedure SaveBMP(const aStream: TStream); virtual;
1131
1132     function LoadTGA(const aStream: TStream): Boolean; virtual;
1133     procedure SaveTGA(const aStream: TStream); virtual;
1134
1135     function LoadDDS(const aStream: TStream): Boolean; virtual;
1136     procedure SaveDDS(const aStream: TStream); virtual;
1137   end;
1138
1139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1140   TglBitmap1D = class(TglBitmap)
1141   protected
1142     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1143       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1144     procedure UploadData(const aBuildWithGlu: Boolean);
1145   public
1146     property Width;
1147     procedure AfterConstruction; override;
1148     function FlipHorz: Boolean; override;
1149     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1150   end;
1151
1152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1153   TglBitmap2D = class(TglBitmap)
1154   protected
1155     fLines: array of PByte;
1156     function GetScanline(const aIndex: Integer): Pointer;
1157     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1158       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1159     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1160   public
1161     property Width;
1162     property Height;
1163     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1164
1165     procedure AfterConstruction; override;
1166
1167     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1168     procedure GetDataFromTexture;
1169     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1170
1171     function FlipHorz: Boolean; override;
1172     function FlipVert: Boolean; override;
1173
1174     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1175       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1176   end;
1177
1178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1179   TglBitmapCubeMap = class(TglBitmap2D)
1180   protected
1181     fGenMode: Integer;
1182     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1183   public
1184     procedure AfterConstruction; override;
1185     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1186     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1187     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1188   end;
1189
1190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1191   TglBitmapNormalMap = class(TglBitmapCubeMap)
1192   public
1193     procedure AfterConstruction; override;
1194     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1195   end;
1196
1197   TglcBitmapFormat    = TglBitmapFormat;
1198   TglcBitmap1D        = TglBitmap1D;
1199   TglcBitmap2D        = TglBitmap2D;
1200   TglcBitmapCubeMap   = TglBitmapCubeMap;
1201   TglcBitmapNormalMap = TglBitmapNormalMap;
1202
1203 const
1204   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1205
1206 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1207 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1208 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1209 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1210 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1211 procedure glBitmapSetDefaultWrap(
1212   const S: Cardinal = GL_CLAMP_TO_EDGE;
1213   const T: Cardinal = GL_CLAMP_TO_EDGE;
1214   const R: Cardinal = GL_CLAMP_TO_EDGE);
1215
1216 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1217 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1218 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1219 function glBitmapGetDefaultFormat: TglBitmapFormat;
1220 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1221 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1222
1223 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1224 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1225 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1226
1227 var
1228   glBitmapDefaultDeleteTextureOnFree: Boolean;
1229   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1230   glBitmapDefaultFormat: TglBitmapFormat;
1231   glBitmapDefaultMipmap: TglBitmapMipMap;
1232   glBitmapDefaultFilterMin: Cardinal;
1233   glBitmapDefaultFilterMag: Cardinal;
1234   glBitmapDefaultWrapS: Cardinal;
1235   glBitmapDefaultWrapT: Cardinal;
1236   glBitmapDefaultWrapR: Cardinal;
1237   glDefaultSwizzle: array[0..3] of GLenum;
1238
1239 {$IFDEF GLB_DELPHI}
1240 function CreateGrayPalette: HPALETTE;
1241 {$ENDIF}
1242
1243 implementation
1244
1245 uses
1246   Math, syncobjs, typinfo
1247   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1248
1249 type
1250 {$IFNDEF fpc}
1251   QWord   = System.UInt64;
1252   PQWord  = ^QWord;
1253
1254   PtrInt  = Longint;
1255   PtrUInt = DWord;
1256 {$ENDIF}
1257
1258 ////////////////////////////////////////////////////////////////////////////////////////////////////
1259   TShiftRec = packed record
1260   case Integer of
1261     0: (r, g, b, a: Byte);
1262     1: (arr: array[0..3] of Byte);
1263   end;
1264
1265   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1266   private
1267     function GetRedMask: QWord;
1268     function GetGreenMask: QWord;
1269     function GetBlueMask: QWord;
1270     function GetAlphaMask: QWord;
1271   protected
1272     fFormat: TglBitmapFormat;
1273     fWithAlpha: TglBitmapFormat;
1274     fWithoutAlpha: TglBitmapFormat;
1275     fRGBInverted: TglBitmapFormat;
1276     fUncompressed: TglBitmapFormat;
1277     fPixelSize: Single;
1278     fIsCompressed: Boolean;
1279
1280     fRange: TglBitmapColorRec;
1281     fShift: TShiftRec;
1282
1283     fglFormat:         GLenum;
1284     fglInternalFormat: GLenum;
1285     fglDataFormat:     GLenum;
1286
1287     function GetIsCompressed: Boolean; override;
1288     function GetHasRed: Boolean; override;
1289     function GetHasGreen: Boolean; override;
1290     function GetHasBlue: Boolean; override;
1291     function GetHasAlpha: Boolean; override;
1292
1293     function GetglFormat: GLenum; override;
1294     function GetglInternalFormat: GLenum; override;
1295     function GetglDataFormat: GLenum; override;
1296
1297     function GetComponents: Integer; virtual;
1298   public
1299     property Format:       TglBitmapFormat read fFormat;
1300     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1301     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1302     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1303     property Components:   Integer         read GetComponents;
1304     property PixelSize:    Single          read fPixelSize;
1305
1306     property Range: TglBitmapColorRec read fRange;
1307     property Shift: TShiftRec         read fShift;
1308
1309     property RedMask:   QWord read GetRedMask;
1310     property GreenMask: QWord read GetGreenMask;
1311     property BlueMask:  QWord read GetBlueMask;
1312     property AlphaMask: QWord read GetAlphaMask;
1313
1314     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1315     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1316
1317     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1318     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1319
1320     function CreateMappingData: Pointer; virtual;
1321     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1322
1323     function IsEmpty:  Boolean; virtual;
1324     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1325
1326     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1327
1328     constructor Create; virtual;
1329   public
1330     class procedure Init;
1331     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1332     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1333     class procedure Clear;
1334     class procedure Finalize;
1335   end;
1336   TFormatDescriptorClass = class of TFormatDescriptor;
1337
1338   TfdEmpty = class(TFormatDescriptor);
1339
1340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1341   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1342     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1343     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1344     constructor Create; override;
1345   end;
1346
1347   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1348     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1349     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1350     constructor Create; override;
1351   end;
1352
1353   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1354     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1355     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1356     constructor Create; override;
1357   end;
1358
1359   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1360     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1361     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1362     constructor Create; override;
1363   end;
1364
1365   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1366     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1367     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1368     constructor Create; override;
1369   end;
1370
1371   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374     constructor Create; override;
1375   end;
1376
1377   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1378     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1379     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1380     constructor Create; override;
1381   end;
1382
1383   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1384     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1385     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1386     constructor Create; override;
1387   end;
1388
1389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1390   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1391     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1392     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1393     constructor Create; override;
1394   end;
1395
1396   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1397     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1398     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1399     constructor Create; override;
1400   end;
1401
1402   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1403     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1404     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1405     constructor Create; override;
1406   end;
1407
1408   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1409     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1410     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1411     constructor Create; override;
1412   end;
1413
1414   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1415     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1416     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1417     constructor Create; override;
1418   end;
1419
1420   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1421     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1422     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1423     constructor Create; override;
1424   end;
1425
1426   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1427     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1428     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1429     constructor Create; override;
1430   end;
1431
1432   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435     constructor Create; override;
1436   end;
1437
1438   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441     constructor Create; override;
1442   end;
1443
1444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1445   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1446     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1447     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1448     constructor Create; override;
1449   end;
1450
1451   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1452     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1453     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1454     constructor Create; override;
1455   end;
1456
1457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1458   TfdAlpha4 = class(TfdAlpha_UB1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdAlpha8 = class(TfdAlpha_UB1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdAlpha12 = class(TfdAlpha_US1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdAlpha16 = class(TfdAlpha_US1)
1471     constructor Create; override;
1472   end;
1473
1474   TfdLuminance4 = class(TfdLuminance_UB1)
1475     constructor Create; override;
1476   end;
1477
1478   TfdLuminance8 = class(TfdLuminance_UB1)
1479     constructor Create; override;
1480   end;
1481
1482   TfdLuminance12 = class(TfdLuminance_US1)
1483     constructor Create; override;
1484   end;
1485
1486   TfdLuminance16 = class(TfdLuminance_US1)
1487     constructor Create; override;
1488   end;
1489
1490   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1491     constructor Create; override;
1492   end;
1493
1494   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1495     constructor Create; override;
1496   end;
1497
1498   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1499     constructor Create; override;
1500   end;
1501
1502   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1503     constructor Create; override;
1504   end;
1505
1506   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1507     constructor Create; override;
1508   end;
1509
1510   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1511     constructor Create; override;
1512   end;
1513
1514   TfdR3G3B2 = class(TfdUniversal_UB1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdRGB4 = class(TfdUniversal_US1)
1519     constructor Create; override;
1520   end;
1521
1522   TfdR5G6B5 = class(TfdUniversal_US1)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGB5 = class(TfdUniversal_US1)
1527     constructor Create; override;
1528   end;
1529
1530   TfdRGB8 = class(TfdRGB_UB3)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGB10 = class(TfdUniversal_UI1)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGB12 = class(TfdRGB_US3)
1539     constructor Create; override;
1540   end;
1541
1542   TfdRGB16 = class(TfdRGB_US3)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGBA2 = class(TfdRGBA_UB4)
1547     constructor Create; override;
1548   end;
1549
1550   TfdRGBA4 = class(TfdUniversal_US1)
1551     constructor Create; override;
1552   end;
1553
1554   TfdRGB5A1 = class(TfdUniversal_US1)
1555     constructor Create; override;
1556   end;
1557
1558   TfdRGBA8 = class(TfdRGBA_UB4)
1559     constructor Create; override;
1560   end;
1561
1562   TfdRGB10A2 = class(TfdUniversal_UI1)
1563     constructor Create; override;
1564   end;
1565
1566   TfdRGBA12 = class(TfdRGBA_US4)
1567     constructor Create; override;
1568   end;
1569
1570   TfdRGBA16 = class(TfdRGBA_US4)
1571     constructor Create; override;
1572   end;
1573
1574   TfdBGR4 = class(TfdUniversal_US1)
1575     constructor Create; override;
1576   end;
1577
1578   TfdB5G6R5 = class(TfdUniversal_US1)
1579     constructor Create; override;
1580   end;
1581
1582   TfdBGR5 = class(TfdUniversal_US1)
1583     constructor Create; override;
1584   end;
1585
1586   TfdBGR8 = class(TfdBGR_UB3)
1587     constructor Create; override;
1588   end;
1589
1590   TfdBGR10 = class(TfdUniversal_UI1)
1591     constructor Create; override;
1592   end;
1593
1594   TfdBGR12 = class(TfdBGR_US3)
1595     constructor Create; override;
1596   end;
1597
1598   TfdBGR16 = class(TfdBGR_US3)
1599     constructor Create; override;
1600   end;
1601
1602   TfdBGRA2 = class(TfdBGRA_UB4)
1603     constructor Create; override;
1604   end;
1605
1606   TfdBGRA4 = class(TfdUniversal_US1)
1607     constructor Create; override;
1608   end;
1609
1610   TfdBGR5A1 = class(TfdUniversal_US1)
1611     constructor Create; override;
1612   end;
1613
1614   TfdBGRA8 = class(TfdBGRA_UB4)
1615     constructor Create; override;
1616   end;
1617
1618   TfdBGR10A2 = class(TfdUniversal_UI1)
1619     constructor Create; override;
1620   end;
1621
1622   TfdBGRA12 = class(TfdBGRA_US4)
1623     constructor Create; override;
1624   end;
1625
1626   TfdBGRA16 = class(TfdBGRA_US4)
1627     constructor Create; override;
1628   end;
1629
1630   TfdDepth16 = class(TfdDepth_US1)
1631     constructor Create; override;
1632   end;
1633
1634   TfdDepth24 = class(TfdDepth_UI1)
1635     constructor Create; override;
1636   end;
1637
1638   TfdDepth32 = class(TfdDepth_UI1)
1639     constructor Create; override;
1640   end;
1641
1642   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1643     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1644     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1645     constructor Create; override;
1646   end;
1647
1648   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1649     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1650     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1651     constructor Create; override;
1652   end;
1653
1654   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1655     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1656     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1657     constructor Create; override;
1658   end;
1659
1660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1661   TbmpBitfieldFormat = class(TFormatDescriptor)
1662   private
1663     procedure SetRedMask  (const aValue: QWord);
1664     procedure SetGreenMask(const aValue: QWord);
1665     procedure SetBlueMask (const aValue: QWord);
1666     procedure SetAlphaMask(const aValue: QWord);
1667
1668     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1669   public
1670     property RedMask:   QWord read GetRedMask   write SetRedMask;
1671     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1672     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1673     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1674
1675     property PixelSize: Single read fPixelSize write fPixelSize;
1676
1677     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1678     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1679   end;
1680
1681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1682   TbmpColorTableEnty = packed record
1683     b, g, r, a: Byte;
1684   end;
1685   TbmpColorTable = array of TbmpColorTableEnty;
1686   TbmpColorTableFormat = class(TFormatDescriptor)
1687   private
1688     fColorTable: TbmpColorTable;
1689   public
1690     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1691     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1692     property Range:      TglBitmapColorRec read fRange      write fRange;
1693     property Shift:      TShiftRec         read fShift      write fShift;
1694     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1695
1696     procedure CreateColorTable;
1697
1698     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1699     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1700     destructor Destroy; override;
1701   end;
1702
1703 const
1704   LUMINANCE_WEIGHT_R = 0.30;
1705   LUMINANCE_WEIGHT_G = 0.59;
1706   LUMINANCE_WEIGHT_B = 0.11;
1707
1708   ALPHA_WEIGHT_R = 0.30;
1709   ALPHA_WEIGHT_G = 0.59;
1710   ALPHA_WEIGHT_B = 0.11;
1711
1712   DEPTH_WEIGHT_R = 0.333333333;
1713   DEPTH_WEIGHT_G = 0.333333333;
1714   DEPTH_WEIGHT_B = 0.333333333;
1715
1716   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1717
1718   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1719     TfdEmpty,
1720
1721     TfdAlpha4,
1722     TfdAlpha8,
1723     TfdAlpha12,
1724     TfdAlpha16,
1725
1726     TfdLuminance4,
1727     TfdLuminance8,
1728     TfdLuminance12,
1729     TfdLuminance16,
1730
1731     TfdLuminance4Alpha4,
1732     TfdLuminance6Alpha2,
1733     TfdLuminance8Alpha8,
1734     TfdLuminance12Alpha4,
1735     TfdLuminance12Alpha12,
1736     TfdLuminance16Alpha16,
1737
1738     TfdR3G3B2,
1739     TfdRGB4,
1740     TfdR5G6B5,
1741     TfdRGB5,
1742     TfdRGB8,
1743     TfdRGB10,
1744     TfdRGB12,
1745     TfdRGB16,
1746
1747     TfdRGBA2,
1748     TfdRGBA4,
1749     TfdRGB5A1,
1750     TfdRGBA8,
1751     TfdRGB10A2,
1752     TfdRGBA12,
1753     TfdRGBA16,
1754
1755     TfdBGR4,
1756     TfdB5G6R5,
1757     TfdBGR5,
1758     TfdBGR8,
1759     TfdBGR10,
1760     TfdBGR12,
1761     TfdBGR16,
1762
1763     TfdBGRA2,
1764     TfdBGRA4,
1765     TfdBGR5A1,
1766     TfdBGRA8,
1767     TfdBGR10A2,
1768     TfdBGRA12,
1769     TfdBGRA16,
1770
1771     TfdDepth16,
1772     TfdDepth24,
1773     TfdDepth32,
1774
1775     TfdS3tcDtx1RGBA,
1776     TfdS3tcDtx3RGBA,
1777     TfdS3tcDtx5RGBA
1778   );
1779
1780 var
1781   FormatDescriptorCS: TCriticalSection;
1782   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1783
1784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1786 begin
1787   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1788 end;
1789
1790 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1791 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1792 begin
1793   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1794 end;
1795
1796 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1797 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1798 begin
1799   result.Fields := [];
1800
1801   if X >= 0 then
1802     result.Fields := result.Fields + [ffX];
1803   if Y >= 0 then
1804     result.Fields := result.Fields + [ffY];
1805
1806   result.X := Max(0, X);
1807   result.Y := Max(0, Y);
1808 end;
1809
1810 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1811 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1812 begin
1813   result.r := r;
1814   result.g := g;
1815   result.b := b;
1816   result.a := a;
1817 end;
1818
1819 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1820 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1821 var
1822   i: Integer;
1823 begin
1824   result := false;
1825   for i := 0 to high(r1.arr) do
1826     if (r1.arr[i] <> r2.arr[i]) then
1827       exit;
1828   result := true;
1829 end;
1830
1831 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1832 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1833 begin
1834   result.r := r;
1835   result.g := g;
1836   result.b := b;
1837   result.a := a;
1838 end;
1839
1840 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1841 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1842 begin
1843   result := [];
1844
1845   if (aFormat in [
1846         //4 bbp
1847         tfLuminance4,
1848
1849         //8bpp
1850         tfR3G3B2, tfLuminance8,
1851
1852         //16bpp
1853         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1854         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1855
1856         //24bpp
1857         tfBGR8, tfRGB8,
1858
1859         //32bpp
1860         tfRGB10, tfRGB10A2, tfRGBA8,
1861         tfBGR10, tfBGR10A2, tfBGRA8]) then
1862     result := result + [ftBMP];
1863
1864   if (aFormat in [
1865         //8 bpp
1866         tfLuminance8, tfAlpha8,
1867
1868         //16 bpp
1869         tfLuminance16, tfLuminance8Alpha8,
1870         tfRGB5, tfRGB5A1, tfRGBA4,
1871         tfBGR5, tfBGR5A1, tfBGRA4,
1872
1873         //24 bpp
1874         tfRGB8, tfBGR8,
1875
1876         //32 bpp
1877         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1878     result := result + [ftTGA];
1879
1880   if (aFormat in [
1881         //8 bpp
1882         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1883         tfR3G3B2, tfRGBA2, tfBGRA2,
1884
1885         //16 bpp
1886         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1887         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1888         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1889
1890         //24 bpp
1891         tfRGB8, tfBGR8,
1892
1893         //32 bbp
1894         tfLuminance16Alpha16,
1895         tfRGBA8, tfRGB10A2,
1896         tfBGRA8, tfBGR10A2,
1897
1898         //compressed
1899         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1900     result := result + [ftDDS];
1901
1902   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1903   if aFormat in [
1904       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1905       tfRGB8, tfRGBA8,
1906       tfBGR8, tfBGRA8] then
1907     result := result + [ftPNG];
1908   {$ENDIF}
1909
1910   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1911   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1912     result := result + [ftJPEG];
1913   {$ENDIF}
1914 end;
1915
1916 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1917 function IsPowerOfTwo(aNumber: Integer): Boolean;
1918 begin
1919   while (aNumber and 1) = 0 do
1920     aNumber := aNumber shr 1;
1921   result := aNumber = 1;
1922 end;
1923
1924 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1925 function GetTopMostBit(aBitSet: QWord): Integer;
1926 begin
1927   result := 0;
1928   while aBitSet > 0 do begin
1929     inc(result);
1930     aBitSet := aBitSet shr 1;
1931   end;
1932 end;
1933
1934 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1935 function CountSetBits(aBitSet: QWord): Integer;
1936 begin
1937   result := 0;
1938   while aBitSet > 0 do begin
1939     if (aBitSet and 1) = 1 then
1940       inc(result);
1941     aBitSet := aBitSet shr 1;
1942   end;
1943 end;
1944
1945 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1946 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1947 begin
1948   result := Trunc(
1949     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1950     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1951     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1952 end;
1953
1954 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1955 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1956 begin
1957   result := Trunc(
1958     DEPTH_WEIGHT_R * aPixel.Data.r +
1959     DEPTH_WEIGHT_G * aPixel.Data.g +
1960     DEPTH_WEIGHT_B * aPixel.Data.b);
1961 end;
1962
1963 {$IFDEF GLB_NATIVE_OGL}
1964 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1965 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1966 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1967 var
1968   GL_LibHandle: Pointer = nil;
1969
1970 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1971 begin
1972   if not Assigned(aLibHandle) then
1973     aLibHandle := GL_LibHandle;
1974
1975 {$IF DEFINED(GLB_WIN)}
1976   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1977   if Assigned(result) then
1978     exit;
1979
1980   if Assigned(wglGetProcAddress) then
1981     result := wglGetProcAddress(aProcName);
1982 {$ELSEIF DEFINED(GLB_LINUX)}
1983   if Assigned(glXGetProcAddress) then begin
1984     result := glXGetProcAddress(aProcName);
1985     if Assigned(result) then
1986       exit;
1987   end;
1988
1989   if Assigned(glXGetProcAddressARB) then begin
1990     result := glXGetProcAddressARB(aProcName);
1991     if Assigned(result) then
1992       exit;
1993   end;
1994
1995   result := dlsym(aLibHandle, aProcName);
1996 {$IFEND}
1997   if not Assigned(result) and aRaiseOnErr then
1998     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1999 end;
2000
2001 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2002 var
2003   GLU_LibHandle: Pointer = nil;
2004   OpenGLInitialized: Boolean;
2005   InitOpenGLCS: TCriticalSection;
2006
2007 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2008 procedure glbInitOpenGL;
2009
2010   ////////////////////////////////////////////////////////////////////////////////
2011   function glbLoadLibrary(const aName: PChar): Pointer;
2012   begin
2013     {$IF DEFINED(GLB_WIN)}
2014     result := {%H-}Pointer(LoadLibrary(aName));
2015     {$ELSEIF DEFINED(GLB_LINUX)}
2016     result := dlopen(Name, RTLD_LAZY);
2017     {$ELSE}
2018     result := nil;
2019     {$IFEND}
2020   end;
2021
2022   ////////////////////////////////////////////////////////////////////////////////
2023   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2024   begin
2025     result := false;
2026     if not Assigned(aLibHandle) then
2027       exit;
2028
2029     {$IF DEFINED(GLB_WIN)}
2030     Result := FreeLibrary({%H-}HINST(aLibHandle));
2031     {$ELSEIF DEFINED(GLB_LINUX)}
2032     Result := dlclose(aLibHandle) = 0;
2033     {$IFEND}
2034   end;
2035
2036 begin
2037   if Assigned(GL_LibHandle) then
2038     glbFreeLibrary(GL_LibHandle);
2039
2040   if Assigned(GLU_LibHandle) then
2041     glbFreeLibrary(GLU_LibHandle);
2042
2043   GL_LibHandle := glbLoadLibrary(libopengl);
2044   if not Assigned(GL_LibHandle) then
2045     raise EglBitmap.Create('unable to load library: ' + libopengl);
2046
2047   GLU_LibHandle := glbLoadLibrary(libglu);
2048   if not Assigned(GLU_LibHandle) then
2049     raise EglBitmap.Create('unable to load library: ' + libglu);
2050
2051 {$IF DEFINED(GLB_WIN)}
2052   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2053 {$ELSEIF DEFINED(GLB_LINUX)}
2054   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2055   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2056 {$IFEND}
2057
2058   glEnable := glbGetProcAddress('glEnable');
2059   glDisable := glbGetProcAddress('glDisable');
2060   glGetString := glbGetProcAddress('glGetString');
2061   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2062   glTexParameteri := glbGetProcAddress('glTexParameteri');
2063   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2064   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2065   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2066   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2067   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2068   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2069   glTexGeni := glbGetProcAddress('glTexGeni');
2070   glGenTextures := glbGetProcAddress('glGenTextures');
2071   glBindTexture := glbGetProcAddress('glBindTexture');
2072   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2073   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2074   glReadPixels := glbGetProcAddress('glReadPixels');
2075   glPixelStorei := glbGetProcAddress('glPixelStorei');
2076   glTexImage1D := glbGetProcAddress('glTexImage1D');
2077   glTexImage2D := glbGetProcAddress('glTexImage2D');
2078   glGetTexImage := glbGetProcAddress('glGetTexImage');
2079
2080   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2081   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2082 end;
2083 {$ENDIF}
2084
2085 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2086 procedure glbReadOpenGLExtensions;
2087 var
2088   Buffer: AnsiString;
2089   MajorVersion, MinorVersion: Integer;
2090
2091   ///////////////////////////////////////////////////////////////////////////////////////////
2092   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2093   var
2094     Separator: Integer;
2095   begin
2096     aMinor := 0;
2097     aMajor := 0;
2098
2099     Separator := Pos(AnsiString('.'), aBuffer);
2100     if (Separator > 1) and (Separator < Length(aBuffer)) and
2101        (aBuffer[Separator - 1] in ['0'..'9']) and
2102        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2103
2104       Dec(Separator);
2105       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2106         Dec(Separator);
2107
2108       Delete(aBuffer, 1, Separator);
2109       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2110
2111       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2112         Inc(Separator);
2113
2114       Delete(aBuffer, Separator, 255);
2115       Separator := Pos(AnsiString('.'), aBuffer);
2116
2117       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2118       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2119     end;
2120   end;
2121
2122   ///////////////////////////////////////////////////////////////////////////////////////////
2123   function CheckExtension(const Extension: AnsiString): Boolean;
2124   var
2125     ExtPos: Integer;
2126   begin
2127     ExtPos := Pos(Extension, Buffer);
2128     result := ExtPos > 0;
2129     if result then
2130       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2131   end;
2132
2133   ///////////////////////////////////////////////////////////////////////////////////////////
2134   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2135   begin
2136     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2137   end;
2138
2139 begin
2140 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2141   InitOpenGLCS.Enter;
2142   try
2143     if not OpenGLInitialized then begin
2144       glbInitOpenGL;
2145       OpenGLInitialized := true;
2146     end;
2147   finally
2148     InitOpenGLCS.Leave;
2149   end;
2150 {$ENDIF}
2151
2152   // Version
2153   Buffer := glGetString(GL_VERSION);
2154   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2155
2156   GL_VERSION_1_2 := CheckVersion(1, 2);
2157   GL_VERSION_1_3 := CheckVersion(1, 3);
2158   GL_VERSION_1_4 := CheckVersion(1, 4);
2159   GL_VERSION_2_0 := CheckVersion(2, 0);
2160   GL_VERSION_3_3 := CheckVersion(3, 3);
2161
2162   // Extensions
2163   Buffer := glGetString(GL_EXTENSIONS);
2164   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2165   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2166   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2167   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2168   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2169   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2170   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2171   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2172   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2173   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2174   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2175   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2176   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2177   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2178
2179   if GL_VERSION_1_3 then begin
2180     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2181     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2182     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2183   end else begin
2184     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2185     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2186     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2187   end;
2188 end;
2189 {$ENDIF}
2190
2191 {$IFDEF GLB_SDL_IMAGE}
2192 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2193 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2194 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2195 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2196 begin
2197   result := TStream(context^.unknown.data1).Seek(offset, whence);
2198 end;
2199
2200 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2201 begin
2202   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2203 end;
2204
2205 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2206 begin
2207   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2208 end;
2209
2210 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2211 begin
2212   result := 0;
2213 end;
2214
2215 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2216 begin
2217   result := SDL_AllocRW;
2218
2219   if result = nil then
2220     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2221
2222   result^.seek := glBitmapRWseek;
2223   result^.read := glBitmapRWread;
2224   result^.write := glBitmapRWwrite;
2225   result^.close := glBitmapRWclose;
2226   result^.unknown.data1 := Stream;
2227 end;
2228 {$ENDIF}
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2232 begin
2233   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2238 begin
2239   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2240 end;
2241
2242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2244 begin
2245   glBitmapDefaultMipmap := aValue;
2246 end;
2247
2248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2250 begin
2251   glBitmapDefaultFormat := aFormat;
2252 end;
2253
2254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2255 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2256 begin
2257   glBitmapDefaultFilterMin := aMin;
2258   glBitmapDefaultFilterMag := aMag;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2263 begin
2264   glBitmapDefaultWrapS := S;
2265   glBitmapDefaultWrapT := T;
2266   glBitmapDefaultWrapR := R;
2267 end;
2268
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2271 begin
2272   glDefaultSwizzle[0] := r;
2273   glDefaultSwizzle[1] := g;
2274   glDefaultSwizzle[2] := b;
2275   glDefaultSwizzle[3] := a;
2276 end;
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2280 begin
2281   result := glBitmapDefaultDeleteTextureOnFree;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2286 begin
2287   result := glBitmapDefaultFreeDataAfterGenTextures;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2292 begin
2293   result := glBitmapDefaultMipmap;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 function glBitmapGetDefaultFormat: TglBitmapFormat;
2298 begin
2299   result := glBitmapDefaultFormat;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2304 begin
2305   aMin := glBitmapDefaultFilterMin;
2306   aMag := glBitmapDefaultFilterMag;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2311 begin
2312   S := glBitmapDefaultWrapS;
2313   T := glBitmapDefaultWrapT;
2314   R := glBitmapDefaultWrapR;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2319 begin
2320   r := glDefaultSwizzle[0];
2321   g := glDefaultSwizzle[1];
2322   b := glDefaultSwizzle[2];
2323   a := glDefaultSwizzle[3];
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 function TFormatDescriptor.GetRedMask: QWord;
2330 begin
2331   result := fRange.r shl fShift.r;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 function TFormatDescriptor.GetGreenMask: QWord;
2336 begin
2337   result := fRange.g shl fShift.g;
2338 end;
2339
2340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2341 function TFormatDescriptor.GetBlueMask: QWord;
2342 begin
2343   result := fRange.b shl fShift.b;
2344 end;
2345
2346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2347 function TFormatDescriptor.GetAlphaMask: QWord;
2348 begin
2349   result := fRange.a shl fShift.a;
2350 end;
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 function TFormatDescriptor.GetIsCompressed: Boolean;
2354 begin
2355   result := fIsCompressed;
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetHasRed: Boolean;
2360 begin
2361   result := (fRange.r > 0);
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetHasGreen: Boolean;
2366 begin
2367   result := (fRange.g > 0);
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetHasBlue: Boolean;
2372 begin
2373   result := (fRange.b > 0);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetHasAlpha: Boolean;
2378 begin
2379   result := (fRange.a > 0);
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetglFormat: GLenum;
2384 begin
2385   result := fglFormat;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetglInternalFormat: GLenum;
2390 begin
2391   result := fglInternalFormat;
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.GetglDataFormat: GLenum;
2396 begin
2397   result := fglDataFormat;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 function TFormatDescriptor.GetComponents: Integer;
2402 var
2403   i: Integer;
2404 begin
2405   result := 0;
2406   for i := 0 to 3 do
2407     if (fRange.arr[i] > 0) then
2408       inc(result);
2409 end;
2410
2411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2412 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2413 var
2414   w, h: Integer;
2415 begin
2416   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2417     w := Max(1, aSize.X);
2418     h := Max(1, aSize.Y);
2419     result := GetSize(w, h);
2420   end else
2421     result := 0;
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2426 begin
2427   result := 0;
2428   if (aWidth <= 0) or (aHeight <= 0) then
2429     exit;
2430   result := Ceil(aWidth * aHeight * fPixelSize);
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 function TFormatDescriptor.CreateMappingData: Pointer;
2435 begin
2436   result := nil;
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2441 begin
2442   //DUMMY
2443 end;
2444
2445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2446 function TFormatDescriptor.IsEmpty: Boolean;
2447 begin
2448   result := (fFormat = tfEmpty);
2449 end;
2450
2451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2452 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2453 begin
2454   result := false;
2455   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2456     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2457   if (aRedMask   <> RedMask) then
2458     exit;
2459   if (aGreenMask <> GreenMask) then
2460     exit;
2461   if (aBlueMask  <> BlueMask) then
2462     exit;
2463   if (aAlphaMask <> AlphaMask) then
2464     exit;
2465   result := true;
2466 end;
2467
2468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2469 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2470 begin
2471   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2472   aPixel.Data   := fRange;
2473   aPixel.Range  := fRange;
2474   aPixel.Format := fFormat;
2475 end;
2476
2477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2478 constructor TFormatDescriptor.Create;
2479 begin
2480   inherited Create;
2481
2482   fFormat       := tfEmpty;
2483   fWithAlpha    := tfEmpty;
2484   fWithoutAlpha := tfEmpty;
2485   fRGBInverted  := tfEmpty;
2486   fUncompressed := tfEmpty;
2487   fPixelSize    := 0.0;
2488   fIsCompressed := false;
2489
2490   fglFormat         := 0;
2491   fglInternalFormat := 0;
2492   fglDataFormat     := 0;
2493
2494   FillChar(fRange, 0, SizeOf(fRange));
2495   FillChar(fShift, 0, SizeOf(fShift));
2496 end;
2497
2498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2501 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2502 begin
2503   aData^ := aPixel.Data.a;
2504   inc(aData);
2505 end;
2506
2507 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2508 begin
2509   aPixel.Data.r := 0;
2510   aPixel.Data.g := 0;
2511   aPixel.Data.b := 0;
2512   aPixel.Data.a := aData^;
2513   inc(aData);
2514 end;
2515
2516 constructor TfdAlpha_UB1.Create;
2517 begin
2518   inherited Create;
2519   fPixelSize        := 1.0;
2520   fRange.a          := $FF;
2521   fglFormat         := GL_ALPHA;
2522   fglDataFormat     := GL_UNSIGNED_BYTE;
2523 end;
2524
2525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2529 begin
2530   aData^ := LuminanceWeight(aPixel);
2531   inc(aData);
2532 end;
2533
2534 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2535 begin
2536   aPixel.Data.r := aData^;
2537   aPixel.Data.g := aData^;
2538   aPixel.Data.b := aData^;
2539   aPixel.Data.a := 0;
2540   inc(aData);
2541 end;
2542
2543 constructor TfdLuminance_UB1.Create;
2544 begin
2545   inherited Create;
2546   fPixelSize        := 1.0;
2547   fRange.r          := $FF;
2548   fRange.g          := $FF;
2549   fRange.b          := $FF;
2550   fglFormat         := GL_LUMINANCE;
2551   fglDataFormat     := GL_UNSIGNED_BYTE;
2552 end;
2553
2554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2558 var
2559   i: Integer;
2560 begin
2561   aData^ := 0;
2562   for i := 0 to 3 do
2563     if (fRange.arr[i] > 0) then
2564       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2565   inc(aData);
2566 end;
2567
2568 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2569 var
2570   i: Integer;
2571 begin
2572   for i := 0 to 3 do
2573     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2574   inc(aData);
2575 end;
2576
2577 constructor TfdUniversal_UB1.Create;
2578 begin
2579   inherited Create;
2580   fPixelSize := 1.0;
2581 end;
2582
2583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2586 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2587 begin
2588   inherited Map(aPixel, aData, aMapData);
2589   aData^ := aPixel.Data.a;
2590   inc(aData);
2591 end;
2592
2593 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 begin
2595   inherited Unmap(aData, aPixel, aMapData);
2596   aPixel.Data.a := aData^;
2597   inc(aData);
2598 end;
2599
2600 constructor TfdLuminanceAlpha_UB2.Create;
2601 begin
2602   inherited Create;
2603   fPixelSize        := 2.0;
2604   fRange.a          := $FF;
2605   fShift.a          :=   8;
2606   fglFormat         := GL_LUMINANCE_ALPHA;
2607   fglDataFormat     := GL_UNSIGNED_BYTE;
2608 end;
2609
2610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2614 begin
2615   aData^ := aPixel.Data.r;
2616   inc(aData);
2617   aData^ := aPixel.Data.g;
2618   inc(aData);
2619   aData^ := aPixel.Data.b;
2620   inc(aData);
2621 end;
2622
2623 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2624 begin
2625   aPixel.Data.r := aData^;
2626   inc(aData);
2627   aPixel.Data.g := aData^;
2628   inc(aData);
2629   aPixel.Data.b := aData^;
2630   inc(aData);
2631   aPixel.Data.a := 0;
2632 end;
2633
2634 constructor TfdRGB_UB3.Create;
2635 begin
2636   inherited Create;
2637   fPixelSize        := 3.0;
2638   fRange.r          := $FF;
2639   fRange.g          := $FF;
2640   fRange.b          := $FF;
2641   fShift.r          :=   0;
2642   fShift.g          :=   8;
2643   fShift.b          :=  16;
2644   fglFormat         := GL_RGB;
2645   fglDataFormat     := GL_UNSIGNED_BYTE;
2646 end;
2647
2648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2651 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2652 begin
2653   aData^ := aPixel.Data.b;
2654   inc(aData);
2655   aData^ := aPixel.Data.g;
2656   inc(aData);
2657   aData^ := aPixel.Data.r;
2658   inc(aData);
2659 end;
2660
2661 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2662 begin
2663   aPixel.Data.b := aData^;
2664   inc(aData);
2665   aPixel.Data.g := aData^;
2666   inc(aData);
2667   aPixel.Data.r := aData^;
2668   inc(aData);
2669   aPixel.Data.a := 0;
2670 end;
2671
2672 constructor TfdBGR_UB3.Create;
2673 begin
2674   fPixelSize        := 3.0;
2675   fRange.r          := $FF;
2676   fRange.g          := $FF;
2677   fRange.b          := $FF;
2678   fShift.r          :=  16;
2679   fShift.g          :=   8;
2680   fShift.b          :=   0;
2681   fglFormat         := GL_BGR;
2682   fglDataFormat     := GL_UNSIGNED_BYTE;
2683 end;
2684
2685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2688 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2689 begin
2690   inherited Map(aPixel, aData, aMapData);
2691   aData^ := aPixel.Data.a;
2692   inc(aData);
2693 end;
2694
2695 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2696 begin
2697   inherited Unmap(aData, aPixel, aMapData);
2698   aPixel.Data.a := aData^;
2699   inc(aData);
2700 end;
2701
2702 constructor TfdRGBA_UB4.Create;
2703 begin
2704   inherited Create;
2705   fPixelSize        := 4.0;
2706   fRange.a          := $FF;
2707   fShift.a          :=  24;
2708   fglFormat         := GL_RGBA;
2709   fglDataFormat     := GL_UNSIGNED_BYTE;
2710 end;
2711
2712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2715 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2716 begin
2717   inherited Map(aPixel, aData, aMapData);
2718   aData^ := aPixel.Data.a;
2719   inc(aData);
2720 end;
2721
2722 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2723 begin
2724   inherited Unmap(aData, aPixel, aMapData);
2725   aPixel.Data.a := aData^;
2726   inc(aData);
2727 end;
2728
2729 constructor TfdBGRA_UB4.Create;
2730 begin
2731   inherited Create;
2732   fPixelSize        := 4.0;
2733   fRange.a          := $FF;
2734   fShift.a          :=  24;
2735   fglFormat         := GL_BGRA;
2736   fglDataFormat     := GL_UNSIGNED_BYTE;
2737 end;
2738
2739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2743 begin
2744   PWord(aData)^ := aPixel.Data.a;
2745   inc(aData, 2);
2746 end;
2747
2748 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2749 begin
2750   aPixel.Data.r := 0;
2751   aPixel.Data.g := 0;
2752   aPixel.Data.b := 0;
2753   aPixel.Data.a := PWord(aData)^;
2754   inc(aData, 2);
2755 end;
2756
2757 constructor TfdAlpha_US1.Create;
2758 begin
2759   inherited Create;
2760   fPixelSize        := 2.0;
2761   fRange.a          := $FFFF;
2762   fglFormat         := GL_ALPHA;
2763   fglDataFormat     := GL_UNSIGNED_SHORT;
2764 end;
2765
2766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2767 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2769 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2770 begin
2771   PWord(aData)^ := LuminanceWeight(aPixel);
2772   inc(aData, 2);
2773 end;
2774
2775 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2776 begin
2777   aPixel.Data.r := PWord(aData)^;
2778   aPixel.Data.g := PWord(aData)^;
2779   aPixel.Data.b := PWord(aData)^;
2780   aPixel.Data.a := 0;
2781   inc(aData, 2);
2782 end;
2783
2784 constructor TfdLuminance_US1.Create;
2785 begin
2786   inherited Create;
2787   fPixelSize        := 2.0;
2788   fRange.r          := $FFFF;
2789   fRange.g          := $FFFF;
2790   fRange.b          := $FFFF;
2791   fglFormat         := GL_LUMINANCE;
2792   fglDataFormat     := GL_UNSIGNED_SHORT;
2793 end;
2794
2795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2796 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2799 var
2800   i: Integer;
2801 begin
2802   PWord(aData)^ := 0;
2803   for i := 0 to 3 do
2804     if (fRange.arr[i] > 0) then
2805       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2806   inc(aData, 2);
2807 end;
2808
2809 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2810 var
2811   i: Integer;
2812 begin
2813   for i := 0 to 3 do
2814     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2815   inc(aData, 2);
2816 end;
2817
2818 constructor TfdUniversal_US1.Create;
2819 begin
2820   inherited Create;
2821   fPixelSize := 2.0;
2822 end;
2823
2824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2828 begin
2829   PWord(aData)^ := DepthWeight(aPixel);
2830   inc(aData, 2);
2831 end;
2832
2833 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2834 begin
2835   aPixel.Data.r := PWord(aData)^;
2836   aPixel.Data.g := PWord(aData)^;
2837   aPixel.Data.b := PWord(aData)^;
2838   aPixel.Data.a := 0;
2839   inc(aData, 2);
2840 end;
2841
2842 constructor TfdDepth_US1.Create;
2843 begin
2844   inherited Create;
2845   fPixelSize        := 2.0;
2846   fRange.r          := $FFFF;
2847   fRange.g          := $FFFF;
2848   fRange.b          := $FFFF;
2849   fglFormat         := GL_DEPTH_COMPONENT;
2850   fglDataFormat     := GL_UNSIGNED_SHORT;
2851 end;
2852
2853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2857 begin
2858   inherited Map(aPixel, aData, aMapData);
2859   PWord(aData)^ := aPixel.Data.a;
2860   inc(aData, 2);
2861 end;
2862
2863 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2864 begin
2865   inherited Unmap(aData, aPixel, aMapData);
2866   aPixel.Data.a := PWord(aData)^;
2867   inc(aData, 2);
2868 end;
2869
2870 constructor TfdLuminanceAlpha_US2.Create;
2871 begin
2872   inherited Create;
2873   fPixelSize        :=   4.0;
2874   fRange.a          := $FFFF;
2875   fShift.a          :=    16;
2876   fglFormat         := GL_LUMINANCE_ALPHA;
2877   fglDataFormat     := GL_UNSIGNED_SHORT;
2878 end;
2879
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2884 begin
2885   PWord(aData)^ := aPixel.Data.r;
2886   inc(aData, 2);
2887   PWord(aData)^ := aPixel.Data.g;
2888   inc(aData, 2);
2889   PWord(aData)^ := aPixel.Data.b;
2890   inc(aData, 2);
2891 end;
2892
2893 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2894 begin
2895   aPixel.Data.r := PWord(aData)^;
2896   inc(aData, 2);
2897   aPixel.Data.g := PWord(aData)^;
2898   inc(aData, 2);
2899   aPixel.Data.b := PWord(aData)^;
2900   inc(aData, 2);
2901   aPixel.Data.a := 0;
2902 end;
2903
2904 constructor TfdRGB_US3.Create;
2905 begin
2906   inherited Create;
2907   fPixelSize        :=   6.0;
2908   fRange.r          := $FFFF;
2909   fRange.g          := $FFFF;
2910   fRange.b          := $FFFF;
2911   fShift.r          :=     0;
2912   fShift.g          :=    16;
2913   fShift.b          :=    32;
2914   fglFormat         := GL_RGB;
2915   fglDataFormat     := GL_UNSIGNED_SHORT;
2916 end;
2917
2918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2922 begin
2923   PWord(aData)^ := aPixel.Data.b;
2924   inc(aData, 2);
2925   PWord(aData)^ := aPixel.Data.g;
2926   inc(aData, 2);
2927   PWord(aData)^ := aPixel.Data.r;
2928   inc(aData, 2);
2929 end;
2930
2931 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 begin
2933   aPixel.Data.b := PWord(aData)^;
2934   inc(aData, 2);
2935   aPixel.Data.g := PWord(aData)^;
2936   inc(aData, 2);
2937   aPixel.Data.r := PWord(aData)^;
2938   inc(aData, 2);
2939   aPixel.Data.a := 0;
2940 end;
2941
2942 constructor TfdBGR_US3.Create;
2943 begin
2944   inherited Create;
2945   fPixelSize        :=   6.0;
2946   fRange.r          := $FFFF;
2947   fRange.g          := $FFFF;
2948   fRange.b          := $FFFF;
2949   fShift.r          :=    32;
2950   fShift.g          :=    16;
2951   fShift.b          :=     0;
2952   fglFormat         := GL_BGR;
2953   fglDataFormat     := GL_UNSIGNED_SHORT;
2954 end;
2955
2956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2957 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2959 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2960 begin
2961   inherited Map(aPixel, aData, aMapData);
2962   PWord(aData)^ := aPixel.Data.a;
2963   inc(aData, 2);
2964 end;
2965
2966 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2967 begin
2968   inherited Unmap(aData, aPixel, aMapData);
2969   aPixel.Data.a := PWord(aData)^;
2970   inc(aData, 2);
2971 end;
2972
2973 constructor TfdRGBA_US4.Create;
2974 begin
2975   inherited Create;
2976   fPixelSize        :=   8.0;
2977   fRange.a          := $FFFF;
2978   fShift.a          :=    48;
2979   fglFormat         := GL_RGBA;
2980   fglDataFormat     := GL_UNSIGNED_SHORT;
2981 end;
2982
2983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2984 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2986 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2987 begin
2988   inherited Map(aPixel, aData, aMapData);
2989   PWord(aData)^ := aPixel.Data.a;
2990   inc(aData, 2);
2991 end;
2992
2993 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2994 begin
2995   inherited Unmap(aData, aPixel, aMapData);
2996   aPixel.Data.a := PWord(aData)^;
2997   inc(aData, 2);
2998 end;
2999
3000 constructor TfdBGRA_US4.Create;
3001 begin
3002   inherited Create;
3003   fPixelSize        :=   8.0;
3004   fRange.a          := $FFFF;
3005   fShift.a          :=    48;
3006   fglFormat         := GL_BGRA;
3007   fglDataFormat     := GL_UNSIGNED_SHORT;
3008 end;
3009
3010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3011 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3013 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3014 var
3015   i: Integer;
3016 begin
3017   PCardinal(aData)^ := 0;
3018   for i := 0 to 3 do
3019     if (fRange.arr[i] > 0) then
3020       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3021   inc(aData, 4);
3022 end;
3023
3024 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3025 var
3026   i: Integer;
3027 begin
3028   for i := 0 to 3 do
3029     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3030   inc(aData, 2);
3031 end;
3032
3033 constructor TfdUniversal_UI1.Create;
3034 begin
3035   inherited Create;
3036   fPixelSize := 4.0;
3037 end;
3038
3039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3040 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3042 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3043 begin
3044   PCardinal(aData)^ := DepthWeight(aPixel);
3045   inc(aData, 4);
3046 end;
3047
3048 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3049 begin
3050   aPixel.Data.r := PCardinal(aData)^;
3051   aPixel.Data.g := PCardinal(aData)^;
3052   aPixel.Data.b := PCardinal(aData)^;
3053   aPixel.Data.a := 0;
3054   inc(aData, 4);
3055 end;
3056
3057 constructor TfdDepth_UI1.Create;
3058 begin
3059   inherited Create;
3060   fPixelSize        := 4.0;
3061   fRange.r          := $FFFFFFFF;
3062   fRange.g          := $FFFFFFFF;
3063   fRange.b          := $FFFFFFFF;
3064   fglFormat         := GL_DEPTH_COMPONENT;
3065   fglDataFormat     := GL_UNSIGNED_INT;
3066 end;
3067
3068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3071 constructor TfdAlpha4.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfAlpha4;
3075   fWithAlpha        := tfAlpha4;
3076   fglInternalFormat := GL_ALPHA4;
3077 end;
3078
3079 constructor TfdAlpha8.Create;
3080 begin
3081   inherited Create;
3082   fFormat           := tfAlpha8;
3083   fWithAlpha        := tfAlpha8;
3084   fglInternalFormat := GL_ALPHA8;
3085 end;
3086
3087 constructor TfdAlpha12.Create;
3088 begin
3089   inherited Create;
3090   fFormat           := tfAlpha12;
3091   fWithAlpha        := tfAlpha12;
3092   fglInternalFormat := GL_ALPHA12;
3093 end;
3094
3095 constructor TfdAlpha16.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfAlpha16;
3099   fWithAlpha        := tfAlpha16;
3100   fglInternalFormat := GL_ALPHA16;
3101 end;
3102
3103 constructor TfdLuminance4.Create;
3104 begin
3105   inherited Create;
3106   fFormat           := tfLuminance4;
3107   fWithAlpha        := tfLuminance4Alpha4;
3108   fWithoutAlpha     := tfLuminance4;
3109   fglInternalFormat := GL_LUMINANCE4;
3110 end;
3111
3112 constructor TfdLuminance8.Create;
3113 begin
3114   inherited Create;
3115   fFormat           := tfLuminance8;
3116   fWithAlpha        := tfLuminance8Alpha8;
3117   fWithoutAlpha     := tfLuminance8;
3118   fglInternalFormat := GL_LUMINANCE8;
3119 end;
3120
3121 constructor TfdLuminance12.Create;
3122 begin
3123   inherited Create;
3124   fFormat           := tfLuminance12;
3125   fWithAlpha        := tfLuminance12Alpha12;
3126   fWithoutAlpha     := tfLuminance12;
3127   fglInternalFormat := GL_LUMINANCE12;
3128 end;
3129
3130 constructor TfdLuminance16.Create;
3131 begin
3132   inherited Create;
3133   fFormat           := tfLuminance16;
3134   fWithAlpha        := tfLuminance16Alpha16;
3135   fWithoutAlpha     := tfLuminance16;
3136   fglInternalFormat := GL_LUMINANCE16;
3137 end;
3138
3139 constructor TfdLuminance4Alpha4.Create;
3140 begin
3141   inherited Create;
3142   fFormat           := tfLuminance4Alpha4;
3143   fWithAlpha        := tfLuminance4Alpha4;
3144   fWithoutAlpha     := tfLuminance4;
3145   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3146 end;
3147
3148 constructor TfdLuminance6Alpha2.Create;
3149 begin
3150   inherited Create;
3151   fFormat           := tfLuminance6Alpha2;
3152   fWithAlpha        := tfLuminance6Alpha2;
3153   fWithoutAlpha     := tfLuminance8;
3154   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3155 end;
3156
3157 constructor TfdLuminance8Alpha8.Create;
3158 begin
3159   inherited Create;
3160   fFormat           := tfLuminance8Alpha8;
3161   fWithAlpha        := tfLuminance8Alpha8;
3162   fWithoutAlpha     := tfLuminance8;
3163   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3164 end;
3165
3166 constructor TfdLuminance12Alpha4.Create;
3167 begin
3168   inherited Create;
3169   fFormat           := tfLuminance12Alpha4;
3170   fWithAlpha        := tfLuminance12Alpha4;
3171   fWithoutAlpha     := tfLuminance12;
3172   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3173 end;
3174
3175 constructor TfdLuminance12Alpha12.Create;
3176 begin
3177   inherited Create;
3178   fFormat           := tfLuminance12Alpha12;
3179   fWithAlpha        := tfLuminance12Alpha12;
3180   fWithoutAlpha     := tfLuminance12;
3181   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3182 end;
3183
3184 constructor TfdLuminance16Alpha16.Create;
3185 begin
3186   inherited Create;
3187   fFormat           := tfLuminance16Alpha16;
3188   fWithAlpha        := tfLuminance16Alpha16;
3189   fWithoutAlpha     := tfLuminance16;
3190   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3191 end;
3192
3193 constructor TfdR3G3B2.Create;
3194 begin
3195   inherited Create;
3196   fFormat           := tfR3G3B2;
3197   fWithAlpha        := tfRGBA2;
3198   fWithoutAlpha     := tfR3G3B2;
3199   fRange.r          := $7;
3200   fRange.g          := $7;
3201   fRange.b          := $3;
3202   fShift.r          :=  0;
3203   fShift.g          :=  3;
3204   fShift.b          :=  6;
3205   fglFormat         := GL_RGB;
3206   fglInternalFormat := GL_R3_G3_B2;
3207   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3208 end;
3209
3210 constructor TfdRGB4.Create;
3211 begin
3212   inherited Create;
3213   fFormat           := tfRGB4;
3214   fWithAlpha        := tfRGBA4;
3215   fWithoutAlpha     := tfRGB4;
3216   fRGBInverted      := tfBGR4;
3217   fRange.r          := $F;
3218   fRange.g          := $F;
3219   fRange.b          := $F;
3220   fShift.r          :=  0;
3221   fShift.g          :=  4;
3222   fShift.b          :=  8;
3223   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3224   fglInternalFormat := GL_RGB4;
3225   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3226 end;
3227
3228 constructor TfdR5G6B5.Create;
3229 begin
3230   inherited Create;
3231   fFormat           := tfR5G6B5;
3232   fWithAlpha        := tfRGBA4;
3233   fWithoutAlpha     := tfR5G6B5;
3234   fRGBInverted      := tfB5G6R5;
3235   fRange.r          := $1F;
3236   fRange.g          := $3F;
3237   fRange.b          := $1F;
3238   fShift.r          :=   0;
3239   fShift.g          :=   5;
3240   fShift.b          :=  11;
3241   fglFormat         := GL_RGB;
3242   fglInternalFormat := GL_RGB565;
3243   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3244 end;
3245
3246 constructor TfdRGB5.Create;
3247 begin
3248   inherited Create;
3249   fFormat           := tfRGB5;
3250   fWithAlpha        := tfRGB5A1;
3251   fWithoutAlpha     := tfRGB5;
3252   fRGBInverted      := tfBGR5;
3253   fRange.r          := $1F;
3254   fRange.g          := $1F;
3255   fRange.b          := $1F;
3256   fShift.r          :=   0;
3257   fShift.g          :=   5;
3258   fShift.b          :=  10;
3259   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3260   fglInternalFormat := GL_RGB5;
3261   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3262 end;
3263
3264 constructor TfdRGB8.Create;
3265 begin
3266   inherited Create;
3267   fFormat           := tfRGB8;
3268   fWithAlpha        := tfRGBA8;
3269   fWithoutAlpha     := tfRGB8;
3270   fRGBInverted      := tfBGR8;
3271   fglInternalFormat := GL_RGB8;
3272 end;
3273
3274 constructor TfdRGB10.Create;
3275 begin
3276   inherited Create;
3277   fFormat           := tfRGB10;
3278   fWithAlpha        := tfRGB10A2;
3279   fWithoutAlpha     := tfRGB10;
3280   fRGBInverted      := tfBGR10;
3281   fRange.r          := $3FF;
3282   fRange.g          := $3FF;
3283   fRange.b          := $3FF;
3284   fShift.r          :=    0;
3285   fShift.g          :=   10;
3286   fShift.b          :=   20;
3287   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3288   fglInternalFormat := GL_RGB10;
3289   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3290 end;
3291
3292 constructor TfdRGB12.Create;
3293 begin
3294   inherited Create;
3295   fFormat           := tfRGB12;
3296   fWithAlpha        := tfRGBA12;
3297   fWithoutAlpha     := tfRGB12;
3298   fRGBInverted      := tfBGR12;
3299   fglInternalFormat := GL_RGB12;
3300 end;
3301
3302 constructor TfdRGB16.Create;
3303 begin
3304   inherited Create;
3305   fFormat           := tfRGB16;
3306   fWithAlpha        := tfRGBA16;
3307   fWithoutAlpha     := tfRGB16;
3308   fRGBInverted      := tfBGR16;
3309   fglInternalFormat := GL_RGB16;
3310 end;
3311
3312 constructor TfdRGBA2.Create;
3313 begin
3314   inherited Create;
3315   fFormat           := tfRGBA2;
3316   fWithAlpha        := tfRGBA2;
3317   fWithoutAlpha     := tfR3G3B2;
3318   fRGBInverted      := tfBGRA2;
3319   fglInternalFormat := GL_RGBA2;
3320 end;
3321
3322 constructor TfdRGBA4.Create;
3323 begin
3324   inherited Create;
3325   fFormat           := tfRGBA4;
3326   fWithAlpha        := tfRGBA4;
3327   fWithoutAlpha     := tfRGB4;
3328   fRGBInverted      := tfBGRA4;
3329   fRange.r          := $F;
3330   fRange.g          := $F;
3331   fRange.b          := $F;
3332   fRange.a          := $F;
3333   fShift.r          :=  0;
3334   fShift.g          :=  4;
3335   fShift.b          :=  8;
3336   fShift.a          := 12;
3337   fglFormat         := GL_RGBA;
3338   fglInternalFormat := GL_RGBA4;
3339   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3340 end;
3341
3342 constructor TfdRGB5A1.Create;
3343 begin
3344   inherited Create;
3345   fFormat           := tfRGB5A1;
3346   fWithAlpha        := tfRGB5A1;
3347   fWithoutAlpha     := tfRGB5;
3348   fRGBInverted      := tfBGR5A1;
3349   fRange.r          := $1F;
3350   fRange.g          := $1F;
3351   fRange.b          := $1F;
3352   fRange.a          := $01;
3353   fShift.r          :=   0;
3354   fShift.g          :=   5;
3355   fShift.b          :=  10;
3356   fShift.a          :=  15;
3357   fglFormat         := GL_RGBA;
3358   fglInternalFormat := GL_RGB5_A1;
3359   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3360 end;
3361
3362 constructor TfdRGBA8.Create;
3363 begin
3364   inherited Create;
3365   fFormat           := tfRGBA8;
3366   fWithAlpha        := tfRGBA8;
3367   fWithoutAlpha     := tfRGB8;
3368   fRGBInverted      := tfBGRA8;
3369   fglInternalFormat := GL_RGBA8;
3370 end;
3371
3372 constructor TfdRGB10A2.Create;
3373 begin
3374   inherited Create;
3375   fFormat           := tfRGB10A2;
3376   fWithAlpha        := tfRGB10A2;
3377   fWithoutAlpha     := tfRGB10;
3378   fRGBInverted      := tfBGR10A2;
3379   fRange.r          := $3FF;
3380   fRange.g          := $3FF;
3381   fRange.b          := $3FF;
3382   fRange.a          := $003;
3383   fShift.r          :=    0;
3384   fShift.g          :=   10;
3385   fShift.b          :=   20;
3386   fShift.a          :=   30;
3387   fglFormat         := GL_RGBA;
3388   fglInternalFormat := GL_RGB10_A2;
3389   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3390 end;
3391
3392 constructor TfdRGBA12.Create;
3393 begin
3394   inherited Create;
3395   fFormat           := tfRGBA12;
3396   fWithAlpha        := tfRGBA12;
3397   fWithoutAlpha     := tfRGB12;
3398   fRGBInverted      := tfBGRA12;
3399   fglInternalFormat := GL_RGBA12;
3400 end;
3401
3402 constructor TfdRGBA16.Create;
3403 begin
3404   inherited Create;
3405   fFormat           := tfRGBA16;
3406   fWithAlpha        := tfRGBA16;
3407   fWithoutAlpha     := tfRGB16;
3408   fRGBInverted      := tfBGRA16;
3409   fglInternalFormat := GL_RGBA16;
3410 end;
3411
3412 constructor TfdBGR4.Create;
3413 begin
3414   inherited Create;
3415   fPixelSize        := 2.0;
3416   fFormat           := tfBGR4;
3417   fWithAlpha        := tfBGRA4;
3418   fWithoutAlpha     := tfBGR4;
3419   fRGBInverted      := tfRGB4;
3420   fRange.r          := $F;
3421   fRange.g          := $F;
3422   fRange.b          := $F;
3423   fRange.a          := $0;
3424   fShift.r          :=  8;
3425   fShift.g          :=  4;
3426   fShift.b          :=  0;
3427   fShift.a          :=  0;
3428   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3429   fglInternalFormat := GL_RGB4;
3430   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3431 end;
3432
3433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3436 constructor TfdB5G6R5.Create;
3437 begin
3438   inherited Create;
3439   fFormat           := tfB5G6R5;
3440   fWithAlpha        := tfBGRA4;
3441   fWithoutAlpha     := tfB5G6R5;
3442   fRGBInverted      := tfR5G6B5;
3443   fRange.r          := $1F;
3444   fRange.g          := $3F;
3445   fRange.b          := $1F;
3446   fShift.r          :=  11;
3447   fShift.g          :=   5;
3448   fShift.b          :=   0;
3449   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3450   fglInternalFormat := GL_RGB8;
3451   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3452 end;
3453
3454 constructor TfdBGR5.Create;
3455 begin
3456   inherited Create;
3457   fPixelSize        := 2.0;
3458   fFormat           := tfBGR5;
3459   fWithAlpha        := tfBGR5A1;
3460   fWithoutAlpha     := tfBGR5;
3461   fRGBInverted      := tfRGB5;
3462   fRange.r          := $1F;
3463   fRange.g          := $1F;
3464   fRange.b          := $1F;
3465   fRange.a          := $00;
3466   fShift.r          :=  10;
3467   fShift.g          :=   5;
3468   fShift.b          :=   0;
3469   fShift.a          :=   0;
3470   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3471   fglInternalFormat := GL_RGB5;
3472   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3473 end;
3474
3475 constructor TfdBGR8.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGR8;
3479   fWithAlpha        := tfBGRA8;
3480   fWithoutAlpha     := tfBGR8;
3481   fRGBInverted      := tfRGB8;
3482   fglInternalFormat := GL_RGB8;
3483 end;
3484
3485 constructor TfdBGR10.Create;
3486 begin
3487   inherited Create;
3488   fFormat           := tfBGR10;
3489   fWithAlpha        := tfBGR10A2;
3490   fWithoutAlpha     := tfBGR10;
3491   fRGBInverted      := tfRGB10;
3492   fRange.r          := $3FF;
3493   fRange.g          := $3FF;
3494   fRange.b          := $3FF;
3495   fRange.a          := $000;
3496   fShift.r          :=   20;
3497   fShift.g          :=   10;
3498   fShift.b          :=    0;
3499   fShift.a          :=    0;
3500   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3501   fglInternalFormat := GL_RGB10;
3502   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3503 end;
3504
3505 constructor TfdBGR12.Create;
3506 begin
3507   inherited Create;
3508   fFormat           := tfBGR12;
3509   fWithAlpha        := tfBGRA12;
3510   fWithoutAlpha     := tfBGR12;
3511   fRGBInverted      := tfRGB12;
3512   fglInternalFormat := GL_RGB12;
3513 end;
3514
3515 constructor TfdBGR16.Create;
3516 begin
3517   inherited Create;
3518   fFormat           := tfBGR16;
3519   fWithAlpha        := tfBGRA16;
3520   fWithoutAlpha     := tfBGR16;
3521   fRGBInverted      := tfRGB16;
3522   fglInternalFormat := GL_RGB16;
3523 end;
3524
3525 constructor TfdBGRA2.Create;
3526 begin
3527   inherited Create;
3528   fFormat           := tfBGRA2;
3529   fWithAlpha        := tfBGRA4;
3530   fWithoutAlpha     := tfBGR4;
3531   fRGBInverted      := tfRGBA2;
3532   fglInternalFormat := GL_RGBA2;
3533 end;
3534
3535 constructor TfdBGRA4.Create;
3536 begin
3537   inherited Create;
3538   fFormat           := tfBGRA4;
3539   fWithAlpha        := tfBGRA4;
3540   fWithoutAlpha     := tfBGR4;
3541   fRGBInverted      := tfRGBA4;
3542   fRange.r          := $F;
3543   fRange.g          := $F;
3544   fRange.b          := $F;
3545   fRange.a          := $F;
3546   fShift.r          :=  8;
3547   fShift.g          :=  4;
3548   fShift.b          :=  0;
3549   fShift.a          := 12;
3550   fglFormat         := GL_BGRA;
3551   fglInternalFormat := GL_RGBA4;
3552   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3553 end;
3554
3555 constructor TfdBGR5A1.Create;
3556 begin
3557   inherited Create;
3558   fFormat           := tfBGR5A1;
3559   fWithAlpha        := tfBGR5A1;
3560   fWithoutAlpha     := tfBGR5;
3561   fRGBInverted      := tfRGB5A1;
3562   fRange.r          := $1F;
3563   fRange.g          := $1F;
3564   fRange.b          := $1F;
3565   fRange.a          := $01;
3566   fShift.r          :=  10;
3567   fShift.g          :=   5;
3568   fShift.b          :=   0;
3569   fShift.a          :=  15;
3570   fglFormat         := GL_BGRA;
3571   fglInternalFormat := GL_RGB5_A1;
3572   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3573 end;
3574
3575 constructor TfdBGRA8.Create;
3576 begin
3577   inherited Create;
3578   fFormat           := tfBGRA8;
3579   fWithAlpha        := tfBGRA8;
3580   fWithoutAlpha     := tfBGR8;
3581   fRGBInverted      := tfRGBA8;
3582   fglInternalFormat := GL_RGBA8;
3583 end;
3584
3585 constructor TfdBGR10A2.Create;
3586 begin
3587   inherited Create;
3588   fFormat           := tfBGR10A2;
3589   fWithAlpha        := tfBGR10A2;
3590   fWithoutAlpha     := tfBGR10;
3591   fRGBInverted      := tfRGB10A2;
3592   fRange.r          := $3FF;
3593   fRange.g          := $3FF;
3594   fRange.b          := $3FF;
3595   fRange.a          := $003;
3596   fShift.r          :=   20;
3597   fShift.g          :=   10;
3598   fShift.b          :=    0;
3599   fShift.a          :=   30;
3600   fglFormat         := GL_BGRA;
3601   fglInternalFormat := GL_RGB10_A2;
3602   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3603 end;
3604
3605 constructor TfdBGRA12.Create;
3606 begin
3607   inherited Create;
3608   fFormat           := tfBGRA12;
3609   fWithAlpha        := tfBGRA12;
3610   fWithoutAlpha     := tfBGR12;
3611   fRGBInverted      := tfRGBA12;
3612   fglInternalFormat := GL_RGBA12;
3613 end;
3614
3615 constructor TfdBGRA16.Create;
3616 begin
3617   inherited Create;
3618   fFormat           := tfBGRA16;
3619   fWithAlpha        := tfBGRA16;
3620   fWithoutAlpha     := tfBGR16;
3621   fRGBInverted      := tfRGBA16;
3622   fglInternalFormat := GL_RGBA16;
3623 end;
3624
3625 constructor TfdDepth16.Create;
3626 begin
3627   inherited Create;
3628   fFormat           := tfDepth16;
3629   fWithAlpha        := tfEmpty;
3630   fWithoutAlpha     := tfDepth16;
3631   fglInternalFormat := GL_DEPTH_COMPONENT16;
3632 end;
3633
3634 constructor TfdDepth24.Create;
3635 begin
3636   inherited Create;
3637   fFormat           := tfDepth24;
3638   fWithAlpha        := tfEmpty;
3639   fWithoutAlpha     := tfDepth24;
3640   fglInternalFormat := GL_DEPTH_COMPONENT24;
3641 end;
3642
3643 constructor TfdDepth32.Create;
3644 begin
3645   inherited Create;
3646   fFormat           := tfDepth32;
3647   fWithAlpha        := tfEmpty;
3648   fWithoutAlpha     := tfDepth32;
3649   fglInternalFormat := GL_DEPTH_COMPONENT32;
3650 end;
3651
3652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3655 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3656 begin
3657   raise EglBitmap.Create('mapping for compressed formats is not supported');
3658 end;
3659
3660 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3661 begin
3662   raise EglBitmap.Create('mapping for compressed formats is not supported');
3663 end;
3664
3665 constructor TfdS3tcDtx1RGBA.Create;
3666 begin
3667   inherited Create;
3668   fFormat           := tfS3tcDtx1RGBA;
3669   fWithAlpha        := tfS3tcDtx1RGBA;
3670   fUncompressed     := tfRGB5A1;
3671   fPixelSize        := 0.5;
3672   fIsCompressed     := true;
3673   fglFormat         := GL_COMPRESSED_RGBA;
3674   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3675   fglDataFormat     := GL_UNSIGNED_BYTE;
3676 end;
3677
3678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3679 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3681 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3682 begin
3683   raise EglBitmap.Create('mapping for compressed formats is not supported');
3684 end;
3685
3686 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3687 begin
3688   raise EglBitmap.Create('mapping for compressed formats is not supported');
3689 end;
3690
3691 constructor TfdS3tcDtx3RGBA.Create;
3692 begin
3693   inherited Create;
3694   fFormat           := tfS3tcDtx3RGBA;
3695   fWithAlpha        := tfS3tcDtx3RGBA;
3696   fUncompressed     := tfRGBA8;
3697   fPixelSize        := 1.0;
3698   fIsCompressed     := true;
3699   fglFormat         := GL_COMPRESSED_RGBA;
3700   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3701   fglDataFormat     := GL_UNSIGNED_BYTE;
3702 end;
3703
3704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3707 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3708 begin
3709   raise EglBitmap.Create('mapping for compressed formats is not supported');
3710 end;
3711
3712 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3713 begin
3714   raise EglBitmap.Create('mapping for compressed formats is not supported');
3715 end;
3716
3717 constructor TfdS3tcDtx5RGBA.Create;
3718 begin
3719   inherited Create;
3720   fFormat           := tfS3tcDtx3RGBA;
3721   fWithAlpha        := tfS3tcDtx3RGBA;
3722   fUncompressed     := tfRGBA8;
3723   fPixelSize        := 1.0;
3724   fIsCompressed     := true;
3725   fglFormat         := GL_COMPRESSED_RGBA;
3726   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3727   fglDataFormat     := GL_UNSIGNED_BYTE;
3728 end;
3729
3730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3733 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3734 var
3735   f: TglBitmapFormat;
3736 begin
3737   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3738     result := TFormatDescriptor.Get(f);
3739     if (result.glInternalFormat = aInternalFormat) then
3740       exit;
3741   end;
3742   result := TFormatDescriptor.Get(tfEmpty);
3743 end;
3744
3745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3746 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 class procedure TFormatDescriptor.Init;
3749 begin
3750   if not Assigned(FormatDescriptorCS) then
3751     FormatDescriptorCS := TCriticalSection.Create;
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3756 begin
3757   FormatDescriptorCS.Enter;
3758   try
3759     result := FormatDescriptors[aFormat];
3760     if not Assigned(result) then begin
3761       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3762       FormatDescriptors[aFormat] := result;
3763     end;
3764   finally
3765     FormatDescriptorCS.Leave;
3766   end;
3767 end;
3768
3769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3770 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3771 begin
3772   result := Get(Get(aFormat).WithAlpha);
3773 end;
3774
3775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3776 class procedure TFormatDescriptor.Clear;
3777 var
3778   f: TglBitmapFormat;
3779 begin
3780   FormatDescriptorCS.Enter;
3781   try
3782     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3783       FreeAndNil(FormatDescriptors[f]);
3784   finally
3785     FormatDescriptorCS.Leave;
3786   end;
3787 end;
3788
3789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3790 class procedure TFormatDescriptor.Finalize;
3791 begin
3792   Clear;
3793   FreeAndNil(FormatDescriptorCS);
3794 end;
3795
3796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3797 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3799 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3800 begin
3801   Update(aValue, fRange.r, fShift.r);
3802 end;
3803
3804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3805 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3806 begin
3807   Update(aValue, fRange.g, fShift.g);
3808 end;
3809
3810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3811 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3812 begin
3813   Update(aValue, fRange.b, fShift.b);
3814 end;
3815
3816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3818 begin
3819   Update(aValue, fRange.a, fShift.a);
3820 end;
3821
3822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3823 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3824   aShift: Byte);
3825 begin
3826   aShift := 0;
3827   aRange := 0;
3828   if (aMask = 0) then
3829     exit;
3830   while (aMask > 0) and ((aMask and 1) = 0) do begin
3831     inc(aShift);
3832     aMask := aMask shr 1;
3833   end;
3834   aRange := 1;
3835   while (aMask > 0) do begin
3836     aRange := aRange shl 1;
3837     aMask  := aMask  shr 1;
3838   end;
3839   dec(aRange);
3840
3841   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3842 end;
3843
3844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3845 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3846 var
3847   data: QWord;
3848   s: Integer;
3849 begin
3850   data :=
3851     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3852     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3853     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3854     ((aPixel.Data.a and fRange.a) shl fShift.a);
3855   s := Round(fPixelSize);
3856   case s of
3857     1:           aData^  := data;
3858     2:     PWord(aData)^ := data;
3859     4: PCardinal(aData)^ := data;
3860     8:    PQWord(aData)^ := data;
3861   else
3862     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3863   end;
3864   inc(aData, s);
3865 end;
3866
3867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3868 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3869 var
3870   data: QWord;
3871   s, i: Integer;
3872 begin
3873   s := Round(fPixelSize);
3874   case s of
3875     1: data :=           aData^;
3876     2: data :=     PWord(aData)^;
3877     4: data := PCardinal(aData)^;
3878     8: data :=    PQWord(aData)^;
3879   else
3880     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3881   end;
3882   for i := 0 to 3 do
3883     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3884   inc(aData, s);
3885 end;
3886
3887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3888 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3890 procedure TbmpColorTableFormat.CreateColorTable;
3891 var
3892   i: Integer;
3893 begin
3894   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3895     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3896
3897   if (Format = tfLuminance4) then
3898     SetLength(fColorTable, 16)
3899   else
3900     SetLength(fColorTable, 256);
3901
3902   case Format of
3903     tfLuminance4: begin
3904       for i := 0 to High(fColorTable) do begin
3905         fColorTable[i].r := 16 * i;
3906         fColorTable[i].g := 16 * i;
3907         fColorTable[i].b := 16 * i;
3908         fColorTable[i].a := 0;
3909       end;
3910     end;
3911
3912     tfLuminance8: begin
3913       for i := 0 to High(fColorTable) do begin
3914         fColorTable[i].r := i;
3915         fColorTable[i].g := i;
3916         fColorTable[i].b := i;
3917         fColorTable[i].a := 0;
3918       end;
3919     end;
3920
3921     tfR3G3B2: begin
3922       for i := 0 to High(fColorTable) do begin
3923         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3924         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3925         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3926         fColorTable[i].a := 0;
3927       end;
3928     end;
3929   end;
3930 end;
3931
3932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3933 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3934 var
3935   d: Byte;
3936 begin
3937   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3938     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3939
3940   case Format of
3941     tfLuminance4: begin
3942       if (aMapData = nil) then
3943         aData^ := 0;
3944       d := LuminanceWeight(aPixel) and Range.r;
3945       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3946       inc(PByte(aMapData), 4);
3947       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3948         inc(aData);
3949         aMapData := nil;
3950       end;
3951     end;
3952
3953     tfLuminance8: begin
3954       aData^ := LuminanceWeight(aPixel) and Range.r;
3955       inc(aData);
3956     end;
3957
3958     tfR3G3B2: begin
3959       aData^ := Round(
3960         ((aPixel.Data.r and Range.r) shl Shift.r) or
3961         ((aPixel.Data.g and Range.g) shl Shift.g) or
3962         ((aPixel.Data.b and Range.b) shl Shift.b));
3963       inc(aData);
3964     end;
3965   end;
3966 end;
3967
3968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3969 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3970 var
3971   idx: QWord;
3972   s: Integer;
3973   bits: Byte;
3974   f: Single;
3975 begin
3976   s    := Trunc(fPixelSize);
3977   f    := fPixelSize - s;
3978   bits := Round(8 * f);
3979   case s of
3980     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3981     1: idx :=           aData^;
3982     2: idx :=     PWord(aData)^;
3983     4: idx := PCardinal(aData)^;
3984     8: idx :=    PQWord(aData)^;
3985   else
3986     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3987   end;
3988   if (idx >= Length(fColorTable)) then
3989     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3990   with fColorTable[idx] do begin
3991     aPixel.Data.r := r;
3992     aPixel.Data.g := g;
3993     aPixel.Data.b := b;
3994     aPixel.Data.a := a;
3995   end;
3996   inc(PByte(aMapData), bits);
3997   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3998     inc(aData, 1);
3999     dec(PByte(aMapData), 8);
4000   end;
4001   inc(aData, s);
4002 end;
4003
4004 destructor TbmpColorTableFormat.Destroy;
4005 begin
4006   SetLength(fColorTable, 0);
4007   inherited Destroy;
4008 end;
4009
4010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4011 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4013 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4014 var
4015   i: Integer;
4016 begin
4017   for i := 0 to 3 do begin
4018     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4019       if (aSourceFD.Range.arr[i] > 0) then
4020         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4021       else
4022         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4023     end;
4024   end;
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4029 begin
4030   with aFuncRec do begin
4031     if (Source.Range.r   > 0) then
4032       Dest.Data.r := Source.Data.r;
4033     if (Source.Range.g > 0) then
4034       Dest.Data.g := Source.Data.g;
4035     if (Source.Range.b  > 0) then
4036       Dest.Data.b := Source.Data.b;
4037     if (Source.Range.a > 0) then
4038       Dest.Data.a := Source.Data.a;
4039   end;
4040 end;
4041
4042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4043 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4044 var
4045   i: Integer;
4046 begin
4047   with aFuncRec do begin
4048     for i := 0 to 3 do
4049       if (Source.Range.arr[i] > 0) then
4050         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4051   end;
4052 end;
4053
4054 type
4055   TShiftData = packed record
4056     case Integer of
4057       0: (r, g, b, a: SmallInt);
4058       1: (arr: array[0..3] of SmallInt);
4059   end;
4060   PShiftData = ^TShiftData;
4061
4062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4063 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4064 var
4065   i: Integer;
4066 begin
4067   with aFuncRec do
4068     for i := 0 to 3 do
4069       if (Source.Range.arr[i] > 0) then
4070         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4071 end;
4072
4073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4074 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4075 begin
4076   with aFuncRec do begin
4077     Dest.Data := Source.Data;
4078     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4079       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4080       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4081       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4082     end;
4083     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4084       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4085     end;
4086   end;
4087 end;
4088
4089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4090 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4091 var
4092   i: Integer;
4093 begin
4094   with aFuncRec do begin
4095     for i := 0 to 3 do
4096       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4097   end;
4098 end;
4099
4100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4101 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4102 var
4103   Temp: Single;
4104 begin
4105   with FuncRec do begin
4106     if (FuncRec.Args = nil) then begin //source has no alpha
4107       Temp :=
4108         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4109         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4110         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4111       Dest.Data.a := Round(Dest.Range.a * Temp);
4112     end else
4113       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4114   end;
4115 end;
4116
4117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4119 type
4120   PglBitmapPixelData = ^TglBitmapPixelData;
4121 begin
4122   with FuncRec do begin
4123     Dest.Data.r := Source.Data.r;
4124     Dest.Data.g := Source.Data.g;
4125     Dest.Data.b := Source.Data.b;
4126
4127     with PglBitmapPixelData(Args)^ do
4128       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4129           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4130           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4131         Dest.Data.a := 0
4132       else
4133         Dest.Data.a := Dest.Range.a;
4134   end;
4135 end;
4136
4137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4138 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4139 begin
4140   with FuncRec do begin
4141     Dest.Data.r := Source.Data.r;
4142     Dest.Data.g := Source.Data.g;
4143     Dest.Data.b := Source.Data.b;
4144     Dest.Data.a := PCardinal(Args)^;
4145   end;
4146 end;
4147
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4150 type
4151   PRGBPix = ^TRGBPix;
4152   TRGBPix = array [0..2] of byte;
4153 var
4154   Temp: Byte;
4155 begin
4156   while aWidth > 0 do begin
4157     Temp := PRGBPix(aData)^[0];
4158     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4159     PRGBPix(aData)^[2] := Temp;
4160
4161     if aHasAlpha then
4162       Inc(aData, 4)
4163     else
4164       Inc(aData, 3);
4165     dec(aWidth);
4166   end;
4167 end;
4168
4169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4170 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4173 begin
4174   result := TFormatDescriptor.Get(Format);
4175 end;
4176
4177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4178 function TglBitmap.GetWidth: Integer;
4179 begin
4180   if (ffX in fDimension.Fields) then
4181     result := fDimension.X
4182   else
4183     result := -1;
4184 end;
4185
4186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4187 function TglBitmap.GetHeight: Integer;
4188 begin
4189   if (ffY in fDimension.Fields) then
4190     result := fDimension.Y
4191   else
4192     result := -1;
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 function TglBitmap.GetFileWidth: Integer;
4197 begin
4198   result := Max(1, Width);
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 function TglBitmap.GetFileHeight: Integer;
4203 begin
4204   result := Max(1, Height);
4205 end;
4206
4207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4208 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4209 begin
4210   if fCustomData = aValue then
4211     exit;
4212   fCustomData := aValue;
4213 end;
4214
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 procedure TglBitmap.SetCustomName(const aValue: String);
4217 begin
4218   if fCustomName = aValue then
4219     exit;
4220   fCustomName := aValue;
4221 end;
4222
4223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4224 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4225 begin
4226   if fCustomNameW = aValue then
4227     exit;
4228   fCustomNameW := aValue;
4229 end;
4230
4231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4232 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4233 begin
4234   if fFreeDataOnDestroy = aValue then
4235     exit;
4236   fFreeDataOnDestroy := aValue;
4237 end;
4238
4239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4240 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4241 begin
4242   if fDeleteTextureOnFree = aValue then
4243     exit;
4244   fDeleteTextureOnFree := aValue;
4245 end;
4246
4247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4248 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4249 begin
4250   if fFormat = aValue then
4251     exit;
4252   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4253     raise EglBitmapUnsupportedFormat.Create(Format);
4254   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4259 begin
4260   if fFreeDataAfterGenTexture = aValue then
4261     exit;
4262   fFreeDataAfterGenTexture := aValue;
4263 end;
4264
4265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4266 procedure TglBitmap.SetID(const aValue: Cardinal);
4267 begin
4268   if fID = aValue then
4269     exit;
4270   fID := aValue;
4271 end;
4272
4273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4274 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4275 begin
4276   if fMipMap = aValue then
4277     exit;
4278   fMipMap := aValue;
4279 end;
4280
4281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4282 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4283 begin
4284   if fTarget = aValue then
4285     exit;
4286   fTarget := aValue;
4287 end;
4288
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4291 var
4292   MaxAnisotropic: Integer;
4293 begin
4294   fAnisotropic := aValue;
4295   if (ID > 0) then begin
4296     if GL_EXT_texture_filter_anisotropic then begin
4297       if fAnisotropic > 0 then begin
4298         Bind(false);
4299         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4300         if aValue > MaxAnisotropic then
4301           fAnisotropic := MaxAnisotropic;
4302         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4303       end;
4304     end else begin
4305       fAnisotropic := 0;
4306     end;
4307   end;
4308 end;
4309
4310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4311 procedure TglBitmap.CreateID;
4312 begin
4313   if (ID <> 0) then
4314     glDeleteTextures(1, @fID);
4315   glGenTextures(1, @fID);
4316   Bind(false);
4317 end;
4318
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4321 begin
4322   // Set Up Parameters
4323   SetWrap(fWrapS, fWrapT, fWrapR);
4324   SetFilter(fFilterMin, fFilterMag);
4325   SetAnisotropic(fAnisotropic);
4326   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4327
4328   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4329     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4330
4331   // Mip Maps Generation Mode
4332   aBuildWithGlu := false;
4333   if (MipMap = mmMipmap) then begin
4334     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4335       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4336     else
4337       aBuildWithGlu := true;
4338   end else if (MipMap = mmMipmapGlu) then
4339     aBuildWithGlu := true;
4340 end;
4341
4342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4343 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4344   const aWidth: Integer; const aHeight: Integer);
4345 var
4346   s: Single;
4347 begin
4348   if (Data <> aData) then begin
4349     if (Assigned(Data)) then
4350       FreeMem(Data);
4351     fData := aData;
4352   end;
4353
4354   if not Assigned(fData) then begin
4355     fPixelSize := 0;
4356     fRowSize   := 0;
4357   end else begin
4358     FillChar(fDimension, SizeOf(fDimension), 0);
4359     if aWidth <> -1 then begin
4360       fDimension.Fields := fDimension.Fields + [ffX];
4361       fDimension.X := aWidth;
4362     end;
4363
4364     if aHeight <> -1 then begin
4365       fDimension.Fields := fDimension.Fields + [ffY];
4366       fDimension.Y := aHeight;
4367     end;
4368
4369     s := TFormatDescriptor.Get(aFormat).PixelSize;
4370     fFormat    := aFormat;
4371     fPixelSize := Ceil(s);
4372     fRowSize   := Ceil(s * aWidth);
4373   end;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmap.FlipHorz: Boolean;
4378 begin
4379   result := false;
4380 end;
4381
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 function TglBitmap.FlipVert: Boolean;
4384 begin
4385   result := false;
4386 end;
4387
4388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4389 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4391 procedure TglBitmap.AfterConstruction;
4392 begin
4393   inherited AfterConstruction;
4394
4395   fID         := 0;
4396   fTarget     := 0;
4397   fIsResident := false;
4398
4399   fMipMap                  := glBitmapDefaultMipmap;
4400   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4401   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4402
4403   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4404   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4405   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4406 end;
4407
4408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4409 procedure TglBitmap.BeforeDestruction;
4410 var
4411   NewData: PByte;
4412 begin
4413   if fFreeDataOnDestroy then begin
4414     NewData := nil;
4415     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4416   end;
4417   if (fID > 0) and fDeleteTextureOnFree then
4418     glDeleteTextures(1, @fID);
4419   inherited BeforeDestruction;
4420 end;
4421
4422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4423 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4424 var
4425   TempPos: Integer;
4426 begin
4427   if not Assigned(aResType) then begin
4428     TempPos   := Pos('.', aResource);
4429     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4430     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4431   end;
4432 end;
4433
4434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4435 procedure TglBitmap.LoadFromFile(const aFilename: String);
4436 var
4437   fs: TFileStream;
4438 begin
4439   if not FileExists(aFilename) then
4440     raise EglBitmap.Create('file does not exist: ' + aFilename);
4441   fFilename := aFilename;
4442   fs := TFileStream.Create(fFilename, fmOpenRead);
4443   try
4444     fs.Position := 0;
4445     LoadFromStream(fs);
4446   finally
4447     fs.Free;
4448   end;
4449 end;
4450
4451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4452 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4453 begin
4454   {$IFDEF GLB_SUPPORT_PNG_READ}
4455   if not LoadPNG(aStream) then
4456   {$ENDIF}
4457   {$IFDEF GLB_SUPPORT_JPEG_READ}
4458   if not LoadJPEG(aStream) then
4459   {$ENDIF}
4460   if not LoadDDS(aStream) then
4461   if not LoadTGA(aStream) then
4462   if not LoadBMP(aStream) then
4463     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4464 end;
4465
4466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4468   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4469 var
4470   tmpData: PByte;
4471   size: Integer;
4472 begin
4473   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4474   GetMem(tmpData, size);
4475   try
4476     FillChar(tmpData^, size, #$FF);
4477     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4478   except
4479     if Assigned(tmpData) then
4480       FreeMem(tmpData);
4481     raise;
4482   end;
4483   AddFunc(Self, aFunc, false, aFormat, aArgs);
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4488 var
4489   rs: TResourceStream;
4490 begin
4491   PrepareResType(aResource, aResType);
4492   rs := TResourceStream.Create(aInstance, aResource, aResType);
4493   try
4494     LoadFromStream(rs);
4495   finally
4496     rs.Free;
4497   end;
4498 end;
4499
4500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4501 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4502 var
4503   rs: TResourceStream;
4504 begin
4505   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4506   try
4507     LoadFromStream(rs);
4508   finally
4509     rs.Free;
4510   end;
4511 end;
4512
4513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4514 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4515 var
4516   fs: TFileStream;
4517 begin
4518   fs := TFileStream.Create(aFileName, fmCreate);
4519   try
4520     fs.Position := 0;
4521     SaveToStream(fs, aFileType);
4522   finally
4523     fs.Free;
4524   end;
4525 end;
4526
4527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4528 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4529 begin
4530   case aFileType of
4531     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4532     ftPNG:  SavePNG(aStream);
4533     {$ENDIF}
4534     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4535     ftJPEG: SaveJPEG(aStream);
4536     {$ENDIF}
4537     ftDDS:  SaveDDS(aStream);
4538     ftTGA:  SaveTGA(aStream);
4539     ftBMP:  SaveBMP(aStream);
4540   end;
4541 end;
4542
4543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4544 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4545 begin
4546   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4547 end;
4548
4549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4550 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4551   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4552 var
4553   DestData, TmpData, SourceData: pByte;
4554   TempHeight, TempWidth: Integer;
4555   SourceFD, DestFD: TFormatDescriptor;
4556   SourceMD, DestMD: Pointer;
4557
4558   FuncRec: TglBitmapFunctionRec;
4559 begin
4560   Assert(Assigned(Data));
4561   Assert(Assigned(aSource));
4562   Assert(Assigned(aSource.Data));
4563
4564   result := false;
4565   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4566     SourceFD := TFormatDescriptor.Get(aSource.Format);
4567     DestFD   := TFormatDescriptor.Get(aFormat);
4568
4569     if (SourceFD.IsCompressed) then
4570       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4571     if (DestFD.IsCompressed) then
4572       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4573
4574     // inkompatible Formats so CreateTemp
4575     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4576       aCreateTemp := true;
4577
4578     // Values
4579     TempHeight := Max(1, aSource.Height);
4580     TempWidth  := Max(1, aSource.Width);
4581
4582     FuncRec.Sender := Self;
4583     FuncRec.Args   := aArgs;
4584
4585     TmpData := nil;
4586     if aCreateTemp then begin
4587       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4588       DestData := TmpData;
4589     end else
4590       DestData := Data;
4591
4592     try
4593       SourceFD.PreparePixel(FuncRec.Source);
4594       DestFD.PreparePixel  (FuncRec.Dest);
4595
4596       SourceMD := SourceFD.CreateMappingData;
4597       DestMD   := DestFD.CreateMappingData;
4598
4599       FuncRec.Size            := aSource.Dimension;
4600       FuncRec.Position.Fields := FuncRec.Size.Fields;
4601
4602       try
4603         SourceData := aSource.Data;
4604         FuncRec.Position.Y := 0;
4605         while FuncRec.Position.Y < TempHeight do begin
4606           FuncRec.Position.X := 0;
4607           while FuncRec.Position.X < TempWidth do begin
4608             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4609             aFunc(FuncRec);
4610             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4611             inc(FuncRec.Position.X);
4612           end;
4613           inc(FuncRec.Position.Y);
4614         end;
4615
4616         // Updating Image or InternalFormat
4617         if aCreateTemp then
4618           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4619         else if (aFormat <> fFormat) then
4620           Format := aFormat;
4621
4622         result := true;
4623       finally
4624         SourceFD.FreeMappingData(SourceMD);
4625         DestFD.FreeMappingData(DestMD);
4626       end;
4627     except
4628       if aCreateTemp and Assigned(TmpData) then
4629         FreeMem(TmpData);
4630       raise;
4631     end;
4632   end;
4633 end;
4634
4635 {$IFDEF GLB_SDL}
4636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4637 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4638 var
4639   Row, RowSize: Integer;
4640   SourceData, TmpData: PByte;
4641   TempDepth: Integer;
4642   FormatDesc: TFormatDescriptor;
4643
4644   function GetRowPointer(Row: Integer): pByte;
4645   begin
4646     result := aSurface.pixels;
4647     Inc(result, Row * RowSize);
4648   end;
4649
4650 begin
4651   result := false;
4652
4653   FormatDesc := TFormatDescriptor.Get(Format);
4654   if FormatDesc.IsCompressed then
4655     raise EglBitmapUnsupportedFormat.Create(Format);
4656
4657   if Assigned(Data) then begin
4658     case Trunc(FormatDesc.PixelSize) of
4659       1: TempDepth :=  8;
4660       2: TempDepth := 16;
4661       3: TempDepth := 24;
4662       4: TempDepth := 32;
4663     else
4664       raise EglBitmapUnsupportedFormat.Create(Format);
4665     end;
4666
4667     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4668       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4669     SourceData := Data;
4670     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4671
4672     for Row := 0 to FileHeight-1 do begin
4673       TmpData := GetRowPointer(Row);
4674       if Assigned(TmpData) then begin
4675         Move(SourceData^, TmpData^, RowSize);
4676         inc(SourceData, RowSize);
4677       end;
4678     end;
4679     result := true;
4680   end;
4681 end;
4682
4683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4684 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4685 var
4686   pSource, pData, pTempData: PByte;
4687   Row, RowSize, TempWidth, TempHeight: Integer;
4688   IntFormat: TglBitmapFormat;
4689   FormatDesc: TFormatDescriptor;
4690
4691   function GetRowPointer(Row: Integer): pByte;
4692   begin
4693     result := aSurface^.pixels;
4694     Inc(result, Row * RowSize);
4695   end;
4696
4697 begin
4698   result := false;
4699   if (Assigned(aSurface)) then begin
4700     with aSurface^.format^ do begin
4701       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4702         FormatDesc := TFormatDescriptor.Get(IntFormat);
4703         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4704           break;
4705       end;
4706       if (IntFormat = tfEmpty) then
4707         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4708     end;
4709
4710     TempWidth  := aSurface^.w;
4711     TempHeight := aSurface^.h;
4712     RowSize := FormatDesc.GetSize(TempWidth, 1);
4713     GetMem(pData, TempHeight * RowSize);
4714     try
4715       pTempData := pData;
4716       for Row := 0 to TempHeight -1 do begin
4717         pSource := GetRowPointer(Row);
4718         if (Assigned(pSource)) then begin
4719           Move(pSource^, pTempData^, RowSize);
4720           Inc(pTempData, RowSize);
4721         end;
4722       end;
4723       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4724       result := true;
4725     except
4726       if Assigned(pData) then
4727         FreeMem(pData);
4728       raise;
4729     end;
4730   end;
4731 end;
4732
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4735 var
4736   Row, Col, AlphaInterleave: Integer;
4737   pSource, pDest: PByte;
4738
4739   function GetRowPointer(Row: Integer): pByte;
4740   begin
4741     result := aSurface.pixels;
4742     Inc(result, Row * Width);
4743   end;
4744
4745 begin
4746   result := false;
4747   if Assigned(Data) then begin
4748     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4749       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4750
4751       AlphaInterleave := 0;
4752       case Format of
4753         tfLuminance8Alpha8:
4754           AlphaInterleave := 1;
4755         tfBGRA8, tfRGBA8:
4756           AlphaInterleave := 3;
4757       end;
4758
4759       pSource := Data;
4760       for Row := 0 to Height -1 do begin
4761         pDest := GetRowPointer(Row);
4762         if Assigned(pDest) then begin
4763           for Col := 0 to Width -1 do begin
4764             Inc(pSource, AlphaInterleave);
4765             pDest^ := pSource^;
4766             Inc(pDest);
4767             Inc(pSource);
4768           end;
4769         end;
4770       end;
4771       result := true;
4772     end;
4773   end;
4774 end;
4775
4776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4777 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4778 var
4779   bmp: TglBitmap2D;
4780 begin
4781   bmp := TglBitmap2D.Create;
4782   try
4783     bmp.AssignFromSurface(aSurface);
4784     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4785   finally
4786     bmp.Free;
4787   end;
4788 end;
4789 {$ENDIF}
4790
4791 {$IFDEF GLB_DELPHI}
4792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4793 function CreateGrayPalette: HPALETTE;
4794 var
4795   Idx: Integer;
4796   Pal: PLogPalette;
4797 begin
4798   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4799
4800   Pal.palVersion := $300;
4801   Pal.palNumEntries := 256;
4802
4803   for Idx := 0 to Pal.palNumEntries - 1 do begin
4804     Pal.palPalEntry[Idx].peRed   := Idx;
4805     Pal.palPalEntry[Idx].peGreen := Idx;
4806     Pal.palPalEntry[Idx].peBlue  := Idx;
4807     Pal.palPalEntry[Idx].peFlags := 0;
4808   end;
4809   Result := CreatePalette(Pal^);
4810   FreeMem(Pal);
4811 end;
4812
4813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4814 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4815 var
4816   Row: Integer;
4817   pSource, pData: PByte;
4818 begin
4819   result := false;
4820   if Assigned(Data) then begin
4821     if Assigned(aBitmap) then begin
4822       aBitmap.Width  := Width;
4823       aBitmap.Height := Height;
4824
4825       case Format of
4826         tfAlpha8, tfLuminance8: begin
4827           aBitmap.PixelFormat := pf8bit;
4828           aBitmap.Palette     := CreateGrayPalette;
4829         end;
4830         tfRGB5A1:
4831           aBitmap.PixelFormat := pf15bit;
4832         tfR5G6B5:
4833           aBitmap.PixelFormat := pf16bit;
4834         tfRGB8, tfBGR8:
4835           aBitmap.PixelFormat := pf24bit;
4836         tfRGBA8, tfBGRA8:
4837           aBitmap.PixelFormat := pf32bit;
4838       else
4839         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4840       end;
4841
4842       pSource := Data;
4843       for Row := 0 to FileHeight -1 do begin
4844         pData := aBitmap.Scanline[Row];
4845         Move(pSource^, pData^, fRowSize);
4846         Inc(pSource, fRowSize);
4847         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4848           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4849       end;
4850       result := true;
4851     end;
4852   end;
4853 end;
4854
4855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4856 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4857 var
4858   pSource, pData, pTempData: PByte;
4859   Row, RowSize, TempWidth, TempHeight: Integer;
4860   IntFormat: TglBitmapFormat;
4861 begin
4862   result := false;
4863
4864   if (Assigned(aBitmap)) then begin
4865     case aBitmap.PixelFormat of
4866       pf8bit:
4867         IntFormat := tfLuminance8;
4868       pf15bit:
4869         IntFormat := tfRGB5A1;
4870       pf16bit:
4871         IntFormat := tfR5G6B5;
4872       pf24bit:
4873         IntFormat := tfBGR8;
4874       pf32bit:
4875         IntFormat := tfBGRA8;
4876     else
4877       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4878     end;
4879
4880     TempWidth  := aBitmap.Width;
4881     TempHeight := aBitmap.Height;
4882     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4883     GetMem(pData, TempHeight * RowSize);
4884     try
4885       pTempData := pData;
4886       for Row := 0 to TempHeight -1 do begin
4887         pSource := aBitmap.Scanline[Row];
4888         if (Assigned(pSource)) then begin
4889           Move(pSource^, pTempData^, RowSize);
4890           Inc(pTempData, RowSize);
4891         end;
4892       end;
4893       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4894       result := true;
4895     except
4896       if Assigned(pData) then
4897         FreeMem(pData);
4898       raise;
4899     end;
4900   end;
4901 end;
4902
4903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4904 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4905 var
4906   Row, Col, AlphaInterleave: Integer;
4907   pSource, pDest: PByte;
4908 begin
4909   result := false;
4910
4911   if Assigned(Data) then begin
4912     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4913       if Assigned(aBitmap) then begin
4914         aBitmap.PixelFormat := pf8bit;
4915         aBitmap.Palette     := CreateGrayPalette;
4916         aBitmap.Width       := Width;
4917         aBitmap.Height      := Height;
4918
4919         case Format of
4920           tfLuminance8Alpha8:
4921             AlphaInterleave := 1;
4922           tfRGBA8, tfBGRA8:
4923             AlphaInterleave := 3;
4924           else
4925             AlphaInterleave := 0;
4926         end;
4927
4928         // Copy Data
4929         pSource := Data;
4930
4931         for Row := 0 to Height -1 do begin
4932           pDest := aBitmap.Scanline[Row];
4933           if Assigned(pDest) then begin
4934             for Col := 0 to Width -1 do begin
4935               Inc(pSource, AlphaInterleave);
4936               pDest^ := pSource^;
4937               Inc(pDest);
4938               Inc(pSource);
4939             end;
4940           end;
4941         end;
4942         result := true;
4943       end;
4944     end;
4945   end;
4946 end;
4947
4948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4949 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4950 var
4951   tex: TglBitmap2D;
4952 begin
4953   tex := TglBitmap2D.Create;
4954   try
4955     tex.AssignFromBitmap(ABitmap);
4956     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4957   finally
4958     tex.Free;
4959   end;
4960 end;
4961 {$ENDIF}
4962
4963 {$IFDEF GLB_LAZARUS}
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4966 var
4967   rid: TRawImageDescription;
4968   FormatDesc: TFormatDescriptor;
4969 begin
4970   result := false;
4971   if not Assigned(aImage) or (Format = tfEmpty) then
4972     exit;
4973   FormatDesc := TFormatDescriptor.Get(Format);
4974   if FormatDesc.IsCompressed then
4975     exit;
4976
4977   FillChar(rid{%H-}, SizeOf(rid), 0);
4978   if (Format in [
4979        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4980        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4981        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4982     rid.Format := ricfGray
4983   else
4984     rid.Format := ricfRGBA;
4985
4986   rid.Width        := Width;
4987   rid.Height       := Height;
4988   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4989   rid.BitOrder     := riboBitsInOrder;
4990   rid.ByteOrder    := riboLSBFirst;
4991   rid.LineOrder    := riloTopToBottom;
4992   rid.LineEnd      := rileTight;
4993   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4994   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4995   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4996   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4997   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4998   rid.RedShift     := FormatDesc.Shift.r;
4999   rid.GreenShift   := FormatDesc.Shift.g;
5000   rid.BlueShift    := FormatDesc.Shift.b;
5001   rid.AlphaShift   := FormatDesc.Shift.a;
5002
5003   rid.MaskBitsPerPixel  := 0;
5004   rid.PaletteColorCount := 0;
5005
5006   aImage.DataDescription := rid;
5007   aImage.CreateData;
5008
5009   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5010
5011   result := true;
5012 end;
5013
5014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5015 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5016 var
5017   f: TglBitmapFormat;
5018   FormatDesc: TFormatDescriptor;
5019   ImageData: PByte;
5020   ImageSize: Integer;
5021   CanCopy: Boolean;
5022
5023   procedure CopyConvert;
5024   var
5025     bfFormat: TbmpBitfieldFormat;
5026     pSourceLine, pDestLine: PByte;
5027     pSourceMD, pDestMD: Pointer;
5028     x, y: Integer;
5029     pixel: TglBitmapPixelData;
5030   begin
5031     bfFormat  := TbmpBitfieldFormat.Create;
5032     with aImage.DataDescription do begin
5033       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5034       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5035       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5036       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5037       bfFormat.PixelSize := BitsPerPixel / 8;
5038     end;
5039     pSourceMD := bfFormat.CreateMappingData;
5040     pDestMD   := FormatDesc.CreateMappingData;
5041     try
5042       for y := 0 to aImage.Height-1 do begin
5043         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5044         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5045         for x := 0 to aImage.Width-1 do begin
5046           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5047           FormatDesc.Map(pixel, pDestLine, pDestMD);
5048         end;
5049       end;
5050     finally
5051       FormatDesc.FreeMappingData(pDestMD);
5052       bfFormat.FreeMappingData(pSourceMD);
5053       bfFormat.Free;
5054     end;
5055   end;
5056
5057 begin
5058   result := false;
5059   if not Assigned(aImage) then
5060     exit;
5061   for f := High(f) downto Low(f) do begin
5062     FormatDesc := TFormatDescriptor.Get(f);
5063     with aImage.DataDescription do
5064       if FormatDesc.MaskMatch(
5065         (QWord(1 shl RedPrec  )-1) shl RedShift,
5066         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5067         (QWord(1 shl BluePrec )-1) shl BlueShift,
5068         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5069         break;
5070   end;
5071
5072   if (f = tfEmpty) then
5073     exit;
5074
5075   CanCopy :=
5076     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5077     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5078
5079   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5080   ImageData := GetMem(ImageSize);
5081   try
5082     if CanCopy then
5083       Move(aImage.PixelData^, ImageData^, ImageSize)
5084     else
5085       CopyConvert;
5086     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5087   except
5088     if Assigned(ImageData) then
5089       FreeMem(ImageData);
5090     raise;
5091   end;
5092
5093   result := true;
5094 end;
5095
5096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5097 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5098 var
5099   rid: TRawImageDescription;
5100   FormatDesc: TFormatDescriptor;
5101   Pixel: TglBitmapPixelData;
5102   x, y: Integer;
5103   srcMD: Pointer;
5104   src, dst: PByte;
5105 begin
5106   result := false;
5107   if not Assigned(aImage) or (Format = tfEmpty) then
5108     exit;
5109   FormatDesc := TFormatDescriptor.Get(Format);
5110   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5111     exit;
5112
5113   FillChar(rid{%H-}, SizeOf(rid), 0);
5114   rid.Format       := ricfGray;
5115   rid.Width        := Width;
5116   rid.Height       := Height;
5117   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5118   rid.BitOrder     := riboBitsInOrder;
5119   rid.ByteOrder    := riboLSBFirst;
5120   rid.LineOrder    := riloTopToBottom;
5121   rid.LineEnd      := rileTight;
5122   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5123   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5124   rid.GreenPrec    := 0;
5125   rid.BluePrec     := 0;
5126   rid.AlphaPrec    := 0;
5127   rid.RedShift     := 0;
5128   rid.GreenShift   := 0;
5129   rid.BlueShift    := 0;
5130   rid.AlphaShift   := 0;
5131
5132   rid.MaskBitsPerPixel  := 0;
5133   rid.PaletteColorCount := 0;
5134
5135   aImage.DataDescription := rid;
5136   aImage.CreateData;
5137
5138   srcMD := FormatDesc.CreateMappingData;
5139   try
5140     FormatDesc.PreparePixel(Pixel);
5141     src := Data;
5142     dst := aImage.PixelData;
5143     for y := 0 to Height-1 do
5144       for x := 0 to Width-1 do begin
5145         FormatDesc.Unmap(src, Pixel, srcMD);
5146         case rid.BitsPerPixel of
5147            8: begin
5148             dst^ := Pixel.Data.a;
5149             inc(dst);
5150           end;
5151           16: begin
5152             PWord(dst)^ := Pixel.Data.a;
5153             inc(dst, 2);
5154           end;
5155           24: begin
5156             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5157             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5158             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5159             inc(dst, 3);
5160           end;
5161           32: begin
5162             PCardinal(dst)^ := Pixel.Data.a;
5163             inc(dst, 4);
5164           end;
5165         else
5166           raise EglBitmapUnsupportedFormat.Create(Format);
5167         end;
5168       end;
5169   finally
5170     FormatDesc.FreeMappingData(srcMD);
5171   end;
5172   result := true;
5173 end;
5174
5175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5176 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5177 var
5178   tex: TglBitmap2D;
5179 begin
5180   tex := TglBitmap2D.Create;
5181   try
5182     tex.AssignFromLazIntfImage(aImage);
5183     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5184   finally
5185     tex.Free;
5186   end;
5187 end;
5188 {$ENDIF}
5189
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5192   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5193 var
5194   rs: TResourceStream;
5195 begin
5196   PrepareResType(aResource, aResType);
5197   rs := TResourceStream.Create(aInstance, aResource, aResType);
5198   try
5199     result := AddAlphaFromStream(rs, aFunc, aArgs);
5200   finally
5201     rs.Free;
5202   end;
5203 end;
5204
5205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5206 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5207   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5208 var
5209   rs: TResourceStream;
5210 begin
5211   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5212   try
5213     result := AddAlphaFromStream(rs, aFunc, aArgs);
5214   finally
5215     rs.Free;
5216   end;
5217 end;
5218
5219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5220 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5221 begin
5222   if TFormatDescriptor.Get(Format).IsCompressed then
5223     raise EglBitmapUnsupportedFormat.Create(Format);
5224   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5225 end;
5226
5227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5228 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5229 var
5230   FS: TFileStream;
5231 begin
5232   FS := TFileStream.Create(aFileName, fmOpenRead);
5233   try
5234     result := AddAlphaFromStream(FS, aFunc, aArgs);
5235   finally
5236     FS.Free;
5237   end;
5238 end;
5239
5240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5241 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5242 var
5243   tex: TglBitmap2D;
5244 begin
5245   tex := TglBitmap2D.Create(aStream);
5246   try
5247     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5248   finally
5249     tex.Free;
5250   end;
5251 end;
5252
5253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5254 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5255 var
5256   DestData, DestData2, SourceData: pByte;
5257   TempHeight, TempWidth: Integer;
5258   SourceFD, DestFD: TFormatDescriptor;
5259   SourceMD, DestMD, DestMD2: Pointer;
5260
5261   FuncRec: TglBitmapFunctionRec;
5262 begin
5263   result := false;
5264
5265   Assert(Assigned(Data));
5266   Assert(Assigned(aBitmap));
5267   Assert(Assigned(aBitmap.Data));
5268
5269   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5270     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5271
5272     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5273     DestFD   := TFormatDescriptor.Get(Format);
5274
5275     if not Assigned(aFunc) then begin
5276       aFunc        := glBitmapAlphaFunc;
5277       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5278     end else
5279       FuncRec.Args := aArgs;
5280
5281     // Values
5282     TempHeight := aBitmap.FileHeight;
5283     TempWidth  := aBitmap.FileWidth;
5284
5285     FuncRec.Sender          := Self;
5286     FuncRec.Size            := Dimension;
5287     FuncRec.Position.Fields := FuncRec.Size.Fields;
5288
5289     DestData   := Data;
5290     DestData2  := Data;
5291     SourceData := aBitmap.Data;
5292
5293     // Mapping
5294     SourceFD.PreparePixel(FuncRec.Source);
5295     DestFD.PreparePixel  (FuncRec.Dest);
5296
5297     SourceMD := SourceFD.CreateMappingData;
5298     DestMD   := DestFD.CreateMappingData;
5299     DestMD2  := DestFD.CreateMappingData;
5300     try
5301       FuncRec.Position.Y := 0;
5302       while FuncRec.Position.Y < TempHeight do begin
5303         FuncRec.Position.X := 0;
5304         while FuncRec.Position.X < TempWidth do begin
5305           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5306           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5307           aFunc(FuncRec);
5308           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5309           inc(FuncRec.Position.X);
5310         end;
5311         inc(FuncRec.Position.Y);
5312       end;
5313     finally
5314       SourceFD.FreeMappingData(SourceMD);
5315       DestFD.FreeMappingData(DestMD);
5316       DestFD.FreeMappingData(DestMD2);
5317     end;
5318   end;
5319 end;
5320
5321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5322 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5323 begin
5324   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5325 end;
5326
5327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5328 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5329 var
5330   PixelData: TglBitmapPixelData;
5331 begin
5332   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5333   result := AddAlphaFromColorKeyFloat(
5334     aRed   / PixelData.Range.r,
5335     aGreen / PixelData.Range.g,
5336     aBlue  / PixelData.Range.b,
5337     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5338 end;
5339
5340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5341 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5342 var
5343   values: array[0..2] of Single;
5344   tmp: Cardinal;
5345   i: Integer;
5346   PixelData: TglBitmapPixelData;
5347 begin
5348   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5349   with PixelData do begin
5350     values[0] := aRed;
5351     values[1] := aGreen;
5352     values[2] := aBlue;
5353
5354     for i := 0 to 2 do begin
5355       tmp          := Trunc(Range.arr[i] * aDeviation);
5356       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5357       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5358     end;
5359     Data.a  := 0;
5360     Range.a := 0;
5361   end;
5362   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5363 end;
5364
5365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5366 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5367 begin
5368   result := AddAlphaFromValueFloat(aAlpha / $FF);
5369 end;
5370
5371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5372 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5373 var
5374   PixelData: TglBitmapPixelData;
5375 begin
5376   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5377   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5378 end;
5379
5380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5381 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5382 var
5383   PixelData: TglBitmapPixelData;
5384 begin
5385   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5386   with PixelData do
5387     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5388   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5389 end;
5390
5391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5392 function TglBitmap.RemoveAlpha: Boolean;
5393 var
5394   FormatDesc: TFormatDescriptor;
5395 begin
5396   result := false;
5397   FormatDesc := TFormatDescriptor.Get(Format);
5398   if Assigned(Data) then begin
5399     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5400       raise EglBitmapUnsupportedFormat.Create(Format);
5401     result := ConvertTo(FormatDesc.WithoutAlpha);
5402   end;
5403 end;
5404
5405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5406 function TglBitmap.Clone: TglBitmap;
5407 var
5408   Temp: TglBitmap;
5409   TempPtr: PByte;
5410   Size: Integer;
5411 begin
5412   result := nil;
5413   Temp := (ClassType.Create as TglBitmap);
5414   try
5415     // copy texture data if assigned
5416     if Assigned(Data) then begin
5417       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5418       GetMem(TempPtr, Size);
5419       try
5420         Move(Data^, TempPtr^, Size);
5421         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5422       except
5423         if Assigned(TempPtr) then
5424           FreeMem(TempPtr);
5425         raise;
5426       end;
5427     end else begin
5428       TempPtr := nil;
5429       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5430     end;
5431
5432         // copy properties
5433     Temp.fID                      := ID;
5434     Temp.fTarget                  := Target;
5435     Temp.fFormat                  := Format;
5436     Temp.fMipMap                  := MipMap;
5437     Temp.fAnisotropic             := Anisotropic;
5438     Temp.fBorderColor             := fBorderColor;
5439     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5440     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5441     Temp.fFilterMin               := fFilterMin;
5442     Temp.fFilterMag               := fFilterMag;
5443     Temp.fWrapS                   := fWrapS;
5444     Temp.fWrapT                   := fWrapT;
5445     Temp.fWrapR                   := fWrapR;
5446     Temp.fFilename                := fFilename;
5447     Temp.fCustomName              := fCustomName;
5448     Temp.fCustomNameW             := fCustomNameW;
5449     Temp.fCustomData              := fCustomData;
5450
5451     result := Temp;
5452   except
5453     FreeAndNil(Temp);
5454     raise;
5455   end;
5456 end;
5457
5458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5459 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5460 var
5461   SourceFD, DestFD: TFormatDescriptor;
5462   SourcePD, DestPD: TglBitmapPixelData;
5463   ShiftData: TShiftData;
5464
5465   function CanCopyDirect: Boolean;
5466   begin
5467     result :=
5468       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5469       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5470       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5471       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5472   end;
5473
5474   function CanShift: Boolean;
5475   begin
5476     result :=
5477       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5478       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5479       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5480       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5481   end;
5482
5483   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5484   begin
5485     result := 0;
5486     while (aSource > aDest) and (aSource > 0) do begin
5487       inc(result);
5488       aSource := aSource shr 1;
5489     end;
5490   end;
5491
5492 begin
5493   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5494     SourceFD := TFormatDescriptor.Get(Format);
5495     DestFD   := TFormatDescriptor.Get(aFormat);
5496
5497     SourceFD.PreparePixel(SourcePD);
5498     DestFD.PreparePixel  (DestPD);
5499
5500     if CanCopyDirect then
5501       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5502     else if CanShift then begin
5503       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5504       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5505       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5506       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5507       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5508     end else
5509       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5510   end else
5511     result := true;
5512 end;
5513
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5516 begin
5517   if aUseRGB or aUseAlpha then
5518     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5519       ((Byte(aUseAlpha) and 1) shl 1) or
5520        (Byte(aUseRGB)   and 1)      ));
5521 end;
5522
5523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5524 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5525 begin
5526   fBorderColor[0] := aRed;
5527   fBorderColor[1] := aGreen;
5528   fBorderColor[2] := aBlue;
5529   fBorderColor[3] := aAlpha;
5530   if (ID > 0) then begin
5531     Bind(false);
5532     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5533   end;
5534 end;
5535
5536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5537 procedure TglBitmap.FreeData;
5538 var
5539   TempPtr: PByte;
5540 begin
5541   TempPtr := nil;
5542   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5543 end;
5544
5545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5546 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5547   const aAlpha: Byte);
5548 begin
5549   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5550 end;
5551
5552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5553 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5554 var
5555   PixelData: TglBitmapPixelData;
5556 begin
5557   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5558   FillWithColorFloat(
5559     aRed   / PixelData.Range.r,
5560     aGreen / PixelData.Range.g,
5561     aBlue  / PixelData.Range.b,
5562     aAlpha / PixelData.Range.a);
5563 end;
5564
5565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5566 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5567 var
5568   PixelData: TglBitmapPixelData;
5569 begin
5570   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5571   with PixelData do begin
5572     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5573     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5574     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5575     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5576   end;
5577   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5578 end;
5579
5580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5581 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5582 begin
5583   //check MIN filter
5584   case aMin of
5585     GL_NEAREST:
5586       fFilterMin := GL_NEAREST;
5587     GL_LINEAR:
5588       fFilterMin := GL_LINEAR;
5589     GL_NEAREST_MIPMAP_NEAREST:
5590       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5591     GL_LINEAR_MIPMAP_NEAREST:
5592       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5593     GL_NEAREST_MIPMAP_LINEAR:
5594       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5595     GL_LINEAR_MIPMAP_LINEAR:
5596       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5597     else
5598       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5599   end;
5600
5601   //check MAG filter
5602   case aMag of
5603     GL_NEAREST:
5604       fFilterMag := GL_NEAREST;
5605     GL_LINEAR:
5606       fFilterMag := GL_LINEAR;
5607     else
5608       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5609   end;
5610
5611   //apply filter
5612   if (ID > 0) then begin
5613     Bind(false);
5614     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5615
5616     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5617       case fFilterMin of
5618         GL_NEAREST, GL_LINEAR:
5619           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5620         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5621           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5622         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5623           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5624       end;
5625     end else
5626       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5627   end;
5628 end;
5629
5630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5631 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5632
5633   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5634   begin
5635     case aValue of
5636       GL_CLAMP:
5637         aTarget := GL_CLAMP;
5638
5639       GL_REPEAT:
5640         aTarget := GL_REPEAT;
5641
5642       GL_CLAMP_TO_EDGE: begin
5643         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5644           aTarget := GL_CLAMP_TO_EDGE
5645         else
5646           aTarget := GL_CLAMP;
5647       end;
5648
5649       GL_CLAMP_TO_BORDER: begin
5650         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5651           aTarget := GL_CLAMP_TO_BORDER
5652         else
5653           aTarget := GL_CLAMP;
5654       end;
5655
5656       GL_MIRRORED_REPEAT: begin
5657         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5658           aTarget := GL_MIRRORED_REPEAT
5659         else
5660           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5661       end;
5662     else
5663       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5664     end;
5665   end;
5666
5667 begin
5668   CheckAndSetWrap(S, fWrapS);
5669   CheckAndSetWrap(T, fWrapT);
5670   CheckAndSetWrap(R, fWrapR);
5671
5672   if (ID > 0) then begin
5673     Bind(false);
5674     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5675     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5676     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5677   end;
5678 end;
5679
5680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5681 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5682
5683   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5684   begin
5685     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5686        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5687       fSwizzle[aIndex] := aValue
5688     else
5689       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5690   end;
5691
5692 begin
5693   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5694     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5695   CheckAndSetValue(r, 0);
5696   CheckAndSetValue(g, 1);
5697   CheckAndSetValue(b, 2);
5698   CheckAndSetValue(a, 3);
5699
5700   if (ID > 0) then begin
5701     Bind(false);
5702     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5703   end;
5704 end;
5705
5706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5707 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5708 begin
5709   if aEnableTextureUnit then
5710     glEnable(Target);
5711   if (ID > 0) then
5712     glBindTexture(Target, ID);
5713 end;
5714
5715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5716 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5717 begin
5718   if aDisableTextureUnit then
5719     glDisable(Target);
5720   glBindTexture(Target, 0);
5721 end;
5722
5723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5724 constructor TglBitmap.Create;
5725 begin
5726   if (ClassType = TglBitmap) then
5727     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5728 {$IFDEF GLB_NATIVE_OGL}
5729   glbReadOpenGLExtensions;
5730 {$ENDIF}
5731   inherited Create;
5732   fFormat            := glBitmapGetDefaultFormat;
5733   fFreeDataOnDestroy := true;
5734 end;
5735
5736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5737 constructor TglBitmap.Create(const aFileName: String);
5738 begin
5739   Create;
5740   LoadFromFile(aFileName);
5741 end;
5742
5743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5744 constructor TglBitmap.Create(const aStream: TStream);
5745 begin
5746   Create;
5747   LoadFromStream(aStream);
5748 end;
5749
5750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5751 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5752 var
5753   ImageSize: Integer;
5754 begin
5755   Create;
5756   if not Assigned(aData) then begin
5757     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5758     GetMem(aData, ImageSize);
5759     try
5760       FillChar(aData^, ImageSize, #$FF);
5761       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5762     except
5763       if Assigned(aData) then
5764         FreeMem(aData);
5765       raise;
5766     end;
5767   end else begin
5768     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5769     fFreeDataOnDestroy := false;
5770   end;
5771 end;
5772
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5775 begin
5776   Create;
5777   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5778 end;
5779
5780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5781 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5782 begin
5783   Create;
5784   LoadFromResource(aInstance, aResource, aResType);
5785 end;
5786
5787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5788 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5789 begin
5790   Create;
5791   LoadFromResourceID(aInstance, aResourceID, aResType);
5792 end;
5793
5794 {$IFDEF GLB_SUPPORT_PNG_READ}
5795 {$IF DEFINED(GLB_LAZ_PNG)}
5796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5797 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5799 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5800 const
5801   MAGIC_LEN = 8;
5802   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5803 var
5804   reader: TLazReaderPNG;
5805   intf: TLazIntfImage;
5806   StreamPos: Int64;
5807   magic: String[MAGIC_LEN];
5808 begin
5809   result := true;
5810   StreamPos := aStream.Position;
5811
5812   SetLength(magic, MAGIC_LEN);
5813   aStream.Read(magic[1], MAGIC_LEN);
5814   aStream.Position := StreamPos;
5815   if (magic <> PNG_MAGIC) then begin
5816     result := false;
5817     exit;
5818   end;
5819
5820   intf   := TLazIntfImage.Create(0, 0);
5821   reader := TLazReaderPNG.Create;
5822   try try
5823     reader.UpdateDescription := true;
5824     reader.ImageRead(aStream, intf);
5825     AssignFromLazIntfImage(intf);
5826   except
5827     result := false;
5828     aStream.Position := StreamPos;
5829     exit;
5830   end;
5831   finally
5832     reader.Free;
5833     intf.Free;
5834   end;
5835 end;
5836
5837 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5839 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5840 var
5841   Surface: PSDL_Surface;
5842   RWops: PSDL_RWops;
5843 begin
5844   result := false;
5845   RWops := glBitmapCreateRWops(aStream);
5846   try
5847     if IMG_isPNG(RWops) > 0 then begin
5848       Surface := IMG_LoadPNG_RW(RWops);
5849       try
5850         AssignFromSurface(Surface);
5851         result := true;
5852       finally
5853         SDL_FreeSurface(Surface);
5854       end;
5855     end;
5856   finally
5857     SDL_FreeRW(RWops);
5858   end;
5859 end;
5860
5861 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5863 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5864 begin
5865   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5866 end;
5867
5868 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5869 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5870 var
5871   StreamPos: Int64;
5872   signature: array [0..7] of byte;
5873   png: png_structp;
5874   png_info: png_infop;
5875
5876   TempHeight, TempWidth: Integer;
5877   Format: TglBitmapFormat;
5878
5879   png_data: pByte;
5880   png_rows: array of pByte;
5881   Row, LineSize: Integer;
5882 begin
5883   result := false;
5884
5885   if not init_libPNG then
5886     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5887
5888   try
5889     // signature
5890     StreamPos := aStream.Position;
5891     aStream.Read(signature{%H-}, 8);
5892     aStream.Position := StreamPos;
5893
5894     if png_check_sig(@signature, 8) <> 0 then begin
5895       // png read struct
5896       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5897       if png = nil then
5898         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5899
5900       // png info
5901       png_info := png_create_info_struct(png);
5902       if png_info = nil then begin
5903         png_destroy_read_struct(@png, nil, nil);
5904         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5905       end;
5906
5907       // set read callback
5908       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5909
5910       // read informations
5911       png_read_info(png, png_info);
5912
5913       // size
5914       TempHeight := png_get_image_height(png, png_info);
5915       TempWidth := png_get_image_width(png, png_info);
5916
5917       // format
5918       case png_get_color_type(png, png_info) of
5919         PNG_COLOR_TYPE_GRAY:
5920           Format := tfLuminance8;
5921         PNG_COLOR_TYPE_GRAY_ALPHA:
5922           Format := tfLuminance8Alpha8;
5923         PNG_COLOR_TYPE_RGB:
5924           Format := tfRGB8;
5925         PNG_COLOR_TYPE_RGB_ALPHA:
5926           Format := tfRGBA8;
5927         else
5928           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5929       end;
5930
5931       // cut upper 8 bit from 16 bit formats
5932       if png_get_bit_depth(png, png_info) > 8 then
5933         png_set_strip_16(png);
5934
5935       // expand bitdepth smaller than 8
5936       if png_get_bit_depth(png, png_info) < 8 then
5937         png_set_expand(png);
5938
5939       // allocating mem for scanlines
5940       LineSize := png_get_rowbytes(png, png_info);
5941       GetMem(png_data, TempHeight * LineSize);
5942       try
5943         SetLength(png_rows, TempHeight);
5944         for Row := Low(png_rows) to High(png_rows) do begin
5945           png_rows[Row] := png_data;
5946           Inc(png_rows[Row], Row * LineSize);
5947         end;
5948
5949         // read complete image into scanlines
5950         png_read_image(png, @png_rows[0]);
5951
5952         // read end
5953         png_read_end(png, png_info);
5954
5955         // destroy read struct
5956         png_destroy_read_struct(@png, @png_info, nil);
5957
5958         SetLength(png_rows, 0);
5959
5960         // set new data
5961         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5962
5963         result := true;
5964       except
5965         if Assigned(png_data) then
5966           FreeMem(png_data);
5967         raise;
5968       end;
5969     end;
5970   finally
5971     quit_libPNG;
5972   end;
5973 end;
5974
5975 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5977 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5978 var
5979   StreamPos: Int64;
5980   Png: TPNGObject;
5981   Header: String[8];
5982   Row, Col, PixSize, LineSize: Integer;
5983   NewImage, pSource, pDest, pAlpha: pByte;
5984   PngFormat: TglBitmapFormat;
5985   FormatDesc: TFormatDescriptor;
5986
5987 const
5988   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5989
5990 begin
5991   result := false;
5992
5993   StreamPos := aStream.Position;
5994   aStream.Read(Header[0], SizeOf(Header));
5995   aStream.Position := StreamPos;
5996
5997   {Test if the header matches}
5998   if Header = PngHeader then begin
5999     Png := TPNGObject.Create;
6000     try
6001       Png.LoadFromStream(aStream);
6002
6003       case Png.Header.ColorType of
6004         COLOR_GRAYSCALE:
6005           PngFormat := tfLuminance8;
6006         COLOR_GRAYSCALEALPHA:
6007           PngFormat := tfLuminance8Alpha8;
6008         COLOR_RGB:
6009           PngFormat := tfBGR8;
6010         COLOR_RGBALPHA:
6011           PngFormat := tfBGRA8;
6012         else
6013           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6014       end;
6015
6016       FormatDesc := TFormatDescriptor.Get(PngFormat);
6017       PixSize    := Round(FormatDesc.PixelSize);
6018       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6019
6020       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6021       try
6022         pDest := NewImage;
6023
6024         case Png.Header.ColorType of
6025           COLOR_RGB, COLOR_GRAYSCALE:
6026             begin
6027               for Row := 0 to Png.Height -1 do begin
6028                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6029                 Inc(pDest, LineSize);
6030               end;
6031             end;
6032           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6033             begin
6034               PixSize := PixSize -1;
6035
6036               for Row := 0 to Png.Height -1 do begin
6037                 pSource := Png.Scanline[Row];
6038                 pAlpha := pByte(Png.AlphaScanline[Row]);
6039
6040                 for Col := 0 to Png.Width -1 do begin
6041                   Move (pSource^, pDest^, PixSize);
6042                   Inc(pSource, PixSize);
6043                   Inc(pDest, PixSize);
6044
6045                   pDest^ := pAlpha^;
6046                   inc(pAlpha);
6047                   Inc(pDest);
6048                 end;
6049               end;
6050             end;
6051           else
6052             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6053         end;
6054
6055         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6056
6057         result := true;
6058       except
6059         if Assigned(NewImage) then
6060           FreeMem(NewImage);
6061         raise;
6062       end;
6063     finally
6064       Png.Free;
6065     end;
6066   end;
6067 end;
6068 {$IFEND}
6069 {$ENDIF}
6070
6071 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6072 {$IFDEF GLB_LIB_PNG}
6073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6074 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6075 begin
6076   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6077 end;
6078 {$ENDIF}
6079
6080 {$IF DEFINED(GLB_LAZ_PNG)}
6081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6082 procedure TglBitmap.SavePNG(const aStream: TStream);
6083 var
6084   png: TPortableNetworkGraphic;
6085   intf: TLazIntfImage;
6086   raw: TRawImage;
6087 begin
6088   png  := TPortableNetworkGraphic.Create;
6089   intf := TLazIntfImage.Create(0, 0);
6090   try
6091     if not AssignToLazIntfImage(intf) then
6092       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6093     intf.GetRawImage(raw);
6094     png.LoadFromRawImage(raw, false);
6095     png.SaveToStream(aStream);
6096   finally
6097     png.Free;
6098     intf.Free;
6099   end;
6100 end;
6101
6102 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6104 procedure TglBitmap.SavePNG(const aStream: TStream);
6105 var
6106   png: png_structp;
6107   png_info: png_infop;
6108   png_rows: array of pByte;
6109   LineSize: Integer;
6110   ColorType: Integer;
6111   Row: Integer;
6112   FormatDesc: TFormatDescriptor;
6113 begin
6114   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6115     raise EglBitmapUnsupportedFormat.Create(Format);
6116
6117   if not init_libPNG then
6118     raise Exception.Create('unable to initialize libPNG.');
6119
6120   try
6121     case Format of
6122       tfAlpha8, tfLuminance8:
6123         ColorType := PNG_COLOR_TYPE_GRAY;
6124       tfLuminance8Alpha8:
6125         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6126       tfBGR8, tfRGB8:
6127         ColorType := PNG_COLOR_TYPE_RGB;
6128       tfBGRA8, tfRGBA8:
6129         ColorType := PNG_COLOR_TYPE_RGBA;
6130       else
6131         raise EglBitmapUnsupportedFormat.Create(Format);
6132     end;
6133
6134     FormatDesc := TFormatDescriptor.Get(Format);
6135     LineSize := FormatDesc.GetSize(Width, 1);
6136
6137     // creating array for scanline
6138     SetLength(png_rows, Height);
6139     try
6140       for Row := 0 to Height - 1 do begin
6141         png_rows[Row] := Data;
6142         Inc(png_rows[Row], Row * LineSize)
6143       end;
6144
6145       // write struct
6146       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6147       if png = nil then
6148         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6149
6150       // create png info
6151       png_info := png_create_info_struct(png);
6152       if png_info = nil then begin
6153         png_destroy_write_struct(@png, nil);
6154         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6155       end;
6156
6157       // set read callback
6158       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6159
6160       // set compression
6161       png_set_compression_level(png, 6);
6162
6163       if Format in [tfBGR8, tfBGRA8] then
6164         png_set_bgr(png);
6165
6166       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6167       png_write_info(png, png_info);
6168       png_write_image(png, @png_rows[0]);
6169       png_write_end(png, png_info);
6170       png_destroy_write_struct(@png, @png_info);
6171     finally
6172       SetLength(png_rows, 0);
6173     end;
6174   finally
6175     quit_libPNG;
6176   end;
6177 end;
6178
6179 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6181 procedure TglBitmap.SavePNG(const aStream: TStream);
6182 var
6183   Png: TPNGObject;
6184
6185   pSource, pDest: pByte;
6186   X, Y, PixSize: Integer;
6187   ColorType: Cardinal;
6188   Alpha: Boolean;
6189
6190   pTemp: pByte;
6191   Temp: Byte;
6192 begin
6193   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6194     raise EglBitmapUnsupportedFormat.Create(Format);
6195
6196   case Format of
6197     tfAlpha8, tfLuminance8: begin
6198       ColorType := COLOR_GRAYSCALE;
6199       PixSize   := 1;
6200       Alpha     := false;
6201     end;
6202     tfLuminance8Alpha8: begin
6203       ColorType := COLOR_GRAYSCALEALPHA;
6204       PixSize   := 1;
6205       Alpha     := true;
6206     end;
6207     tfBGR8, tfRGB8: begin
6208       ColorType := COLOR_RGB;
6209       PixSize   := 3;
6210       Alpha     := false;
6211     end;
6212     tfBGRA8, tfRGBA8: begin
6213       ColorType := COLOR_RGBALPHA;
6214       PixSize   := 3;
6215       Alpha     := true
6216     end;
6217   else
6218     raise EglBitmapUnsupportedFormat.Create(Format);
6219   end;
6220
6221   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6222   try
6223     // Copy ImageData
6224     pSource := Data;
6225     for Y := 0 to Height -1 do begin
6226       pDest := png.ScanLine[Y];
6227       for X := 0 to Width -1 do begin
6228         Move(pSource^, pDest^, PixSize);
6229         Inc(pDest, PixSize);
6230         Inc(pSource, PixSize);
6231         if Alpha then begin
6232           png.AlphaScanline[Y]^[X] := pSource^;
6233           Inc(pSource);
6234         end;
6235       end;
6236
6237       // convert RGB line to BGR
6238       if Format in [tfRGB8, tfRGBA8] then begin
6239         pTemp := png.ScanLine[Y];
6240         for X := 0 to Width -1 do begin
6241           Temp := pByteArray(pTemp)^[0];
6242           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6243           pByteArray(pTemp)^[2] := Temp;
6244           Inc(pTemp, 3);
6245         end;
6246       end;
6247     end;
6248
6249     // Save to Stream
6250     Png.CompressionLevel := 6;
6251     Png.SaveToStream(aStream);
6252   finally
6253     FreeAndNil(Png);
6254   end;
6255 end;
6256 {$IFEND}
6257 {$ENDIF}
6258
6259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6260 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6262 {$IFDEF GLB_LIB_JPEG}
6263 type
6264   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6265   glBitmap_libJPEG_source_mgr = record
6266     pub: jpeg_source_mgr;
6267
6268     SrcStream: TStream;
6269     SrcBuffer: array [1..4096] of byte;
6270   end;
6271
6272   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6273   glBitmap_libJPEG_dest_mgr = record
6274     pub: jpeg_destination_mgr;
6275
6276     DestStream: TStream;
6277     DestBuffer: array [1..4096] of byte;
6278   end;
6279
6280 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6281 begin
6282   //DUMMY
6283 end;
6284
6285
6286 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6287 begin
6288   //DUMMY
6289 end;
6290
6291
6292 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6293 begin
6294   //DUMMY
6295 end;
6296
6297 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6298 begin
6299   //DUMMY
6300 end;
6301
6302
6303 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6304 begin
6305   //DUMMY
6306 end;
6307
6308
6309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6310 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6311 var
6312   src: glBitmap_libJPEG_source_mgr_ptr;
6313   bytes: integer;
6314 begin
6315   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6316
6317   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6318         if (bytes <= 0) then begin
6319                 src^.SrcBuffer[1] := $FF;
6320                 src^.SrcBuffer[2] := JPEG_EOI;
6321                 bytes := 2;
6322         end;
6323
6324         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6325         src^.pub.bytes_in_buffer := bytes;
6326
6327   result := true;
6328 end;
6329
6330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6331 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6332 var
6333   src: glBitmap_libJPEG_source_mgr_ptr;
6334 begin
6335   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6336
6337   if num_bytes > 0 then begin
6338     // wanted byte isn't in buffer so set stream position and read buffer
6339     if num_bytes > src^.pub.bytes_in_buffer then begin
6340       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6341       src^.pub.fill_input_buffer(cinfo);
6342     end else begin
6343       // wanted byte is in buffer so only skip
6344                 inc(src^.pub.next_input_byte, num_bytes);
6345                 dec(src^.pub.bytes_in_buffer, num_bytes);
6346     end;
6347   end;
6348 end;
6349
6350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6351 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6352 var
6353   dest: glBitmap_libJPEG_dest_mgr_ptr;
6354 begin
6355   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6356
6357   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6358     // write complete buffer
6359     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6360
6361     // reset buffer
6362     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6363     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6364   end;
6365
6366   result := true;
6367 end;
6368
6369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6370 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6371 var
6372   Idx: Integer;
6373   dest: glBitmap_libJPEG_dest_mgr_ptr;
6374 begin
6375   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6376
6377   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6378     // check for endblock
6379     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6380       // write endblock
6381       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6382
6383       // leave
6384       break;
6385     end else
6386       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6387   end;
6388 end;
6389 {$ENDIF}
6390
6391 {$IFDEF GLB_SUPPORT_JPEG_READ}
6392 {$IF DEFINED(GLB_LAZ_JPEG)}
6393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6394 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6395 const
6396   MAGIC_LEN = 2;
6397   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6398 var
6399   intf: TLazIntfImage;
6400   reader: TFPReaderJPEG;
6401   StreamPos: Int64;
6402   magic: String[MAGIC_LEN];
6403 begin
6404   result := true;
6405   StreamPos := aStream.Position;
6406
6407   SetLength(magic, MAGIC_LEN);
6408   aStream.Read(magic[1], MAGIC_LEN);
6409   aStream.Position := StreamPos;
6410   if (magic <> JPEG_MAGIC) then begin
6411     result := false;
6412     exit;
6413   end;
6414
6415   reader := TFPReaderJPEG.Create;
6416   intf := TLazIntfImage.Create(0, 0);
6417   try try
6418     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6419     reader.ImageRead(aStream, intf);
6420     AssignFromLazIntfImage(intf);
6421   except
6422     result := false;
6423     aStream.Position := StreamPos;
6424     exit;
6425   end;
6426   finally
6427     reader.Free;
6428     intf.Free;
6429   end;
6430 end;
6431
6432 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6434 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6435 var
6436   Surface: PSDL_Surface;
6437   RWops: PSDL_RWops;
6438 begin
6439   result := false;
6440
6441   RWops := glBitmapCreateRWops(aStream);
6442   try
6443     if IMG_isJPG(RWops) > 0 then begin
6444       Surface := IMG_LoadJPG_RW(RWops);
6445       try
6446         AssignFromSurface(Surface);
6447         result := true;
6448       finally
6449         SDL_FreeSurface(Surface);
6450       end;
6451     end;
6452   finally
6453     SDL_FreeRW(RWops);
6454   end;
6455 end;
6456
6457 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6459 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6460 var
6461   StreamPos: Int64;
6462   Temp: array[0..1]of Byte;
6463
6464   jpeg: jpeg_decompress_struct;
6465   jpeg_err: jpeg_error_mgr;
6466
6467   IntFormat: TglBitmapFormat;
6468   pImage: pByte;
6469   TempHeight, TempWidth: Integer;
6470
6471   pTemp: pByte;
6472   Row: Integer;
6473
6474   FormatDesc: TFormatDescriptor;
6475 begin
6476   result := false;
6477
6478   if not init_libJPEG then
6479     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6480
6481   try
6482     // reading first two bytes to test file and set cursor back to begin
6483     StreamPos := aStream.Position;
6484     aStream.Read({%H-}Temp[0], 2);
6485     aStream.Position := StreamPos;
6486
6487     // if Bitmap then read file.
6488     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6489       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6490       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6491
6492       // error managment
6493       jpeg.err := jpeg_std_error(@jpeg_err);
6494       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6495       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6496
6497       // decompression struct
6498       jpeg_create_decompress(@jpeg);
6499
6500       // allocation space for streaming methods
6501       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6502
6503       // seeting up custom functions
6504       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6505         pub.init_source       := glBitmap_libJPEG_init_source;
6506         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6507         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6508         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6509         pub.term_source       := glBitmap_libJPEG_term_source;
6510
6511         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6512         pub.next_input_byte := nil;   // until buffer loaded
6513
6514         SrcStream := aStream;
6515       end;
6516
6517       // set global decoding state
6518       jpeg.global_state := DSTATE_START;
6519
6520       // read header of jpeg
6521       jpeg_read_header(@jpeg, false);
6522
6523       // setting output parameter
6524       case jpeg.jpeg_color_space of
6525         JCS_GRAYSCALE:
6526           begin
6527             jpeg.out_color_space := JCS_GRAYSCALE;
6528             IntFormat := tfLuminance8;
6529           end;
6530         else
6531           jpeg.out_color_space := JCS_RGB;
6532           IntFormat := tfRGB8;
6533       end;
6534
6535       // reading image
6536       jpeg_start_decompress(@jpeg);
6537
6538       TempHeight := jpeg.output_height;
6539       TempWidth := jpeg.output_width;
6540
6541       FormatDesc := TFormatDescriptor.Get(IntFormat);
6542
6543       // creating new image
6544       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6545       try
6546         pTemp := pImage;
6547
6548         for Row := 0 to TempHeight -1 do begin
6549           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6550           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6551         end;
6552
6553         // finish decompression
6554         jpeg_finish_decompress(@jpeg);
6555
6556         // destroy decompression
6557         jpeg_destroy_decompress(@jpeg);
6558
6559         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6560
6561         result := true;
6562       except
6563         if Assigned(pImage) then
6564           FreeMem(pImage);
6565         raise;
6566       end;
6567     end;
6568   finally
6569     quit_libJPEG;
6570   end;
6571 end;
6572
6573 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6575 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6576 var
6577   bmp: TBitmap;
6578   jpg: TJPEGImage;
6579   StreamPos: Int64;
6580   Temp: array[0..1]of Byte;
6581 begin
6582   result := false;
6583
6584   // reading first two bytes to test file and set cursor back to begin
6585   StreamPos := aStream.Position;
6586   aStream.Read(Temp[0], 2);
6587   aStream.Position := StreamPos;
6588
6589   // if Bitmap then read file.
6590   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6591     bmp := TBitmap.Create;
6592     try
6593       jpg := TJPEGImage.Create;
6594       try
6595         jpg.LoadFromStream(aStream);
6596         bmp.Assign(jpg);
6597         result := AssignFromBitmap(bmp);
6598       finally
6599         jpg.Free;
6600       end;
6601     finally
6602       bmp.Free;
6603     end;
6604   end;
6605 end;
6606 {$IFEND}
6607 {$ENDIF}
6608
6609 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6610 {$IF DEFINED(GLB_LAZ_JPEG)}
6611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6612 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6613 var
6614   jpeg: TJPEGImage;
6615   intf: TLazIntfImage;
6616   raw: TRawImage;
6617 begin
6618   jpeg := TJPEGImage.Create;
6619   intf := TLazIntfImage.Create(0, 0);
6620   try
6621     if not AssignToLazIntfImage(intf) then
6622       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6623     intf.GetRawImage(raw);
6624     jpeg.LoadFromRawImage(raw, false);
6625     jpeg.SaveToStream(aStream);
6626   finally
6627     intf.Free;
6628     jpeg.Free;
6629   end;
6630 end;
6631
6632 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6634 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6635 var
6636   jpeg: jpeg_compress_struct;
6637   jpeg_err: jpeg_error_mgr;
6638   Row: Integer;
6639   pTemp, pTemp2: pByte;
6640
6641   procedure CopyRow(pDest, pSource: pByte);
6642   var
6643     X: Integer;
6644   begin
6645     for X := 0 to Width - 1 do begin
6646       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6647       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6648       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6649       Inc(pDest, 3);
6650       Inc(pSource, 3);
6651     end;
6652   end;
6653
6654 begin
6655   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6656     raise EglBitmapUnsupportedFormat.Create(Format);
6657
6658   if not init_libJPEG then
6659     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6660
6661   try
6662     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6663     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6664
6665     // error managment
6666     jpeg.err := jpeg_std_error(@jpeg_err);
6667     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6668     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6669
6670     // compression struct
6671     jpeg_create_compress(@jpeg);
6672
6673     // allocation space for streaming methods
6674     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6675
6676     // seeting up custom functions
6677     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6678       pub.init_destination    := glBitmap_libJPEG_init_destination;
6679       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6680       pub.term_destination    := glBitmap_libJPEG_term_destination;
6681
6682       pub.next_output_byte  := @DestBuffer[1];
6683       pub.free_in_buffer    := Length(DestBuffer);
6684
6685       DestStream := aStream;
6686     end;
6687
6688     // very important state
6689     jpeg.global_state := CSTATE_START;
6690     jpeg.image_width  := Width;
6691     jpeg.image_height := Height;
6692     case Format of
6693       tfAlpha8, tfLuminance8: begin
6694         jpeg.input_components := 1;
6695         jpeg.in_color_space   := JCS_GRAYSCALE;
6696       end;
6697       tfRGB8, tfBGR8: begin
6698         jpeg.input_components := 3;
6699         jpeg.in_color_space   := JCS_RGB;
6700       end;
6701     end;
6702
6703     jpeg_set_defaults(@jpeg);
6704     jpeg_set_quality(@jpeg, 95, true);
6705     jpeg_start_compress(@jpeg, true);
6706     pTemp := Data;
6707
6708     if Format = tfBGR8 then
6709       GetMem(pTemp2, fRowSize)
6710     else
6711       pTemp2 := pTemp;
6712
6713     try
6714       for Row := 0 to jpeg.image_height -1 do begin
6715         // prepare row
6716         if Format = tfBGR8 then
6717           CopyRow(pTemp2, pTemp)
6718         else
6719           pTemp2 := pTemp;
6720
6721         // write row
6722         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6723         inc(pTemp, fRowSize);
6724       end;
6725     finally
6726       // free memory
6727       if Format = tfBGR8 then
6728         FreeMem(pTemp2);
6729     end;
6730     jpeg_finish_compress(@jpeg);
6731     jpeg_destroy_compress(@jpeg);
6732   finally
6733     quit_libJPEG;
6734   end;
6735 end;
6736
6737 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6739 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6740 var
6741   Bmp: TBitmap;
6742   Jpg: TJPEGImage;
6743 begin
6744   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6745     raise EglBitmapUnsupportedFormat.Create(Format);
6746
6747   Bmp := TBitmap.Create;
6748   try
6749     Jpg := TJPEGImage.Create;
6750     try
6751       AssignToBitmap(Bmp);
6752       if (Format in [tfAlpha8, tfLuminance8]) then begin
6753         Jpg.Grayscale   := true;
6754         Jpg.PixelFormat := jf8Bit;
6755       end;
6756       Jpg.Assign(Bmp);
6757       Jpg.SaveToStream(aStream);
6758     finally
6759       FreeAndNil(Jpg);
6760     end;
6761   finally
6762     FreeAndNil(Bmp);
6763   end;
6764 end;
6765 {$IFEND}
6766 {$ENDIF}
6767
6768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6769 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6771 const
6772   BMP_MAGIC          = $4D42;
6773
6774   BMP_COMP_RGB       = 0;
6775   BMP_COMP_RLE8      = 1;
6776   BMP_COMP_RLE4      = 2;
6777   BMP_COMP_BITFIELDS = 3;
6778
6779 type
6780   TBMPHeader = packed record
6781     bfType: Word;
6782     bfSize: Cardinal;
6783     bfReserved1: Word;
6784     bfReserved2: Word;
6785     bfOffBits: Cardinal;
6786   end;
6787
6788   TBMPInfo = packed record
6789     biSize: Cardinal;
6790     biWidth: Longint;
6791     biHeight: Longint;
6792     biPlanes: Word;
6793     biBitCount: Word;
6794     biCompression: Cardinal;
6795     biSizeImage: Cardinal;
6796     biXPelsPerMeter: Longint;
6797     biYPelsPerMeter: Longint;
6798     biClrUsed: Cardinal;
6799     biClrImportant: Cardinal;
6800   end;
6801
6802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6803 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6804
6805   //////////////////////////////////////////////////////////////////////////////////////////////////
6806   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6807   begin
6808     result := tfEmpty;
6809     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6810     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6811
6812     //Read Compression
6813     case aInfo.biCompression of
6814       BMP_COMP_RLE4,
6815       BMP_COMP_RLE8: begin
6816         raise EglBitmap.Create('RLE compression is not supported');
6817       end;
6818       BMP_COMP_BITFIELDS: begin
6819         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6820           aStream.Read(aMask.r, SizeOf(aMask.r));
6821           aStream.Read(aMask.g, SizeOf(aMask.g));
6822           aStream.Read(aMask.b, SizeOf(aMask.b));
6823           aStream.Read(aMask.a, SizeOf(aMask.a));
6824         end else
6825           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6826       end;
6827     end;
6828
6829     //get suitable format
6830     case aInfo.biBitCount of
6831        8: result := tfLuminance8;
6832       16: result := tfBGR5;
6833       24: result := tfBGR8;
6834       32: result := tfBGRA8;
6835     end;
6836   end;
6837
6838   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6839   var
6840     i, c: Integer;
6841     ColorTable: TbmpColorTable;
6842   begin
6843     result := nil;
6844     if (aInfo.biBitCount >= 16) then
6845       exit;
6846     aFormat := tfLuminance8;
6847     c := aInfo.biClrUsed;
6848     if (c = 0) then
6849       c := 1 shl aInfo.biBitCount;
6850     SetLength(ColorTable, c);
6851     for i := 0 to c-1 do begin
6852       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6853       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6854         aFormat := tfRGB8;
6855     end;
6856
6857     result := TbmpColorTableFormat.Create;
6858     result.PixelSize  := aInfo.biBitCount / 8;
6859     result.ColorTable := ColorTable;
6860     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6861   end;
6862
6863   //////////////////////////////////////////////////////////////////////////////////////////////////
6864   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6865     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6866   var
6867     TmpFormat: TglBitmapFormat;
6868     FormatDesc: TFormatDescriptor;
6869   begin
6870     result := nil;
6871     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6872       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6873         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6874         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6875           aFormat := FormatDesc.Format;
6876           exit;
6877         end;
6878       end;
6879
6880       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6881         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6882       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6883         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6884
6885       result := TbmpBitfieldFormat.Create;
6886       result.PixelSize := aInfo.biBitCount / 8;
6887       result.RedMask   := aMask.r;
6888       result.GreenMask := aMask.g;
6889       result.BlueMask  := aMask.b;
6890       result.AlphaMask := aMask.a;
6891     end;
6892   end;
6893
6894 var
6895   //simple types
6896   StartPos: Int64;
6897   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6898   PaddingBuff: Cardinal;
6899   LineBuf, ImageData, TmpData: PByte;
6900   SourceMD, DestMD: Pointer;
6901   BmpFormat: TglBitmapFormat;
6902
6903   //records
6904   Mask: TglBitmapColorRec;
6905   Header: TBMPHeader;
6906   Info: TBMPInfo;
6907
6908   //classes
6909   SpecialFormat: TFormatDescriptor;
6910   FormatDesc: TFormatDescriptor;
6911
6912   //////////////////////////////////////////////////////////////////////////////////////////////////
6913   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6914   var
6915     i: Integer;
6916     Pixel: TglBitmapPixelData;
6917   begin
6918     aStream.Read(aLineBuf^, rbLineSize);
6919     SpecialFormat.PreparePixel(Pixel);
6920     for i := 0 to Info.biWidth-1 do begin
6921       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6922       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6923       FormatDesc.Map(Pixel, aData, DestMD);
6924     end;
6925   end;
6926
6927 begin
6928   result        := false;
6929   BmpFormat     := tfEmpty;
6930   SpecialFormat := nil;
6931   LineBuf       := nil;
6932   SourceMD      := nil;
6933   DestMD        := nil;
6934
6935   // Header
6936   StartPos := aStream.Position;
6937   aStream.Read(Header{%H-}, SizeOf(Header));
6938
6939   if Header.bfType = BMP_MAGIC then begin
6940     try try
6941       BmpFormat        := ReadInfo(Info, Mask);
6942       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6943       if not Assigned(SpecialFormat) then
6944         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6945       aStream.Position := StartPos + Header.bfOffBits;
6946
6947       if (BmpFormat <> tfEmpty) then begin
6948         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6949         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6950         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6951         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6952
6953         //get Memory
6954         DestMD    := FormatDesc.CreateMappingData;
6955         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6956         GetMem(ImageData, ImageSize);
6957         if Assigned(SpecialFormat) then begin
6958           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6959           SourceMD := SpecialFormat.CreateMappingData;
6960         end;
6961
6962         //read Data
6963         try try
6964           FillChar(ImageData^, ImageSize, $FF);
6965           TmpData := ImageData;
6966           if (Info.biHeight > 0) then
6967             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6968           for i := 0 to Abs(Info.biHeight)-1 do begin
6969             if Assigned(SpecialFormat) then
6970               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6971             else
6972               aStream.Read(TmpData^, wbLineSize);   //else only read data
6973             if (Info.biHeight > 0) then
6974               dec(TmpData, wbLineSize)
6975             else
6976               inc(TmpData, wbLineSize);
6977             aStream.Read(PaddingBuff{%H-}, Padding);
6978           end;
6979           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6980           result := true;
6981         finally
6982           if Assigned(LineBuf) then
6983             FreeMem(LineBuf);
6984           if Assigned(SourceMD) then
6985             SpecialFormat.FreeMappingData(SourceMD);
6986           FormatDesc.FreeMappingData(DestMD);
6987         end;
6988         except
6989           if Assigned(ImageData) then
6990             FreeMem(ImageData);
6991           raise;
6992         end;
6993       end else
6994         raise EglBitmap.Create('LoadBMP - No suitable format found');
6995     except
6996       aStream.Position := StartPos;
6997       raise;
6998     end;
6999     finally
7000       FreeAndNil(SpecialFormat);
7001     end;
7002   end
7003     else aStream.Position := StartPos;
7004 end;
7005
7006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7007 procedure TglBitmap.SaveBMP(const aStream: TStream);
7008 var
7009   Header: TBMPHeader;
7010   Info: TBMPInfo;
7011   Converter: TFormatDescriptor;
7012   FormatDesc: TFormatDescriptor;
7013   SourceFD, DestFD: Pointer;
7014   pData, srcData, dstData, ConvertBuffer: pByte;
7015
7016   Pixel: TglBitmapPixelData;
7017   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7018   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7019
7020   PaddingBuff: Cardinal;
7021
7022   function GetLineWidth : Integer;
7023   begin
7024     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7025   end;
7026
7027 begin
7028   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7029     raise EglBitmapUnsupportedFormat.Create(Format);
7030
7031   Converter  := nil;
7032   FormatDesc := TFormatDescriptor.Get(Format);
7033   ImageSize  := FormatDesc.GetSize(Dimension);
7034
7035   FillChar(Header{%H-}, SizeOf(Header), 0);
7036   Header.bfType      := BMP_MAGIC;
7037   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7038   Header.bfReserved1 := 0;
7039   Header.bfReserved2 := 0;
7040   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7041
7042   FillChar(Info{%H-}, SizeOf(Info), 0);
7043   Info.biSize        := SizeOf(Info);
7044   Info.biWidth       := Width;
7045   Info.biHeight      := Height;
7046   Info.biPlanes      := 1;
7047   Info.biCompression := BMP_COMP_RGB;
7048   Info.biSizeImage   := ImageSize;
7049
7050   try
7051     case Format of
7052       tfLuminance4: begin
7053         Info.biBitCount  := 4;
7054         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7055         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7056         Converter := TbmpColorTableFormat.Create;
7057         with (Converter as TbmpColorTableFormat) do begin
7058           PixelSize := 0.5;
7059           Format    := Format;
7060           Range     := glBitmapColorRec($F, $F, $F, $0);
7061           CreateColorTable;
7062         end;
7063       end;
7064
7065       tfR3G3B2, tfLuminance8: begin
7066         Info.biBitCount  :=  8;
7067         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7068         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7069         Converter := TbmpColorTableFormat.Create;
7070         with (Converter as TbmpColorTableFormat) do begin
7071           PixelSize := 1;
7072           Format    := Format;
7073           if (Format = tfR3G3B2) then begin
7074             Range := glBitmapColorRec($7, $7, $3, $0);
7075             Shift := glBitmapShiftRec(0, 3, 6, 0);
7076           end else
7077             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7078           CreateColorTable;
7079         end;
7080       end;
7081
7082       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7083       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7084         Info.biBitCount    := 16;
7085         Info.biCompression := BMP_COMP_BITFIELDS;
7086       end;
7087
7088       tfBGR8, tfRGB8: begin
7089         Info.biBitCount := 24;
7090         if (Format = tfRGB8) then
7091           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7092       end;
7093
7094       tfRGB10, tfRGB10A2, tfRGBA8,
7095       tfBGR10, tfBGR10A2, tfBGRA8: begin
7096         Info.biBitCount    := 32;
7097         Info.biCompression := BMP_COMP_BITFIELDS;
7098       end;
7099     else
7100       raise EglBitmapUnsupportedFormat.Create(Format);
7101     end;
7102     Info.biXPelsPerMeter := 2835;
7103     Info.biYPelsPerMeter := 2835;
7104
7105     // prepare bitmasks
7106     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7107       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7108       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7109
7110       RedMask    := FormatDesc.RedMask;
7111       GreenMask  := FormatDesc.GreenMask;
7112       BlueMask   := FormatDesc.BlueMask;
7113       AlphaMask  := FormatDesc.AlphaMask;
7114     end;
7115
7116     // headers
7117     aStream.Write(Header, SizeOf(Header));
7118     aStream.Write(Info, SizeOf(Info));
7119
7120     // colortable
7121     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7122       with (Converter as TbmpColorTableFormat) do
7123         aStream.Write(ColorTable[0].b,
7124           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7125
7126     // bitmasks
7127     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7128       aStream.Write(RedMask,   SizeOf(Cardinal));
7129       aStream.Write(GreenMask, SizeOf(Cardinal));
7130       aStream.Write(BlueMask,  SizeOf(Cardinal));
7131       aStream.Write(AlphaMask, SizeOf(Cardinal));
7132     end;
7133
7134     // image data
7135     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7136     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7137     Padding     := GetLineWidth - wbLineSize;
7138     PaddingBuff := 0;
7139
7140     pData := Data;
7141     inc(pData, (Height-1) * rbLineSize);
7142
7143     // prepare row buffer. But only for RGB because RGBA supports color masks
7144     // so it's possible to change color within the image.
7145     if Assigned(Converter) then begin
7146       FormatDesc.PreparePixel(Pixel);
7147       GetMem(ConvertBuffer, wbLineSize);
7148       SourceFD := FormatDesc.CreateMappingData;
7149       DestFD   := Converter.CreateMappingData;
7150     end else
7151       ConvertBuffer := nil;
7152
7153     try
7154       for LineIdx := 0 to Height - 1 do begin
7155         // preparing row
7156         if Assigned(Converter) then begin
7157           srcData := pData;
7158           dstData := ConvertBuffer;
7159           for PixelIdx := 0 to Info.biWidth-1 do begin
7160             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7161             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7162             Converter.Map(Pixel, dstData, DestFD);
7163           end;
7164           aStream.Write(ConvertBuffer^, wbLineSize);
7165         end else begin
7166           aStream.Write(pData^, rbLineSize);
7167         end;
7168         dec(pData, rbLineSize);
7169         if (Padding > 0) then
7170           aStream.Write(PaddingBuff, Padding);
7171       end;
7172     finally
7173       // destroy row buffer
7174       if Assigned(ConvertBuffer) then begin
7175         FormatDesc.FreeMappingData(SourceFD);
7176         Converter.FreeMappingData(DestFD);
7177         FreeMem(ConvertBuffer);
7178       end;
7179     end;
7180   finally
7181     if Assigned(Converter) then
7182       Converter.Free;
7183   end;
7184 end;
7185
7186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7187 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7189 type
7190   TTGAHeader = packed record
7191     ImageID: Byte;
7192     ColorMapType: Byte;
7193     ImageType: Byte;
7194     //ColorMapSpec: Array[0..4] of Byte;
7195     ColorMapStart: Word;
7196     ColorMapLength: Word;
7197     ColorMapEntrySize: Byte;
7198     OrigX: Word;
7199     OrigY: Word;
7200     Width: Word;
7201     Height: Word;
7202     Bpp: Byte;
7203     ImageDesc: Byte;
7204   end;
7205
7206 const
7207   TGA_UNCOMPRESSED_RGB  =  2;
7208   TGA_UNCOMPRESSED_GRAY =  3;
7209   TGA_COMPRESSED_RGB    = 10;
7210   TGA_COMPRESSED_GRAY   = 11;
7211
7212   TGA_NONE_COLOR_TABLE  = 0;
7213
7214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7215 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7216 var
7217   Header: TTGAHeader;
7218   ImageData: System.PByte;
7219   StartPosition: Int64;
7220   PixelSize, LineSize: Integer;
7221   tgaFormat: TglBitmapFormat;
7222   FormatDesc: TFormatDescriptor;
7223   Counter: packed record
7224     X, Y: packed record
7225       low, high, dir: Integer;
7226     end;
7227   end;
7228
7229 const
7230   CACHE_SIZE = $4000;
7231
7232   ////////////////////////////////////////////////////////////////////////////////////////
7233   procedure ReadUncompressed;
7234   var
7235     i, j: Integer;
7236     buf, tmp1, tmp2: System.PByte;
7237   begin
7238     buf := nil;
7239     if (Counter.X.dir < 0) then
7240       GetMem(buf, LineSize);
7241     try
7242       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7243         tmp1 := ImageData;
7244         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7245         if (Counter.X.dir < 0) then begin               //flip X
7246           aStream.Read(buf^, LineSize);
7247           tmp2 := buf;
7248           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7249           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7250             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7251               tmp1^ := tmp2^;
7252               inc(tmp1);
7253               inc(tmp2);
7254             end;
7255             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7256           end;
7257         end else
7258           aStream.Read(tmp1^, LineSize);
7259         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7260       end;
7261     finally
7262       if Assigned(buf) then
7263         FreeMem(buf);
7264     end;
7265   end;
7266
7267   ////////////////////////////////////////////////////////////////////////////////////////
7268   procedure ReadCompressed;
7269
7270     /////////////////////////////////////////////////////////////////
7271     var
7272       TmpData: System.PByte;
7273       LinePixelsRead: Integer;
7274     procedure CheckLine;
7275     begin
7276       if (LinePixelsRead >= Header.Width) then begin
7277         LinePixelsRead := 0;
7278         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7279         TmpData := ImageData;
7280         inc(TmpData, Counter.Y.low * LineSize);           //set line
7281         if (Counter.X.dir < 0) then                       //if x flipped then
7282           inc(TmpData, LineSize - PixelSize);             //set last pixel
7283       end;
7284     end;
7285
7286     /////////////////////////////////////////////////////////////////
7287     var
7288       Cache: PByte;
7289       CacheSize, CachePos: Integer;
7290     procedure CachedRead(out Buffer; Count: Integer);
7291     var
7292       BytesRead: Integer;
7293     begin
7294       if (CachePos + Count > CacheSize) then begin
7295         //if buffer overflow save non read bytes
7296         BytesRead := 0;
7297         if (CacheSize - CachePos > 0) then begin
7298           BytesRead := CacheSize - CachePos;
7299           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7300           inc(CachePos, BytesRead);
7301         end;
7302
7303         //load cache from file
7304         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7305         aStream.Read(Cache^, CacheSize);
7306         CachePos := 0;
7307
7308         //read rest of requested bytes
7309         if (Count - BytesRead > 0) then begin
7310           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7311           inc(CachePos, Count - BytesRead);
7312         end;
7313       end else begin
7314         //if no buffer overflow just read the data
7315         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7316         inc(CachePos, Count);
7317       end;
7318     end;
7319
7320     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7321     begin
7322       case PixelSize of
7323         1: begin
7324           aBuffer^ := aData^;
7325           inc(aBuffer, Counter.X.dir);
7326         end;
7327         2: begin
7328           PWord(aBuffer)^ := PWord(aData)^;
7329           inc(aBuffer, 2 * Counter.X.dir);
7330         end;
7331         3: begin
7332           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7333           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7334           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7335           inc(aBuffer, 3 * Counter.X.dir);
7336         end;
7337         4: begin
7338           PCardinal(aBuffer)^ := PCardinal(aData)^;
7339           inc(aBuffer, 4 * Counter.X.dir);
7340         end;
7341       end;
7342     end;
7343
7344   var
7345     TotalPixelsToRead, TotalPixelsRead: Integer;
7346     Temp: Byte;
7347     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7348     PixelRepeat: Boolean;
7349     PixelsToRead, PixelCount: Integer;
7350   begin
7351     CacheSize := 0;
7352     CachePos  := 0;
7353
7354     TotalPixelsToRead := Header.Width * Header.Height;
7355     TotalPixelsRead   := 0;
7356     LinePixelsRead    := 0;
7357
7358     GetMem(Cache, CACHE_SIZE);
7359     try
7360       TmpData := ImageData;
7361       inc(TmpData, Counter.Y.low * LineSize);           //set line
7362       if (Counter.X.dir < 0) then                       //if x flipped then
7363         inc(TmpData, LineSize - PixelSize);             //set last pixel
7364
7365       repeat
7366         //read CommandByte
7367         CachedRead(Temp, 1);
7368         PixelRepeat  := (Temp and $80) > 0;
7369         PixelsToRead := (Temp and $7F) + 1;
7370         inc(TotalPixelsRead, PixelsToRead);
7371
7372         if PixelRepeat then
7373           CachedRead(buf[0], PixelSize);
7374         while (PixelsToRead > 0) do begin
7375           CheckLine;
7376           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7377           while (PixelCount > 0) do begin
7378             if not PixelRepeat then
7379               CachedRead(buf[0], PixelSize);
7380             PixelToBuffer(@buf[0], TmpData);
7381             inc(LinePixelsRead);
7382             dec(PixelsToRead);
7383             dec(PixelCount);
7384           end;
7385         end;
7386       until (TotalPixelsRead >= TotalPixelsToRead);
7387     finally
7388       FreeMem(Cache);
7389     end;
7390   end;
7391
7392   function IsGrayFormat: Boolean;
7393   begin
7394     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7395   end;
7396
7397 begin
7398   result := false;
7399
7400   // reading header to test file and set cursor back to begin
7401   StartPosition := aStream.Position;
7402   aStream.Read(Header{%H-}, SizeOf(Header));
7403
7404   // no colormapped files
7405   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7406     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7407   begin
7408     try
7409       if Header.ImageID <> 0 then       // skip image ID
7410         aStream.Position := aStream.Position + Header.ImageID;
7411
7412       tgaFormat := tfEmpty;
7413       case Header.Bpp of
7414          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7415                0: tgaFormat := tfLuminance8;
7416                8: tgaFormat := tfAlpha8;
7417             end;
7418
7419         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7420                0: tgaFormat := tfLuminance16;
7421                8: tgaFormat := tfLuminance8Alpha8;
7422             end else case (Header.ImageDesc and $F) of
7423                0: tgaFormat := tfBGR5;
7424                1: tgaFormat := tfBGR5A1;
7425                4: tgaFormat := tfBGRA4;
7426             end;
7427
7428         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7429                0: tgaFormat := tfBGR8;
7430             end;
7431
7432         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7433                2: tgaFormat := tfBGR10A2;
7434                8: tgaFormat := tfBGRA8;
7435             end;
7436       end;
7437
7438       if (tgaFormat = tfEmpty) then
7439         raise EglBitmap.Create('LoadTga - unsupported format');
7440
7441       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7442       PixelSize  := FormatDesc.GetSize(1, 1);
7443       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7444
7445       GetMem(ImageData, LineSize * Header.Height);
7446       try
7447         //column direction
7448         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7449           Counter.X.low  := Header.Height-1;;
7450           Counter.X.high := 0;
7451           Counter.X.dir  := -1;
7452         end else begin
7453           Counter.X.low  := 0;
7454           Counter.X.high := Header.Height-1;
7455           Counter.X.dir  := 1;
7456         end;
7457
7458         // Row direction
7459         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7460           Counter.Y.low  := 0;
7461           Counter.Y.high := Header.Height-1;
7462           Counter.Y.dir  := 1;
7463         end else begin
7464           Counter.Y.low  := Header.Height-1;;
7465           Counter.Y.high := 0;
7466           Counter.Y.dir  := -1;
7467         end;
7468
7469         // Read Image
7470         case Header.ImageType of
7471           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7472             ReadUncompressed;
7473           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7474             ReadCompressed;
7475         end;
7476
7477         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7478         result := true;
7479       except
7480         if Assigned(ImageData) then
7481           FreeMem(ImageData);
7482         raise;
7483       end;
7484     finally
7485       aStream.Position := StartPosition;
7486     end;
7487   end
7488     else aStream.Position := StartPosition;
7489 end;
7490
7491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7492 procedure TglBitmap.SaveTGA(const aStream: TStream);
7493 var
7494   Header: TTGAHeader;
7495   LineSize, Size, x, y: Integer;
7496   Pixel: TglBitmapPixelData;
7497   LineBuf, SourceData, DestData: PByte;
7498   SourceMD, DestMD: Pointer;
7499   FormatDesc: TFormatDescriptor;
7500   Converter: TFormatDescriptor;
7501 begin
7502   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7503     raise EglBitmapUnsupportedFormat.Create(Format);
7504
7505   //prepare header
7506   FillChar(Header{%H-}, SizeOf(Header), 0);
7507
7508   //set ImageType
7509   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7510                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7511     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7512   else
7513     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7514
7515   //set BitsPerPixel
7516   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7517     Header.Bpp := 8
7518   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7519                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7520     Header.Bpp := 16
7521   else if (Format in [tfBGR8, tfRGB8]) then
7522     Header.Bpp := 24
7523   else
7524     Header.Bpp := 32;
7525
7526   //set AlphaBitCount
7527   case Format of
7528     tfRGB5A1, tfBGR5A1:
7529       Header.ImageDesc := 1 and $F;
7530     tfRGB10A2, tfBGR10A2:
7531       Header.ImageDesc := 2 and $F;
7532     tfRGBA4, tfBGRA4:
7533       Header.ImageDesc := 4 and $F;
7534     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7535       Header.ImageDesc := 8 and $F;
7536   end;
7537
7538   Header.Width     := Width;
7539   Header.Height    := Height;
7540   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7541   aStream.Write(Header, SizeOf(Header));
7542
7543   // convert RGB(A) to BGR(A)
7544   Converter  := nil;
7545   FormatDesc := TFormatDescriptor.Get(Format);
7546   Size       := FormatDesc.GetSize(Dimension);
7547   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7548     if (FormatDesc.RGBInverted = tfEmpty) then
7549       raise EglBitmap.Create('inverted RGB format is empty');
7550     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7551     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7552        (Converter.PixelSize <> FormatDesc.PixelSize) then
7553       raise EglBitmap.Create('invalid inverted RGB format');
7554   end;
7555
7556   if Assigned(Converter) then begin
7557     LineSize := FormatDesc.GetSize(Width, 1);
7558     GetMem(LineBuf, LineSize);
7559     SourceMD := FormatDesc.CreateMappingData;
7560     DestMD   := Converter.CreateMappingData;
7561     try
7562       SourceData := Data;
7563       for y := 0 to Height-1 do begin
7564         DestData := LineBuf;
7565         for x := 0 to Width-1 do begin
7566           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7567           Converter.Map(Pixel, DestData, DestMD);
7568         end;
7569         aStream.Write(LineBuf^, LineSize);
7570       end;
7571     finally
7572       FreeMem(LineBuf);
7573       FormatDesc.FreeMappingData(SourceMD);
7574       FormatDesc.FreeMappingData(DestMD);
7575     end;
7576   end else
7577     aStream.Write(Data^, Size);
7578 end;
7579
7580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7581 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7583 const
7584   DDS_MAGIC: Cardinal         = $20534444;
7585
7586   // DDS_header.dwFlags
7587   DDSD_CAPS                   = $00000001;
7588   DDSD_HEIGHT                 = $00000002;
7589   DDSD_WIDTH                  = $00000004;
7590   DDSD_PIXELFORMAT            = $00001000;
7591
7592   // DDS_header.sPixelFormat.dwFlags
7593   DDPF_ALPHAPIXELS            = $00000001;
7594   DDPF_ALPHA                  = $00000002;
7595   DDPF_FOURCC                 = $00000004;
7596   DDPF_RGB                    = $00000040;
7597   DDPF_LUMINANCE              = $00020000;
7598
7599   // DDS_header.sCaps.dwCaps1
7600   DDSCAPS_TEXTURE             = $00001000;
7601
7602   // DDS_header.sCaps.dwCaps2
7603   DDSCAPS2_CUBEMAP            = $00000200;
7604
7605   D3DFMT_DXT1                 = $31545844;
7606   D3DFMT_DXT3                 = $33545844;
7607   D3DFMT_DXT5                 = $35545844;
7608
7609 type
7610   TDDSPixelFormat = packed record
7611     dwSize: Cardinal;
7612     dwFlags: Cardinal;
7613     dwFourCC: Cardinal;
7614     dwRGBBitCount: Cardinal;
7615     dwRBitMask: Cardinal;
7616     dwGBitMask: Cardinal;
7617     dwBBitMask: Cardinal;
7618     dwABitMask: Cardinal;
7619   end;
7620
7621   TDDSCaps = packed record
7622     dwCaps1: Cardinal;
7623     dwCaps2: Cardinal;
7624     dwDDSX: Cardinal;
7625     dwReserved: Cardinal;
7626   end;
7627
7628   TDDSHeader = packed record
7629     dwSize: Cardinal;
7630     dwFlags: Cardinal;
7631     dwHeight: Cardinal;
7632     dwWidth: Cardinal;
7633     dwPitchOrLinearSize: Cardinal;
7634     dwDepth: Cardinal;
7635     dwMipMapCount: Cardinal;
7636     dwReserved: array[0..10] of Cardinal;
7637     PixelFormat: TDDSPixelFormat;
7638     Caps: TDDSCaps;
7639     dwReserved2: Cardinal;
7640   end;
7641
7642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7643 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7644 var
7645   Header: TDDSHeader;
7646   Converter: TbmpBitfieldFormat;
7647
7648   function GetDDSFormat: TglBitmapFormat;
7649   var
7650     fd: TFormatDescriptor;
7651     i: Integer;
7652     Range: TglBitmapColorRec;
7653     match: Boolean;
7654   begin
7655     result := tfEmpty;
7656     with Header.PixelFormat do begin
7657       // Compresses
7658       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7659         case Header.PixelFormat.dwFourCC of
7660           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7661           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7662           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7663         end;
7664       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7665
7666         //find matching format
7667         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7668           fd := TFormatDescriptor.Get(result);
7669           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7670              (8 * fd.PixelSize = dwRGBBitCount) then
7671             exit;
7672         end;
7673
7674         //find format with same Range
7675         Range.r := dwRBitMask;
7676         Range.g := dwGBitMask;
7677         Range.b := dwBBitMask;
7678         Range.a := dwABitMask;
7679         for i := 0 to 3 do begin
7680           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7681             Range.arr[i] := Range.arr[i] shr 1;
7682         end;
7683         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7684           fd := TFormatDescriptor.Get(result);
7685           match := true;
7686           for i := 0 to 3 do
7687             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7688               match := false;
7689               break;
7690             end;
7691           if match then
7692             break;
7693         end;
7694
7695         //no format with same range found -> use default
7696         if (result = tfEmpty) then begin
7697           if (dwABitMask > 0) then
7698             result := tfBGRA8
7699           else
7700             result := tfBGR8;
7701         end;
7702
7703         Converter := TbmpBitfieldFormat.Create;
7704         Converter.RedMask   := dwRBitMask;
7705         Converter.GreenMask := dwGBitMask;
7706         Converter.BlueMask  := dwBBitMask;
7707         Converter.AlphaMask := dwABitMask;
7708         Converter.PixelSize := dwRGBBitCount / 8;
7709       end;
7710     end;
7711   end;
7712
7713 var
7714   StreamPos: Int64;
7715   x, y, LineSize, RowSize, Magic: Cardinal;
7716   NewImage, TmpData, RowData, SrcData: System.PByte;
7717   SourceMD, DestMD: Pointer;
7718   Pixel: TglBitmapPixelData;
7719   ddsFormat: TglBitmapFormat;
7720   FormatDesc: TFormatDescriptor;
7721
7722 begin
7723   result    := false;
7724   Converter := nil;
7725   StreamPos := aStream.Position;
7726
7727   // Magic
7728   aStream.Read(Magic{%H-}, sizeof(Magic));
7729   if (Magic <> DDS_MAGIC) then begin
7730     aStream.Position := StreamPos;
7731     exit;
7732   end;
7733
7734   //Header
7735   aStream.Read(Header{%H-}, sizeof(Header));
7736   if (Header.dwSize <> SizeOf(Header)) or
7737      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7738         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7739   begin
7740     aStream.Position := StreamPos;
7741     exit;
7742   end;
7743
7744   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7745     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7746
7747   ddsFormat := GetDDSFormat;
7748   try
7749     if (ddsFormat = tfEmpty) then
7750       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7751
7752     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7753     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7754     GetMem(NewImage, Header.dwHeight * LineSize);
7755     try
7756       TmpData := NewImage;
7757
7758       //Converter needed
7759       if Assigned(Converter) then begin
7760         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7761         GetMem(RowData, RowSize);
7762         SourceMD := Converter.CreateMappingData;
7763         DestMD   := FormatDesc.CreateMappingData;
7764         try
7765           for y := 0 to Header.dwHeight-1 do begin
7766             TmpData := NewImage;
7767             inc(TmpData, y * LineSize);
7768             SrcData := RowData;
7769             aStream.Read(SrcData^, RowSize);
7770             for x := 0 to Header.dwWidth-1 do begin
7771               Converter.Unmap(SrcData, Pixel, SourceMD);
7772               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7773               FormatDesc.Map(Pixel, TmpData, DestMD);
7774             end;
7775           end;
7776         finally
7777           Converter.FreeMappingData(SourceMD);
7778           FormatDesc.FreeMappingData(DestMD);
7779           FreeMem(RowData);
7780         end;
7781       end else
7782
7783       // Compressed
7784       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7785         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7786         for Y := 0 to Header.dwHeight-1 do begin
7787           aStream.Read(TmpData^, RowSize);
7788           Inc(TmpData, LineSize);
7789         end;
7790       end else
7791
7792       // Uncompressed
7793       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7794         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7795         for Y := 0 to Header.dwHeight-1 do begin
7796           aStream.Read(TmpData^, RowSize);
7797           Inc(TmpData, LineSize);
7798         end;
7799       end else
7800         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7801
7802       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7803       result := true;
7804     except
7805       if Assigned(NewImage) then
7806         FreeMem(NewImage);
7807       raise;
7808     end;
7809   finally
7810     FreeAndNil(Converter);
7811   end;
7812 end;
7813
7814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7815 procedure TglBitmap.SaveDDS(const aStream: TStream);
7816 var
7817   Header: TDDSHeader;
7818   FormatDesc: TFormatDescriptor;
7819 begin
7820   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7821     raise EglBitmapUnsupportedFormat.Create(Format);
7822
7823   FormatDesc := TFormatDescriptor.Get(Format);
7824
7825   // Generell
7826   FillChar(Header{%H-}, SizeOf(Header), 0);
7827   Header.dwSize  := SizeOf(Header);
7828   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7829
7830   Header.dwWidth  := Max(1, Width);
7831   Header.dwHeight := Max(1, Height);
7832
7833   // Caps
7834   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7835
7836   // Pixelformat
7837   Header.PixelFormat.dwSize := sizeof(Header);
7838   if (FormatDesc.IsCompressed) then begin
7839     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7840     case Format of
7841       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7842       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7843       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7844     end;
7845   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7846     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7847     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7848     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7849   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7850     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7851     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7852     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7853     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7854   end else begin
7855     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7856     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7857     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7858     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7859     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7860     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7861   end;
7862
7863   if (FormatDesc.HasAlpha) then
7864     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7865
7866   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7867   aStream.Write(Header, SizeOf(Header));
7868   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7869 end;
7870
7871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7872 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7874 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7875   const aWidth: Integer; const aHeight: Integer);
7876 var
7877   pTemp: pByte;
7878   Size: Integer;
7879 begin
7880   if (aHeight > 1) then begin
7881     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7882     GetMem(pTemp, Size);
7883     try
7884       Move(aData^, pTemp^, Size);
7885       FreeMem(aData);
7886       aData := nil;
7887     except
7888       FreeMem(pTemp);
7889       raise;
7890     end;
7891   end else
7892     pTemp := aData;
7893   inherited SetDataPointer(pTemp, aFormat, aWidth);
7894 end;
7895
7896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7897 function TglBitmap1D.FlipHorz: Boolean;
7898 var
7899   Col: Integer;
7900   pTempDest, pDest, pSource: PByte;
7901 begin
7902   result := inherited FlipHorz;
7903   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7904     pSource := Data;
7905     GetMem(pDest, fRowSize);
7906     try
7907       pTempDest := pDest;
7908       Inc(pTempDest, fRowSize);
7909       for Col := 0 to Width-1 do begin
7910         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7911         Move(pSource^, pTempDest^, fPixelSize);
7912         Inc(pSource, fPixelSize);
7913       end;
7914       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7915       result := true;
7916     except
7917       if Assigned(pDest) then
7918         FreeMem(pDest);
7919       raise;
7920     end;
7921   end;
7922 end;
7923
7924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7925 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7926 var
7927   FormatDesc: TFormatDescriptor;
7928 begin
7929   // Upload data
7930   FormatDesc := TFormatDescriptor.Get(Format);
7931   if FormatDesc.IsCompressed then begin
7932     if not Assigned(glCompressedTexImage1D) then
7933       raise EglBitmap.Create('compressed formats not supported by video adapter');
7934     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7935   end else if aBuildWithGlu then
7936     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7937   else
7938     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7939
7940   // Free Data
7941   if (FreeDataAfterGenTexture) then
7942     FreeData;
7943 end;
7944
7945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7946 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7947 var
7948   BuildWithGlu, TexRec: Boolean;
7949   TexSize: Integer;
7950 begin
7951   if Assigned(Data) then begin
7952     // Check Texture Size
7953     if (aTestTextureSize) then begin
7954       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7955
7956       if (Width > TexSize) then
7957         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7958
7959       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7960                 (Target = GL_TEXTURE_RECTANGLE);
7961       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7962         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7963     end;
7964
7965     CreateId;
7966     SetupParameters(BuildWithGlu);
7967     UploadData(BuildWithGlu);
7968     glAreTexturesResident(1, @fID, @fIsResident);
7969   end;
7970 end;
7971
7972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7973 procedure TglBitmap1D.AfterConstruction;
7974 begin
7975   inherited;
7976   Target := GL_TEXTURE_1D;
7977 end;
7978
7979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7980 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7982 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7983 begin
7984   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7985     result := fLines[aIndex]
7986   else
7987     result := nil;
7988 end;
7989
7990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7991 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7992   const aWidth: Integer; const aHeight: Integer);
7993 var
7994   Idx, LineWidth: Integer;
7995 begin
7996   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7997
7998   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7999     // Assigning Data
8000     if Assigned(Data) then begin
8001       SetLength(fLines, GetHeight);
8002       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
8003
8004       for Idx := 0 to GetHeight-1 do begin
8005         fLines[Idx] := Data;
8006         Inc(fLines[Idx], Idx * LineWidth);
8007       end;
8008     end
8009       else SetLength(fLines, 0);
8010   end else begin
8011     SetLength(fLines, 0);
8012   end;
8013 end;
8014
8015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8016 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8017 var
8018   FormatDesc: TFormatDescriptor;
8019 begin
8020   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8021
8022   FormatDesc := TFormatDescriptor.Get(Format);
8023   if FormatDesc.IsCompressed then begin
8024     if not Assigned(glCompressedTexImage2D) then
8025       raise EglBitmap.Create('compressed formats not supported by video adapter');
8026     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8027   end else if aBuildWithGlu then begin
8028     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8029       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8030   end else begin
8031     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8032       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8033   end;
8034
8035   // Freigeben
8036   if (FreeDataAfterGenTexture) then
8037     FreeData;
8038 end;
8039
8040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8041 procedure TglBitmap2D.AfterConstruction;
8042 begin
8043   inherited;
8044   Target := GL_TEXTURE_2D;
8045 end;
8046
8047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8048 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8049 var
8050   Temp: pByte;
8051   Size, w, h: Integer;
8052   FormatDesc: TFormatDescriptor;
8053 begin
8054   FormatDesc := TFormatDescriptor.Get(aFormat);
8055   if FormatDesc.IsCompressed then
8056     raise EglBitmapUnsupportedFormat.Create(aFormat);
8057
8058   w    := aRight  - aLeft;
8059   h    := aBottom - aTop;
8060   Size := FormatDesc.GetSize(w, h);
8061   GetMem(Temp, Size);
8062   try
8063     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8064     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8065     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8066     FlipVert;
8067   except
8068     if Assigned(Temp) then
8069       FreeMem(Temp);
8070     raise;
8071   end;
8072 end;
8073
8074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8075 procedure TglBitmap2D.GetDataFromTexture;
8076 var
8077   Temp: PByte;
8078   TempWidth, TempHeight: Integer;
8079   TempIntFormat: GLint;
8080   IntFormat: TglBitmapFormat;
8081   FormatDesc: TFormatDescriptor;
8082 begin
8083   Bind;
8084
8085   // Request Data
8086   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8087   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8088   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8089
8090   IntFormat  := tfEmpty;
8091   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8092   IntFormat  := FormatDesc.Format;
8093
8094   // Getting data from OpenGL
8095   FormatDesc := TFormatDescriptor.Get(IntFormat);
8096   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8097   try
8098     if FormatDesc.IsCompressed then begin
8099       if not Assigned(glGetCompressedTexImage) then
8100         raise EglBitmap.Create('compressed formats not supported by video adapter');
8101       glGetCompressedTexImage(Target, 0, Temp)
8102     end else
8103       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8104     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8105   except
8106     if Assigned(Temp) then
8107       FreeMem(Temp);
8108     raise;
8109   end;
8110 end;
8111
8112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8113 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8114 var
8115   BuildWithGlu, PotTex, TexRec: Boolean;
8116   TexSize: Integer;
8117 begin
8118   if Assigned(Data) then begin
8119     // Check Texture Size
8120     if (aTestTextureSize) then begin
8121       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8122
8123       if ((Height > TexSize) or (Width > TexSize)) then
8124         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8125
8126       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8127       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8128       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8129         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8130     end;
8131
8132     CreateId;
8133     SetupParameters(BuildWithGlu);
8134     UploadData(Target, BuildWithGlu);
8135     glAreTexturesResident(1, @fID, @fIsResident);
8136   end;
8137 end;
8138
8139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8140 function TglBitmap2D.FlipHorz: Boolean;
8141 var
8142   Col, Row: Integer;
8143   TempDestData, DestData, SourceData: PByte;
8144   ImgSize: Integer;
8145 begin
8146   result := inherited FlipHorz;
8147   if Assigned(Data) then begin
8148     SourceData := Data;
8149     ImgSize := Height * fRowSize;
8150     GetMem(DestData, ImgSize);
8151     try
8152       TempDestData := DestData;
8153       Dec(TempDestData, fRowSize + fPixelSize);
8154       for Row := 0 to Height -1 do begin
8155         Inc(TempDestData, fRowSize * 2);
8156         for Col := 0 to Width -1 do begin
8157           Move(SourceData^, TempDestData^, fPixelSize);
8158           Inc(SourceData, fPixelSize);
8159           Dec(TempDestData, fPixelSize);
8160         end;
8161       end;
8162       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8163       result := true;
8164     except
8165       if Assigned(DestData) then
8166         FreeMem(DestData);
8167       raise;
8168     end;
8169   end;
8170 end;
8171
8172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8173 function TglBitmap2D.FlipVert: Boolean;
8174 var
8175   Row: Integer;
8176   TempDestData, DestData, SourceData: PByte;
8177 begin
8178   result := inherited FlipVert;
8179   if Assigned(Data) then begin
8180     SourceData := Data;
8181     GetMem(DestData, Height * fRowSize);
8182     try
8183       TempDestData := DestData;
8184       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8185       for Row := 0 to Height -1 do begin
8186         Move(SourceData^, TempDestData^, fRowSize);
8187         Dec(TempDestData, fRowSize);
8188         Inc(SourceData, fRowSize);
8189       end;
8190       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8191       result := true;
8192     except
8193       if Assigned(DestData) then
8194         FreeMem(DestData);
8195       raise;
8196     end;
8197   end;
8198 end;
8199
8200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8201 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8203 type
8204   TMatrixItem = record
8205     X, Y: Integer;
8206     W: Single;
8207   end;
8208
8209   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8210   TglBitmapToNormalMapRec = Record
8211     Scale: Single;
8212     Heights: array of Single;
8213     MatrixU : array of TMatrixItem;
8214     MatrixV : array of TMatrixItem;
8215   end;
8216
8217 const
8218   ONE_OVER_255 = 1 / 255;
8219
8220   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8221 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8222 var
8223   Val: Single;
8224 begin
8225   with FuncRec do begin
8226     Val :=
8227       Source.Data.r * LUMINANCE_WEIGHT_R +
8228       Source.Data.g * LUMINANCE_WEIGHT_G +
8229       Source.Data.b * LUMINANCE_WEIGHT_B;
8230     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8231   end;
8232 end;
8233
8234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8235 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8236 begin
8237   with FuncRec do
8238     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8239 end;
8240
8241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8242 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8243 type
8244   TVec = Array[0..2] of Single;
8245 var
8246   Idx: Integer;
8247   du, dv: Double;
8248   Len: Single;
8249   Vec: TVec;
8250
8251   function GetHeight(X, Y: Integer): Single;
8252   begin
8253     with FuncRec do begin
8254       X := Max(0, Min(Size.X -1, X));
8255       Y := Max(0, Min(Size.Y -1, Y));
8256       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8257     end;
8258   end;
8259
8260 begin
8261   with FuncRec do begin
8262     with PglBitmapToNormalMapRec(Args)^ do begin
8263       du := 0;
8264       for Idx := Low(MatrixU) to High(MatrixU) do
8265         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8266
8267       dv := 0;
8268       for Idx := Low(MatrixU) to High(MatrixU) do
8269         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8270
8271       Vec[0] := -du * Scale;
8272       Vec[1] := -dv * Scale;
8273       Vec[2] := 1;
8274     end;
8275
8276     // Normalize
8277     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8278     if Len <> 0 then begin
8279       Vec[0] := Vec[0] * Len;
8280       Vec[1] := Vec[1] * Len;
8281       Vec[2] := Vec[2] * Len;
8282     end;
8283
8284     // Farbe zuweisem
8285     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8286     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8287     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8288   end;
8289 end;
8290
8291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8292 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8293 var
8294   Rec: TglBitmapToNormalMapRec;
8295
8296   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8297   begin
8298     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8299       Matrix[Index].X := X;
8300       Matrix[Index].Y := Y;
8301       Matrix[Index].W := W;
8302     end;
8303   end;
8304
8305 begin
8306   if TFormatDescriptor.Get(Format).IsCompressed then
8307     raise EglBitmapUnsupportedFormat.Create(Format);
8308
8309   if aScale > 100 then
8310     Rec.Scale := 100
8311   else if aScale < -100 then
8312     Rec.Scale := -100
8313   else
8314     Rec.Scale := aScale;
8315
8316   SetLength(Rec.Heights, Width * Height);
8317   try
8318     case aFunc of
8319       nm4Samples: begin
8320         SetLength(Rec.MatrixU, 2);
8321         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8322         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8323
8324         SetLength(Rec.MatrixV, 2);
8325         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8326         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8327       end;
8328
8329       nmSobel: begin
8330         SetLength(Rec.MatrixU, 6);
8331         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8332         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8333         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8334         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8335         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8336         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8337
8338         SetLength(Rec.MatrixV, 6);
8339         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8340         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8341         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8342         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8343         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8344         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8345       end;
8346
8347       nm3x3: begin
8348         SetLength(Rec.MatrixU, 6);
8349         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8350         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8351         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8352         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8353         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8354         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8355
8356         SetLength(Rec.MatrixV, 6);
8357         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8358         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8359         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8360         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8361         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8362         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8363       end;
8364
8365       nm5x5: begin
8366         SetLength(Rec.MatrixU, 20);
8367         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8368         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8369         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8370         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8371         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8372         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8373         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8374         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8375         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8376         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8377         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8378         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8379         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8380         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8381         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8382         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8383         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8384         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8385         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8386         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8387
8388         SetLength(Rec.MatrixV, 20);
8389         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8390         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8391         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8392         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8393         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8394         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8395         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8396         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8397         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8398         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8399         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8400         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8401         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8402         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8403         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8404         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8405         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8406         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8407         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8408         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8409       end;
8410     end;
8411
8412     // Daten Sammeln
8413     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8414       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8415     else
8416       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8417     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8418   finally
8419     SetLength(Rec.Heights, 0);
8420   end;
8421 end;
8422
8423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8424 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8426 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8427 begin
8428   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8429 end;
8430
8431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8432 procedure TglBitmapCubeMap.AfterConstruction;
8433 begin
8434   inherited;
8435
8436   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8437     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8438
8439   SetWrap;
8440   Target   := GL_TEXTURE_CUBE_MAP;
8441   fGenMode := GL_REFLECTION_MAP;
8442 end;
8443
8444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8445 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8446 var
8447   BuildWithGlu: Boolean;
8448   TexSize: Integer;
8449 begin
8450   if (aTestTextureSize) then begin
8451     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8452
8453     if (Height > TexSize) or (Width > TexSize) then
8454       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8455
8456     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8457       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8458   end;
8459
8460   if (ID = 0) then
8461     CreateID;
8462   SetupParameters(BuildWithGlu);
8463   UploadData(aCubeTarget, BuildWithGlu);
8464 end;
8465
8466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8467 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8468 begin
8469   inherited Bind (aEnableTextureUnit);
8470   if aEnableTexCoordsGen then begin
8471     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8472     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8473     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8474     glEnable(GL_TEXTURE_GEN_S);
8475     glEnable(GL_TEXTURE_GEN_T);
8476     glEnable(GL_TEXTURE_GEN_R);
8477   end;
8478 end;
8479
8480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8481 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8482 begin
8483   inherited Unbind(aDisableTextureUnit);
8484   if aDisableTexCoordsGen then begin
8485     glDisable(GL_TEXTURE_GEN_S);
8486     glDisable(GL_TEXTURE_GEN_T);
8487     glDisable(GL_TEXTURE_GEN_R);
8488   end;
8489 end;
8490
8491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8492 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 type
8495   TVec = Array[0..2] of Single;
8496   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8497
8498   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8499   TglBitmapNormalMapRec = record
8500     HalfSize : Integer;
8501     Func: TglBitmapNormalMapGetVectorFunc;
8502   end;
8503
8504   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8505 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8506 begin
8507   aVec[0] := aHalfSize;
8508   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8509   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8510 end;
8511
8512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8513 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8514 begin
8515   aVec[0] := - aHalfSize;
8516   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8517   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8518 end;
8519
8520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8521 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8522 begin
8523   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8524   aVec[1] := aHalfSize;
8525   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8526 end;
8527
8528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8529 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8530 begin
8531   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8532   aVec[1] := - aHalfSize;
8533   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8534 end;
8535
8536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8537 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8538 begin
8539   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8540   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8541   aVec[2] := aHalfSize;
8542 end;
8543
8544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8545 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8546 begin
8547   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8548   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8549   aVec[2] := - aHalfSize;
8550 end;
8551
8552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8553 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8554 var
8555   i: Integer;
8556   Vec: TVec;
8557   Len: Single;
8558 begin
8559   with FuncRec do begin
8560     with PglBitmapNormalMapRec(Args)^ do begin
8561       Func(Vec, Position, HalfSize);
8562
8563       // Normalize
8564       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8565       if Len <> 0 then begin
8566         Vec[0] := Vec[0] * Len;
8567         Vec[1] := Vec[1] * Len;
8568         Vec[2] := Vec[2] * Len;
8569       end;
8570
8571       // Scale Vector and AddVectro
8572       Vec[0] := Vec[0] * 0.5 + 0.5;
8573       Vec[1] := Vec[1] * 0.5 + 0.5;
8574       Vec[2] := Vec[2] * 0.5 + 0.5;
8575     end;
8576
8577     // Set Color
8578     for i := 0 to 2 do
8579       Dest.Data.arr[i] := Round(Vec[i] * 255);
8580   end;
8581 end;
8582
8583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8584 procedure TglBitmapNormalMap.AfterConstruction;
8585 begin
8586   inherited;
8587   fGenMode := GL_NORMAL_MAP;
8588 end;
8589
8590 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8591 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8592 var
8593   Rec: TglBitmapNormalMapRec;
8594   SizeRec: TglBitmapPixelPosition;
8595 begin
8596   Rec.HalfSize := aSize div 2;
8597   FreeDataAfterGenTexture := false;
8598
8599   SizeRec.Fields := [ffX, ffY];
8600   SizeRec.X := aSize;
8601   SizeRec.Y := aSize;
8602
8603   // Positive X
8604   Rec.Func := glBitmapNormalMapPosX;
8605   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8606   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8607
8608   // Negative X
8609   Rec.Func := glBitmapNormalMapNegX;
8610   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8611   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8612
8613   // Positive Y
8614   Rec.Func := glBitmapNormalMapPosY;
8615   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8616   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8617
8618   // Negative Y
8619   Rec.Func := glBitmapNormalMapNegY;
8620   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8621   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8622
8623   // Positive Z
8624   Rec.Func := glBitmapNormalMapPosZ;
8625   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8626   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8627
8628   // Negative Z
8629   Rec.Func := glBitmapNormalMapNegZ;
8630   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8631   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8632 end;
8633
8634
8635 initialization
8636   glBitmapSetDefaultFormat (tfEmpty);
8637   glBitmapSetDefaultMipmap (mmMipmap);
8638   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8639   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8640   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8641
8642   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8643   glBitmapSetDefaultDeleteTextureOnFree    (true);
8644
8645   TFormatDescriptor.Init;
8646
8647 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8648   OpenGLInitialized := false;
8649   InitOpenGLCS := TCriticalSection.Create;
8650 {$ENDIF}
8651
8652 finalization
8653   TFormatDescriptor.Finalize;
8654
8655 {$IFDEF GLB_NATIVE_OGL}
8656   if Assigned(GL_LibHandle) then
8657     glbFreeLibrary(GL_LibHandle);
8658
8659 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8660   if Assigned(GLU_LibHandle) then
8661     glbFreeLibrary(GLU_LibHandle);
8662   FreeAndNil(InitOpenGLCS);
8663 {$ENDIF}
8664 {$ENDIF}
8665
8666 end.