glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.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 glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE 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 const
1198   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1199
1200 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1201 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1202 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1203 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1204 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1205 procedure glBitmapSetDefaultWrap(
1206   const S: Cardinal = GL_CLAMP_TO_EDGE;
1207   const T: Cardinal = GL_CLAMP_TO_EDGE;
1208   const R: Cardinal = GL_CLAMP_TO_EDGE);
1209
1210 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1211 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1212 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1213 function glBitmapGetDefaultFormat: TglBitmapFormat;
1214 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1215 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1216
1217 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1218 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1219 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1220
1221 var
1222   glBitmapDefaultDeleteTextureOnFree: Boolean;
1223   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1224   glBitmapDefaultFormat: TglBitmapFormat;
1225   glBitmapDefaultMipmap: TglBitmapMipMap;
1226   glBitmapDefaultFilterMin: Cardinal;
1227   glBitmapDefaultFilterMag: Cardinal;
1228   glBitmapDefaultWrapS: Cardinal;
1229   glBitmapDefaultWrapT: Cardinal;
1230   glBitmapDefaultWrapR: Cardinal;
1231   glDefaultSwizzle: array[0..3] of GLenum;
1232
1233 {$IFDEF GLB_DELPHI}
1234 function CreateGrayPalette: HPALETTE;
1235 {$ENDIF}
1236
1237 implementation
1238
1239 uses
1240   Math, syncobjs, typinfo
1241   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1242
1243 type
1244 {$IFNDEF fpc}
1245   QWord   = System.UInt64;
1246   PQWord  = ^QWord;
1247
1248   PtrInt  = Longint;
1249   PtrUInt = DWord;
1250 {$ENDIF}
1251
1252 ////////////////////////////////////////////////////////////////////////////////////////////////////
1253   TShiftRec = packed record
1254   case Integer of
1255     0: (r, g, b, a: Byte);
1256     1: (arr: array[0..3] of Byte);
1257   end;
1258
1259   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1260   private
1261     function GetRedMask: QWord;
1262     function GetGreenMask: QWord;
1263     function GetBlueMask: QWord;
1264     function GetAlphaMask: QWord;
1265   protected
1266     fFormat: TglBitmapFormat;
1267     fWithAlpha: TglBitmapFormat;
1268     fWithoutAlpha: TglBitmapFormat;
1269     fRGBInverted: TglBitmapFormat;
1270     fUncompressed: TglBitmapFormat;
1271     fPixelSize: Single;
1272     fIsCompressed: Boolean;
1273
1274     fRange: TglBitmapColorRec;
1275     fShift: TShiftRec;
1276
1277     fglFormat:         GLenum;
1278     fglInternalFormat: GLenum;
1279     fglDataFormat:     GLenum;
1280
1281     function GetIsCompressed: Boolean; override;
1282     function GetHasRed: Boolean; override;
1283     function GetHasGreen: Boolean; override;
1284     function GetHasBlue: Boolean; override;
1285     function GetHasAlpha: Boolean; override;
1286
1287     function GetglFormat: GLenum; override;
1288     function GetglInternalFormat: GLenum; override;
1289     function GetglDataFormat: GLenum; override;
1290
1291     function GetComponents: Integer; virtual;
1292   public
1293     property Format:       TglBitmapFormat read fFormat;
1294     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1295     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1296     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1297     property Components:   Integer         read GetComponents;
1298     property PixelSize:    Single          read fPixelSize;
1299
1300     property Range: TglBitmapColorRec read fRange;
1301     property Shift: TShiftRec         read fShift;
1302
1303     property RedMask:   QWord read GetRedMask;
1304     property GreenMask: QWord read GetGreenMask;
1305     property BlueMask:  QWord read GetBlueMask;
1306     property AlphaMask: QWord read GetAlphaMask;
1307
1308     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1309     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1310
1311     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1312     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1313
1314     function CreateMappingData: Pointer; virtual;
1315     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1316
1317     function IsEmpty:  Boolean; virtual;
1318     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1319
1320     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1321
1322     constructor Create; virtual;
1323   public
1324     class procedure Init;
1325     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1326     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1327     class procedure Clear;
1328     class procedure Finalize;
1329   end;
1330   TFormatDescriptorClass = class of TFormatDescriptor;
1331
1332   TfdEmpty = class(TFormatDescriptor);
1333
1334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1335   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1336     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1337     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1338     constructor Create; override;
1339   end;
1340
1341   TfdLuminance_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   TfdUniversal_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   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* 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   TfdRGB_UB3 = class(TFormatDescriptor) //3* 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   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
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   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
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   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1384   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1385     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1386     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1387     constructor Create; override;
1388   end;
1389
1390   TfdLuminance_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   TfdUniversal_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   TfdDepth_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   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* 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   TfdRGB_US3 = class(TFormatDescriptor) //3* 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   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
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   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
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   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1439   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1440     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1441     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1442     constructor Create; override;
1443   end;
1444
1445   TfdDepth_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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1452   TfdAlpha4 = class(TfdAlpha_UB1)
1453     constructor Create; override;
1454   end;
1455
1456   TfdAlpha8 = class(TfdAlpha_UB1)
1457     constructor Create; override;
1458   end;
1459
1460   TfdAlpha12 = class(TfdAlpha_US1)
1461     constructor Create; override;
1462   end;
1463
1464   TfdAlpha16 = class(TfdAlpha_US1)
1465     constructor Create; override;
1466   end;
1467
1468   TfdLuminance4 = class(TfdLuminance_UB1)
1469     constructor Create; override;
1470   end;
1471
1472   TfdLuminance8 = class(TfdLuminance_UB1)
1473     constructor Create; override;
1474   end;
1475
1476   TfdLuminance12 = class(TfdLuminance_US1)
1477     constructor Create; override;
1478   end;
1479
1480   TfdLuminance16 = class(TfdLuminance_US1)
1481     constructor Create; override;
1482   end;
1483
1484   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1485     constructor Create; override;
1486   end;
1487
1488   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1489     constructor Create; override;
1490   end;
1491
1492   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1493     constructor Create; override;
1494   end;
1495
1496   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1497     constructor Create; override;
1498   end;
1499
1500   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1501     constructor Create; override;
1502   end;
1503
1504   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1505     constructor Create; override;
1506   end;
1507
1508   TfdR3G3B2 = class(TfdUniversal_UB1)
1509     constructor Create; override;
1510   end;
1511
1512   TfdRGB4 = class(TfdUniversal_US1)
1513     constructor Create; override;
1514   end;
1515
1516   TfdR5G6B5 = class(TfdUniversal_US1)
1517     constructor Create; override;
1518   end;
1519
1520   TfdRGB5 = class(TfdUniversal_US1)
1521     constructor Create; override;
1522   end;
1523
1524   TfdRGB8 = class(TfdRGB_UB3)
1525     constructor Create; override;
1526   end;
1527
1528   TfdRGB10 = class(TfdUniversal_UI1)
1529     constructor Create; override;
1530   end;
1531
1532   TfdRGB12 = class(TfdRGB_US3)
1533     constructor Create; override;
1534   end;
1535
1536   TfdRGB16 = class(TfdRGB_US3)
1537     constructor Create; override;
1538   end;
1539
1540   TfdRGBA2 = class(TfdRGBA_UB4)
1541     constructor Create; override;
1542   end;
1543
1544   TfdRGBA4 = class(TfdUniversal_US1)
1545     constructor Create; override;
1546   end;
1547
1548   TfdRGB5A1 = class(TfdUniversal_US1)
1549     constructor Create; override;
1550   end;
1551
1552   TfdRGBA8 = class(TfdRGBA_UB4)
1553     constructor Create; override;
1554   end;
1555
1556   TfdRGB10A2 = class(TfdUniversal_UI1)
1557     constructor Create; override;
1558   end;
1559
1560   TfdRGBA12 = class(TfdRGBA_US4)
1561     constructor Create; override;
1562   end;
1563
1564   TfdRGBA16 = class(TfdRGBA_US4)
1565     constructor Create; override;
1566   end;
1567
1568   TfdBGR4 = class(TfdUniversal_US1)
1569     constructor Create; override;
1570   end;
1571
1572   TfdB5G6R5 = class(TfdUniversal_US1)
1573     constructor Create; override;
1574   end;
1575
1576   TfdBGR5 = class(TfdUniversal_US1)
1577     constructor Create; override;
1578   end;
1579
1580   TfdBGR8 = class(TfdBGR_UB3)
1581     constructor Create; override;
1582   end;
1583
1584   TfdBGR10 = class(TfdUniversal_UI1)
1585     constructor Create; override;
1586   end;
1587
1588   TfdBGR12 = class(TfdBGR_US3)
1589     constructor Create; override;
1590   end;
1591
1592   TfdBGR16 = class(TfdBGR_US3)
1593     constructor Create; override;
1594   end;
1595
1596   TfdBGRA2 = class(TfdBGRA_UB4)
1597     constructor Create; override;
1598   end;
1599
1600   TfdBGRA4 = class(TfdUniversal_US1)
1601     constructor Create; override;
1602   end;
1603
1604   TfdBGR5A1 = class(TfdUniversal_US1)
1605     constructor Create; override;
1606   end;
1607
1608   TfdBGRA8 = class(TfdBGRA_UB4)
1609     constructor Create; override;
1610   end;
1611
1612   TfdBGR10A2 = class(TfdUniversal_UI1)
1613     constructor Create; override;
1614   end;
1615
1616   TfdBGRA12 = class(TfdBGRA_US4)
1617     constructor Create; override;
1618   end;
1619
1620   TfdBGRA16 = class(TfdBGRA_US4)
1621     constructor Create; override;
1622   end;
1623
1624   TfdDepth16 = class(TfdDepth_US1)
1625     constructor Create; override;
1626   end;
1627
1628   TfdDepth24 = class(TfdDepth_UI1)
1629     constructor Create; override;
1630   end;
1631
1632   TfdDepth32 = class(TfdDepth_UI1)
1633     constructor Create; override;
1634   end;
1635
1636   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1637     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1638     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1639     constructor Create; override;
1640   end;
1641
1642   TfdS3tcDtx3RGBA = 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   TfdS3tcDtx5RGBA = 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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655   TbmpBitfieldFormat = class(TFormatDescriptor)
1656   private
1657     procedure SetRedMask  (const aValue: QWord);
1658     procedure SetGreenMask(const aValue: QWord);
1659     procedure SetBlueMask (const aValue: QWord);
1660     procedure SetAlphaMask(const aValue: QWord);
1661
1662     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1663   public
1664     property RedMask:   QWord read GetRedMask   write SetRedMask;
1665     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1666     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1667     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1668
1669     property PixelSize: Single read fPixelSize write fPixelSize;
1670
1671     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1672     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1673   end;
1674
1675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1676   TbmpColorTableEnty = packed record
1677     b, g, r, a: Byte;
1678   end;
1679   TbmpColorTable = array of TbmpColorTableEnty;
1680   TbmpColorTableFormat = class(TFormatDescriptor)
1681   private
1682     fColorTable: TbmpColorTable;
1683   public
1684     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1685     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1686     property Range:      TglBitmapColorRec read fRange      write fRange;
1687     property Shift:      TShiftRec         read fShift      write fShift;
1688     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1689
1690     procedure CreateColorTable;
1691
1692     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1693     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1694     destructor Destroy; override;
1695   end;
1696
1697 const
1698   LUMINANCE_WEIGHT_R = 0.30;
1699   LUMINANCE_WEIGHT_G = 0.59;
1700   LUMINANCE_WEIGHT_B = 0.11;
1701
1702   ALPHA_WEIGHT_R = 0.30;
1703   ALPHA_WEIGHT_G = 0.59;
1704   ALPHA_WEIGHT_B = 0.11;
1705
1706   DEPTH_WEIGHT_R = 0.333333333;
1707   DEPTH_WEIGHT_G = 0.333333333;
1708   DEPTH_WEIGHT_B = 0.333333333;
1709
1710   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1711
1712   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1713     TfdEmpty,
1714
1715     TfdAlpha4,
1716     TfdAlpha8,
1717     TfdAlpha12,
1718     TfdAlpha16,
1719
1720     TfdLuminance4,
1721     TfdLuminance8,
1722     TfdLuminance12,
1723     TfdLuminance16,
1724
1725     TfdLuminance4Alpha4,
1726     TfdLuminance6Alpha2,
1727     TfdLuminance8Alpha8,
1728     TfdLuminance12Alpha4,
1729     TfdLuminance12Alpha12,
1730     TfdLuminance16Alpha16,
1731
1732     TfdR3G3B2,
1733     TfdRGB4,
1734     TfdR5G6B5,
1735     TfdRGB5,
1736     TfdRGB8,
1737     TfdRGB10,
1738     TfdRGB12,
1739     TfdRGB16,
1740
1741     TfdRGBA2,
1742     TfdRGBA4,
1743     TfdRGB5A1,
1744     TfdRGBA8,
1745     TfdRGB10A2,
1746     TfdRGBA12,
1747     TfdRGBA16,
1748
1749     TfdBGR4,
1750     TfdB5G6R5,
1751     TfdBGR5,
1752     TfdBGR8,
1753     TfdBGR10,
1754     TfdBGR12,
1755     TfdBGR16,
1756
1757     TfdBGRA2,
1758     TfdBGRA4,
1759     TfdBGR5A1,
1760     TfdBGRA8,
1761     TfdBGR10A2,
1762     TfdBGRA12,
1763     TfdBGRA16,
1764
1765     TfdDepth16,
1766     TfdDepth24,
1767     TfdDepth32,
1768
1769     TfdS3tcDtx1RGBA,
1770     TfdS3tcDtx3RGBA,
1771     TfdS3tcDtx5RGBA
1772   );
1773
1774 var
1775   FormatDescriptorCS: TCriticalSection;
1776   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1777
1778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1779 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1780 begin
1781   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1782 end;
1783
1784 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1786 begin
1787   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1788 end;
1789
1790 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1791 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1792 begin
1793   result.Fields := [];
1794
1795   if X >= 0 then
1796     result.Fields := result.Fields + [ffX];
1797   if Y >= 0 then
1798     result.Fields := result.Fields + [ffY];
1799
1800   result.X := Max(0, X);
1801   result.Y := Max(0, Y);
1802 end;
1803
1804 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1805 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1806 begin
1807   result.r := r;
1808   result.g := g;
1809   result.b := b;
1810   result.a := a;
1811 end;
1812
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1815 var
1816   i: Integer;
1817 begin
1818   result := false;
1819   for i := 0 to high(r1.arr) do
1820     if (r1.arr[i] <> r2.arr[i]) then
1821       exit;
1822   result := true;
1823 end;
1824
1825 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1826 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1827 begin
1828   result.r := r;
1829   result.g := g;
1830   result.b := b;
1831   result.a := a;
1832 end;
1833
1834 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1835 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1836 begin
1837   result := [];
1838
1839   if (aFormat in [
1840         //4 bbp
1841         tfLuminance4,
1842
1843         //8bpp
1844         tfR3G3B2, tfLuminance8,
1845
1846         //16bpp
1847         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1848         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1849
1850         //24bpp
1851         tfBGR8, tfRGB8,
1852
1853         //32bpp
1854         tfRGB10, tfRGB10A2, tfRGBA8,
1855         tfBGR10, tfBGR10A2, tfBGRA8]) then
1856     result := result + [ftBMP];
1857
1858   if (aFormat in [
1859         //8 bpp
1860         tfLuminance8, tfAlpha8,
1861
1862         //16 bpp
1863         tfLuminance16, tfLuminance8Alpha8,
1864         tfRGB5, tfRGB5A1, tfRGBA4,
1865         tfBGR5, tfBGR5A1, tfBGRA4,
1866
1867         //24 bpp
1868         tfRGB8, tfBGR8,
1869
1870         //32 bpp
1871         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1872     result := result + [ftTGA];
1873
1874   if (aFormat in [
1875         //8 bpp
1876         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1877         tfR3G3B2, tfRGBA2, tfBGRA2,
1878
1879         //16 bpp
1880         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1881         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1882         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1883
1884         //24 bpp
1885         tfRGB8, tfBGR8,
1886
1887         //32 bbp
1888         tfLuminance16Alpha16,
1889         tfRGBA8, tfRGB10A2,
1890         tfBGRA8, tfBGR10A2,
1891
1892         //compressed
1893         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1894     result := result + [ftDDS];
1895
1896   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1897   if aFormat in [
1898       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1899       tfRGB8, tfRGBA8,
1900       tfBGR8, tfBGRA8] then
1901     result := result + [ftPNG];
1902   {$ENDIF}
1903
1904   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1905   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1906     result := result + [ftJPEG];
1907   {$ENDIF}
1908 end;
1909
1910 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1911 function IsPowerOfTwo(aNumber: Integer): Boolean;
1912 begin
1913   while (aNumber and 1) = 0 do
1914     aNumber := aNumber shr 1;
1915   result := aNumber = 1;
1916 end;
1917
1918 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1919 function GetTopMostBit(aBitSet: QWord): Integer;
1920 begin
1921   result := 0;
1922   while aBitSet > 0 do begin
1923     inc(result);
1924     aBitSet := aBitSet shr 1;
1925   end;
1926 end;
1927
1928 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1929 function CountSetBits(aBitSet: QWord): Integer;
1930 begin
1931   result := 0;
1932   while aBitSet > 0 do begin
1933     if (aBitSet and 1) = 1 then
1934       inc(result);
1935     aBitSet := aBitSet shr 1;
1936   end;
1937 end;
1938
1939 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1940 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1941 begin
1942   result := Trunc(
1943     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1944     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1945     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1946 end;
1947
1948 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1950 begin
1951   result := Trunc(
1952     DEPTH_WEIGHT_R * aPixel.Data.r +
1953     DEPTH_WEIGHT_G * aPixel.Data.g +
1954     DEPTH_WEIGHT_B * aPixel.Data.b);
1955 end;
1956
1957 {$IFDEF GLB_NATIVE_OGL}
1958 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1959 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1960 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1961 var
1962   GL_LibHandle: Pointer = nil;
1963
1964 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1965 begin
1966   if not Assigned(aLibHandle) then
1967     aLibHandle := GL_LibHandle;
1968
1969 {$IF DEFINED(GLB_WIN)}
1970   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1971   if Assigned(result) then
1972     exit;
1973
1974   if Assigned(wglGetProcAddress) then
1975     result := wglGetProcAddress(aProcName);
1976 {$ELSEIF DEFINED(GLB_LINUX)}
1977   if Assigned(glXGetProcAddress) then begin
1978     result := glXGetProcAddress(aProcName);
1979     if Assigned(result) then
1980       exit;
1981   end;
1982
1983   if Assigned(glXGetProcAddressARB) then begin
1984     result := glXGetProcAddressARB(aProcName);
1985     if Assigned(result) then
1986       exit;
1987   end;
1988
1989   result := dlsym(aLibHandle, aProcName);
1990 {$IFEND}
1991   if not Assigned(result) and aRaiseOnErr then
1992     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1993 end;
1994
1995 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1996 var
1997   GLU_LibHandle: Pointer = nil;
1998   OpenGLInitialized: Boolean;
1999   InitOpenGLCS: TCriticalSection;
2000
2001 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2002 procedure glbInitOpenGL;
2003
2004   ////////////////////////////////////////////////////////////////////////////////
2005   function glbLoadLibrary(const aName: PChar): Pointer;
2006   begin
2007     {$IF DEFINED(GLB_WIN)}
2008     result := {%H-}Pointer(LoadLibrary(aName));
2009     {$ELSEIF DEFINED(GLB_LINUX)}
2010     result := dlopen(Name, RTLD_LAZY);
2011     {$ELSE}
2012     result := nil;
2013     {$IFEND}
2014   end;
2015
2016   ////////////////////////////////////////////////////////////////////////////////
2017   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2018   begin
2019     result := false;
2020     if not Assigned(aLibHandle) then
2021       exit;
2022
2023     {$IF DEFINED(GLB_WIN)}
2024     Result := FreeLibrary({%H-}HINST(aLibHandle));
2025     {$ELSEIF DEFINED(GLB_LINUX)}
2026     Result := dlclose(aLibHandle) = 0;
2027     {$IFEND}
2028   end;
2029
2030 begin
2031   if Assigned(GL_LibHandle) then
2032     glbFreeLibrary(GL_LibHandle);
2033
2034   if Assigned(GLU_LibHandle) then
2035     glbFreeLibrary(GLU_LibHandle);
2036
2037   GL_LibHandle := glbLoadLibrary(libopengl);
2038   if not Assigned(GL_LibHandle) then
2039     raise EglBitmap.Create('unable to load library: ' + libopengl);
2040
2041   GLU_LibHandle := glbLoadLibrary(libglu);
2042   if not Assigned(GLU_LibHandle) then
2043     raise EglBitmap.Create('unable to load library: ' + libglu);
2044
2045 {$IF DEFINED(GLB_WIN)}
2046   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2047 {$ELSEIF DEFINED(GLB_LINUX)}
2048   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2049   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2050 {$IFEND}
2051
2052   glEnable := glbGetProcAddress('glEnable');
2053   glDisable := glbGetProcAddress('glDisable');
2054   glGetString := glbGetProcAddress('glGetString');
2055   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2056   glTexParameteri := glbGetProcAddress('glTexParameteri');
2057   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2058   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2059   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2060   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2061   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2062   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2063   glTexGeni := glbGetProcAddress('glTexGeni');
2064   glGenTextures := glbGetProcAddress('glGenTextures');
2065   glBindTexture := glbGetProcAddress('glBindTexture');
2066   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2067   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2068   glReadPixels := glbGetProcAddress('glReadPixels');
2069   glPixelStorei := glbGetProcAddress('glPixelStorei');
2070   glTexImage1D := glbGetProcAddress('glTexImage1D');
2071   glTexImage2D := glbGetProcAddress('glTexImage2D');
2072   glGetTexImage := glbGetProcAddress('glGetTexImage');
2073
2074   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2075   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2076 end;
2077 {$ENDIF}
2078
2079 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2080 procedure glbReadOpenGLExtensions;
2081 var
2082   Buffer: AnsiString;
2083   MajorVersion, MinorVersion: Integer;
2084
2085   ///////////////////////////////////////////////////////////////////////////////////////////
2086   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2087   var
2088     Separator: Integer;
2089   begin
2090     aMinor := 0;
2091     aMajor := 0;
2092
2093     Separator := Pos(AnsiString('.'), aBuffer);
2094     if (Separator > 1) and (Separator < Length(aBuffer)) and
2095        (aBuffer[Separator - 1] in ['0'..'9']) and
2096        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2097
2098       Dec(Separator);
2099       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2100         Dec(Separator);
2101
2102       Delete(aBuffer, 1, Separator);
2103       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2104
2105       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2106         Inc(Separator);
2107
2108       Delete(aBuffer, Separator, 255);
2109       Separator := Pos(AnsiString('.'), aBuffer);
2110
2111       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2112       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2113     end;
2114   end;
2115
2116   ///////////////////////////////////////////////////////////////////////////////////////////
2117   function CheckExtension(const Extension: AnsiString): Boolean;
2118   var
2119     ExtPos: Integer;
2120   begin
2121     ExtPos := Pos(Extension, Buffer);
2122     result := ExtPos > 0;
2123     if result then
2124       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2125   end;
2126
2127   ///////////////////////////////////////////////////////////////////////////////////////////
2128   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2129   begin
2130     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2131   end;
2132
2133 begin
2134 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2135   InitOpenGLCS.Enter;
2136   try
2137     if not OpenGLInitialized then begin
2138       glbInitOpenGL;
2139       OpenGLInitialized := true;
2140     end;
2141   finally
2142     InitOpenGLCS.Leave;
2143   end;
2144 {$ENDIF}
2145
2146   // Version
2147   Buffer := glGetString(GL_VERSION);
2148   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2149
2150   GL_VERSION_1_2 := CheckVersion(1, 2);
2151   GL_VERSION_1_3 := CheckVersion(1, 3);
2152   GL_VERSION_1_4 := CheckVersion(1, 4);
2153   GL_VERSION_2_0 := CheckVersion(2, 0);
2154   GL_VERSION_3_3 := CheckVersion(3, 3);
2155
2156   // Extensions
2157   Buffer := glGetString(GL_EXTENSIONS);
2158   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2159   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2160   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2161   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2162   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2163   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2164   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2165   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2166   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2167   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2168   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2169   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2170   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2171   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2172
2173   if GL_VERSION_1_3 then begin
2174     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2175     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2176     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2177   end else begin
2178     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2179     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2180     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2181   end;
2182 end;
2183 {$ENDIF}
2184
2185 {$IFDEF GLB_SDL_IMAGE}
2186 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2189 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2190 begin
2191   result := TStream(context^.unknown.data1).Seek(offset, whence);
2192 end;
2193
2194 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2195 begin
2196   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2197 end;
2198
2199 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2200 begin
2201   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2202 end;
2203
2204 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2205 begin
2206   result := 0;
2207 end;
2208
2209 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2210 begin
2211   result := SDL_AllocRW;
2212
2213   if result = nil then
2214     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2215
2216   result^.seek := glBitmapRWseek;
2217   result^.read := glBitmapRWread;
2218   result^.write := glBitmapRWwrite;
2219   result^.close := glBitmapRWclose;
2220   result^.unknown.data1 := Stream;
2221 end;
2222 {$ENDIF}
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2226 begin
2227   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2232 begin
2233   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2238 begin
2239   glBitmapDefaultMipmap := aValue;
2240 end;
2241
2242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2244 begin
2245   glBitmapDefaultFormat := aFormat;
2246 end;
2247
2248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2250 begin
2251   glBitmapDefaultFilterMin := aMin;
2252   glBitmapDefaultFilterMag := aMag;
2253 end;
2254
2255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2257 begin
2258   glBitmapDefaultWrapS := S;
2259   glBitmapDefaultWrapT := T;
2260   glBitmapDefaultWrapR := R;
2261 end;
2262
2263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2264 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2265 begin
2266   glDefaultSwizzle[0] := r;
2267   glDefaultSwizzle[1] := g;
2268   glDefaultSwizzle[2] := b;
2269   glDefaultSwizzle[3] := a;
2270 end;
2271
2272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2273 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2274 begin
2275   result := glBitmapDefaultDeleteTextureOnFree;
2276 end;
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2280 begin
2281   result := glBitmapDefaultFreeDataAfterGenTextures;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2286 begin
2287   result := glBitmapDefaultMipmap;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 function glBitmapGetDefaultFormat: TglBitmapFormat;
2292 begin
2293   result := glBitmapDefaultFormat;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2298 begin
2299   aMin := glBitmapDefaultFilterMin;
2300   aMag := glBitmapDefaultFilterMag;
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2305 begin
2306   S := glBitmapDefaultWrapS;
2307   T := glBitmapDefaultWrapT;
2308   R := glBitmapDefaultWrapR;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2313 begin
2314   r := glDefaultSwizzle[0];
2315   g := glDefaultSwizzle[1];
2316   b := glDefaultSwizzle[2];
2317   a := glDefaultSwizzle[3];
2318 end;
2319
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2323 function TFormatDescriptor.GetRedMask: QWord;
2324 begin
2325   result := fRange.r shl fShift.r;
2326 end;
2327
2328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 function TFormatDescriptor.GetGreenMask: QWord;
2330 begin
2331   result := fRange.g shl fShift.g;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 function TFormatDescriptor.GetBlueMask: QWord;
2336 begin
2337   result := fRange.b shl fShift.b;
2338 end;
2339
2340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2341 function TFormatDescriptor.GetAlphaMask: QWord;
2342 begin
2343   result := fRange.a shl fShift.a;
2344 end;
2345
2346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2347 function TFormatDescriptor.GetIsCompressed: Boolean;
2348 begin
2349   result := fIsCompressed;
2350 end;
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 function TFormatDescriptor.GetHasRed: Boolean;
2354 begin
2355   result := (fRange.r > 0);
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetHasGreen: Boolean;
2360 begin
2361   result := (fRange.g > 0);
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetHasBlue: Boolean;
2366 begin
2367   result := (fRange.b > 0);
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetHasAlpha: Boolean;
2372 begin
2373   result := (fRange.a > 0);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetglFormat: GLenum;
2378 begin
2379   result := fglFormat;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetglInternalFormat: GLenum;
2384 begin
2385   result := fglInternalFormat;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetglDataFormat: GLenum;
2390 begin
2391   result := fglDataFormat;
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.GetComponents: Integer;
2396 var
2397   i: Integer;
2398 begin
2399   result := 0;
2400   for i := 0 to 3 do
2401     if (fRange.arr[i] > 0) then
2402       inc(result);
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2407 var
2408   w, h: Integer;
2409 begin
2410   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2411     w := Max(1, aSize.X);
2412     h := Max(1, aSize.Y);
2413     result := GetSize(w, h);
2414   end else
2415     result := 0;
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2420 begin
2421   result := 0;
2422   if (aWidth <= 0) or (aHeight <= 0) then
2423     exit;
2424   result := Ceil(aWidth * aHeight * fPixelSize);
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 function TFormatDescriptor.CreateMappingData: Pointer;
2429 begin
2430   result := nil;
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2435 begin
2436   //DUMMY
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 function TFormatDescriptor.IsEmpty: Boolean;
2441 begin
2442   result := (fFormat = tfEmpty);
2443 end;
2444
2445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2446 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2447 begin
2448   result := false;
2449   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2450     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2451   if (aRedMask   <> RedMask) then
2452     exit;
2453   if (aGreenMask <> GreenMask) then
2454     exit;
2455   if (aBlueMask  <> BlueMask) then
2456     exit;
2457   if (aAlphaMask <> AlphaMask) then
2458     exit;
2459   result := true;
2460 end;
2461
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2464 begin
2465   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2466   aPixel.Data   := fRange;
2467   aPixel.Range  := fRange;
2468   aPixel.Format := fFormat;
2469 end;
2470
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 constructor TFormatDescriptor.Create;
2473 begin
2474   inherited Create;
2475
2476   fFormat       := tfEmpty;
2477   fWithAlpha    := tfEmpty;
2478   fWithoutAlpha := tfEmpty;
2479   fRGBInverted  := tfEmpty;
2480   fUncompressed := tfEmpty;
2481   fPixelSize    := 0.0;
2482   fIsCompressed := false;
2483
2484   fglFormat         := 0;
2485   fglInternalFormat := 0;
2486   fglDataFormat     := 0;
2487
2488   FillChar(fRange, 0, SizeOf(fRange));
2489   FillChar(fShift, 0, SizeOf(fShift));
2490 end;
2491
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2495 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2496 begin
2497   aData^ := aPixel.Data.a;
2498   inc(aData);
2499 end;
2500
2501 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2502 begin
2503   aPixel.Data.r := 0;
2504   aPixel.Data.g := 0;
2505   aPixel.Data.b := 0;
2506   aPixel.Data.a := aData^;
2507   inc(aData);
2508 end;
2509
2510 constructor TfdAlpha_UB1.Create;
2511 begin
2512   inherited Create;
2513   fPixelSize        := 1.0;
2514   fRange.a          := $FF;
2515   fglFormat         := GL_ALPHA;
2516   fglDataFormat     := GL_UNSIGNED_BYTE;
2517 end;
2518
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 begin
2524   aData^ := LuminanceWeight(aPixel);
2525   inc(aData);
2526 end;
2527
2528 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2529 begin
2530   aPixel.Data.r := aData^;
2531   aPixel.Data.g := aData^;
2532   aPixel.Data.b := aData^;
2533   aPixel.Data.a := 0;
2534   inc(aData);
2535 end;
2536
2537 constructor TfdLuminance_UB1.Create;
2538 begin
2539   inherited Create;
2540   fPixelSize        := 1.0;
2541   fRange.r          := $FF;
2542   fRange.g          := $FF;
2543   fRange.b          := $FF;
2544   fglFormat         := GL_LUMINANCE;
2545   fglDataFormat     := GL_UNSIGNED_BYTE;
2546 end;
2547
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2552 var
2553   i: Integer;
2554 begin
2555   aData^ := 0;
2556   for i := 0 to 3 do
2557     if (fRange.arr[i] > 0) then
2558       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2559   inc(aData);
2560 end;
2561
2562 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2563 var
2564   i: Integer;
2565 begin
2566   for i := 0 to 3 do
2567     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2568   inc(aData);
2569 end;
2570
2571 constructor TfdUniversal_UB1.Create;
2572 begin
2573   inherited Create;
2574   fPixelSize := 1.0;
2575 end;
2576
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2581 begin
2582   inherited Map(aPixel, aData, aMapData);
2583   aData^ := aPixel.Data.a;
2584   inc(aData);
2585 end;
2586
2587 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2588 begin
2589   inherited Unmap(aData, aPixel, aMapData);
2590   aPixel.Data.a := aData^;
2591   inc(aData);
2592 end;
2593
2594 constructor TfdLuminanceAlpha_UB2.Create;
2595 begin
2596   inherited Create;
2597   fPixelSize        := 2.0;
2598   fRange.a          := $FF;
2599   fShift.a          :=   8;
2600   fglFormat         := GL_LUMINANCE_ALPHA;
2601   fglDataFormat     := GL_UNSIGNED_BYTE;
2602 end;
2603
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2607 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2608 begin
2609   aData^ := aPixel.Data.r;
2610   inc(aData);
2611   aData^ := aPixel.Data.g;
2612   inc(aData);
2613   aData^ := aPixel.Data.b;
2614   inc(aData);
2615 end;
2616
2617 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2618 begin
2619   aPixel.Data.r := aData^;
2620   inc(aData);
2621   aPixel.Data.g := aData^;
2622   inc(aData);
2623   aPixel.Data.b := aData^;
2624   inc(aData);
2625   aPixel.Data.a := 0;
2626 end;
2627
2628 constructor TfdRGB_UB3.Create;
2629 begin
2630   inherited Create;
2631   fPixelSize        := 3.0;
2632   fRange.r          := $FF;
2633   fRange.g          := $FF;
2634   fRange.b          := $FF;
2635   fShift.r          :=   0;
2636   fShift.g          :=   8;
2637   fShift.b          :=  16;
2638   fglFormat         := GL_RGB;
2639   fglDataFormat     := GL_UNSIGNED_BYTE;
2640 end;
2641
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2646 begin
2647   aData^ := aPixel.Data.b;
2648   inc(aData);
2649   aData^ := aPixel.Data.g;
2650   inc(aData);
2651   aData^ := aPixel.Data.r;
2652   inc(aData);
2653 end;
2654
2655 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2656 begin
2657   aPixel.Data.b := aData^;
2658   inc(aData);
2659   aPixel.Data.g := aData^;
2660   inc(aData);
2661   aPixel.Data.r := aData^;
2662   inc(aData);
2663   aPixel.Data.a := 0;
2664 end;
2665
2666 constructor TfdBGR_UB3.Create;
2667 begin
2668   fPixelSize        := 3.0;
2669   fRange.r          := $FF;
2670   fRange.g          := $FF;
2671   fRange.b          := $FF;
2672   fShift.r          :=  16;
2673   fShift.g          :=   8;
2674   fShift.b          :=   0;
2675   fglFormat         := GL_BGR;
2676   fglDataFormat     := GL_UNSIGNED_BYTE;
2677 end;
2678
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2682 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2683 begin
2684   inherited Map(aPixel, aData, aMapData);
2685   aData^ := aPixel.Data.a;
2686   inc(aData);
2687 end;
2688
2689 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2690 begin
2691   inherited Unmap(aData, aPixel, aMapData);
2692   aPixel.Data.a := aData^;
2693   inc(aData);
2694 end;
2695
2696 constructor TfdRGBA_UB4.Create;
2697 begin
2698   inherited Create;
2699   fPixelSize        := 4.0;
2700   fRange.a          := $FF;
2701   fShift.a          :=  24;
2702   fglFormat         := GL_RGBA;
2703   fglDataFormat     := GL_UNSIGNED_BYTE;
2704 end;
2705
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2709 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2710 begin
2711   inherited Map(aPixel, aData, aMapData);
2712   aData^ := aPixel.Data.a;
2713   inc(aData);
2714 end;
2715
2716 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2717 begin
2718   inherited Unmap(aData, aPixel, aMapData);
2719   aPixel.Data.a := aData^;
2720   inc(aData);
2721 end;
2722
2723 constructor TfdBGRA_UB4.Create;
2724 begin
2725   inherited Create;
2726   fPixelSize        := 4.0;
2727   fRange.a          := $FF;
2728   fShift.a          :=  24;
2729   fglFormat         := GL_BGRA;
2730   fglDataFormat     := GL_UNSIGNED_BYTE;
2731 end;
2732
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2737 begin
2738   PWord(aData)^ := aPixel.Data.a;
2739   inc(aData, 2);
2740 end;
2741
2742 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2743 begin
2744   aPixel.Data.r := 0;
2745   aPixel.Data.g := 0;
2746   aPixel.Data.b := 0;
2747   aPixel.Data.a := PWord(aData)^;
2748   inc(aData, 2);
2749 end;
2750
2751 constructor TfdAlpha_US1.Create;
2752 begin
2753   inherited Create;
2754   fPixelSize        := 2.0;
2755   fRange.a          := $FFFF;
2756   fglFormat         := GL_ALPHA;
2757   fglDataFormat     := GL_UNSIGNED_SHORT;
2758 end;
2759
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2764 begin
2765   PWord(aData)^ := LuminanceWeight(aPixel);
2766   inc(aData, 2);
2767 end;
2768
2769 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2770 begin
2771   aPixel.Data.r := PWord(aData)^;
2772   aPixel.Data.g := PWord(aData)^;
2773   aPixel.Data.b := PWord(aData)^;
2774   aPixel.Data.a := 0;
2775   inc(aData, 2);
2776 end;
2777
2778 constructor TfdLuminance_US1.Create;
2779 begin
2780   inherited Create;
2781   fPixelSize        := 2.0;
2782   fRange.r          := $FFFF;
2783   fRange.g          := $FFFF;
2784   fRange.b          := $FFFF;
2785   fglFormat         := GL_LUMINANCE;
2786   fglDataFormat     := GL_UNSIGNED_SHORT;
2787 end;
2788
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2793 var
2794   i: Integer;
2795 begin
2796   PWord(aData)^ := 0;
2797   for i := 0 to 3 do
2798     if (fRange.arr[i] > 0) then
2799       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2800   inc(aData, 2);
2801 end;
2802
2803 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2804 var
2805   i: Integer;
2806 begin
2807   for i := 0 to 3 do
2808     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2809   inc(aData, 2);
2810 end;
2811
2812 constructor TfdUniversal_US1.Create;
2813 begin
2814   inherited Create;
2815   fPixelSize := 2.0;
2816 end;
2817
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2822 begin
2823   PWord(aData)^ := DepthWeight(aPixel);
2824   inc(aData, 2);
2825 end;
2826
2827 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2828 begin
2829   aPixel.Data.r := PWord(aData)^;
2830   aPixel.Data.g := PWord(aData)^;
2831   aPixel.Data.b := PWord(aData)^;
2832   aPixel.Data.a := 0;
2833   inc(aData, 2);
2834 end;
2835
2836 constructor TfdDepth_US1.Create;
2837 begin
2838   inherited Create;
2839   fPixelSize        := 2.0;
2840   fRange.r          := $FFFF;
2841   fRange.g          := $FFFF;
2842   fRange.b          := $FFFF;
2843   fglFormat         := GL_DEPTH_COMPONENT;
2844   fglDataFormat     := GL_UNSIGNED_SHORT;
2845 end;
2846
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2850 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2851 begin
2852   inherited Map(aPixel, aData, aMapData);
2853   PWord(aData)^ := aPixel.Data.a;
2854   inc(aData, 2);
2855 end;
2856
2857 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2858 begin
2859   inherited Unmap(aData, aPixel, aMapData);
2860   aPixel.Data.a := PWord(aData)^;
2861   inc(aData, 2);
2862 end;
2863
2864 constructor TfdLuminanceAlpha_US2.Create;
2865 begin
2866   inherited Create;
2867   fPixelSize        :=   4.0;
2868   fRange.a          := $FFFF;
2869   fShift.a          :=    16;
2870   fglFormat         := GL_LUMINANCE_ALPHA;
2871   fglDataFormat     := GL_UNSIGNED_SHORT;
2872 end;
2873
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2877 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2878 begin
2879   PWord(aData)^ := aPixel.Data.r;
2880   inc(aData, 2);
2881   PWord(aData)^ := aPixel.Data.g;
2882   inc(aData, 2);
2883   PWord(aData)^ := aPixel.Data.b;
2884   inc(aData, 2);
2885 end;
2886
2887 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2888 begin
2889   aPixel.Data.r := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.g := PWord(aData)^;
2892   inc(aData, 2);
2893   aPixel.Data.b := PWord(aData)^;
2894   inc(aData, 2);
2895   aPixel.Data.a := 0;
2896 end;
2897
2898 constructor TfdRGB_US3.Create;
2899 begin
2900   inherited Create;
2901   fPixelSize        :=   6.0;
2902   fRange.r          := $FFFF;
2903   fRange.g          := $FFFF;
2904   fRange.b          := $FFFF;
2905   fShift.r          :=     0;
2906   fShift.g          :=    16;
2907   fShift.b          :=    32;
2908   fglFormat         := GL_RGB;
2909   fglDataFormat     := GL_UNSIGNED_SHORT;
2910 end;
2911
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2916 begin
2917   PWord(aData)^ := aPixel.Data.b;
2918   inc(aData, 2);
2919   PWord(aData)^ := aPixel.Data.g;
2920   inc(aData, 2);
2921   PWord(aData)^ := aPixel.Data.r;
2922   inc(aData, 2);
2923 end;
2924
2925 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2926 begin
2927   aPixel.Data.b := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.g := PWord(aData)^;
2930   inc(aData, 2);
2931   aPixel.Data.r := PWord(aData)^;
2932   inc(aData, 2);
2933   aPixel.Data.a := 0;
2934 end;
2935
2936 constructor TfdBGR_US3.Create;
2937 begin
2938   inherited Create;
2939   fPixelSize        :=   6.0;
2940   fRange.r          := $FFFF;
2941   fRange.g          := $FFFF;
2942   fRange.b          := $FFFF;
2943   fShift.r          :=    32;
2944   fShift.g          :=    16;
2945   fShift.b          :=     0;
2946   fglFormat         := GL_BGR;
2947   fglDataFormat     := GL_UNSIGNED_SHORT;
2948 end;
2949
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2953 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2954 begin
2955   inherited Map(aPixel, aData, aMapData);
2956   PWord(aData)^ := aPixel.Data.a;
2957   inc(aData, 2);
2958 end;
2959
2960 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2961 begin
2962   inherited Unmap(aData, aPixel, aMapData);
2963   aPixel.Data.a := PWord(aData)^;
2964   inc(aData, 2);
2965 end;
2966
2967 constructor TfdRGBA_US4.Create;
2968 begin
2969   inherited Create;
2970   fPixelSize        :=   8.0;
2971   fRange.a          := $FFFF;
2972   fShift.a          :=    48;
2973   fglFormat         := GL_RGBA;
2974   fglDataFormat     := GL_UNSIGNED_SHORT;
2975 end;
2976
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2980 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2981 begin
2982   inherited Map(aPixel, aData, aMapData);
2983   PWord(aData)^ := aPixel.Data.a;
2984   inc(aData, 2);
2985 end;
2986
2987 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2988 begin
2989   inherited Unmap(aData, aPixel, aMapData);
2990   aPixel.Data.a := PWord(aData)^;
2991   inc(aData, 2);
2992 end;
2993
2994 constructor TfdBGRA_US4.Create;
2995 begin
2996   inherited Create;
2997   fPixelSize        :=   8.0;
2998   fRange.a          := $FFFF;
2999   fShift.a          :=    48;
3000   fglFormat         := GL_BGRA;
3001   fglDataFormat     := GL_UNSIGNED_SHORT;
3002 end;
3003
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3007 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3008 var
3009   i: Integer;
3010 begin
3011   PCardinal(aData)^ := 0;
3012   for i := 0 to 3 do
3013     if (fRange.arr[i] > 0) then
3014       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3015   inc(aData, 4);
3016 end;
3017
3018 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3019 var
3020   i: Integer;
3021 begin
3022   for i := 0 to 3 do
3023     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3024   inc(aData, 2);
3025 end;
3026
3027 constructor TfdUniversal_UI1.Create;
3028 begin
3029   inherited Create;
3030   fPixelSize := 4.0;
3031 end;
3032
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3037 begin
3038   PCardinal(aData)^ := DepthWeight(aPixel);
3039   inc(aData, 4);
3040 end;
3041
3042 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3043 begin
3044   aPixel.Data.r := PCardinal(aData)^;
3045   aPixel.Data.g := PCardinal(aData)^;
3046   aPixel.Data.b := PCardinal(aData)^;
3047   aPixel.Data.a := 0;
3048   inc(aData, 4);
3049 end;
3050
3051 constructor TfdDepth_UI1.Create;
3052 begin
3053   inherited Create;
3054   fPixelSize        := 4.0;
3055   fRange.r          := $FFFFFFFF;
3056   fRange.g          := $FFFFFFFF;
3057   fRange.b          := $FFFFFFFF;
3058   fglFormat         := GL_DEPTH_COMPONENT;
3059   fglDataFormat     := GL_UNSIGNED_INT;
3060 end;
3061
3062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3065 constructor TfdAlpha4.Create;
3066 begin
3067   inherited Create;
3068   fFormat           := tfAlpha4;
3069   fWithAlpha        := tfAlpha4;
3070   fglInternalFormat := GL_ALPHA4;
3071 end;
3072
3073 constructor TfdAlpha8.Create;
3074 begin
3075   inherited Create;
3076   fFormat           := tfAlpha8;
3077   fWithAlpha        := tfAlpha8;
3078   fglInternalFormat := GL_ALPHA8;
3079 end;
3080
3081 constructor TfdAlpha12.Create;
3082 begin
3083   inherited Create;
3084   fFormat           := tfAlpha12;
3085   fWithAlpha        := tfAlpha12;
3086   fglInternalFormat := GL_ALPHA12;
3087 end;
3088
3089 constructor TfdAlpha16.Create;
3090 begin
3091   inherited Create;
3092   fFormat           := tfAlpha16;
3093   fWithAlpha        := tfAlpha16;
3094   fglInternalFormat := GL_ALPHA16;
3095 end;
3096
3097 constructor TfdLuminance4.Create;
3098 begin
3099   inherited Create;
3100   fFormat           := tfLuminance4;
3101   fWithAlpha        := tfLuminance4Alpha4;
3102   fWithoutAlpha     := tfLuminance4;
3103   fglInternalFormat := GL_LUMINANCE4;
3104 end;
3105
3106 constructor TfdLuminance8.Create;
3107 begin
3108   inherited Create;
3109   fFormat           := tfLuminance8;
3110   fWithAlpha        := tfLuminance8Alpha8;
3111   fWithoutAlpha     := tfLuminance8;
3112   fglInternalFormat := GL_LUMINANCE8;
3113 end;
3114
3115 constructor TfdLuminance12.Create;
3116 begin
3117   inherited Create;
3118   fFormat           := tfLuminance12;
3119   fWithAlpha        := tfLuminance12Alpha12;
3120   fWithoutAlpha     := tfLuminance12;
3121   fglInternalFormat := GL_LUMINANCE12;
3122 end;
3123
3124 constructor TfdLuminance16.Create;
3125 begin
3126   inherited Create;
3127   fFormat           := tfLuminance16;
3128   fWithAlpha        := tfLuminance16Alpha16;
3129   fWithoutAlpha     := tfLuminance16;
3130   fglInternalFormat := GL_LUMINANCE16;
3131 end;
3132
3133 constructor TfdLuminance4Alpha4.Create;
3134 begin
3135   inherited Create;
3136   fFormat           := tfLuminance4Alpha4;
3137   fWithAlpha        := tfLuminance4Alpha4;
3138   fWithoutAlpha     := tfLuminance4;
3139   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3140 end;
3141
3142 constructor TfdLuminance6Alpha2.Create;
3143 begin
3144   inherited Create;
3145   fFormat           := tfLuminance6Alpha2;
3146   fWithAlpha        := tfLuminance6Alpha2;
3147   fWithoutAlpha     := tfLuminance8;
3148   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3149 end;
3150
3151 constructor TfdLuminance8Alpha8.Create;
3152 begin
3153   inherited Create;
3154   fFormat           := tfLuminance8Alpha8;
3155   fWithAlpha        := tfLuminance8Alpha8;
3156   fWithoutAlpha     := tfLuminance8;
3157   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3158 end;
3159
3160 constructor TfdLuminance12Alpha4.Create;
3161 begin
3162   inherited Create;
3163   fFormat           := tfLuminance12Alpha4;
3164   fWithAlpha        := tfLuminance12Alpha4;
3165   fWithoutAlpha     := tfLuminance12;
3166   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3167 end;
3168
3169 constructor TfdLuminance12Alpha12.Create;
3170 begin
3171   inherited Create;
3172   fFormat           := tfLuminance12Alpha12;
3173   fWithAlpha        := tfLuminance12Alpha12;
3174   fWithoutAlpha     := tfLuminance12;
3175   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3176 end;
3177
3178 constructor TfdLuminance16Alpha16.Create;
3179 begin
3180   inherited Create;
3181   fFormat           := tfLuminance16Alpha16;
3182   fWithAlpha        := tfLuminance16Alpha16;
3183   fWithoutAlpha     := tfLuminance16;
3184   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3185 end;
3186
3187 constructor TfdR3G3B2.Create;
3188 begin
3189   inherited Create;
3190   fFormat           := tfR3G3B2;
3191   fWithAlpha        := tfRGBA2;
3192   fWithoutAlpha     := tfR3G3B2;
3193   fRange.r          := $7;
3194   fRange.g          := $7;
3195   fRange.b          := $3;
3196   fShift.r          :=  0;
3197   fShift.g          :=  3;
3198   fShift.b          :=  6;
3199   fglFormat         := GL_RGB;
3200   fglInternalFormat := GL_R3_G3_B2;
3201   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3202 end;
3203
3204 constructor TfdRGB4.Create;
3205 begin
3206   inherited Create;
3207   fFormat           := tfRGB4;
3208   fWithAlpha        := tfRGBA4;
3209   fWithoutAlpha     := tfRGB4;
3210   fRGBInverted      := tfBGR4;
3211   fRange.r          := $F;
3212   fRange.g          := $F;
3213   fRange.b          := $F;
3214   fShift.r          :=  0;
3215   fShift.g          :=  4;
3216   fShift.b          :=  8;
3217   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3218   fglInternalFormat := GL_RGB4;
3219   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3220 end;
3221
3222 constructor TfdR5G6B5.Create;
3223 begin
3224   inherited Create;
3225   fFormat           := tfR5G6B5;
3226   fWithAlpha        := tfRGBA4;
3227   fWithoutAlpha     := tfR5G6B5;
3228   fRGBInverted      := tfB5G6R5;
3229   fRange.r          := $1F;
3230   fRange.g          := $3F;
3231   fRange.b          := $1F;
3232   fShift.r          :=   0;
3233   fShift.g          :=   5;
3234   fShift.b          :=  11;
3235   fglFormat         := GL_RGB;
3236   fglInternalFormat := GL_RGB565;
3237   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3238 end;
3239
3240 constructor TfdRGB5.Create;
3241 begin
3242   inherited Create;
3243   fFormat           := tfRGB5;
3244   fWithAlpha        := tfRGB5A1;
3245   fWithoutAlpha     := tfRGB5;
3246   fRGBInverted      := tfBGR5;
3247   fRange.r          := $1F;
3248   fRange.g          := $1F;
3249   fRange.b          := $1F;
3250   fShift.r          :=   0;
3251   fShift.g          :=   5;
3252   fShift.b          :=  10;
3253   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3254   fglInternalFormat := GL_RGB5;
3255   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3256 end;
3257
3258 constructor TfdRGB8.Create;
3259 begin
3260   inherited Create;
3261   fFormat           := tfRGB8;
3262   fWithAlpha        := tfRGBA8;
3263   fWithoutAlpha     := tfRGB8;
3264   fRGBInverted      := tfBGR8;
3265   fglInternalFormat := GL_RGB8;
3266 end;
3267
3268 constructor TfdRGB10.Create;
3269 begin
3270   inherited Create;
3271   fFormat           := tfRGB10;
3272   fWithAlpha        := tfRGB10A2;
3273   fWithoutAlpha     := tfRGB10;
3274   fRGBInverted      := tfBGR10;
3275   fRange.r          := $3FF;
3276   fRange.g          := $3FF;
3277   fRange.b          := $3FF;
3278   fShift.r          :=    0;
3279   fShift.g          :=   10;
3280   fShift.b          :=   20;
3281   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3282   fglInternalFormat := GL_RGB10;
3283   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3284 end;
3285
3286 constructor TfdRGB12.Create;
3287 begin
3288   inherited Create;
3289   fFormat           := tfRGB12;
3290   fWithAlpha        := tfRGBA12;
3291   fWithoutAlpha     := tfRGB12;
3292   fRGBInverted      := tfBGR12;
3293   fglInternalFormat := GL_RGB12;
3294 end;
3295
3296 constructor TfdRGB16.Create;
3297 begin
3298   inherited Create;
3299   fFormat           := tfRGB16;
3300   fWithAlpha        := tfRGBA16;
3301   fWithoutAlpha     := tfRGB16;
3302   fRGBInverted      := tfBGR16;
3303   fglInternalFormat := GL_RGB16;
3304 end;
3305
3306 constructor TfdRGBA2.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfRGBA2;
3310   fWithAlpha        := tfRGBA2;
3311   fWithoutAlpha     := tfR3G3B2;
3312   fRGBInverted      := tfBGRA2;
3313   fglInternalFormat := GL_RGBA2;
3314 end;
3315
3316 constructor TfdRGBA4.Create;
3317 begin
3318   inherited Create;
3319   fFormat           := tfRGBA4;
3320   fWithAlpha        := tfRGBA4;
3321   fWithoutAlpha     := tfRGB4;
3322   fRGBInverted      := tfBGRA4;
3323   fRange.r          := $F;
3324   fRange.g          := $F;
3325   fRange.b          := $F;
3326   fRange.a          := $F;
3327   fShift.r          :=  0;
3328   fShift.g          :=  4;
3329   fShift.b          :=  8;
3330   fShift.a          := 12;
3331   fglFormat         := GL_RGBA;
3332   fglInternalFormat := GL_RGBA4;
3333   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3334 end;
3335
3336 constructor TfdRGB5A1.Create;
3337 begin
3338   inherited Create;
3339   fFormat           := tfRGB5A1;
3340   fWithAlpha        := tfRGB5A1;
3341   fWithoutAlpha     := tfRGB5;
3342   fRGBInverted      := tfBGR5A1;
3343   fRange.r          := $1F;
3344   fRange.g          := $1F;
3345   fRange.b          := $1F;
3346   fRange.a          := $01;
3347   fShift.r          :=   0;
3348   fShift.g          :=   5;
3349   fShift.b          :=  10;
3350   fShift.a          :=  15;
3351   fglFormat         := GL_RGBA;
3352   fglInternalFormat := GL_RGB5_A1;
3353   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3354 end;
3355
3356 constructor TfdRGBA8.Create;
3357 begin
3358   inherited Create;
3359   fFormat           := tfRGBA8;
3360   fWithAlpha        := tfRGBA8;
3361   fWithoutAlpha     := tfRGB8;
3362   fRGBInverted      := tfBGRA8;
3363   fglInternalFormat := GL_RGBA8;
3364 end;
3365
3366 constructor TfdRGB10A2.Create;
3367 begin
3368   inherited Create;
3369   fFormat           := tfRGB10A2;
3370   fWithAlpha        := tfRGB10A2;
3371   fWithoutAlpha     := tfRGB10;
3372   fRGBInverted      := tfBGR10A2;
3373   fRange.r          := $3FF;
3374   fRange.g          := $3FF;
3375   fRange.b          := $3FF;
3376   fRange.a          := $003;
3377   fShift.r          :=    0;
3378   fShift.g          :=   10;
3379   fShift.b          :=   20;
3380   fShift.a          :=   30;
3381   fglFormat         := GL_RGBA;
3382   fglInternalFormat := GL_RGB10_A2;
3383   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3384 end;
3385
3386 constructor TfdRGBA12.Create;
3387 begin
3388   inherited Create;
3389   fFormat           := tfRGBA12;
3390   fWithAlpha        := tfRGBA12;
3391   fWithoutAlpha     := tfRGB12;
3392   fRGBInverted      := tfBGRA12;
3393   fglInternalFormat := GL_RGBA12;
3394 end;
3395
3396 constructor TfdRGBA16.Create;
3397 begin
3398   inherited Create;
3399   fFormat           := tfRGBA16;
3400   fWithAlpha        := tfRGBA16;
3401   fWithoutAlpha     := tfRGB16;
3402   fRGBInverted      := tfBGRA16;
3403   fglInternalFormat := GL_RGBA16;
3404 end;
3405
3406 constructor TfdBGR4.Create;
3407 begin
3408   inherited Create;
3409   fPixelSize        := 2.0;
3410   fFormat           := tfBGR4;
3411   fWithAlpha        := tfBGRA4;
3412   fWithoutAlpha     := tfBGR4;
3413   fRGBInverted      := tfRGB4;
3414   fRange.r          := $F;
3415   fRange.g          := $F;
3416   fRange.b          := $F;
3417   fRange.a          := $0;
3418   fShift.r          :=  8;
3419   fShift.g          :=  4;
3420   fShift.b          :=  0;
3421   fShift.a          :=  0;
3422   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3423   fglInternalFormat := GL_RGB4;
3424   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3425 end;
3426
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3430 constructor TfdB5G6R5.Create;
3431 begin
3432   inherited Create;
3433   fFormat           := tfB5G6R5;
3434   fWithAlpha        := tfBGRA4;
3435   fWithoutAlpha     := tfB5G6R5;
3436   fRGBInverted      := tfR5G6B5;
3437   fRange.r          := $1F;
3438   fRange.g          := $3F;
3439   fRange.b          := $1F;
3440   fShift.r          :=  11;
3441   fShift.g          :=   5;
3442   fShift.b          :=   0;
3443   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3444   fglInternalFormat := GL_RGB8;
3445   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3446 end;
3447
3448 constructor TfdBGR5.Create;
3449 begin
3450   inherited Create;
3451   fPixelSize        := 2.0;
3452   fFormat           := tfBGR5;
3453   fWithAlpha        := tfBGR5A1;
3454   fWithoutAlpha     := tfBGR5;
3455   fRGBInverted      := tfRGB5;
3456   fRange.r          := $1F;
3457   fRange.g          := $1F;
3458   fRange.b          := $1F;
3459   fRange.a          := $00;
3460   fShift.r          :=  10;
3461   fShift.g          :=   5;
3462   fShift.b          :=   0;
3463   fShift.a          :=   0;
3464   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3465   fglInternalFormat := GL_RGB5;
3466   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3467 end;
3468
3469 constructor TfdBGR8.Create;
3470 begin
3471   inherited Create;
3472   fFormat           := tfBGR8;
3473   fWithAlpha        := tfBGRA8;
3474   fWithoutAlpha     := tfBGR8;
3475   fRGBInverted      := tfRGB8;
3476   fglInternalFormat := GL_RGB8;
3477 end;
3478
3479 constructor TfdBGR10.Create;
3480 begin
3481   inherited Create;
3482   fFormat           := tfBGR10;
3483   fWithAlpha        := tfBGR10A2;
3484   fWithoutAlpha     := tfBGR10;
3485   fRGBInverted      := tfRGB10;
3486   fRange.r          := $3FF;
3487   fRange.g          := $3FF;
3488   fRange.b          := $3FF;
3489   fRange.a          := $000;
3490   fShift.r          :=   20;
3491   fShift.g          :=   10;
3492   fShift.b          :=    0;
3493   fShift.a          :=    0;
3494   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3495   fglInternalFormat := GL_RGB10;
3496   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3497 end;
3498
3499 constructor TfdBGR12.Create;
3500 begin
3501   inherited Create;
3502   fFormat           := tfBGR12;
3503   fWithAlpha        := tfBGRA12;
3504   fWithoutAlpha     := tfBGR12;
3505   fRGBInverted      := tfRGB12;
3506   fglInternalFormat := GL_RGB12;
3507 end;
3508
3509 constructor TfdBGR16.Create;
3510 begin
3511   inherited Create;
3512   fFormat           := tfBGR16;
3513   fWithAlpha        := tfBGRA16;
3514   fWithoutAlpha     := tfBGR16;
3515   fRGBInverted      := tfRGB16;
3516   fglInternalFormat := GL_RGB16;
3517 end;
3518
3519 constructor TfdBGRA2.Create;
3520 begin
3521   inherited Create;
3522   fFormat           := tfBGRA2;
3523   fWithAlpha        := tfBGRA4;
3524   fWithoutAlpha     := tfBGR4;
3525   fRGBInverted      := tfRGBA2;
3526   fglInternalFormat := GL_RGBA2;
3527 end;
3528
3529 constructor TfdBGRA4.Create;
3530 begin
3531   inherited Create;
3532   fFormat           := tfBGRA4;
3533   fWithAlpha        := tfBGRA4;
3534   fWithoutAlpha     := tfBGR4;
3535   fRGBInverted      := tfRGBA4;
3536   fRange.r          := $F;
3537   fRange.g          := $F;
3538   fRange.b          := $F;
3539   fRange.a          := $F;
3540   fShift.r          :=  8;
3541   fShift.g          :=  4;
3542   fShift.b          :=  0;
3543   fShift.a          := 12;
3544   fglFormat         := GL_BGRA;
3545   fglInternalFormat := GL_RGBA4;
3546   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3547 end;
3548
3549 constructor TfdBGR5A1.Create;
3550 begin
3551   inherited Create;
3552   fFormat           := tfBGR5A1;
3553   fWithAlpha        := tfBGR5A1;
3554   fWithoutAlpha     := tfBGR5;
3555   fRGBInverted      := tfRGB5A1;
3556   fRange.r          := $1F;
3557   fRange.g          := $1F;
3558   fRange.b          := $1F;
3559   fRange.a          := $01;
3560   fShift.r          :=  10;
3561   fShift.g          :=   5;
3562   fShift.b          :=   0;
3563   fShift.a          :=  15;
3564   fglFormat         := GL_BGRA;
3565   fglInternalFormat := GL_RGB5_A1;
3566   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3567 end;
3568
3569 constructor TfdBGRA8.Create;
3570 begin
3571   inherited Create;
3572   fFormat           := tfBGRA8;
3573   fWithAlpha        := tfBGRA8;
3574   fWithoutAlpha     := tfBGR8;
3575   fRGBInverted      := tfRGBA8;
3576   fglInternalFormat := GL_RGBA8;
3577 end;
3578
3579 constructor TfdBGR10A2.Create;
3580 begin
3581   inherited Create;
3582   fFormat           := tfBGR10A2;
3583   fWithAlpha        := tfBGR10A2;
3584   fWithoutAlpha     := tfBGR10;
3585   fRGBInverted      := tfRGB10A2;
3586   fRange.r          := $3FF;
3587   fRange.g          := $3FF;
3588   fRange.b          := $3FF;
3589   fRange.a          := $003;
3590   fShift.r          :=   20;
3591   fShift.g          :=   10;
3592   fShift.b          :=    0;
3593   fShift.a          :=   30;
3594   fglFormat         := GL_BGRA;
3595   fglInternalFormat := GL_RGB10_A2;
3596   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3597 end;
3598
3599 constructor TfdBGRA12.Create;
3600 begin
3601   inherited Create;
3602   fFormat           := tfBGRA12;
3603   fWithAlpha        := tfBGRA12;
3604   fWithoutAlpha     := tfBGR12;
3605   fRGBInverted      := tfRGBA12;
3606   fglInternalFormat := GL_RGBA12;
3607 end;
3608
3609 constructor TfdBGRA16.Create;
3610 begin
3611   inherited Create;
3612   fFormat           := tfBGRA16;
3613   fWithAlpha        := tfBGRA16;
3614   fWithoutAlpha     := tfBGR16;
3615   fRGBInverted      := tfRGBA16;
3616   fglInternalFormat := GL_RGBA16;
3617 end;
3618
3619 constructor TfdDepth16.Create;
3620 begin
3621   inherited Create;
3622   fFormat           := tfDepth16;
3623   fWithAlpha        := tfEmpty;
3624   fWithoutAlpha     := tfDepth16;
3625   fglInternalFormat := GL_DEPTH_COMPONENT16;
3626 end;
3627
3628 constructor TfdDepth24.Create;
3629 begin
3630   inherited Create;
3631   fFormat           := tfDepth24;
3632   fWithAlpha        := tfEmpty;
3633   fWithoutAlpha     := tfDepth24;
3634   fglInternalFormat := GL_DEPTH_COMPONENT24;
3635 end;
3636
3637 constructor TfdDepth32.Create;
3638 begin
3639   inherited Create;
3640   fFormat           := tfDepth32;
3641   fWithAlpha        := tfEmpty;
3642   fWithoutAlpha     := tfDepth32;
3643   fglInternalFormat := GL_DEPTH_COMPONENT32;
3644 end;
3645
3646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3649 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3650 begin
3651   raise EglBitmap.Create('mapping for compressed formats is not supported');
3652 end;
3653
3654 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3655 begin
3656   raise EglBitmap.Create('mapping for compressed formats is not supported');
3657 end;
3658
3659 constructor TfdS3tcDtx1RGBA.Create;
3660 begin
3661   inherited Create;
3662   fFormat           := tfS3tcDtx1RGBA;
3663   fWithAlpha        := tfS3tcDtx1RGBA;
3664   fUncompressed     := tfRGB5A1;
3665   fPixelSize        := 0.5;
3666   fIsCompressed     := true;
3667   fglFormat         := GL_COMPRESSED_RGBA;
3668   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3669   fglDataFormat     := GL_UNSIGNED_BYTE;
3670 end;
3671
3672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3675 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3676 begin
3677   raise EglBitmap.Create('mapping for compressed formats is not supported');
3678 end;
3679
3680 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3681 begin
3682   raise EglBitmap.Create('mapping for compressed formats is not supported');
3683 end;
3684
3685 constructor TfdS3tcDtx3RGBA.Create;
3686 begin
3687   inherited Create;
3688   fFormat           := tfS3tcDtx3RGBA;
3689   fWithAlpha        := tfS3tcDtx3RGBA;
3690   fUncompressed     := tfRGBA8;
3691   fPixelSize        := 1.0;
3692   fIsCompressed     := true;
3693   fglFormat         := GL_COMPRESSED_RGBA;
3694   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3695   fglDataFormat     := GL_UNSIGNED_BYTE;
3696 end;
3697
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3701 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3702 begin
3703   raise EglBitmap.Create('mapping for compressed formats is not supported');
3704 end;
3705
3706 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3707 begin
3708   raise EglBitmap.Create('mapping for compressed formats is not supported');
3709 end;
3710
3711 constructor TfdS3tcDtx5RGBA.Create;
3712 begin
3713   inherited Create;
3714   fFormat           := tfS3tcDtx3RGBA;
3715   fWithAlpha        := tfS3tcDtx3RGBA;
3716   fUncompressed     := tfRGBA8;
3717   fPixelSize        := 1.0;
3718   fIsCompressed     := true;
3719   fglFormat         := GL_COMPRESSED_RGBA;
3720   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3721   fglDataFormat     := GL_UNSIGNED_BYTE;
3722 end;
3723
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3727 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3728 var
3729   f: TglBitmapFormat;
3730 begin
3731   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3732     result := TFormatDescriptor.Get(f);
3733     if (result.glInternalFormat = aInternalFormat) then
3734       exit;
3735   end;
3736   result := TFormatDescriptor.Get(tfEmpty);
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3742 class procedure TFormatDescriptor.Init;
3743 begin
3744   if not Assigned(FormatDescriptorCS) then
3745     FormatDescriptorCS := TCriticalSection.Create;
3746 end;
3747
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3750 begin
3751   FormatDescriptorCS.Enter;
3752   try
3753     result := FormatDescriptors[aFormat];
3754     if not Assigned(result) then begin
3755       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3756       FormatDescriptors[aFormat] := result;
3757     end;
3758   finally
3759     FormatDescriptorCS.Leave;
3760   end;
3761 end;
3762
3763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3764 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3765 begin
3766   result := Get(Get(aFormat).WithAlpha);
3767 end;
3768
3769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3770 class procedure TFormatDescriptor.Clear;
3771 var
3772   f: TglBitmapFormat;
3773 begin
3774   FormatDescriptorCS.Enter;
3775   try
3776     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3777       FreeAndNil(FormatDescriptors[f]);
3778   finally
3779     FormatDescriptorCS.Leave;
3780   end;
3781 end;
3782
3783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3784 class procedure TFormatDescriptor.Finalize;
3785 begin
3786   Clear;
3787   FreeAndNil(FormatDescriptorCS);
3788 end;
3789
3790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3791 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3793 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3794 begin
3795   Update(aValue, fRange.r, fShift.r);
3796 end;
3797
3798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3799 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3800 begin
3801   Update(aValue, fRange.g, fShift.g);
3802 end;
3803
3804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3805 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3806 begin
3807   Update(aValue, fRange.b, fShift.b);
3808 end;
3809
3810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3811 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3812 begin
3813   Update(aValue, fRange.a, fShift.a);
3814 end;
3815
3816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3818   aShift: Byte);
3819 begin
3820   aShift := 0;
3821   aRange := 0;
3822   if (aMask = 0) then
3823     exit;
3824   while (aMask > 0) and ((aMask and 1) = 0) do begin
3825     inc(aShift);
3826     aMask := aMask shr 1;
3827   end;
3828   aRange := 1;
3829   while (aMask > 0) do begin
3830     aRange := aRange shl 1;
3831     aMask  := aMask  shr 1;
3832   end;
3833   dec(aRange);
3834
3835   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3836 end;
3837
3838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3840 var
3841   data: QWord;
3842   s: Integer;
3843 begin
3844   data :=
3845     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3846     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3847     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3848     ((aPixel.Data.a and fRange.a) shl fShift.a);
3849   s := Round(fPixelSize);
3850   case s of
3851     1:           aData^  := data;
3852     2:     PWord(aData)^ := data;
3853     4: PCardinal(aData)^ := data;
3854     8:    PQWord(aData)^ := data;
3855   else
3856     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3857   end;
3858   inc(aData, s);
3859 end;
3860
3861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3862 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3863 var
3864   data: QWord;
3865   s, i: Integer;
3866 begin
3867   s := Round(fPixelSize);
3868   case s of
3869     1: data :=           aData^;
3870     2: data :=     PWord(aData)^;
3871     4: data := PCardinal(aData)^;
3872     8: data :=    PQWord(aData)^;
3873   else
3874     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3875   end;
3876   for i := 0 to 3 do
3877     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3878   inc(aData, s);
3879 end;
3880
3881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 procedure TbmpColorTableFormat.CreateColorTable;
3885 var
3886   i: Integer;
3887 begin
3888   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3889     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3890
3891   if (Format = tfLuminance4) then
3892     SetLength(fColorTable, 16)
3893   else
3894     SetLength(fColorTable, 256);
3895
3896   case Format of
3897     tfLuminance4: begin
3898       for i := 0 to High(fColorTable) do begin
3899         fColorTable[i].r := 16 * i;
3900         fColorTable[i].g := 16 * i;
3901         fColorTable[i].b := 16 * i;
3902         fColorTable[i].a := 0;
3903       end;
3904     end;
3905
3906     tfLuminance8: begin
3907       for i := 0 to High(fColorTable) do begin
3908         fColorTable[i].r := i;
3909         fColorTable[i].g := i;
3910         fColorTable[i].b := i;
3911         fColorTable[i].a := 0;
3912       end;
3913     end;
3914
3915     tfR3G3B2: begin
3916       for i := 0 to High(fColorTable) do begin
3917         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3918         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3919         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3920         fColorTable[i].a := 0;
3921       end;
3922     end;
3923   end;
3924 end;
3925
3926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3927 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3928 var
3929   d: Byte;
3930 begin
3931   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3932     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3933
3934   case Format of
3935     tfLuminance4: begin
3936       if (aMapData = nil) then
3937         aData^ := 0;
3938       d := LuminanceWeight(aPixel) and Range.r;
3939       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3940       inc(PByte(aMapData), 4);
3941       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3942         inc(aData);
3943         aMapData := nil;
3944       end;
3945     end;
3946
3947     tfLuminance8: begin
3948       aData^ := LuminanceWeight(aPixel) and Range.r;
3949       inc(aData);
3950     end;
3951
3952     tfR3G3B2: begin
3953       aData^ := Round(
3954         ((aPixel.Data.r and Range.r) shl Shift.r) or
3955         ((aPixel.Data.g and Range.g) shl Shift.g) or
3956         ((aPixel.Data.b and Range.b) shl Shift.b));
3957       inc(aData);
3958     end;
3959   end;
3960 end;
3961
3962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3963 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3964 var
3965   idx: QWord;
3966   s: Integer;
3967   bits: Byte;
3968   f: Single;
3969 begin
3970   s    := Trunc(fPixelSize);
3971   f    := fPixelSize - s;
3972   bits := Round(8 * f);
3973   case s of
3974     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3975     1: idx :=           aData^;
3976     2: idx :=     PWord(aData)^;
3977     4: idx := PCardinal(aData)^;
3978     8: idx :=    PQWord(aData)^;
3979   else
3980     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3981   end;
3982   if (idx >= Length(fColorTable)) then
3983     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3984   with fColorTable[idx] do begin
3985     aPixel.Data.r := r;
3986     aPixel.Data.g := g;
3987     aPixel.Data.b := b;
3988     aPixel.Data.a := a;
3989   end;
3990   inc(PByte(aMapData), bits);
3991   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3992     inc(aData, 1);
3993     dec(PByte(aMapData), 8);
3994   end;
3995   inc(aData, s);
3996 end;
3997
3998 destructor TbmpColorTableFormat.Destroy;
3999 begin
4000   SetLength(fColorTable, 0);
4001   inherited Destroy;
4002 end;
4003
4004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4005 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4008 var
4009   i: Integer;
4010 begin
4011   for i := 0 to 3 do begin
4012     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4013       if (aSourceFD.Range.arr[i] > 0) then
4014         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4015       else
4016         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4017     end;
4018   end;
4019 end;
4020
4021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4023 begin
4024   with aFuncRec do begin
4025     if (Source.Range.r   > 0) then
4026       Dest.Data.r := Source.Data.r;
4027     if (Source.Range.g > 0) then
4028       Dest.Data.g := Source.Data.g;
4029     if (Source.Range.b  > 0) then
4030       Dest.Data.b := Source.Data.b;
4031     if (Source.Range.a > 0) then
4032       Dest.Data.a := Source.Data.a;
4033   end;
4034 end;
4035
4036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4037 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4038 var
4039   i: Integer;
4040 begin
4041   with aFuncRec do begin
4042     for i := 0 to 3 do
4043       if (Source.Range.arr[i] > 0) then
4044         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4045   end;
4046 end;
4047
4048 type
4049   TShiftData = packed record
4050     case Integer of
4051       0: (r, g, b, a: SmallInt);
4052       1: (arr: array[0..3] of SmallInt);
4053   end;
4054   PShiftData = ^TShiftData;
4055
4056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4057 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4058 var
4059   i: Integer;
4060 begin
4061   with aFuncRec do
4062     for i := 0 to 3 do
4063       if (Source.Range.arr[i] > 0) then
4064         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4069 begin
4070   with aFuncRec do begin
4071     Dest.Data := Source.Data;
4072     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4073       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4074       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4075       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4076     end;
4077     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4078       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4079     end;
4080   end;
4081 end;
4082
4083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4084 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4085 var
4086   i: Integer;
4087 begin
4088   with aFuncRec do begin
4089     for i := 0 to 3 do
4090       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4091   end;
4092 end;
4093
4094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4095 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4096 var
4097   Temp: Single;
4098 begin
4099   with FuncRec do begin
4100     if (FuncRec.Args = nil) then begin //source has no alpha
4101       Temp :=
4102         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4103         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4104         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4105       Dest.Data.a := Round(Dest.Range.a * Temp);
4106     end else
4107       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4108   end;
4109 end;
4110
4111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4112 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4113 type
4114   PglBitmapPixelData = ^TglBitmapPixelData;
4115 begin
4116   with FuncRec do begin
4117     Dest.Data.r := Source.Data.r;
4118     Dest.Data.g := Source.Data.g;
4119     Dest.Data.b := Source.Data.b;
4120
4121     with PglBitmapPixelData(Args)^ do
4122       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4123           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4124           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4125         Dest.Data.a := 0
4126       else
4127         Dest.Data.a := Dest.Range.a;
4128   end;
4129 end;
4130
4131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4132 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4133 begin
4134   with FuncRec do begin
4135     Dest.Data.r := Source.Data.r;
4136     Dest.Data.g := Source.Data.g;
4137     Dest.Data.b := Source.Data.b;
4138     Dest.Data.a := PCardinal(Args)^;
4139   end;
4140 end;
4141
4142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4144 type
4145   PRGBPix = ^TRGBPix;
4146   TRGBPix = array [0..2] of byte;
4147 var
4148   Temp: Byte;
4149 begin
4150   while aWidth > 0 do begin
4151     Temp := PRGBPix(aData)^[0];
4152     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4153     PRGBPix(aData)^[2] := Temp;
4154
4155     if aHasAlpha then
4156       Inc(aData, 4)
4157     else
4158       Inc(aData, 3);
4159     dec(aWidth);
4160   end;
4161 end;
4162
4163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4164 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4167 begin
4168   result := TFormatDescriptor.Get(Format);
4169 end;
4170
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 function TglBitmap.GetWidth: Integer;
4173 begin
4174   if (ffX in fDimension.Fields) then
4175     result := fDimension.X
4176   else
4177     result := -1;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 function TglBitmap.GetHeight: Integer;
4182 begin
4183   if (ffY in fDimension.Fields) then
4184     result := fDimension.Y
4185   else
4186     result := -1;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 function TglBitmap.GetFileWidth: Integer;
4191 begin
4192   result := Max(1, Width);
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 function TglBitmap.GetFileHeight: Integer;
4197 begin
4198   result := Max(1, Height);
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4203 begin
4204   if fCustomData = aValue then
4205     exit;
4206   fCustomData := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetCustomName(const aValue: String);
4211 begin
4212   if fCustomName = aValue then
4213     exit;
4214   fCustomName := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4219 begin
4220   if fCustomNameW = aValue then
4221     exit;
4222   fCustomNameW := aValue;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4227 begin
4228   if fFreeDataOnDestroy = aValue then
4229     exit;
4230   fFreeDataOnDestroy := aValue;
4231 end;
4232
4233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4234 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4235 begin
4236   if fDeleteTextureOnFree = aValue then
4237     exit;
4238   fDeleteTextureOnFree := aValue;
4239 end;
4240
4241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4242 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4243 begin
4244   if fFormat = aValue then
4245     exit;
4246   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4247     raise EglBitmapUnsupportedFormat.Create(Format);
4248   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4249 end;
4250
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4253 begin
4254   if fFreeDataAfterGenTexture = aValue then
4255     exit;
4256   fFreeDataAfterGenTexture := aValue;
4257 end;
4258
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TglBitmap.SetID(const aValue: Cardinal);
4261 begin
4262   if fID = aValue then
4263     exit;
4264   fID := aValue;
4265 end;
4266
4267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4268 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4269 begin
4270   if fMipMap = aValue then
4271     exit;
4272   fMipMap := aValue;
4273 end;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4277 begin
4278   if fTarget = aValue then
4279     exit;
4280   fTarget := aValue;
4281 end;
4282
4283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4284 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4285 var
4286   MaxAnisotropic: Integer;
4287 begin
4288   fAnisotropic := aValue;
4289   if (ID > 0) then begin
4290     if GL_EXT_texture_filter_anisotropic then begin
4291       if fAnisotropic > 0 then begin
4292         Bind(false);
4293         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4294         if aValue > MaxAnisotropic then
4295           fAnisotropic := MaxAnisotropic;
4296         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4297       end;
4298     end else begin
4299       fAnisotropic := 0;
4300     end;
4301   end;
4302 end;
4303
4304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4305 procedure TglBitmap.CreateID;
4306 begin
4307   if (ID <> 0) then
4308     glDeleteTextures(1, @fID);
4309   glGenTextures(1, @fID);
4310   Bind(false);
4311 end;
4312
4313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4314 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4315 begin
4316   // Set Up Parameters
4317   SetWrap(fWrapS, fWrapT, fWrapR);
4318   SetFilter(fFilterMin, fFilterMag);
4319   SetAnisotropic(fAnisotropic);
4320   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4321
4322   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4323     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4324
4325   // Mip Maps Generation Mode
4326   aBuildWithGlu := false;
4327   if (MipMap = mmMipmap) then begin
4328     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4329       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4330     else
4331       aBuildWithGlu := true;
4332   end else if (MipMap = mmMipmapGlu) then
4333     aBuildWithGlu := true;
4334 end;
4335
4336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4337 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4338   const aWidth: Integer; const aHeight: Integer);
4339 var
4340   s: Single;
4341 begin
4342   if (Data <> aData) then begin
4343     if (Assigned(Data)) then
4344       FreeMem(Data);
4345     fData := aData;
4346   end;
4347
4348   if not Assigned(fData) then begin
4349     fPixelSize := 0;
4350     fRowSize   := 0;
4351   end else begin
4352     FillChar(fDimension, SizeOf(fDimension), 0);
4353     if aWidth <> -1 then begin
4354       fDimension.Fields := fDimension.Fields + [ffX];
4355       fDimension.X := aWidth;
4356     end;
4357
4358     if aHeight <> -1 then begin
4359       fDimension.Fields := fDimension.Fields + [ffY];
4360       fDimension.Y := aHeight;
4361     end;
4362
4363     s := TFormatDescriptor.Get(aFormat).PixelSize;
4364     fFormat    := aFormat;
4365     fPixelSize := Ceil(s);
4366     fRowSize   := Ceil(s * aWidth);
4367   end;
4368 end;
4369
4370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4371 function TglBitmap.FlipHorz: Boolean;
4372 begin
4373   result := false;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmap.FlipVert: Boolean;
4378 begin
4379   result := false;
4380 end;
4381
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure TglBitmap.AfterConstruction;
4386 begin
4387   inherited AfterConstruction;
4388
4389   fID         := 0;
4390   fTarget     := 0;
4391   fIsResident := false;
4392
4393   fMipMap                  := glBitmapDefaultMipmap;
4394   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4395   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4396
4397   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4398   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4399   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4400 end;
4401
4402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4403 procedure TglBitmap.BeforeDestruction;
4404 var
4405   NewData: PByte;
4406 begin
4407   if fFreeDataOnDestroy then begin
4408     NewData := nil;
4409     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4410   end;
4411   if (fID > 0) and fDeleteTextureOnFree then
4412     glDeleteTextures(1, @fID);
4413   inherited BeforeDestruction;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4418 var
4419   TempPos: Integer;
4420 begin
4421   if not Assigned(aResType) then begin
4422     TempPos   := Pos('.', aResource);
4423     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4424     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4425   end;
4426 end;
4427
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 procedure TglBitmap.LoadFromFile(const aFilename: String);
4430 var
4431   fs: TFileStream;
4432 begin
4433   if not FileExists(aFilename) then
4434     raise EglBitmap.Create('file does not exist: ' + aFilename);
4435   fFilename := aFilename;
4436   fs := TFileStream.Create(fFilename, fmOpenRead);
4437   try
4438     fs.Position := 0;
4439     LoadFromStream(fs);
4440   finally
4441     fs.Free;
4442   end;
4443 end;
4444
4445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4446 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4447 begin
4448   {$IFDEF GLB_SUPPORT_PNG_READ}
4449   if not LoadPNG(aStream) then
4450   {$ENDIF}
4451   {$IFDEF GLB_SUPPORT_JPEG_READ}
4452   if not LoadJPEG(aStream) then
4453   {$ENDIF}
4454   if not LoadDDS(aStream) then
4455   if not LoadTGA(aStream) then
4456   if not LoadBMP(aStream) then
4457     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4458 end;
4459
4460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4461 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4462   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4463 var
4464   tmpData: PByte;
4465   size: Integer;
4466 begin
4467   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4468   GetMem(tmpData, size);
4469   try
4470     FillChar(tmpData^, size, #$FF);
4471     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4472   except
4473     if Assigned(tmpData) then
4474       FreeMem(tmpData);
4475     raise;
4476   end;
4477   AddFunc(Self, aFunc, false, aFormat, aArgs);
4478 end;
4479
4480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4481 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4482 var
4483   rs: TResourceStream;
4484 begin
4485   PrepareResType(aResource, aResType);
4486   rs := TResourceStream.Create(aInstance, aResource, aResType);
4487   try
4488     LoadFromStream(rs);
4489   finally
4490     rs.Free;
4491   end;
4492 end;
4493
4494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4495 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4496 var
4497   rs: TResourceStream;
4498 begin
4499   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4500   try
4501     LoadFromStream(rs);
4502   finally
4503     rs.Free;
4504   end;
4505 end;
4506
4507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4508 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4509 var
4510   fs: TFileStream;
4511 begin
4512   fs := TFileStream.Create(aFileName, fmCreate);
4513   try
4514     fs.Position := 0;
4515     SaveToStream(fs, aFileType);
4516   finally
4517     fs.Free;
4518   end;
4519 end;
4520
4521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4522 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4523 begin
4524   case aFileType of
4525     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4526     ftPNG:  SavePNG(aStream);
4527     {$ENDIF}
4528     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4529     ftJPEG: SaveJPEG(aStream);
4530     {$ENDIF}
4531     ftDDS:  SaveDDS(aStream);
4532     ftTGA:  SaveTGA(aStream);
4533     ftBMP:  SaveBMP(aStream);
4534   end;
4535 end;
4536
4537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4538 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4539 begin
4540   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4541 end;
4542
4543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4544 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4545   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4546 var
4547   DestData, TmpData, SourceData: pByte;
4548   TempHeight, TempWidth: Integer;
4549   SourceFD, DestFD: TFormatDescriptor;
4550   SourceMD, DestMD: Pointer;
4551
4552   FuncRec: TglBitmapFunctionRec;
4553 begin
4554   Assert(Assigned(Data));
4555   Assert(Assigned(aSource));
4556   Assert(Assigned(aSource.Data));
4557
4558   result := false;
4559   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4560     SourceFD := TFormatDescriptor.Get(aSource.Format);
4561     DestFD   := TFormatDescriptor.Get(aFormat);
4562
4563     if (SourceFD.IsCompressed) then
4564       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4565     if (DestFD.IsCompressed) then
4566       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4567
4568     // inkompatible Formats so CreateTemp
4569     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4570       aCreateTemp := true;
4571
4572     // Values
4573     TempHeight := Max(1, aSource.Height);
4574     TempWidth  := Max(1, aSource.Width);
4575
4576     FuncRec.Sender := Self;
4577     FuncRec.Args   := aArgs;
4578
4579     TmpData := nil;
4580     if aCreateTemp then begin
4581       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4582       DestData := TmpData;
4583     end else
4584       DestData := Data;
4585
4586     try
4587       SourceFD.PreparePixel(FuncRec.Source);
4588       DestFD.PreparePixel  (FuncRec.Dest);
4589
4590       SourceMD := SourceFD.CreateMappingData;
4591       DestMD   := DestFD.CreateMappingData;
4592
4593       FuncRec.Size            := aSource.Dimension;
4594       FuncRec.Position.Fields := FuncRec.Size.Fields;
4595
4596       try
4597         SourceData := aSource.Data;
4598         FuncRec.Position.Y := 0;
4599         while FuncRec.Position.Y < TempHeight do begin
4600           FuncRec.Position.X := 0;
4601           while FuncRec.Position.X < TempWidth do begin
4602             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4603             aFunc(FuncRec);
4604             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4605             inc(FuncRec.Position.X);
4606           end;
4607           inc(FuncRec.Position.Y);
4608         end;
4609
4610         // Updating Image or InternalFormat
4611         if aCreateTemp then
4612           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4613         else if (aFormat <> fFormat) then
4614           Format := aFormat;
4615
4616         result := true;
4617       finally
4618         SourceFD.FreeMappingData(SourceMD);
4619         DestFD.FreeMappingData(DestMD);
4620       end;
4621     except
4622       if aCreateTemp and Assigned(TmpData) then
4623         FreeMem(TmpData);
4624       raise;
4625     end;
4626   end;
4627 end;
4628
4629 {$IFDEF GLB_SDL}
4630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4631 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4632 var
4633   Row, RowSize: Integer;
4634   SourceData, TmpData: PByte;
4635   TempDepth: Integer;
4636   FormatDesc: TFormatDescriptor;
4637
4638   function GetRowPointer(Row: Integer): pByte;
4639   begin
4640     result := aSurface.pixels;
4641     Inc(result, Row * RowSize);
4642   end;
4643
4644 begin
4645   result := false;
4646
4647   FormatDesc := TFormatDescriptor.Get(Format);
4648   if FormatDesc.IsCompressed then
4649     raise EglBitmapUnsupportedFormat.Create(Format);
4650
4651   if Assigned(Data) then begin
4652     case Trunc(FormatDesc.PixelSize) of
4653       1: TempDepth :=  8;
4654       2: TempDepth := 16;
4655       3: TempDepth := 24;
4656       4: TempDepth := 32;
4657     else
4658       raise EglBitmapUnsupportedFormat.Create(Format);
4659     end;
4660
4661     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4662       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4663     SourceData := Data;
4664     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4665
4666     for Row := 0 to FileHeight-1 do begin
4667       TmpData := GetRowPointer(Row);
4668       if Assigned(TmpData) then begin
4669         Move(SourceData^, TmpData^, RowSize);
4670         inc(SourceData, RowSize);
4671       end;
4672     end;
4673     result := true;
4674   end;
4675 end;
4676
4677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4678 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4679 var
4680   pSource, pData, pTempData: PByte;
4681   Row, RowSize, TempWidth, TempHeight: Integer;
4682   IntFormat: TglBitmapFormat;
4683   FormatDesc: TFormatDescriptor;
4684
4685   function GetRowPointer(Row: Integer): pByte;
4686   begin
4687     result := aSurface^.pixels;
4688     Inc(result, Row * RowSize);
4689   end;
4690
4691 begin
4692   result := false;
4693   if (Assigned(aSurface)) then begin
4694     with aSurface^.format^ do begin
4695       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4696         FormatDesc := TFormatDescriptor.Get(IntFormat);
4697         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4698           break;
4699       end;
4700       if (IntFormat = tfEmpty) then
4701         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4702     end;
4703
4704     TempWidth  := aSurface^.w;
4705     TempHeight := aSurface^.h;
4706     RowSize := FormatDesc.GetSize(TempWidth, 1);
4707     GetMem(pData, TempHeight * RowSize);
4708     try
4709       pTempData := pData;
4710       for Row := 0 to TempHeight -1 do begin
4711         pSource := GetRowPointer(Row);
4712         if (Assigned(pSource)) then begin
4713           Move(pSource^, pTempData^, RowSize);
4714           Inc(pTempData, RowSize);
4715         end;
4716       end;
4717       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4718       result := true;
4719     except
4720       if Assigned(pData) then
4721         FreeMem(pData);
4722       raise;
4723     end;
4724   end;
4725 end;
4726
4727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4728 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4729 var
4730   Row, Col, AlphaInterleave: Integer;
4731   pSource, pDest: PByte;
4732
4733   function GetRowPointer(Row: Integer): pByte;
4734   begin
4735     result := aSurface.pixels;
4736     Inc(result, Row * Width);
4737   end;
4738
4739 begin
4740   result := false;
4741   if Assigned(Data) then begin
4742     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4743       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4744
4745       AlphaInterleave := 0;
4746       case Format of
4747         tfLuminance8Alpha8:
4748           AlphaInterleave := 1;
4749         tfBGRA8, tfRGBA8:
4750           AlphaInterleave := 3;
4751       end;
4752
4753       pSource := Data;
4754       for Row := 0 to Height -1 do begin
4755         pDest := GetRowPointer(Row);
4756         if Assigned(pDest) then begin
4757           for Col := 0 to Width -1 do begin
4758             Inc(pSource, AlphaInterleave);
4759             pDest^ := pSource^;
4760             Inc(pDest);
4761             Inc(pSource);
4762           end;
4763         end;
4764       end;
4765       result := true;
4766     end;
4767   end;
4768 end;
4769
4770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4771 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4772 var
4773   bmp: TglBitmap2D;
4774 begin
4775   bmp := TglBitmap2D.Create;
4776   try
4777     bmp.AssignFromSurface(aSurface);
4778     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4779   finally
4780     bmp.Free;
4781   end;
4782 end;
4783 {$ENDIF}
4784
4785 {$IFDEF GLB_DELPHI}
4786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4787 function CreateGrayPalette: HPALETTE;
4788 var
4789   Idx: Integer;
4790   Pal: PLogPalette;
4791 begin
4792   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4793
4794   Pal.palVersion := $300;
4795   Pal.palNumEntries := 256;
4796
4797   for Idx := 0 to Pal.palNumEntries - 1 do begin
4798     Pal.palPalEntry[Idx].peRed   := Idx;
4799     Pal.palPalEntry[Idx].peGreen := Idx;
4800     Pal.palPalEntry[Idx].peBlue  := Idx;
4801     Pal.palPalEntry[Idx].peFlags := 0;
4802   end;
4803   Result := CreatePalette(Pal^);
4804   FreeMem(Pal);
4805 end;
4806
4807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4808 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4809 var
4810   Row: Integer;
4811   pSource, pData: PByte;
4812 begin
4813   result := false;
4814   if Assigned(Data) then begin
4815     if Assigned(aBitmap) then begin
4816       aBitmap.Width  := Width;
4817       aBitmap.Height := Height;
4818
4819       case Format of
4820         tfAlpha8, tfLuminance8: begin
4821           aBitmap.PixelFormat := pf8bit;
4822           aBitmap.Palette     := CreateGrayPalette;
4823         end;
4824         tfRGB5A1:
4825           aBitmap.PixelFormat := pf15bit;
4826         tfR5G6B5:
4827           aBitmap.PixelFormat := pf16bit;
4828         tfRGB8, tfBGR8:
4829           aBitmap.PixelFormat := pf24bit;
4830         tfRGBA8, tfBGRA8:
4831           aBitmap.PixelFormat := pf32bit;
4832       else
4833         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4834       end;
4835
4836       pSource := Data;
4837       for Row := 0 to FileHeight -1 do begin
4838         pData := aBitmap.Scanline[Row];
4839         Move(pSource^, pData^, fRowSize);
4840         Inc(pSource, fRowSize);
4841         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4842           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4843       end;
4844       result := true;
4845     end;
4846   end;
4847 end;
4848
4849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4850 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4851 var
4852   pSource, pData, pTempData: PByte;
4853   Row, RowSize, TempWidth, TempHeight: Integer;
4854   IntFormat: TglBitmapFormat;
4855 begin
4856   result := false;
4857
4858   if (Assigned(aBitmap)) then begin
4859     case aBitmap.PixelFormat of
4860       pf8bit:
4861         IntFormat := tfLuminance8;
4862       pf15bit:
4863         IntFormat := tfRGB5A1;
4864       pf16bit:
4865         IntFormat := tfR5G6B5;
4866       pf24bit:
4867         IntFormat := tfBGR8;
4868       pf32bit:
4869         IntFormat := tfBGRA8;
4870     else
4871       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4872     end;
4873
4874     TempWidth  := aBitmap.Width;
4875     TempHeight := aBitmap.Height;
4876     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4877     GetMem(pData, TempHeight * RowSize);
4878     try
4879       pTempData := pData;
4880       for Row := 0 to TempHeight -1 do begin
4881         pSource := aBitmap.Scanline[Row];
4882         if (Assigned(pSource)) then begin
4883           Move(pSource^, pTempData^, RowSize);
4884           Inc(pTempData, RowSize);
4885         end;
4886       end;
4887       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4888       result := true;
4889     except
4890       if Assigned(pData) then
4891         FreeMem(pData);
4892       raise;
4893     end;
4894   end;
4895 end;
4896
4897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4898 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4899 var
4900   Row, Col, AlphaInterleave: Integer;
4901   pSource, pDest: PByte;
4902 begin
4903   result := false;
4904
4905   if Assigned(Data) then begin
4906     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4907       if Assigned(aBitmap) then begin
4908         aBitmap.PixelFormat := pf8bit;
4909         aBitmap.Palette     := CreateGrayPalette;
4910         aBitmap.Width       := Width;
4911         aBitmap.Height      := Height;
4912
4913         case Format of
4914           tfLuminance8Alpha8:
4915             AlphaInterleave := 1;
4916           tfRGBA8, tfBGRA8:
4917             AlphaInterleave := 3;
4918           else
4919             AlphaInterleave := 0;
4920         end;
4921
4922         // Copy Data
4923         pSource := Data;
4924
4925         for Row := 0 to Height -1 do begin
4926           pDest := aBitmap.Scanline[Row];
4927           if Assigned(pDest) then begin
4928             for Col := 0 to Width -1 do begin
4929               Inc(pSource, AlphaInterleave);
4930               pDest^ := pSource^;
4931               Inc(pDest);
4932               Inc(pSource);
4933             end;
4934           end;
4935         end;
4936         result := true;
4937       end;
4938     end;
4939   end;
4940 end;
4941
4942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4943 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4944 var
4945   tex: TglBitmap2D;
4946 begin
4947   tex := TglBitmap2D.Create;
4948   try
4949     tex.AssignFromBitmap(ABitmap);
4950     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4951   finally
4952     tex.Free;
4953   end;
4954 end;
4955 {$ENDIF}
4956
4957 {$IFDEF GLB_LAZARUS}
4958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4959 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4960 var
4961   rid: TRawImageDescription;
4962   FormatDesc: TFormatDescriptor;
4963 begin
4964   result := false;
4965   if not Assigned(aImage) or (Format = tfEmpty) then
4966     exit;
4967   FormatDesc := TFormatDescriptor.Get(Format);
4968   if FormatDesc.IsCompressed then
4969     exit;
4970
4971   FillChar(rid{%H-}, SizeOf(rid), 0);
4972   if (Format in [
4973        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4974        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4975        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4976     rid.Format := ricfGray
4977   else
4978     rid.Format := ricfRGBA;
4979
4980   rid.Width        := Width;
4981   rid.Height       := Height;
4982   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4983   rid.BitOrder     := riboBitsInOrder;
4984   rid.ByteOrder    := riboLSBFirst;
4985   rid.LineOrder    := riloTopToBottom;
4986   rid.LineEnd      := rileTight;
4987   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4988   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4989   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4990   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4991   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4992   rid.RedShift     := FormatDesc.Shift.r;
4993   rid.GreenShift   := FormatDesc.Shift.g;
4994   rid.BlueShift    := FormatDesc.Shift.b;
4995   rid.AlphaShift   := FormatDesc.Shift.a;
4996
4997   rid.MaskBitsPerPixel  := 0;
4998   rid.PaletteColorCount := 0;
4999
5000   aImage.DataDescription := rid;
5001   aImage.CreateData;
5002
5003   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5004
5005   result := true;
5006 end;
5007
5008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5009 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5010 var
5011   f: TglBitmapFormat;
5012   FormatDesc: TFormatDescriptor;
5013   ImageData: PByte;
5014   ImageSize: Integer;
5015   CanCopy: Boolean;
5016
5017   procedure CopyConvert;
5018   var
5019     bfFormat: TbmpBitfieldFormat;
5020     pSourceLine, pDestLine: PByte;
5021     pSourceMD, pDestMD: Pointer;
5022     x, y: Integer;
5023     pixel: TglBitmapPixelData;
5024   begin
5025     bfFormat  := TbmpBitfieldFormat.Create;
5026     with aImage.DataDescription do begin
5027       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5028       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5029       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5030       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5031       bfFormat.PixelSize := BitsPerPixel / 8;
5032     end;
5033     pSourceMD := bfFormat.CreateMappingData;
5034     pDestMD   := FormatDesc.CreateMappingData;
5035     try
5036       for y := 0 to aImage.Height-1 do begin
5037         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5038         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5039         for x := 0 to aImage.Width-1 do begin
5040           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5041           FormatDesc.Map(pixel, pDestLine, pDestMD);
5042         end;
5043       end;
5044     finally
5045       FormatDesc.FreeMappingData(pDestMD);
5046       bfFormat.FreeMappingData(pSourceMD);
5047       bfFormat.Free;
5048     end;
5049   end;
5050
5051 begin
5052   result := false;
5053   if not Assigned(aImage) then
5054     exit;
5055   for f := High(f) downto Low(f) do begin
5056     FormatDesc := TFormatDescriptor.Get(f);
5057     with aImage.DataDescription do
5058       if FormatDesc.MaskMatch(
5059         (QWord(1 shl RedPrec  )-1) shl RedShift,
5060         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5061         (QWord(1 shl BluePrec )-1) shl BlueShift,
5062         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5063         break;
5064   end;
5065
5066   if (f = tfEmpty) then
5067     exit;
5068
5069   CanCopy :=
5070     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5071     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5072
5073   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5074   ImageData := GetMem(ImageSize);
5075   try
5076     if CanCopy then
5077       Move(aImage.PixelData^, ImageData^, ImageSize)
5078     else
5079       CopyConvert;
5080     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5081   except
5082     if Assigned(ImageData) then
5083       FreeMem(ImageData);
5084     raise;
5085   end;
5086
5087   result := true;
5088 end;
5089
5090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5091 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5092 var
5093   rid: TRawImageDescription;
5094   FormatDesc: TFormatDescriptor;
5095   Pixel: TglBitmapPixelData;
5096   x, y: Integer;
5097   srcMD: Pointer;
5098   src, dst: PByte;
5099 begin
5100   result := false;
5101   if not Assigned(aImage) or (Format = tfEmpty) then
5102     exit;
5103   FormatDesc := TFormatDescriptor.Get(Format);
5104   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5105     exit;
5106
5107   FillChar(rid{%H-}, SizeOf(rid), 0);
5108   rid.Format       := ricfGray;
5109   rid.Width        := Width;
5110   rid.Height       := Height;
5111   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5112   rid.BitOrder     := riboBitsInOrder;
5113   rid.ByteOrder    := riboLSBFirst;
5114   rid.LineOrder    := riloTopToBottom;
5115   rid.LineEnd      := rileTight;
5116   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5117   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5118   rid.GreenPrec    := 0;
5119   rid.BluePrec     := 0;
5120   rid.AlphaPrec    := 0;
5121   rid.RedShift     := 0;
5122   rid.GreenShift   := 0;
5123   rid.BlueShift    := 0;
5124   rid.AlphaShift   := 0;
5125
5126   rid.MaskBitsPerPixel  := 0;
5127   rid.PaletteColorCount := 0;
5128
5129   aImage.DataDescription := rid;
5130   aImage.CreateData;
5131
5132   srcMD := FormatDesc.CreateMappingData;
5133   try
5134     FormatDesc.PreparePixel(Pixel);
5135     src := Data;
5136     dst := aImage.PixelData;
5137     for y := 0 to Height-1 do
5138       for x := 0 to Width-1 do begin
5139         FormatDesc.Unmap(src, Pixel, srcMD);
5140         case rid.BitsPerPixel of
5141            8: begin
5142             dst^ := Pixel.Data.a;
5143             inc(dst);
5144           end;
5145           16: begin
5146             PWord(dst)^ := Pixel.Data.a;
5147             inc(dst, 2);
5148           end;
5149           24: begin
5150             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5151             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5152             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5153             inc(dst, 3);
5154           end;
5155           32: begin
5156             PCardinal(dst)^ := Pixel.Data.a;
5157             inc(dst, 4);
5158           end;
5159         else
5160           raise EglBitmapUnsupportedFormat.Create(Format);
5161         end;
5162       end;
5163   finally
5164     FormatDesc.FreeMappingData(srcMD);
5165   end;
5166   result := true;
5167 end;
5168
5169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5170 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5171 var
5172   tex: TglBitmap2D;
5173 begin
5174   tex := TglBitmap2D.Create;
5175   try
5176     tex.AssignFromLazIntfImage(aImage);
5177     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5178   finally
5179     tex.Free;
5180   end;
5181 end;
5182 {$ENDIF}
5183
5184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5185 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5186   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5187 var
5188   rs: TResourceStream;
5189 begin
5190   PrepareResType(aResource, aResType);
5191   rs := TResourceStream.Create(aInstance, aResource, aResType);
5192   try
5193     result := AddAlphaFromStream(rs, aFunc, aArgs);
5194   finally
5195     rs.Free;
5196   end;
5197 end;
5198
5199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5200 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5201   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5202 var
5203   rs: TResourceStream;
5204 begin
5205   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5206   try
5207     result := AddAlphaFromStream(rs, aFunc, aArgs);
5208   finally
5209     rs.Free;
5210   end;
5211 end;
5212
5213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5214 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5215 begin
5216   if TFormatDescriptor.Get(Format).IsCompressed then
5217     raise EglBitmapUnsupportedFormat.Create(Format);
5218   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5219 end;
5220
5221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5222 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5223 var
5224   FS: TFileStream;
5225 begin
5226   FS := TFileStream.Create(aFileName, fmOpenRead);
5227   try
5228     result := AddAlphaFromStream(FS, aFunc, aArgs);
5229   finally
5230     FS.Free;
5231   end;
5232 end;
5233
5234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5235 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5236 var
5237   tex: TglBitmap2D;
5238 begin
5239   tex := TglBitmap2D.Create(aStream);
5240   try
5241     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5242   finally
5243     tex.Free;
5244   end;
5245 end;
5246
5247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5248 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5249 var
5250   DestData, DestData2, SourceData: pByte;
5251   TempHeight, TempWidth: Integer;
5252   SourceFD, DestFD: TFormatDescriptor;
5253   SourceMD, DestMD, DestMD2: Pointer;
5254
5255   FuncRec: TglBitmapFunctionRec;
5256 begin
5257   result := false;
5258
5259   Assert(Assigned(Data));
5260   Assert(Assigned(aBitmap));
5261   Assert(Assigned(aBitmap.Data));
5262
5263   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5264     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5265
5266     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5267     DestFD   := TFormatDescriptor.Get(Format);
5268
5269     if not Assigned(aFunc) then begin
5270       aFunc        := glBitmapAlphaFunc;
5271       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5272     end else
5273       FuncRec.Args := aArgs;
5274
5275     // Values
5276     TempHeight := aBitmap.FileHeight;
5277     TempWidth  := aBitmap.FileWidth;
5278
5279     FuncRec.Sender          := Self;
5280     FuncRec.Size            := Dimension;
5281     FuncRec.Position.Fields := FuncRec.Size.Fields;
5282
5283     DestData   := Data;
5284     DestData2  := Data;
5285     SourceData := aBitmap.Data;
5286
5287     // Mapping
5288     SourceFD.PreparePixel(FuncRec.Source);
5289     DestFD.PreparePixel  (FuncRec.Dest);
5290
5291     SourceMD := SourceFD.CreateMappingData;
5292     DestMD   := DestFD.CreateMappingData;
5293     DestMD2  := DestFD.CreateMappingData;
5294     try
5295       FuncRec.Position.Y := 0;
5296       while FuncRec.Position.Y < TempHeight do begin
5297         FuncRec.Position.X := 0;
5298         while FuncRec.Position.X < TempWidth do begin
5299           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5300           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5301           aFunc(FuncRec);
5302           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5303           inc(FuncRec.Position.X);
5304         end;
5305         inc(FuncRec.Position.Y);
5306       end;
5307     finally
5308       SourceFD.FreeMappingData(SourceMD);
5309       DestFD.FreeMappingData(DestMD);
5310       DestFD.FreeMappingData(DestMD2);
5311     end;
5312   end;
5313 end;
5314
5315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5316 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5317 begin
5318   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5319 end;
5320
5321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5322 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5323 var
5324   PixelData: TglBitmapPixelData;
5325 begin
5326   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5327   result := AddAlphaFromColorKeyFloat(
5328     aRed   / PixelData.Range.r,
5329     aGreen / PixelData.Range.g,
5330     aBlue  / PixelData.Range.b,
5331     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5332 end;
5333
5334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5335 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5336 var
5337   values: array[0..2] of Single;
5338   tmp: Cardinal;
5339   i: Integer;
5340   PixelData: TglBitmapPixelData;
5341 begin
5342   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5343   with PixelData do begin
5344     values[0] := aRed;
5345     values[1] := aGreen;
5346     values[2] := aBlue;
5347
5348     for i := 0 to 2 do begin
5349       tmp          := Trunc(Range.arr[i] * aDeviation);
5350       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5351       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5352     end;
5353     Data.a  := 0;
5354     Range.a := 0;
5355   end;
5356   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5357 end;
5358
5359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5360 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5361 begin
5362   result := AddAlphaFromValueFloat(aAlpha / $FF);
5363 end;
5364
5365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5366 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5367 var
5368   PixelData: TglBitmapPixelData;
5369 begin
5370   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5371   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5372 end;
5373
5374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5375 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5376 var
5377   PixelData: TglBitmapPixelData;
5378 begin
5379   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5380   with PixelData do
5381     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5382   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5383 end;
5384
5385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5386 function TglBitmap.RemoveAlpha: Boolean;
5387 var
5388   FormatDesc: TFormatDescriptor;
5389 begin
5390   result := false;
5391   FormatDesc := TFormatDescriptor.Get(Format);
5392   if Assigned(Data) then begin
5393     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5394       raise EglBitmapUnsupportedFormat.Create(Format);
5395     result := ConvertTo(FormatDesc.WithoutAlpha);
5396   end;
5397 end;
5398
5399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5400 function TglBitmap.Clone: TglBitmap;
5401 var
5402   Temp: TglBitmap;
5403   TempPtr: PByte;
5404   Size: Integer;
5405 begin
5406   result := nil;
5407   Temp := (ClassType.Create as TglBitmap);
5408   try
5409     // copy texture data if assigned
5410     if Assigned(Data) then begin
5411       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5412       GetMem(TempPtr, Size);
5413       try
5414         Move(Data^, TempPtr^, Size);
5415         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5416       except
5417         if Assigned(TempPtr) then
5418           FreeMem(TempPtr);
5419         raise;
5420       end;
5421     end else begin
5422       TempPtr := nil;
5423       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5424     end;
5425
5426         // copy properties
5427     Temp.fID                      := ID;
5428     Temp.fTarget                  := Target;
5429     Temp.fFormat                  := Format;
5430     Temp.fMipMap                  := MipMap;
5431     Temp.fAnisotropic             := Anisotropic;
5432     Temp.fBorderColor             := fBorderColor;
5433     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5434     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5435     Temp.fFilterMin               := fFilterMin;
5436     Temp.fFilterMag               := fFilterMag;
5437     Temp.fWrapS                   := fWrapS;
5438     Temp.fWrapT                   := fWrapT;
5439     Temp.fWrapR                   := fWrapR;
5440     Temp.fFilename                := fFilename;
5441     Temp.fCustomName              := fCustomName;
5442     Temp.fCustomNameW             := fCustomNameW;
5443     Temp.fCustomData              := fCustomData;
5444
5445     result := Temp;
5446   except
5447     FreeAndNil(Temp);
5448     raise;
5449   end;
5450 end;
5451
5452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5453 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5454 var
5455   SourceFD, DestFD: TFormatDescriptor;
5456   SourcePD, DestPD: TglBitmapPixelData;
5457   ShiftData: TShiftData;
5458
5459   function CanCopyDirect: Boolean;
5460   begin
5461     result :=
5462       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5463       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5464       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5465       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5466   end;
5467
5468   function CanShift: Boolean;
5469   begin
5470     result :=
5471       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5472       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5473       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5474       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5475   end;
5476
5477   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5478   begin
5479     result := 0;
5480     while (aSource > aDest) and (aSource > 0) do begin
5481       inc(result);
5482       aSource := aSource shr 1;
5483     end;
5484   end;
5485
5486 begin
5487   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5488     SourceFD := TFormatDescriptor.Get(Format);
5489     DestFD   := TFormatDescriptor.Get(aFormat);
5490
5491     SourceFD.PreparePixel(SourcePD);
5492     DestFD.PreparePixel  (DestPD);
5493
5494     if CanCopyDirect then
5495       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5496     else if CanShift then begin
5497       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5498       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5499       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5500       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5501       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5502     end else
5503       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5504   end else
5505     result := true;
5506 end;
5507
5508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5509 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5510 begin
5511   if aUseRGB or aUseAlpha then
5512     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5513       ((Byte(aUseAlpha) and 1) shl 1) or
5514        (Byte(aUseRGB)   and 1)      ));
5515 end;
5516
5517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5518 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5519 begin
5520   fBorderColor[0] := aRed;
5521   fBorderColor[1] := aGreen;
5522   fBorderColor[2] := aBlue;
5523   fBorderColor[3] := aAlpha;
5524   if (ID > 0) then begin
5525     Bind(false);
5526     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5527   end;
5528 end;
5529
5530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5531 procedure TglBitmap.FreeData;
5532 var
5533   TempPtr: PByte;
5534 begin
5535   TempPtr := nil;
5536   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5537 end;
5538
5539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5540 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5541   const aAlpha: Byte);
5542 begin
5543   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5544 end;
5545
5546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5547 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5548 var
5549   PixelData: TglBitmapPixelData;
5550 begin
5551   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5552   FillWithColorFloat(
5553     aRed   / PixelData.Range.r,
5554     aGreen / PixelData.Range.g,
5555     aBlue  / PixelData.Range.b,
5556     aAlpha / PixelData.Range.a);
5557 end;
5558
5559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5560 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5561 var
5562   PixelData: TglBitmapPixelData;
5563 begin
5564   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5565   with PixelData do begin
5566     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5567     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5568     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5569     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5570   end;
5571   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5572 end;
5573
5574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5575 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5576 begin
5577   //check MIN filter
5578   case aMin of
5579     GL_NEAREST:
5580       fFilterMin := GL_NEAREST;
5581     GL_LINEAR:
5582       fFilterMin := GL_LINEAR;
5583     GL_NEAREST_MIPMAP_NEAREST:
5584       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5585     GL_LINEAR_MIPMAP_NEAREST:
5586       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5587     GL_NEAREST_MIPMAP_LINEAR:
5588       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5589     GL_LINEAR_MIPMAP_LINEAR:
5590       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5591     else
5592       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5593   end;
5594
5595   //check MAG filter
5596   case aMag of
5597     GL_NEAREST:
5598       fFilterMag := GL_NEAREST;
5599     GL_LINEAR:
5600       fFilterMag := GL_LINEAR;
5601     else
5602       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5603   end;
5604
5605   //apply filter
5606   if (ID > 0) then begin
5607     Bind(false);
5608     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5609
5610     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5611       case fFilterMin of
5612         GL_NEAREST, GL_LINEAR:
5613           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5614         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5615           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5616         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5617           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5618       end;
5619     end else
5620       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5621   end;
5622 end;
5623
5624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5625 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5626
5627   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5628   begin
5629     case aValue of
5630       GL_CLAMP:
5631         aTarget := GL_CLAMP;
5632
5633       GL_REPEAT:
5634         aTarget := GL_REPEAT;
5635
5636       GL_CLAMP_TO_EDGE: begin
5637         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5638           aTarget := GL_CLAMP_TO_EDGE
5639         else
5640           aTarget := GL_CLAMP;
5641       end;
5642
5643       GL_CLAMP_TO_BORDER: begin
5644         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5645           aTarget := GL_CLAMP_TO_BORDER
5646         else
5647           aTarget := GL_CLAMP;
5648       end;
5649
5650       GL_MIRRORED_REPEAT: begin
5651         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5652           aTarget := GL_MIRRORED_REPEAT
5653         else
5654           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5655       end;
5656     else
5657       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5658     end;
5659   end;
5660
5661 begin
5662   CheckAndSetWrap(S, fWrapS);
5663   CheckAndSetWrap(T, fWrapT);
5664   CheckAndSetWrap(R, fWrapR);
5665
5666   if (ID > 0) then begin
5667     Bind(false);
5668     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5669     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5670     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5671   end;
5672 end;
5673
5674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5675 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5676
5677   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5678   begin
5679     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5680        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5681       fSwizzle[aIndex] := aValue
5682     else
5683       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5684   end;
5685
5686 begin
5687   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5688     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5689   CheckAndSetValue(r, 0);
5690   CheckAndSetValue(g, 1);
5691   CheckAndSetValue(b, 2);
5692   CheckAndSetValue(a, 3);
5693
5694   if (ID > 0) then begin
5695     Bind(false);
5696     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5697   end;
5698 end;
5699
5700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5701 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5702 begin
5703   if aEnableTextureUnit then
5704     glEnable(Target);
5705   if (ID > 0) then
5706     glBindTexture(Target, ID);
5707 end;
5708
5709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5710 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5711 begin
5712   if aDisableTextureUnit then
5713     glDisable(Target);
5714   glBindTexture(Target, 0);
5715 end;
5716
5717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5718 constructor TglBitmap.Create;
5719 begin
5720   if (ClassType = TglBitmap) then
5721     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5722 {$IFDEF GLB_NATIVE_OGL}
5723   glbReadOpenGLExtensions;
5724 {$ENDIF}
5725   inherited Create;
5726   fFormat            := glBitmapGetDefaultFormat;
5727   fFreeDataOnDestroy := true;
5728 end;
5729
5730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5731 constructor TglBitmap.Create(const aFileName: String);
5732 begin
5733   Create;
5734   LoadFromFile(aFileName);
5735 end;
5736
5737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5738 constructor TglBitmap.Create(const aStream: TStream);
5739 begin
5740   Create;
5741   LoadFromStream(aStream);
5742 end;
5743
5744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5745 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5746 var
5747   ImageSize: Integer;
5748 begin
5749   Create;
5750   if not Assigned(aData) then begin
5751     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5752     GetMem(aData, ImageSize);
5753     try
5754       FillChar(aData^, ImageSize, #$FF);
5755       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5756     except
5757       if Assigned(aData) then
5758         FreeMem(aData);
5759       raise;
5760     end;
5761   end else begin
5762     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5763     fFreeDataOnDestroy := false;
5764   end;
5765 end;
5766
5767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5768 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5769 begin
5770   Create;
5771   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5772 end;
5773
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5776 begin
5777   Create;
5778   LoadFromResource(aInstance, aResource, aResType);
5779 end;
5780
5781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5782 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5783 begin
5784   Create;
5785   LoadFromResourceID(aInstance, aResourceID, aResType);
5786 end;
5787
5788 {$IFDEF GLB_SUPPORT_PNG_READ}
5789 {$IF DEFINED(GLB_LAZ_PNG)}
5790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5791 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5793 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5794 const
5795   MAGIC_LEN = 8;
5796   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5797 var
5798   reader: TLazReaderPNG;
5799   intf: TLazIntfImage;
5800   StreamPos: Int64;
5801   magic: String[MAGIC_LEN];
5802 begin
5803   result := true;
5804   StreamPos := aStream.Position;
5805
5806   SetLength(magic, MAGIC_LEN);
5807   aStream.Read(magic[1], MAGIC_LEN);
5808   aStream.Position := StreamPos;
5809   if (magic <> PNG_MAGIC) then begin
5810     result := false;
5811     exit;
5812   end;
5813
5814   intf   := TLazIntfImage.Create(0, 0);
5815   reader := TLazReaderPNG.Create;
5816   try try
5817     reader.UpdateDescription := true;
5818     reader.ImageRead(aStream, intf);
5819     AssignFromLazIntfImage(intf);
5820   except
5821     result := false;
5822     aStream.Position := StreamPos;
5823     exit;
5824   end;
5825   finally
5826     reader.Free;
5827     intf.Free;
5828   end;
5829 end;
5830
5831 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5833 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5834 var
5835   Surface: PSDL_Surface;
5836   RWops: PSDL_RWops;
5837 begin
5838   result := false;
5839   RWops := glBitmapCreateRWops(aStream);
5840   try
5841     if IMG_isPNG(RWops) > 0 then begin
5842       Surface := IMG_LoadPNG_RW(RWops);
5843       try
5844         AssignFromSurface(Surface);
5845         result := true;
5846       finally
5847         SDL_FreeSurface(Surface);
5848       end;
5849     end;
5850   finally
5851     SDL_FreeRW(RWops);
5852   end;
5853 end;
5854
5855 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5857 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5858 begin
5859   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5860 end;
5861
5862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5863 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5864 var
5865   StreamPos: Int64;
5866   signature: array [0..7] of byte;
5867   png: png_structp;
5868   png_info: png_infop;
5869
5870   TempHeight, TempWidth: Integer;
5871   Format: TglBitmapFormat;
5872
5873   png_data: pByte;
5874   png_rows: array of pByte;
5875   Row, LineSize: Integer;
5876 begin
5877   result := false;
5878
5879   if not init_libPNG then
5880     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5881
5882   try
5883     // signature
5884     StreamPos := aStream.Position;
5885     aStream.Read(signature{%H-}, 8);
5886     aStream.Position := StreamPos;
5887
5888     if png_check_sig(@signature, 8) <> 0 then begin
5889       // png read struct
5890       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5891       if png = nil then
5892         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5893
5894       // png info
5895       png_info := png_create_info_struct(png);
5896       if png_info = nil then begin
5897         png_destroy_read_struct(@png, nil, nil);
5898         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5899       end;
5900
5901       // set read callback
5902       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5903
5904       // read informations
5905       png_read_info(png, png_info);
5906
5907       // size
5908       TempHeight := png_get_image_height(png, png_info);
5909       TempWidth := png_get_image_width(png, png_info);
5910
5911       // format
5912       case png_get_color_type(png, png_info) of
5913         PNG_COLOR_TYPE_GRAY:
5914           Format := tfLuminance8;
5915         PNG_COLOR_TYPE_GRAY_ALPHA:
5916           Format := tfLuminance8Alpha8;
5917         PNG_COLOR_TYPE_RGB:
5918           Format := tfRGB8;
5919         PNG_COLOR_TYPE_RGB_ALPHA:
5920           Format := tfRGBA8;
5921         else
5922           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5923       end;
5924
5925       // cut upper 8 bit from 16 bit formats
5926       if png_get_bit_depth(png, png_info) > 8 then
5927         png_set_strip_16(png);
5928
5929       // expand bitdepth smaller than 8
5930       if png_get_bit_depth(png, png_info) < 8 then
5931         png_set_expand(png);
5932
5933       // allocating mem for scanlines
5934       LineSize := png_get_rowbytes(png, png_info);
5935       GetMem(png_data, TempHeight * LineSize);
5936       try
5937         SetLength(png_rows, TempHeight);
5938         for Row := Low(png_rows) to High(png_rows) do begin
5939           png_rows[Row] := png_data;
5940           Inc(png_rows[Row], Row * LineSize);
5941         end;
5942
5943         // read complete image into scanlines
5944         png_read_image(png, @png_rows[0]);
5945
5946         // read end
5947         png_read_end(png, png_info);
5948
5949         // destroy read struct
5950         png_destroy_read_struct(@png, @png_info, nil);
5951
5952         SetLength(png_rows, 0);
5953
5954         // set new data
5955         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5956
5957         result := true;
5958       except
5959         if Assigned(png_data) then
5960           FreeMem(png_data);
5961         raise;
5962       end;
5963     end;
5964   finally
5965     quit_libPNG;
5966   end;
5967 end;
5968
5969 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5971 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5972 var
5973   StreamPos: Int64;
5974   Png: TPNGObject;
5975   Header: String[8];
5976   Row, Col, PixSize, LineSize: Integer;
5977   NewImage, pSource, pDest, pAlpha: pByte;
5978   PngFormat: TglBitmapFormat;
5979   FormatDesc: TFormatDescriptor;
5980
5981 const
5982   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5983
5984 begin
5985   result := false;
5986
5987   StreamPos := aStream.Position;
5988   aStream.Read(Header[0], SizeOf(Header));
5989   aStream.Position := StreamPos;
5990
5991   {Test if the header matches}
5992   if Header = PngHeader then begin
5993     Png := TPNGObject.Create;
5994     try
5995       Png.LoadFromStream(aStream);
5996
5997       case Png.Header.ColorType of
5998         COLOR_GRAYSCALE:
5999           PngFormat := tfLuminance8;
6000         COLOR_GRAYSCALEALPHA:
6001           PngFormat := tfLuminance8Alpha8;
6002         COLOR_RGB:
6003           PngFormat := tfBGR8;
6004         COLOR_RGBALPHA:
6005           PngFormat := tfBGRA8;
6006         else
6007           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6008       end;
6009
6010       FormatDesc := TFormatDescriptor.Get(PngFormat);
6011       PixSize    := Round(FormatDesc.PixelSize);
6012       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6013
6014       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6015       try
6016         pDest := NewImage;
6017
6018         case Png.Header.ColorType of
6019           COLOR_RGB, COLOR_GRAYSCALE:
6020             begin
6021               for Row := 0 to Png.Height -1 do begin
6022                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6023                 Inc(pDest, LineSize);
6024               end;
6025             end;
6026           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6027             begin
6028               PixSize := PixSize -1;
6029
6030               for Row := 0 to Png.Height -1 do begin
6031                 pSource := Png.Scanline[Row];
6032                 pAlpha := pByte(Png.AlphaScanline[Row]);
6033
6034                 for Col := 0 to Png.Width -1 do begin
6035                   Move (pSource^, pDest^, PixSize);
6036                   Inc(pSource, PixSize);
6037                   Inc(pDest, PixSize);
6038
6039                   pDest^ := pAlpha^;
6040                   inc(pAlpha);
6041                   Inc(pDest);
6042                 end;
6043               end;
6044             end;
6045           else
6046             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6047         end;
6048
6049         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6050
6051         result := true;
6052       except
6053         if Assigned(NewImage) then
6054           FreeMem(NewImage);
6055         raise;
6056       end;
6057     finally
6058       Png.Free;
6059     end;
6060   end;
6061 end;
6062 {$IFEND}
6063 {$ENDIF}
6064
6065 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6066 {$IFDEF GLB_LIB_PNG}
6067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6068 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6069 begin
6070   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6071 end;
6072 {$ENDIF}
6073
6074 {$IF DEFINED(GLB_LAZ_PNG)}
6075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6076 procedure TglBitmap.SavePNG(const aStream: TStream);
6077 var
6078   png: TPortableNetworkGraphic;
6079   intf: TLazIntfImage;
6080   raw: TRawImage;
6081 begin
6082   png  := TPortableNetworkGraphic.Create;
6083   intf := TLazIntfImage.Create(0, 0);
6084   try
6085     if not AssignToLazIntfImage(intf) then
6086       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6087     intf.GetRawImage(raw);
6088     png.LoadFromRawImage(raw, false);
6089     png.SaveToStream(aStream);
6090   finally
6091     png.Free;
6092     intf.Free;
6093   end;
6094 end;
6095
6096 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6098 procedure TglBitmap.SavePNG(const aStream: TStream);
6099 var
6100   png: png_structp;
6101   png_info: png_infop;
6102   png_rows: array of pByte;
6103   LineSize: Integer;
6104   ColorType: Integer;
6105   Row: Integer;
6106   FormatDesc: TFormatDescriptor;
6107 begin
6108   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6109     raise EglBitmapUnsupportedFormat.Create(Format);
6110
6111   if not init_libPNG then
6112     raise Exception.Create('unable to initialize libPNG.');
6113
6114   try
6115     case Format of
6116       tfAlpha8, tfLuminance8:
6117         ColorType := PNG_COLOR_TYPE_GRAY;
6118       tfLuminance8Alpha8:
6119         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6120       tfBGR8, tfRGB8:
6121         ColorType := PNG_COLOR_TYPE_RGB;
6122       tfBGRA8, tfRGBA8:
6123         ColorType := PNG_COLOR_TYPE_RGBA;
6124       else
6125         raise EglBitmapUnsupportedFormat.Create(Format);
6126     end;
6127
6128     FormatDesc := TFormatDescriptor.Get(Format);
6129     LineSize := FormatDesc.GetSize(Width, 1);
6130
6131     // creating array for scanline
6132     SetLength(png_rows, Height);
6133     try
6134       for Row := 0 to Height - 1 do begin
6135         png_rows[Row] := Data;
6136         Inc(png_rows[Row], Row * LineSize)
6137       end;
6138
6139       // write struct
6140       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6141       if png = nil then
6142         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6143
6144       // create png info
6145       png_info := png_create_info_struct(png);
6146       if png_info = nil then begin
6147         png_destroy_write_struct(@png, nil);
6148         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6149       end;
6150
6151       // set read callback
6152       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6153
6154       // set compression
6155       png_set_compression_level(png, 6);
6156
6157       if Format in [tfBGR8, tfBGRA8] then
6158         png_set_bgr(png);
6159
6160       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6161       png_write_info(png, png_info);
6162       png_write_image(png, @png_rows[0]);
6163       png_write_end(png, png_info);
6164       png_destroy_write_struct(@png, @png_info);
6165     finally
6166       SetLength(png_rows, 0);
6167     end;
6168   finally
6169     quit_libPNG;
6170   end;
6171 end;
6172
6173 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6175 procedure TglBitmap.SavePNG(const aStream: TStream);
6176 var
6177   Png: TPNGObject;
6178
6179   pSource, pDest: pByte;
6180   X, Y, PixSize: Integer;
6181   ColorType: Cardinal;
6182   Alpha: Boolean;
6183
6184   pTemp: pByte;
6185   Temp: Byte;
6186 begin
6187   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6188     raise EglBitmapUnsupportedFormat.Create(Format);
6189
6190   case Format of
6191     tfAlpha8, tfLuminance8: begin
6192       ColorType := COLOR_GRAYSCALE;
6193       PixSize   := 1;
6194       Alpha     := false;
6195     end;
6196     tfLuminance8Alpha8: begin
6197       ColorType := COLOR_GRAYSCALEALPHA;
6198       PixSize   := 1;
6199       Alpha     := true;
6200     end;
6201     tfBGR8, tfRGB8: begin
6202       ColorType := COLOR_RGB;
6203       PixSize   := 3;
6204       Alpha     := false;
6205     end;
6206     tfBGRA8, tfRGBA8: begin
6207       ColorType := COLOR_RGBALPHA;
6208       PixSize   := 3;
6209       Alpha     := true
6210     end;
6211   else
6212     raise EglBitmapUnsupportedFormat.Create(Format);
6213   end;
6214
6215   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6216   try
6217     // Copy ImageData
6218     pSource := Data;
6219     for Y := 0 to Height -1 do begin
6220       pDest := png.ScanLine[Y];
6221       for X := 0 to Width -1 do begin
6222         Move(pSource^, pDest^, PixSize);
6223         Inc(pDest, PixSize);
6224         Inc(pSource, PixSize);
6225         if Alpha then begin
6226           png.AlphaScanline[Y]^[X] := pSource^;
6227           Inc(pSource);
6228         end;
6229       end;
6230
6231       // convert RGB line to BGR
6232       if Format in [tfRGB8, tfRGBA8] then begin
6233         pTemp := png.ScanLine[Y];
6234         for X := 0 to Width -1 do begin
6235           Temp := pByteArray(pTemp)^[0];
6236           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6237           pByteArray(pTemp)^[2] := Temp;
6238           Inc(pTemp, 3);
6239         end;
6240       end;
6241     end;
6242
6243     // Save to Stream
6244     Png.CompressionLevel := 6;
6245     Png.SaveToStream(aStream);
6246   finally
6247     FreeAndNil(Png);
6248   end;
6249 end;
6250 {$IFEND}
6251 {$ENDIF}
6252
6253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6254 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6256 {$IFDEF GLB_LIB_JPEG}
6257 type
6258   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6259   glBitmap_libJPEG_source_mgr = record
6260     pub: jpeg_source_mgr;
6261
6262     SrcStream: TStream;
6263     SrcBuffer: array [1..4096] of byte;
6264   end;
6265
6266   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6267   glBitmap_libJPEG_dest_mgr = record
6268     pub: jpeg_destination_mgr;
6269
6270     DestStream: TStream;
6271     DestBuffer: array [1..4096] of byte;
6272   end;
6273
6274 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6275 begin
6276   //DUMMY
6277 end;
6278
6279
6280 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6281 begin
6282   //DUMMY
6283 end;
6284
6285
6286 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6287 begin
6288   //DUMMY
6289 end;
6290
6291 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6292 begin
6293   //DUMMY
6294 end;
6295
6296
6297 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6298 begin
6299   //DUMMY
6300 end;
6301
6302
6303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6304 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6305 var
6306   src: glBitmap_libJPEG_source_mgr_ptr;
6307   bytes: integer;
6308 begin
6309   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6310
6311   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6312         if (bytes <= 0) then begin
6313                 src^.SrcBuffer[1] := $FF;
6314                 src^.SrcBuffer[2] := JPEG_EOI;
6315                 bytes := 2;
6316         end;
6317
6318         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6319         src^.pub.bytes_in_buffer := bytes;
6320
6321   result := true;
6322 end;
6323
6324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6325 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6326 var
6327   src: glBitmap_libJPEG_source_mgr_ptr;
6328 begin
6329   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6330
6331   if num_bytes > 0 then begin
6332     // wanted byte isn't in buffer so set stream position and read buffer
6333     if num_bytes > src^.pub.bytes_in_buffer then begin
6334       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6335       src^.pub.fill_input_buffer(cinfo);
6336     end else begin
6337       // wanted byte is in buffer so only skip
6338                 inc(src^.pub.next_input_byte, num_bytes);
6339                 dec(src^.pub.bytes_in_buffer, num_bytes);
6340     end;
6341   end;
6342 end;
6343
6344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6345 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6346 var
6347   dest: glBitmap_libJPEG_dest_mgr_ptr;
6348 begin
6349   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6350
6351   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6352     // write complete buffer
6353     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6354
6355     // reset buffer
6356     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6357     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6358   end;
6359
6360   result := true;
6361 end;
6362
6363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6365 var
6366   Idx: Integer;
6367   dest: glBitmap_libJPEG_dest_mgr_ptr;
6368 begin
6369   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6370
6371   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6372     // check for endblock
6373     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6374       // write endblock
6375       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6376
6377       // leave
6378       break;
6379     end else
6380       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6381   end;
6382 end;
6383 {$ENDIF}
6384
6385 {$IFDEF GLB_SUPPORT_JPEG_READ}
6386 {$IF DEFINED(GLB_LAZ_JPEG)}
6387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6388 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6389 const
6390   MAGIC_LEN = 2;
6391   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6392 var
6393   intf: TLazIntfImage;
6394   reader: TFPReaderJPEG;
6395   StreamPos: Int64;
6396   magic: String[MAGIC_LEN];
6397 begin
6398   result := true;
6399   StreamPos := aStream.Position;
6400
6401   SetLength(magic, MAGIC_LEN);
6402   aStream.Read(magic[1], MAGIC_LEN);
6403   aStream.Position := StreamPos;
6404   if (magic <> JPEG_MAGIC) then begin
6405     result := false;
6406     exit;
6407   end;
6408
6409   reader := TFPReaderJPEG.Create;
6410   intf := TLazIntfImage.Create(0, 0);
6411   try try
6412     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6413     reader.ImageRead(aStream, intf);
6414     AssignFromLazIntfImage(intf);
6415   except
6416     result := false;
6417     aStream.Position := StreamPos;
6418     exit;
6419   end;
6420   finally
6421     reader.Free;
6422     intf.Free;
6423   end;
6424 end;
6425
6426 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6428 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6429 var
6430   Surface: PSDL_Surface;
6431   RWops: PSDL_RWops;
6432 begin
6433   result := false;
6434
6435   RWops := glBitmapCreateRWops(aStream);
6436   try
6437     if IMG_isJPG(RWops) > 0 then begin
6438       Surface := IMG_LoadJPG_RW(RWops);
6439       try
6440         AssignFromSurface(Surface);
6441         result := true;
6442       finally
6443         SDL_FreeSurface(Surface);
6444       end;
6445     end;
6446   finally
6447     SDL_FreeRW(RWops);
6448   end;
6449 end;
6450
6451 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6453 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6454 var
6455   StreamPos: Int64;
6456   Temp: array[0..1]of Byte;
6457
6458   jpeg: jpeg_decompress_struct;
6459   jpeg_err: jpeg_error_mgr;
6460
6461   IntFormat: TglBitmapFormat;
6462   pImage: pByte;
6463   TempHeight, TempWidth: Integer;
6464
6465   pTemp: pByte;
6466   Row: Integer;
6467
6468   FormatDesc: TFormatDescriptor;
6469 begin
6470   result := false;
6471
6472   if not init_libJPEG then
6473     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6474
6475   try
6476     // reading first two bytes to test file and set cursor back to begin
6477     StreamPos := aStream.Position;
6478     aStream.Read({%H-}Temp[0], 2);
6479     aStream.Position := StreamPos;
6480
6481     // if Bitmap then read file.
6482     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6483       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6484       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6485
6486       // error managment
6487       jpeg.err := jpeg_std_error(@jpeg_err);
6488       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6489       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6490
6491       // decompression struct
6492       jpeg_create_decompress(@jpeg);
6493
6494       // allocation space for streaming methods
6495       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6496
6497       // seeting up custom functions
6498       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6499         pub.init_source       := glBitmap_libJPEG_init_source;
6500         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6501         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6502         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6503         pub.term_source       := glBitmap_libJPEG_term_source;
6504
6505         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6506         pub.next_input_byte := nil;   // until buffer loaded
6507
6508         SrcStream := aStream;
6509       end;
6510
6511       // set global decoding state
6512       jpeg.global_state := DSTATE_START;
6513
6514       // read header of jpeg
6515       jpeg_read_header(@jpeg, false);
6516
6517       // setting output parameter
6518       case jpeg.jpeg_color_space of
6519         JCS_GRAYSCALE:
6520           begin
6521             jpeg.out_color_space := JCS_GRAYSCALE;
6522             IntFormat := tfLuminance8;
6523           end;
6524         else
6525           jpeg.out_color_space := JCS_RGB;
6526           IntFormat := tfRGB8;
6527       end;
6528
6529       // reading image
6530       jpeg_start_decompress(@jpeg);
6531
6532       TempHeight := jpeg.output_height;
6533       TempWidth := jpeg.output_width;
6534
6535       FormatDesc := TFormatDescriptor.Get(IntFormat);
6536
6537       // creating new image
6538       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6539       try
6540         pTemp := pImage;
6541
6542         for Row := 0 to TempHeight -1 do begin
6543           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6544           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6545         end;
6546
6547         // finish decompression
6548         jpeg_finish_decompress(@jpeg);
6549
6550         // destroy decompression
6551         jpeg_destroy_decompress(@jpeg);
6552
6553         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6554
6555         result := true;
6556       except
6557         if Assigned(pImage) then
6558           FreeMem(pImage);
6559         raise;
6560       end;
6561     end;
6562   finally
6563     quit_libJPEG;
6564   end;
6565 end;
6566
6567 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6569 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6570 var
6571   bmp: TBitmap;
6572   jpg: TJPEGImage;
6573   StreamPos: Int64;
6574   Temp: array[0..1]of Byte;
6575 begin
6576   result := false;
6577
6578   // reading first two bytes to test file and set cursor back to begin
6579   StreamPos := aStream.Position;
6580   aStream.Read(Temp[0], 2);
6581   aStream.Position := StreamPos;
6582
6583   // if Bitmap then read file.
6584   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6585     bmp := TBitmap.Create;
6586     try
6587       jpg := TJPEGImage.Create;
6588       try
6589         jpg.LoadFromStream(aStream);
6590         bmp.Assign(jpg);
6591         result := AssignFromBitmap(bmp);
6592       finally
6593         jpg.Free;
6594       end;
6595     finally
6596       bmp.Free;
6597     end;
6598   end;
6599 end;
6600 {$IFEND}
6601 {$ENDIF}
6602
6603 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6604 {$IF DEFINED(GLB_LAZ_JPEG)}
6605 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6606 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6607 var
6608   jpeg: TJPEGImage;
6609   intf: TLazIntfImage;
6610   raw: TRawImage;
6611 begin
6612   jpeg := TJPEGImage.Create;
6613   intf := TLazIntfImage.Create(0, 0);
6614   try
6615     if not AssignToLazIntfImage(intf) then
6616       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6617     intf.GetRawImage(raw);
6618     jpeg.LoadFromRawImage(raw, false);
6619     jpeg.SaveToStream(aStream);
6620   finally
6621     intf.Free;
6622     jpeg.Free;
6623   end;
6624 end;
6625
6626 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6628 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6629 var
6630   jpeg: jpeg_compress_struct;
6631   jpeg_err: jpeg_error_mgr;
6632   Row: Integer;
6633   pTemp, pTemp2: pByte;
6634
6635   procedure CopyRow(pDest, pSource: pByte);
6636   var
6637     X: Integer;
6638   begin
6639     for X := 0 to Width - 1 do begin
6640       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6641       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6642       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6643       Inc(pDest, 3);
6644       Inc(pSource, 3);
6645     end;
6646   end;
6647
6648 begin
6649   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6650     raise EglBitmapUnsupportedFormat.Create(Format);
6651
6652   if not init_libJPEG then
6653     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6654
6655   try
6656     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6657     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6658
6659     // error managment
6660     jpeg.err := jpeg_std_error(@jpeg_err);
6661     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6662     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6663
6664     // compression struct
6665     jpeg_create_compress(@jpeg);
6666
6667     // allocation space for streaming methods
6668     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6669
6670     // seeting up custom functions
6671     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6672       pub.init_destination    := glBitmap_libJPEG_init_destination;
6673       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6674       pub.term_destination    := glBitmap_libJPEG_term_destination;
6675
6676       pub.next_output_byte  := @DestBuffer[1];
6677       pub.free_in_buffer    := Length(DestBuffer);
6678
6679       DestStream := aStream;
6680     end;
6681
6682     // very important state
6683     jpeg.global_state := CSTATE_START;
6684     jpeg.image_width  := Width;
6685     jpeg.image_height := Height;
6686     case Format of
6687       tfAlpha8, tfLuminance8: begin
6688         jpeg.input_components := 1;
6689         jpeg.in_color_space   := JCS_GRAYSCALE;
6690       end;
6691       tfRGB8, tfBGR8: begin
6692         jpeg.input_components := 3;
6693         jpeg.in_color_space   := JCS_RGB;
6694       end;
6695     end;
6696
6697     jpeg_set_defaults(@jpeg);
6698     jpeg_set_quality(@jpeg, 95, true);
6699     jpeg_start_compress(@jpeg, true);
6700     pTemp := Data;
6701
6702     if Format = tfBGR8 then
6703       GetMem(pTemp2, fRowSize)
6704     else
6705       pTemp2 := pTemp;
6706
6707     try
6708       for Row := 0 to jpeg.image_height -1 do begin
6709         // prepare row
6710         if Format = tfBGR8 then
6711           CopyRow(pTemp2, pTemp)
6712         else
6713           pTemp2 := pTemp;
6714
6715         // write row
6716         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6717         inc(pTemp, fRowSize);
6718       end;
6719     finally
6720       // free memory
6721       if Format = tfBGR8 then
6722         FreeMem(pTemp2);
6723     end;
6724     jpeg_finish_compress(@jpeg);
6725     jpeg_destroy_compress(@jpeg);
6726   finally
6727     quit_libJPEG;
6728   end;
6729 end;
6730
6731 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6733 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6734 var
6735   Bmp: TBitmap;
6736   Jpg: TJPEGImage;
6737 begin
6738   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6739     raise EglBitmapUnsupportedFormat.Create(Format);
6740
6741   Bmp := TBitmap.Create;
6742   try
6743     Jpg := TJPEGImage.Create;
6744     try
6745       AssignToBitmap(Bmp);
6746       if (Format in [tfAlpha8, tfLuminance8]) then begin
6747         Jpg.Grayscale   := true;
6748         Jpg.PixelFormat := jf8Bit;
6749       end;
6750       Jpg.Assign(Bmp);
6751       Jpg.SaveToStream(aStream);
6752     finally
6753       FreeAndNil(Jpg);
6754     end;
6755   finally
6756     FreeAndNil(Bmp);
6757   end;
6758 end;
6759 {$IFEND}
6760 {$ENDIF}
6761
6762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6763 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6765 const
6766   BMP_MAGIC          = $4D42;
6767
6768   BMP_COMP_RGB       = 0;
6769   BMP_COMP_RLE8      = 1;
6770   BMP_COMP_RLE4      = 2;
6771   BMP_COMP_BITFIELDS = 3;
6772
6773 type
6774   TBMPHeader = packed record
6775     bfType: Word;
6776     bfSize: Cardinal;
6777     bfReserved1: Word;
6778     bfReserved2: Word;
6779     bfOffBits: Cardinal;
6780   end;
6781
6782   TBMPInfo = packed record
6783     biSize: Cardinal;
6784     biWidth: Longint;
6785     biHeight: Longint;
6786     biPlanes: Word;
6787     biBitCount: Word;
6788     biCompression: Cardinal;
6789     biSizeImage: Cardinal;
6790     biXPelsPerMeter: Longint;
6791     biYPelsPerMeter: Longint;
6792     biClrUsed: Cardinal;
6793     biClrImportant: Cardinal;
6794   end;
6795
6796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6797 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6798
6799   //////////////////////////////////////////////////////////////////////////////////////////////////
6800   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6801   begin
6802     result := tfEmpty;
6803     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6804     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6805
6806     //Read Compression
6807     case aInfo.biCompression of
6808       BMP_COMP_RLE4,
6809       BMP_COMP_RLE8: begin
6810         raise EglBitmap.Create('RLE compression is not supported');
6811       end;
6812       BMP_COMP_BITFIELDS: begin
6813         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6814           aStream.Read(aMask.r, SizeOf(aMask.r));
6815           aStream.Read(aMask.g, SizeOf(aMask.g));
6816           aStream.Read(aMask.b, SizeOf(aMask.b));
6817           aStream.Read(aMask.a, SizeOf(aMask.a));
6818         end else
6819           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6820       end;
6821     end;
6822
6823     //get suitable format
6824     case aInfo.biBitCount of
6825        8: result := tfLuminance8;
6826       16: result := tfBGR5;
6827       24: result := tfBGR8;
6828       32: result := tfBGRA8;
6829     end;
6830   end;
6831
6832   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6833   var
6834     i, c: Integer;
6835     ColorTable: TbmpColorTable;
6836   begin
6837     result := nil;
6838     if (aInfo.biBitCount >= 16) then
6839       exit;
6840     aFormat := tfLuminance8;
6841     c := aInfo.biClrUsed;
6842     if (c = 0) then
6843       c := 1 shl aInfo.biBitCount;
6844     SetLength(ColorTable, c);
6845     for i := 0 to c-1 do begin
6846       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6847       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6848         aFormat := tfRGB8;
6849     end;
6850
6851     result := TbmpColorTableFormat.Create;
6852     result.PixelSize  := aInfo.biBitCount / 8;
6853     result.ColorTable := ColorTable;
6854     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6855   end;
6856
6857   //////////////////////////////////////////////////////////////////////////////////////////////////
6858   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6859     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6860   var
6861     TmpFormat: TglBitmapFormat;
6862     FormatDesc: TFormatDescriptor;
6863   begin
6864     result := nil;
6865     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6866       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6867         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6868         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6869           aFormat := FormatDesc.Format;
6870           exit;
6871         end;
6872       end;
6873
6874       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6875         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6876       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6877         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6878
6879       result := TbmpBitfieldFormat.Create;
6880       result.PixelSize := aInfo.biBitCount / 8;
6881       result.RedMask   := aMask.r;
6882       result.GreenMask := aMask.g;
6883       result.BlueMask  := aMask.b;
6884       result.AlphaMask := aMask.a;
6885     end;
6886   end;
6887
6888 var
6889   //simple types
6890   StartPos: Int64;
6891   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6892   PaddingBuff: Cardinal;
6893   LineBuf, ImageData, TmpData: PByte;
6894   SourceMD, DestMD: Pointer;
6895   BmpFormat: TglBitmapFormat;
6896
6897   //records
6898   Mask: TglBitmapColorRec;
6899   Header: TBMPHeader;
6900   Info: TBMPInfo;
6901
6902   //classes
6903   SpecialFormat: TFormatDescriptor;
6904   FormatDesc: TFormatDescriptor;
6905
6906   //////////////////////////////////////////////////////////////////////////////////////////////////
6907   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6908   var
6909     i: Integer;
6910     Pixel: TglBitmapPixelData;
6911   begin
6912     aStream.Read(aLineBuf^, rbLineSize);
6913     SpecialFormat.PreparePixel(Pixel);
6914     for i := 0 to Info.biWidth-1 do begin
6915       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6916       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6917       FormatDesc.Map(Pixel, aData, DestMD);
6918     end;
6919   end;
6920
6921 begin
6922   result        := false;
6923   BmpFormat     := tfEmpty;
6924   SpecialFormat := nil;
6925   LineBuf       := nil;
6926   SourceMD      := nil;
6927   DestMD        := nil;
6928
6929   // Header
6930   StartPos := aStream.Position;
6931   aStream.Read(Header{%H-}, SizeOf(Header));
6932
6933   if Header.bfType = BMP_MAGIC then begin
6934     try try
6935       BmpFormat        := ReadInfo(Info, Mask);
6936       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6937       if not Assigned(SpecialFormat) then
6938         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6939       aStream.Position := StartPos + Header.bfOffBits;
6940
6941       if (BmpFormat <> tfEmpty) then begin
6942         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6943         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6944         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6945         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6946
6947         //get Memory
6948         DestMD    := FormatDesc.CreateMappingData;
6949         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6950         GetMem(ImageData, ImageSize);
6951         if Assigned(SpecialFormat) then begin
6952           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6953           SourceMD := SpecialFormat.CreateMappingData;
6954         end;
6955
6956         //read Data
6957         try try
6958           FillChar(ImageData^, ImageSize, $FF);
6959           TmpData := ImageData;
6960           if (Info.biHeight > 0) then
6961             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6962           for i := 0 to Abs(Info.biHeight)-1 do begin
6963             if Assigned(SpecialFormat) then
6964               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6965             else
6966               aStream.Read(TmpData^, wbLineSize);   //else only read data
6967             if (Info.biHeight > 0) then
6968               dec(TmpData, wbLineSize)
6969             else
6970               inc(TmpData, wbLineSize);
6971             aStream.Read(PaddingBuff{%H-}, Padding);
6972           end;
6973           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6974           result := true;
6975         finally
6976           if Assigned(LineBuf) then
6977             FreeMem(LineBuf);
6978           if Assigned(SourceMD) then
6979             SpecialFormat.FreeMappingData(SourceMD);
6980           FormatDesc.FreeMappingData(DestMD);
6981         end;
6982         except
6983           if Assigned(ImageData) then
6984             FreeMem(ImageData);
6985           raise;
6986         end;
6987       end else
6988         raise EglBitmap.Create('LoadBMP - No suitable format found');
6989     except
6990       aStream.Position := StartPos;
6991       raise;
6992     end;
6993     finally
6994       FreeAndNil(SpecialFormat);
6995     end;
6996   end
6997     else aStream.Position := StartPos;
6998 end;
6999
7000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7001 procedure TglBitmap.SaveBMP(const aStream: TStream);
7002 var
7003   Header: TBMPHeader;
7004   Info: TBMPInfo;
7005   Converter: TFormatDescriptor;
7006   FormatDesc: TFormatDescriptor;
7007   SourceFD, DestFD: Pointer;
7008   pData, srcData, dstData, ConvertBuffer: pByte;
7009
7010   Pixel: TglBitmapPixelData;
7011   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7012   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7013
7014   PaddingBuff: Cardinal;
7015
7016   function GetLineWidth : Integer;
7017   begin
7018     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7019   end;
7020
7021 begin
7022   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7023     raise EglBitmapUnsupportedFormat.Create(Format);
7024
7025   Converter  := nil;
7026   FormatDesc := TFormatDescriptor.Get(Format);
7027   ImageSize  := FormatDesc.GetSize(Dimension);
7028
7029   FillChar(Header{%H-}, SizeOf(Header), 0);
7030   Header.bfType      := BMP_MAGIC;
7031   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7032   Header.bfReserved1 := 0;
7033   Header.bfReserved2 := 0;
7034   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7035
7036   FillChar(Info{%H-}, SizeOf(Info), 0);
7037   Info.biSize        := SizeOf(Info);
7038   Info.biWidth       := Width;
7039   Info.biHeight      := Height;
7040   Info.biPlanes      := 1;
7041   Info.biCompression := BMP_COMP_RGB;
7042   Info.biSizeImage   := ImageSize;
7043
7044   try
7045     case Format of
7046       tfLuminance4: begin
7047         Info.biBitCount  := 4;
7048         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7049         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7050         Converter := TbmpColorTableFormat.Create;
7051         with (Converter as TbmpColorTableFormat) do begin
7052           PixelSize := 0.5;
7053           Format    := Format;
7054           Range     := glBitmapColorRec($F, $F, $F, $0);
7055           CreateColorTable;
7056         end;
7057       end;
7058
7059       tfR3G3B2, tfLuminance8: begin
7060         Info.biBitCount  :=  8;
7061         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7062         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7063         Converter := TbmpColorTableFormat.Create;
7064         with (Converter as TbmpColorTableFormat) do begin
7065           PixelSize := 1;
7066           Format    := Format;
7067           if (Format = tfR3G3B2) then begin
7068             Range := glBitmapColorRec($7, $7, $3, $0);
7069             Shift := glBitmapShiftRec(0, 3, 6, 0);
7070           end else
7071             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7072           CreateColorTable;
7073         end;
7074       end;
7075
7076       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7077       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7078         Info.biBitCount    := 16;
7079         Info.biCompression := BMP_COMP_BITFIELDS;
7080       end;
7081
7082       tfBGR8, tfRGB8: begin
7083         Info.biBitCount := 24;
7084         if (Format = tfRGB8) then
7085           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7086       end;
7087
7088       tfRGB10, tfRGB10A2, tfRGBA8,
7089       tfBGR10, tfBGR10A2, tfBGRA8: begin
7090         Info.biBitCount    := 32;
7091         Info.biCompression := BMP_COMP_BITFIELDS;
7092       end;
7093     else
7094       raise EglBitmapUnsupportedFormat.Create(Format);
7095     end;
7096     Info.biXPelsPerMeter := 2835;
7097     Info.biYPelsPerMeter := 2835;
7098
7099     // prepare bitmasks
7100     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7101       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7102       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7103
7104       RedMask    := FormatDesc.RedMask;
7105       GreenMask  := FormatDesc.GreenMask;
7106       BlueMask   := FormatDesc.BlueMask;
7107       AlphaMask  := FormatDesc.AlphaMask;
7108     end;
7109
7110     // headers
7111     aStream.Write(Header, SizeOf(Header));
7112     aStream.Write(Info, SizeOf(Info));
7113
7114     // colortable
7115     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7116       with (Converter as TbmpColorTableFormat) do
7117         aStream.Write(ColorTable[0].b,
7118           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7119
7120     // bitmasks
7121     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7122       aStream.Write(RedMask,   SizeOf(Cardinal));
7123       aStream.Write(GreenMask, SizeOf(Cardinal));
7124       aStream.Write(BlueMask,  SizeOf(Cardinal));
7125       aStream.Write(AlphaMask, SizeOf(Cardinal));
7126     end;
7127
7128     // image data
7129     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7130     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7131     Padding     := GetLineWidth - wbLineSize;
7132     PaddingBuff := 0;
7133
7134     pData := Data;
7135     inc(pData, (Height-1) * rbLineSize);
7136
7137     // prepare row buffer. But only for RGB because RGBA supports color masks
7138     // so it's possible to change color within the image.
7139     if Assigned(Converter) then begin
7140       FormatDesc.PreparePixel(Pixel);
7141       GetMem(ConvertBuffer, wbLineSize);
7142       SourceFD := FormatDesc.CreateMappingData;
7143       DestFD   := Converter.CreateMappingData;
7144     end else
7145       ConvertBuffer := nil;
7146
7147     try
7148       for LineIdx := 0 to Height - 1 do begin
7149         // preparing row
7150         if Assigned(Converter) then begin
7151           srcData := pData;
7152           dstData := ConvertBuffer;
7153           for PixelIdx := 0 to Info.biWidth-1 do begin
7154             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7155             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7156             Converter.Map(Pixel, dstData, DestFD);
7157           end;
7158           aStream.Write(ConvertBuffer^, wbLineSize);
7159         end else begin
7160           aStream.Write(pData^, rbLineSize);
7161         end;
7162         dec(pData, rbLineSize);
7163         if (Padding > 0) then
7164           aStream.Write(PaddingBuff, Padding);
7165       end;
7166     finally
7167       // destroy row buffer
7168       if Assigned(ConvertBuffer) then begin
7169         FormatDesc.FreeMappingData(SourceFD);
7170         Converter.FreeMappingData(DestFD);
7171         FreeMem(ConvertBuffer);
7172       end;
7173     end;
7174   finally
7175     if Assigned(Converter) then
7176       Converter.Free;
7177   end;
7178 end;
7179
7180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7181 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7183 type
7184   TTGAHeader = packed record
7185     ImageID: Byte;
7186     ColorMapType: Byte;
7187     ImageType: Byte;
7188     //ColorMapSpec: Array[0..4] of Byte;
7189     ColorMapStart: Word;
7190     ColorMapLength: Word;
7191     ColorMapEntrySize: Byte;
7192     OrigX: Word;
7193     OrigY: Word;
7194     Width: Word;
7195     Height: Word;
7196     Bpp: Byte;
7197     ImageDesc: Byte;
7198   end;
7199
7200 const
7201   TGA_UNCOMPRESSED_RGB  =  2;
7202   TGA_UNCOMPRESSED_GRAY =  3;
7203   TGA_COMPRESSED_RGB    = 10;
7204   TGA_COMPRESSED_GRAY   = 11;
7205
7206   TGA_NONE_COLOR_TABLE  = 0;
7207
7208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7209 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7210 var
7211   Header: TTGAHeader;
7212   ImageData: System.PByte;
7213   StartPosition: Int64;
7214   PixelSize, LineSize: Integer;
7215   tgaFormat: TglBitmapFormat;
7216   FormatDesc: TFormatDescriptor;
7217   Counter: packed record
7218     X, Y: packed record
7219       low, high, dir: Integer;
7220     end;
7221   end;
7222
7223 const
7224   CACHE_SIZE = $4000;
7225
7226   ////////////////////////////////////////////////////////////////////////////////////////
7227   procedure ReadUncompressed;
7228   var
7229     i, j: Integer;
7230     buf, tmp1, tmp2: System.PByte;
7231   begin
7232     buf := nil;
7233     if (Counter.X.dir < 0) then
7234       GetMem(buf, LineSize);
7235     try
7236       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7237         tmp1 := ImageData;
7238         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7239         if (Counter.X.dir < 0) then begin               //flip X
7240           aStream.Read(buf^, LineSize);
7241           tmp2 := buf;
7242           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7243           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7244             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7245               tmp1^ := tmp2^;
7246               inc(tmp1);
7247               inc(tmp2);
7248             end;
7249             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7250           end;
7251         end else
7252           aStream.Read(tmp1^, LineSize);
7253         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7254       end;
7255     finally
7256       if Assigned(buf) then
7257         FreeMem(buf);
7258     end;
7259   end;
7260
7261   ////////////////////////////////////////////////////////////////////////////////////////
7262   procedure ReadCompressed;
7263
7264     /////////////////////////////////////////////////////////////////
7265     var
7266       TmpData: System.PByte;
7267       LinePixelsRead: Integer;
7268     procedure CheckLine;
7269     begin
7270       if (LinePixelsRead >= Header.Width) then begin
7271         LinePixelsRead := 0;
7272         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7273         TmpData := ImageData;
7274         inc(TmpData, Counter.Y.low * LineSize);           //set line
7275         if (Counter.X.dir < 0) then                       //if x flipped then
7276           inc(TmpData, LineSize - PixelSize);             //set last pixel
7277       end;
7278     end;
7279
7280     /////////////////////////////////////////////////////////////////
7281     var
7282       Cache: PByte;
7283       CacheSize, CachePos: Integer;
7284     procedure CachedRead(out Buffer; Count: Integer);
7285     var
7286       BytesRead: Integer;
7287     begin
7288       if (CachePos + Count > CacheSize) then begin
7289         //if buffer overflow save non read bytes
7290         BytesRead := 0;
7291         if (CacheSize - CachePos > 0) then begin
7292           BytesRead := CacheSize - CachePos;
7293           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7294           inc(CachePos, BytesRead);
7295         end;
7296
7297         //load cache from file
7298         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7299         aStream.Read(Cache^, CacheSize);
7300         CachePos := 0;
7301
7302         //read rest of requested bytes
7303         if (Count - BytesRead > 0) then begin
7304           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7305           inc(CachePos, Count - BytesRead);
7306         end;
7307       end else begin
7308         //if no buffer overflow just read the data
7309         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7310         inc(CachePos, Count);
7311       end;
7312     end;
7313
7314     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7315     begin
7316       case PixelSize of
7317         1: begin
7318           aBuffer^ := aData^;
7319           inc(aBuffer, Counter.X.dir);
7320         end;
7321         2: begin
7322           PWord(aBuffer)^ := PWord(aData)^;
7323           inc(aBuffer, 2 * Counter.X.dir);
7324         end;
7325         3: begin
7326           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7327           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7328           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7329           inc(aBuffer, 3 * Counter.X.dir);
7330         end;
7331         4: begin
7332           PCardinal(aBuffer)^ := PCardinal(aData)^;
7333           inc(aBuffer, 4 * Counter.X.dir);
7334         end;
7335       end;
7336     end;
7337
7338   var
7339     TotalPixelsToRead, TotalPixelsRead: Integer;
7340     Temp: Byte;
7341     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7342     PixelRepeat: Boolean;
7343     PixelsToRead, PixelCount: Integer;
7344   begin
7345     CacheSize := 0;
7346     CachePos  := 0;
7347
7348     TotalPixelsToRead := Header.Width * Header.Height;
7349     TotalPixelsRead   := 0;
7350     LinePixelsRead    := 0;
7351
7352     GetMem(Cache, CACHE_SIZE);
7353     try
7354       TmpData := ImageData;
7355       inc(TmpData, Counter.Y.low * LineSize);           //set line
7356       if (Counter.X.dir < 0) then                       //if x flipped then
7357         inc(TmpData, LineSize - PixelSize);             //set last pixel
7358
7359       repeat
7360         //read CommandByte
7361         CachedRead(Temp, 1);
7362         PixelRepeat  := (Temp and $80) > 0;
7363         PixelsToRead := (Temp and $7F) + 1;
7364         inc(TotalPixelsRead, PixelsToRead);
7365
7366         if PixelRepeat then
7367           CachedRead(buf[0], PixelSize);
7368         while (PixelsToRead > 0) do begin
7369           CheckLine;
7370           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7371           while (PixelCount > 0) do begin
7372             if not PixelRepeat then
7373               CachedRead(buf[0], PixelSize);
7374             PixelToBuffer(@buf[0], TmpData);
7375             inc(LinePixelsRead);
7376             dec(PixelsToRead);
7377             dec(PixelCount);
7378           end;
7379         end;
7380       until (TotalPixelsRead >= TotalPixelsToRead);
7381     finally
7382       FreeMem(Cache);
7383     end;
7384   end;
7385
7386   function IsGrayFormat: Boolean;
7387   begin
7388     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7389   end;
7390
7391 begin
7392   result := false;
7393
7394   // reading header to test file and set cursor back to begin
7395   StartPosition := aStream.Position;
7396   aStream.Read(Header{%H-}, SizeOf(Header));
7397
7398   // no colormapped files
7399   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7400     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7401   begin
7402     try
7403       if Header.ImageID <> 0 then       // skip image ID
7404         aStream.Position := aStream.Position + Header.ImageID;
7405
7406       tgaFormat := tfEmpty;
7407       case Header.Bpp of
7408          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7409                0: tgaFormat := tfLuminance8;
7410                8: tgaFormat := tfAlpha8;
7411             end;
7412
7413         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7414                0: tgaFormat := tfLuminance16;
7415                8: tgaFormat := tfLuminance8Alpha8;
7416             end else case (Header.ImageDesc and $F) of
7417                0: tgaFormat := tfBGR5;
7418                1: tgaFormat := tfBGR5A1;
7419                4: tgaFormat := tfBGRA4;
7420             end;
7421
7422         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7423                0: tgaFormat := tfBGR8;
7424             end;
7425
7426         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7427                2: tgaFormat := tfBGR10A2;
7428                8: tgaFormat := tfBGRA8;
7429             end;
7430       end;
7431
7432       if (tgaFormat = tfEmpty) then
7433         raise EglBitmap.Create('LoadTga - unsupported format');
7434
7435       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7436       PixelSize  := FormatDesc.GetSize(1, 1);
7437       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7438
7439       GetMem(ImageData, LineSize * Header.Height);
7440       try
7441         //column direction
7442         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7443           Counter.X.low  := Header.Height-1;;
7444           Counter.X.high := 0;
7445           Counter.X.dir  := -1;
7446         end else begin
7447           Counter.X.low  := 0;
7448           Counter.X.high := Header.Height-1;
7449           Counter.X.dir  := 1;
7450         end;
7451
7452         // Row direction
7453         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7454           Counter.Y.low  := 0;
7455           Counter.Y.high := Header.Height-1;
7456           Counter.Y.dir  := 1;
7457         end else begin
7458           Counter.Y.low  := Header.Height-1;;
7459           Counter.Y.high := 0;
7460           Counter.Y.dir  := -1;
7461         end;
7462
7463         // Read Image
7464         case Header.ImageType of
7465           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7466             ReadUncompressed;
7467           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7468             ReadCompressed;
7469         end;
7470
7471         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7472         result := true;
7473       except
7474         if Assigned(ImageData) then
7475           FreeMem(ImageData);
7476         raise;
7477       end;
7478     finally
7479       aStream.Position := StartPosition;
7480     end;
7481   end
7482     else aStream.Position := StartPosition;
7483 end;
7484
7485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7486 procedure TglBitmap.SaveTGA(const aStream: TStream);
7487 var
7488   Header: TTGAHeader;
7489   LineSize, Size, x, y: Integer;
7490   Pixel: TglBitmapPixelData;
7491   LineBuf, SourceData, DestData: PByte;
7492   SourceMD, DestMD: Pointer;
7493   FormatDesc: TFormatDescriptor;
7494   Converter: TFormatDescriptor;
7495 begin
7496   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7497     raise EglBitmapUnsupportedFormat.Create(Format);
7498
7499   //prepare header
7500   FillChar(Header{%H-}, SizeOf(Header), 0);
7501
7502   //set ImageType
7503   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7504                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7505     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7506   else
7507     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7508
7509   //set BitsPerPixel
7510   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7511     Header.Bpp := 8
7512   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7513                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7514     Header.Bpp := 16
7515   else if (Format in [tfBGR8, tfRGB8]) then
7516     Header.Bpp := 24
7517   else
7518     Header.Bpp := 32;
7519
7520   //set AlphaBitCount
7521   case Format of
7522     tfRGB5A1, tfBGR5A1:
7523       Header.ImageDesc := 1 and $F;
7524     tfRGB10A2, tfBGR10A2:
7525       Header.ImageDesc := 2 and $F;
7526     tfRGBA4, tfBGRA4:
7527       Header.ImageDesc := 4 and $F;
7528     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7529       Header.ImageDesc := 8 and $F;
7530   end;
7531
7532   Header.Width     := Width;
7533   Header.Height    := Height;
7534   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7535   aStream.Write(Header, SizeOf(Header));
7536
7537   // convert RGB(A) to BGR(A)
7538   Converter  := nil;
7539   FormatDesc := TFormatDescriptor.Get(Format);
7540   Size       := FormatDesc.GetSize(Dimension);
7541   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7542     if (FormatDesc.RGBInverted = tfEmpty) then
7543       raise EglBitmap.Create('inverted RGB format is empty');
7544     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7545     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7546        (Converter.PixelSize <> FormatDesc.PixelSize) then
7547       raise EglBitmap.Create('invalid inverted RGB format');
7548   end;
7549
7550   if Assigned(Converter) then begin
7551     LineSize := FormatDesc.GetSize(Width, 1);
7552     GetMem(LineBuf, LineSize);
7553     SourceMD := FormatDesc.CreateMappingData;
7554     DestMD   := Converter.CreateMappingData;
7555     try
7556       SourceData := Data;
7557       for y := 0 to Height-1 do begin
7558         DestData := LineBuf;
7559         for x := 0 to Width-1 do begin
7560           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7561           Converter.Map(Pixel, DestData, DestMD);
7562         end;
7563         aStream.Write(LineBuf^, LineSize);
7564       end;
7565     finally
7566       FreeMem(LineBuf);
7567       FormatDesc.FreeMappingData(SourceMD);
7568       FormatDesc.FreeMappingData(DestMD);
7569     end;
7570   end else
7571     aStream.Write(Data^, Size);
7572 end;
7573
7574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7575 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7577 const
7578   DDS_MAGIC: Cardinal         = $20534444;
7579
7580   // DDS_header.dwFlags
7581   DDSD_CAPS                   = $00000001;
7582   DDSD_HEIGHT                 = $00000002;
7583   DDSD_WIDTH                  = $00000004;
7584   DDSD_PIXELFORMAT            = $00001000;
7585
7586   // DDS_header.sPixelFormat.dwFlags
7587   DDPF_ALPHAPIXELS            = $00000001;
7588   DDPF_ALPHA                  = $00000002;
7589   DDPF_FOURCC                 = $00000004;
7590   DDPF_RGB                    = $00000040;
7591   DDPF_LUMINANCE              = $00020000;
7592
7593   // DDS_header.sCaps.dwCaps1
7594   DDSCAPS_TEXTURE             = $00001000;
7595
7596   // DDS_header.sCaps.dwCaps2
7597   DDSCAPS2_CUBEMAP            = $00000200;
7598
7599   D3DFMT_DXT1                 = $31545844;
7600   D3DFMT_DXT3                 = $33545844;
7601   D3DFMT_DXT5                 = $35545844;
7602
7603 type
7604   TDDSPixelFormat = packed record
7605     dwSize: Cardinal;
7606     dwFlags: Cardinal;
7607     dwFourCC: Cardinal;
7608     dwRGBBitCount: Cardinal;
7609     dwRBitMask: Cardinal;
7610     dwGBitMask: Cardinal;
7611     dwBBitMask: Cardinal;
7612     dwABitMask: Cardinal;
7613   end;
7614
7615   TDDSCaps = packed record
7616     dwCaps1: Cardinal;
7617     dwCaps2: Cardinal;
7618     dwDDSX: Cardinal;
7619     dwReserved: Cardinal;
7620   end;
7621
7622   TDDSHeader = packed record
7623     dwSize: Cardinal;
7624     dwFlags: Cardinal;
7625     dwHeight: Cardinal;
7626     dwWidth: Cardinal;
7627     dwPitchOrLinearSize: Cardinal;
7628     dwDepth: Cardinal;
7629     dwMipMapCount: Cardinal;
7630     dwReserved: array[0..10] of Cardinal;
7631     PixelFormat: TDDSPixelFormat;
7632     Caps: TDDSCaps;
7633     dwReserved2: Cardinal;
7634   end;
7635
7636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7637 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7638 var
7639   Header: TDDSHeader;
7640   Converter: TbmpBitfieldFormat;
7641
7642   function GetDDSFormat: TglBitmapFormat;
7643   var
7644     fd: TFormatDescriptor;
7645     i: Integer;
7646     Range: TglBitmapColorRec;
7647     match: Boolean;
7648   begin
7649     result := tfEmpty;
7650     with Header.PixelFormat do begin
7651       // Compresses
7652       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7653         case Header.PixelFormat.dwFourCC of
7654           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7655           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7656           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7657         end;
7658       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7659
7660         //find matching format
7661         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7662           fd := TFormatDescriptor.Get(result);
7663           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7664              (8 * fd.PixelSize = dwRGBBitCount) then
7665             exit;
7666         end;
7667
7668         //find format with same Range
7669         Range.r := dwRBitMask;
7670         Range.g := dwGBitMask;
7671         Range.b := dwBBitMask;
7672         Range.a := dwABitMask;
7673         for i := 0 to 3 do begin
7674           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7675             Range.arr[i] := Range.arr[i] shr 1;
7676         end;
7677         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7678           fd := TFormatDescriptor.Get(result);
7679           match := true;
7680           for i := 0 to 3 do
7681             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7682               match := false;
7683               break;
7684             end;
7685           if match then
7686             break;
7687         end;
7688
7689         //no format with same range found -> use default
7690         if (result = tfEmpty) then begin
7691           if (dwABitMask > 0) then
7692             result := tfBGRA8
7693           else
7694             result := tfBGR8;
7695         end;
7696
7697         Converter := TbmpBitfieldFormat.Create;
7698         Converter.RedMask   := dwRBitMask;
7699         Converter.GreenMask := dwGBitMask;
7700         Converter.BlueMask  := dwBBitMask;
7701         Converter.AlphaMask := dwABitMask;
7702         Converter.PixelSize := dwRGBBitCount / 8;
7703       end;
7704     end;
7705   end;
7706
7707 var
7708   StreamPos: Int64;
7709   x, y, LineSize, RowSize, Magic: Cardinal;
7710   NewImage, TmpData, RowData, SrcData: System.PByte;
7711   SourceMD, DestMD: Pointer;
7712   Pixel: TglBitmapPixelData;
7713   ddsFormat: TglBitmapFormat;
7714   FormatDesc: TFormatDescriptor;
7715
7716 begin
7717   result    := false;
7718   Converter := nil;
7719   StreamPos := aStream.Position;
7720
7721   // Magic
7722   aStream.Read(Magic{%H-}, sizeof(Magic));
7723   if (Magic <> DDS_MAGIC) then begin
7724     aStream.Position := StreamPos;
7725     exit;
7726   end;
7727
7728   //Header
7729   aStream.Read(Header{%H-}, sizeof(Header));
7730   if (Header.dwSize <> SizeOf(Header)) or
7731      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7732         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7733   begin
7734     aStream.Position := StreamPos;
7735     exit;
7736   end;
7737
7738   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7739     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7740
7741   ddsFormat := GetDDSFormat;
7742   try
7743     if (ddsFormat = tfEmpty) then
7744       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7745
7746     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7747     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7748     GetMem(NewImage, Header.dwHeight * LineSize);
7749     try
7750       TmpData := NewImage;
7751
7752       //Converter needed
7753       if Assigned(Converter) then begin
7754         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7755         GetMem(RowData, RowSize);
7756         SourceMD := Converter.CreateMappingData;
7757         DestMD   := FormatDesc.CreateMappingData;
7758         try
7759           for y := 0 to Header.dwHeight-1 do begin
7760             TmpData := NewImage;
7761             inc(TmpData, y * LineSize);
7762             SrcData := RowData;
7763             aStream.Read(SrcData^, RowSize);
7764             for x := 0 to Header.dwWidth-1 do begin
7765               Converter.Unmap(SrcData, Pixel, SourceMD);
7766               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7767               FormatDesc.Map(Pixel, TmpData, DestMD);
7768             end;
7769           end;
7770         finally
7771           Converter.FreeMappingData(SourceMD);
7772           FormatDesc.FreeMappingData(DestMD);
7773           FreeMem(RowData);
7774         end;
7775       end else
7776
7777       // Compressed
7778       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7779         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7780         for Y := 0 to Header.dwHeight-1 do begin
7781           aStream.Read(TmpData^, RowSize);
7782           Inc(TmpData, LineSize);
7783         end;
7784       end else
7785
7786       // Uncompressed
7787       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7788         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7789         for Y := 0 to Header.dwHeight-1 do begin
7790           aStream.Read(TmpData^, RowSize);
7791           Inc(TmpData, LineSize);
7792         end;
7793       end else
7794         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7795
7796       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7797       result := true;
7798     except
7799       if Assigned(NewImage) then
7800         FreeMem(NewImage);
7801       raise;
7802     end;
7803   finally
7804     FreeAndNil(Converter);
7805   end;
7806 end;
7807
7808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7809 procedure TglBitmap.SaveDDS(const aStream: TStream);
7810 var
7811   Header: TDDSHeader;
7812   FormatDesc: TFormatDescriptor;
7813 begin
7814   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7815     raise EglBitmapUnsupportedFormat.Create(Format);
7816
7817   FormatDesc := TFormatDescriptor.Get(Format);
7818
7819   // Generell
7820   FillChar(Header{%H-}, SizeOf(Header), 0);
7821   Header.dwSize  := SizeOf(Header);
7822   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7823
7824   Header.dwWidth  := Max(1, Width);
7825   Header.dwHeight := Max(1, Height);
7826
7827   // Caps
7828   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7829
7830   // Pixelformat
7831   Header.PixelFormat.dwSize := sizeof(Header);
7832   if (FormatDesc.IsCompressed) then begin
7833     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7834     case Format of
7835       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7836       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7837       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7838     end;
7839   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7840     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7841     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7842     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7843   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7844     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7845     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7846     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7847     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7848   end else begin
7849     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7850     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7851     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7852     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7853     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7854     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7855   end;
7856
7857   if (FormatDesc.HasAlpha) then
7858     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7859
7860   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7861   aStream.Write(Header, SizeOf(Header));
7862   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7863 end;
7864
7865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7866 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7868 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7869   const aWidth: Integer; const aHeight: Integer);
7870 var
7871   pTemp: pByte;
7872   Size: Integer;
7873 begin
7874   if (aHeight > 1) then begin
7875     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7876     GetMem(pTemp, Size);
7877     try
7878       Move(aData^, pTemp^, Size);
7879       FreeMem(aData);
7880       aData := nil;
7881     except
7882       FreeMem(pTemp);
7883       raise;
7884     end;
7885   end else
7886     pTemp := aData;
7887   inherited SetDataPointer(pTemp, aFormat, aWidth);
7888 end;
7889
7890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7891 function TglBitmap1D.FlipHorz: Boolean;
7892 var
7893   Col: Integer;
7894   pTempDest, pDest, pSource: PByte;
7895 begin
7896   result := inherited FlipHorz;
7897   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7898     pSource := Data;
7899     GetMem(pDest, fRowSize);
7900     try
7901       pTempDest := pDest;
7902       Inc(pTempDest, fRowSize);
7903       for Col := 0 to Width-1 do begin
7904         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7905         Move(pSource^, pTempDest^, fPixelSize);
7906         Inc(pSource, fPixelSize);
7907       end;
7908       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7909       result := true;
7910     except
7911       if Assigned(pDest) then
7912         FreeMem(pDest);
7913       raise;
7914     end;
7915   end;
7916 end;
7917
7918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7919 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7920 var
7921   FormatDesc: TFormatDescriptor;
7922 begin
7923   // Upload data
7924   FormatDesc := TFormatDescriptor.Get(Format);
7925   if FormatDesc.IsCompressed then begin
7926     if not Assigned(glCompressedTexImage1D) then
7927       raise EglBitmap.Create('compressed formats not supported by video adapter');
7928     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7929   end else if aBuildWithGlu then
7930     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7931   else
7932     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7933
7934   // Free Data
7935   if (FreeDataAfterGenTexture) then
7936     FreeData;
7937 end;
7938
7939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7940 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7941 var
7942   BuildWithGlu, TexRec: Boolean;
7943   TexSize: Integer;
7944 begin
7945   if Assigned(Data) then begin
7946     // Check Texture Size
7947     if (aTestTextureSize) then begin
7948       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7949
7950       if (Width > TexSize) then
7951         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7952
7953       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7954                 (Target = GL_TEXTURE_RECTANGLE);
7955       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7956         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7957     end;
7958
7959     CreateId;
7960     SetupParameters(BuildWithGlu);
7961     UploadData(BuildWithGlu);
7962     glAreTexturesResident(1, @fID, @fIsResident);
7963   end;
7964 end;
7965
7966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7967 procedure TglBitmap1D.AfterConstruction;
7968 begin
7969   inherited;
7970   Target := GL_TEXTURE_1D;
7971 end;
7972
7973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7974 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7976 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7977 begin
7978   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7979     result := fLines[aIndex]
7980   else
7981     result := nil;
7982 end;
7983
7984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7985 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7986   const aWidth: Integer; const aHeight: Integer);
7987 var
7988   Idx, LineWidth: Integer;
7989 begin
7990   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7991
7992   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7993     // Assigning Data
7994     if Assigned(Data) then begin
7995       SetLength(fLines, GetHeight);
7996       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7997
7998       for Idx := 0 to GetHeight-1 do begin
7999         fLines[Idx] := Data;
8000         Inc(fLines[Idx], Idx * LineWidth);
8001       end;
8002     end
8003       else SetLength(fLines, 0);
8004   end else begin
8005     SetLength(fLines, 0);
8006   end;
8007 end;
8008
8009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8010 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
8011 var
8012   FormatDesc: TFormatDescriptor;
8013 begin
8014   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8015
8016   FormatDesc := TFormatDescriptor.Get(Format);
8017   if FormatDesc.IsCompressed then begin
8018     if not Assigned(glCompressedTexImage2D) then
8019       raise EglBitmap.Create('compressed formats not supported by video adapter');
8020     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8021   end else if aBuildWithGlu then begin
8022     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8023       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8024   end else begin
8025     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8026       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8027   end;
8028
8029   // Freigeben
8030   if (FreeDataAfterGenTexture) then
8031     FreeData;
8032 end;
8033
8034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8035 procedure TglBitmap2D.AfterConstruction;
8036 begin
8037   inherited;
8038   Target := GL_TEXTURE_2D;
8039 end;
8040
8041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8042 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8043 var
8044   Temp: pByte;
8045   Size, w, h: Integer;
8046   FormatDesc: TFormatDescriptor;
8047 begin
8048   FormatDesc := TFormatDescriptor.Get(aFormat);
8049   if FormatDesc.IsCompressed then
8050     raise EglBitmapUnsupportedFormat.Create(aFormat);
8051
8052   w    := aRight  - aLeft;
8053   h    := aBottom - aTop;
8054   Size := FormatDesc.GetSize(w, h);
8055   GetMem(Temp, Size);
8056   try
8057     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8058     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8059     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8060     FlipVert;
8061   except
8062     if Assigned(Temp) then
8063       FreeMem(Temp);
8064     raise;
8065   end;
8066 end;
8067
8068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8069 procedure TglBitmap2D.GetDataFromTexture;
8070 var
8071   Temp: PByte;
8072   TempWidth, TempHeight: Integer;
8073   TempIntFormat: GLint;
8074   IntFormat: TglBitmapFormat;
8075   FormatDesc: TFormatDescriptor;
8076 begin
8077   Bind;
8078
8079   // Request Data
8080   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8081   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8082   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8083
8084   IntFormat  := tfEmpty;
8085   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8086   IntFormat  := FormatDesc.Format;
8087
8088   // Getting data from OpenGL
8089   FormatDesc := TFormatDescriptor.Get(IntFormat);
8090   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8091   try
8092     if FormatDesc.IsCompressed then begin
8093       if not Assigned(glGetCompressedTexImage) then
8094         raise EglBitmap.Create('compressed formats not supported by video adapter');
8095       glGetCompressedTexImage(Target, 0, Temp)
8096     end else
8097       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8098     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8099   except
8100     if Assigned(Temp) then
8101       FreeMem(Temp);
8102     raise;
8103   end;
8104 end;
8105
8106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8107 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8108 var
8109   BuildWithGlu, PotTex, TexRec: Boolean;
8110   TexSize: Integer;
8111 begin
8112   if Assigned(Data) then begin
8113     // Check Texture Size
8114     if (aTestTextureSize) then begin
8115       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8116
8117       if ((Height > TexSize) or (Width > TexSize)) then
8118         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8119
8120       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8121       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8122       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8123         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8124     end;
8125
8126     CreateId;
8127     SetupParameters(BuildWithGlu);
8128     UploadData(Target, BuildWithGlu);
8129     glAreTexturesResident(1, @fID, @fIsResident);
8130   end;
8131 end;
8132
8133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8134 function TglBitmap2D.FlipHorz: Boolean;
8135 var
8136   Col, Row: Integer;
8137   TempDestData, DestData, SourceData: PByte;
8138   ImgSize: Integer;
8139 begin
8140   result := inherited FlipHorz;
8141   if Assigned(Data) then begin
8142     SourceData := Data;
8143     ImgSize := Height * fRowSize;
8144     GetMem(DestData, ImgSize);
8145     try
8146       TempDestData := DestData;
8147       Dec(TempDestData, fRowSize + fPixelSize);
8148       for Row := 0 to Height -1 do begin
8149         Inc(TempDestData, fRowSize * 2);
8150         for Col := 0 to Width -1 do begin
8151           Move(SourceData^, TempDestData^, fPixelSize);
8152           Inc(SourceData, fPixelSize);
8153           Dec(TempDestData, fPixelSize);
8154         end;
8155       end;
8156       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8157       result := true;
8158     except
8159       if Assigned(DestData) then
8160         FreeMem(DestData);
8161       raise;
8162     end;
8163   end;
8164 end;
8165
8166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8167 function TglBitmap2D.FlipVert: Boolean;
8168 var
8169   Row: Integer;
8170   TempDestData, DestData, SourceData: PByte;
8171 begin
8172   result := inherited FlipVert;
8173   if Assigned(Data) then begin
8174     SourceData := Data;
8175     GetMem(DestData, Height * fRowSize);
8176     try
8177       TempDestData := DestData;
8178       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8179       for Row := 0 to Height -1 do begin
8180         Move(SourceData^, TempDestData^, fRowSize);
8181         Dec(TempDestData, fRowSize);
8182         Inc(SourceData, fRowSize);
8183       end;
8184       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8185       result := true;
8186     except
8187       if Assigned(DestData) then
8188         FreeMem(DestData);
8189       raise;
8190     end;
8191   end;
8192 end;
8193
8194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8195 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8197 type
8198   TMatrixItem = record
8199     X, Y: Integer;
8200     W: Single;
8201   end;
8202
8203   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8204   TglBitmapToNormalMapRec = Record
8205     Scale: Single;
8206     Heights: array of Single;
8207     MatrixU : array of TMatrixItem;
8208     MatrixV : array of TMatrixItem;
8209   end;
8210
8211 const
8212   ONE_OVER_255 = 1 / 255;
8213
8214   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8215 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8216 var
8217   Val: Single;
8218 begin
8219   with FuncRec do begin
8220     Val :=
8221       Source.Data.r * LUMINANCE_WEIGHT_R +
8222       Source.Data.g * LUMINANCE_WEIGHT_G +
8223       Source.Data.b * LUMINANCE_WEIGHT_B;
8224     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8225   end;
8226 end;
8227
8228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8229 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8230 begin
8231   with FuncRec do
8232     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8233 end;
8234
8235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8236 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8237 type
8238   TVec = Array[0..2] of Single;
8239 var
8240   Idx: Integer;
8241   du, dv: Double;
8242   Len: Single;
8243   Vec: TVec;
8244
8245   function GetHeight(X, Y: Integer): Single;
8246   begin
8247     with FuncRec do begin
8248       X := Max(0, Min(Size.X -1, X));
8249       Y := Max(0, Min(Size.Y -1, Y));
8250       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8251     end;
8252   end;
8253
8254 begin
8255   with FuncRec do begin
8256     with PglBitmapToNormalMapRec(Args)^ do begin
8257       du := 0;
8258       for Idx := Low(MatrixU) to High(MatrixU) do
8259         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8260
8261       dv := 0;
8262       for Idx := Low(MatrixU) to High(MatrixU) do
8263         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8264
8265       Vec[0] := -du * Scale;
8266       Vec[1] := -dv * Scale;
8267       Vec[2] := 1;
8268     end;
8269
8270     // Normalize
8271     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8272     if Len <> 0 then begin
8273       Vec[0] := Vec[0] * Len;
8274       Vec[1] := Vec[1] * Len;
8275       Vec[2] := Vec[2] * Len;
8276     end;
8277
8278     // Farbe zuweisem
8279     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8280     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8281     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8282   end;
8283 end;
8284
8285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8286 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8287 var
8288   Rec: TglBitmapToNormalMapRec;
8289
8290   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8291   begin
8292     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8293       Matrix[Index].X := X;
8294       Matrix[Index].Y := Y;
8295       Matrix[Index].W := W;
8296     end;
8297   end;
8298
8299 begin
8300   if TFormatDescriptor.Get(Format).IsCompressed then
8301     raise EglBitmapUnsupportedFormat.Create(Format);
8302
8303   if aScale > 100 then
8304     Rec.Scale := 100
8305   else if aScale < -100 then
8306     Rec.Scale := -100
8307   else
8308     Rec.Scale := aScale;
8309
8310   SetLength(Rec.Heights, Width * Height);
8311   try
8312     case aFunc of
8313       nm4Samples: begin
8314         SetLength(Rec.MatrixU, 2);
8315         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8316         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8317
8318         SetLength(Rec.MatrixV, 2);
8319         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8320         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8321       end;
8322
8323       nmSobel: begin
8324         SetLength(Rec.MatrixU, 6);
8325         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8326         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8327         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8328         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8329         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8330         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8331
8332         SetLength(Rec.MatrixV, 6);
8333         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8334         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8335         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8336         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8337         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8338         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8339       end;
8340
8341       nm3x3: begin
8342         SetLength(Rec.MatrixU, 6);
8343         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8344         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8345         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8346         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8347         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8348         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8349
8350         SetLength(Rec.MatrixV, 6);
8351         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8352         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8353         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8354         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8355         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8356         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8357       end;
8358
8359       nm5x5: begin
8360         SetLength(Rec.MatrixU, 20);
8361         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8362         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8363         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8364         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8365         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8366         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8367         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8368         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8369         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8370         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8371         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8372         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8373         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8374         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8375         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8376         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8377         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8378         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8379         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8380         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8381
8382         SetLength(Rec.MatrixV, 20);
8383         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8384         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8385         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8386         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8387         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8388         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8389         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8390         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8391         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8392         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8393         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8394         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8395         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8396         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8397         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8398         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8399         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8400         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8401         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8402         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8403       end;
8404     end;
8405
8406     // Daten Sammeln
8407     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8408       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8409     else
8410       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8411     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8412   finally
8413     SetLength(Rec.Heights, 0);
8414   end;
8415 end;
8416
8417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8418 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8420 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8421 begin
8422   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8423 end;
8424
8425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8426 procedure TglBitmapCubeMap.AfterConstruction;
8427 begin
8428   inherited;
8429
8430   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8431     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8432
8433   SetWrap;
8434   Target   := GL_TEXTURE_CUBE_MAP;
8435   fGenMode := GL_REFLECTION_MAP;
8436 end;
8437
8438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8439 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8440 var
8441   BuildWithGlu: Boolean;
8442   TexSize: Integer;
8443 begin
8444   if (aTestTextureSize) then begin
8445     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8446
8447     if (Height > TexSize) or (Width > TexSize) then
8448       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8449
8450     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8451       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8452   end;
8453
8454   if (ID = 0) then
8455     CreateID;
8456   SetupParameters(BuildWithGlu);
8457   UploadData(aCubeTarget, BuildWithGlu);
8458 end;
8459
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8462 begin
8463   inherited Bind (aEnableTextureUnit);
8464   if aEnableTexCoordsGen then begin
8465     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8466     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8467     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8468     glEnable(GL_TEXTURE_GEN_S);
8469     glEnable(GL_TEXTURE_GEN_T);
8470     glEnable(GL_TEXTURE_GEN_R);
8471   end;
8472 end;
8473
8474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8476 begin
8477   inherited Unbind(aDisableTextureUnit);
8478   if aDisableTexCoordsGen then begin
8479     glDisable(GL_TEXTURE_GEN_S);
8480     glDisable(GL_TEXTURE_GEN_T);
8481     glDisable(GL_TEXTURE_GEN_R);
8482   end;
8483 end;
8484
8485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8486 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8488 type
8489   TVec = Array[0..2] of Single;
8490   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8491
8492   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8493   TglBitmapNormalMapRec = record
8494     HalfSize : Integer;
8495     Func: TglBitmapNormalMapGetVectorFunc;
8496   end;
8497
8498   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8499 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8500 begin
8501   aVec[0] := aHalfSize;
8502   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8503   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8504 end;
8505
8506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8507 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8508 begin
8509   aVec[0] := - aHalfSize;
8510   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8511   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8512 end;
8513
8514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8515 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8516 begin
8517   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8518   aVec[1] := aHalfSize;
8519   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8520 end;
8521
8522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8523 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8524 begin
8525   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8526   aVec[1] := - aHalfSize;
8527   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8528 end;
8529
8530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8531 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8532 begin
8533   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8534   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8535   aVec[2] := aHalfSize;
8536 end;
8537
8538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8539 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8540 begin
8541   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8542   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8543   aVec[2] := - aHalfSize;
8544 end;
8545
8546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8547 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8548 var
8549   i: Integer;
8550   Vec: TVec;
8551   Len: Single;
8552 begin
8553   with FuncRec do begin
8554     with PglBitmapNormalMapRec(Args)^ do begin
8555       Func(Vec, Position, HalfSize);
8556
8557       // Normalize
8558       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8559       if Len <> 0 then begin
8560         Vec[0] := Vec[0] * Len;
8561         Vec[1] := Vec[1] * Len;
8562         Vec[2] := Vec[2] * Len;
8563       end;
8564
8565       // Scale Vector and AddVectro
8566       Vec[0] := Vec[0] * 0.5 + 0.5;
8567       Vec[1] := Vec[1] * 0.5 + 0.5;
8568       Vec[2] := Vec[2] * 0.5 + 0.5;
8569     end;
8570
8571     // Set Color
8572     for i := 0 to 2 do
8573       Dest.Data.arr[i] := Round(Vec[i] * 255);
8574   end;
8575 end;
8576
8577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8578 procedure TglBitmapNormalMap.AfterConstruction;
8579 begin
8580   inherited;
8581   fGenMode := GL_NORMAL_MAP;
8582 end;
8583
8584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8585 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8586 var
8587   Rec: TglBitmapNormalMapRec;
8588   SizeRec: TglBitmapPixelPosition;
8589 begin
8590   Rec.HalfSize := aSize div 2;
8591   FreeDataAfterGenTexture := false;
8592
8593   SizeRec.Fields := [ffX, ffY];
8594   SizeRec.X := aSize;
8595   SizeRec.Y := aSize;
8596
8597   // Positive X
8598   Rec.Func := glBitmapNormalMapPosX;
8599   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8600   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8601
8602   // Negative X
8603   Rec.Func := glBitmapNormalMapNegX;
8604   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8605   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8606
8607   // Positive Y
8608   Rec.Func := glBitmapNormalMapPosY;
8609   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8610   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8611
8612   // Negative Y
8613   Rec.Func := glBitmapNormalMapNegY;
8614   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8615   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8616
8617   // Positive Z
8618   Rec.Func := glBitmapNormalMapPosZ;
8619   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8620   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8621
8622   // Negative Z
8623   Rec.Func := glBitmapNormalMapNegZ;
8624   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8625   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8626 end;
8627
8628
8629 initialization
8630   glBitmapSetDefaultFormat (tfEmpty);
8631   glBitmapSetDefaultMipmap (mmMipmap);
8632   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8633   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8634   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8635
8636   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8637   glBitmapSetDefaultDeleteTextureOnFree    (true);
8638
8639   TFormatDescriptor.Init;
8640
8641 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8642   OpenGLInitialized := false;
8643   InitOpenGLCS := TCriticalSection.Create;
8644 {$ENDIF}
8645
8646 finalization
8647   TFormatDescriptor.Finalize;
8648
8649 {$IFDEF GLB_NATIVE_OGL}
8650   if Assigned(GL_LibHandle) then
8651     glbFreeLibrary(GL_LibHandle);
8652
8653 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8654   if Assigned(GLU_LibHandle) then
8655     glbFreeLibrary(GLU_LibHandle);
8656   FreeAndNil(InitOpenGLCS);
8657 {$ENDIF}
8658 {$ENDIF}
8659
8660 end.