glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE 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   end;
 911
 912 ////////////////////////////////////////////////////////////////////////////////////////////////////
 913   TglBitmap = class;
 914   TglBitmapFunctionRec = record
 915     Sender:   TglBitmap;
 916     Size:     TglBitmapPixelPosition;
 917     Position: TglBitmapPixelPosition;
 918     Source:   TglBitmapPixelData;
 919     Dest:     TglBitmapPixelData;
 920     Args:     Pointer;
 921   end;
 922   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 923
 924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 925   TglBitmap = class
 926   private
 927     function GetFormatDesc: TglBitmapFormatDescriptor;
 928   protected
 929     fID: GLuint;
 930     fTarget: GLuint;
 931     fAnisotropic: Integer;
 932     fDeleteTextureOnFree: Boolean;
 933     fFreeDataOnDestroy: Boolean;
 934     fFreeDataAfterGenTexture: Boolean;
 935     fData: PByte;
 936     fIsResident: GLboolean;
 937     fBorderColor: array[0..3] of Single;
 938
 939     fDimension: TglBitmapPixelPosition;
 940     fMipMap: TglBitmapMipMap;
 941     fFormat: TglBitmapFormat;
 942
 943     // Mapping
 944     fPixelSize: Integer;
 945     fRowSize: Integer;
 946
 947     // Filtering
 948     fFilterMin: GLenum;
 949     fFilterMag: GLenum;
 950
 951     // TexturWarp
 952     fWrapS: GLenum;
 953     fWrapT: GLenum;
 954     fWrapR: GLenum;
 955
 956     //Swizzle
 957     fSwizzle: array[0..3] of GLenum;
 958
 959     // CustomData
 960     fFilename: String;
 961     fCustomName: String;
 962     fCustomNameW: WideString;
 963     fCustomData: Pointer;
 964
 965     //Getter
 966     function GetWidth:  Integer; virtual;
 967     function GetHeight: Integer; virtual;
 968
 969     function GetFileWidth:  Integer; virtual;
 970     function GetFileHeight: Integer; virtual;
 971
 972     //Setter
 973     procedure SetCustomData(const aValue: Pointer);
 974     procedure SetCustomName(const aValue: String);
 975     procedure SetCustomNameW(const aValue: WideString);
 976     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 977     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 978     procedure SetFormat(const aValue: TglBitmapFormat);
 979     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 980     procedure SetID(const aValue: Cardinal);
 981     procedure SetMipMap(const aValue: TglBitmapMipMap);
 982     procedure SetTarget(const aValue: Cardinal);
 983     procedure SetAnisotropic(const aValue: Integer);
 984
 985     procedure CreateID;
 986     procedure SetupParameters(out aBuildWithGlu: Boolean);
 987     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 988       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 989     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 990
 991     function FlipHorz: Boolean; virtual;
 992     function FlipVert: Boolean; virtual;
 993
 994     property Width:  Integer read GetWidth;
 995     property Height: Integer read GetHeight;
 996
 997     property FileWidth:  Integer read GetFileWidth;
 998     property FileHeight: Integer read GetFileHeight;
 999   public
1000     //Properties
1001     property ID:           Cardinal        read fID          write SetID;
1002     property Target:       Cardinal        read fTarget      write SetTarget;
1003     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1004     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1005     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1006
1007     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1008
1009     property Filename:    String     read fFilename;
1010     property CustomName:  String     read fCustomName  write SetCustomName;
1011     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1012     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1013
1014     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1015     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1016     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1017
1018     property Dimension:  TglBitmapPixelPosition  read fDimension;
1019     property Data:       PByte                   read fData;
1020     property IsResident: GLboolean               read fIsResident;
1021
1022     procedure AfterConstruction; override;
1023     procedure BeforeDestruction; override;
1024
1025     procedure PrepareResType(var aResource: String; var aResType: PChar);
1026
1027     //Load
1028     procedure LoadFromFile(const aFilename: String);
1029     procedure LoadFromStream(const aStream: TStream); virtual;
1030     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1031       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1032     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1033     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1034
1035     //Save
1036     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1037     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1038
1039     //Convert
1040     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1041     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1042       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1043   public
1044     //Alpha & Co
1045     {$IFDEF GLB_SDL}
1046     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1047     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1048     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1049     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1050       const aArgs: Pointer = nil): Boolean;
1051     {$ENDIF}
1052
1053     {$IFDEF GLB_DELPHI}
1054     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1055     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1056     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1057     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1058       const aArgs: Pointer = nil): Boolean;
1059     {$ENDIF}
1060
1061     {$IFDEF GLB_LAZARUS}
1062     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1063     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1064     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1065     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1066       const aArgs: Pointer = nil): Boolean;
1067     {$ENDIF}
1068
1069     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1070       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1071     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1072       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1073
1074     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1075     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1076     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1077     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1078
1079     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1080     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1081     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1082
1083     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1084     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1085     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1086
1087     function RemoveAlpha: Boolean; virtual;
1088   public
1089     //Common
1090     function Clone: TglBitmap;
1091     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1092     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1093     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1094     procedure FreeData;
1095
1096     //ColorFill
1097     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1098     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1099     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1100
1101     //TexParameters
1102     procedure SetFilter(const aMin, aMag: GLenum);
1103     procedure SetWrap(
1104       const S: GLenum = GL_CLAMP_TO_EDGE;
1105       const T: GLenum = GL_CLAMP_TO_EDGE;
1106       const R: GLenum = GL_CLAMP_TO_EDGE);
1107     procedure SetSwizzle(const r, g, b, a: GLenum);
1108
1109     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1110     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1111
1112     //Constructors
1113     constructor Create; overload;
1114     constructor Create(const aFileName: String); overload;
1115     constructor Create(const aStream: TStream); overload;
1116     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1117     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1118     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1119     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1120   private
1121     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1122     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1123
1124     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1125     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1126
1127     function LoadBMP(const aStream: TStream): Boolean; virtual;
1128     procedure SaveBMP(const aStream: TStream); virtual;
1129
1130     function LoadTGA(const aStream: TStream): Boolean; virtual;
1131     procedure SaveTGA(const aStream: TStream); virtual;
1132
1133     function LoadDDS(const aStream: TStream): Boolean; virtual;
1134     procedure SaveDDS(const aStream: TStream); virtual;
1135   end;
1136
1137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1138   TglBitmap1D = class(TglBitmap)
1139   protected
1140     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1141       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1142     procedure UploadData(const aBuildWithGlu: Boolean);
1143   public
1144     property Width;
1145     procedure AfterConstruction; override;
1146     function FlipHorz: Boolean; override;
1147     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1148   end;
1149
1150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1151   TglBitmap2D = class(TglBitmap)
1152   protected
1153     fLines: array of PByte;
1154     function GetScanline(const aIndex: Integer): Pointer;
1155     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1156       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1157     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1158   public
1159     property Width;
1160     property Height;
1161     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1162
1163     procedure AfterConstruction; override;
1164
1165     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1166     procedure GetDataFromTexture;
1167     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1168
1169     function FlipHorz: Boolean; override;
1170     function FlipVert: Boolean; override;
1171
1172     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1173       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1174   end;
1175
1176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1177   TglBitmapCubeMap = class(TglBitmap2D)
1178   protected
1179     fGenMode: Integer;
1180     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1181   public
1182     procedure AfterConstruction; override;
1183     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1184     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1185     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1186   end;
1187
1188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1189   TglBitmapNormalMap = class(TglBitmapCubeMap)
1190   public
1191     procedure AfterConstruction; override;
1192     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1193   end;
1194
1195 const
1196   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1197
1198 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1199 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1200 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1201 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1202 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1203 procedure glBitmapSetDefaultWrap(
1204   const S: Cardinal = GL_CLAMP_TO_EDGE;
1205   const T: Cardinal = GL_CLAMP_TO_EDGE;
1206   const R: Cardinal = GL_CLAMP_TO_EDGE);
1207
1208 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1209 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1210 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1211 function glBitmapGetDefaultFormat: TglBitmapFormat;
1212 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1213 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1214
1215 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1216 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1217 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1218
1219 var
1220   glBitmapDefaultDeleteTextureOnFree: Boolean;
1221   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1222   glBitmapDefaultFormat: TglBitmapFormat;
1223   glBitmapDefaultMipmap: TglBitmapMipMap;
1224   glBitmapDefaultFilterMin: Cardinal;
1225   glBitmapDefaultFilterMag: Cardinal;
1226   glBitmapDefaultWrapS: Cardinal;
1227   glBitmapDefaultWrapT: Cardinal;
1228   glBitmapDefaultWrapR: Cardinal;
1229   glDefaultSwizzle: array[0..3] of GLenum;
1230
1231 {$IFDEF GLB_DELPHI}
1232 function CreateGrayPalette: HPALETTE;
1233 {$ENDIF}
1234
1235 implementation
1236
1237 uses
1238   Math, syncobjs, typinfo
1239   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1240
1241 type
1242 {$IFNDEF fpc}
1243   QWord   = System.UInt64;
1244   PQWord  = ^QWord;
1245
1246   PtrInt  = Longint;
1247   PtrUInt = DWord;
1248 {$ENDIF}
1249
1250 ////////////////////////////////////////////////////////////////////////////////////////////////////
1251   TShiftRec = packed record
1252   case Integer of
1253     0: (r, g, b, a: Byte);
1254     1: (arr: array[0..3] of Byte);
1255   end;
1256
1257   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1258   private
1259     function GetRedMask: QWord;
1260     function GetGreenMask: QWord;
1261     function GetBlueMask: QWord;
1262     function GetAlphaMask: QWord;
1263   protected
1264     fFormat: TglBitmapFormat;
1265     fWithAlpha: TglBitmapFormat;
1266     fWithoutAlpha: TglBitmapFormat;
1267     fRGBInverted: TglBitmapFormat;
1268     fUncompressed: TglBitmapFormat;
1269     fPixelSize: Single;
1270     fIsCompressed: Boolean;
1271
1272     fRange: TglBitmapColorRec;
1273     fShift: TShiftRec;
1274
1275     fglFormat:         GLenum;
1276     fglInternalFormat: GLenum;
1277     fglDataFormat:     GLenum;
1278
1279     function GetIsCompressed: Boolean; override;
1280     function GetHasRed: Boolean; override;
1281     function GetHasGreen: Boolean; override;
1282     function GetHasBlue: Boolean; override;
1283     function GetHasAlpha: Boolean; override;
1284
1285     function GetglFormat: GLenum; override;
1286     function GetglInternalFormat: GLenum; override;
1287     function GetglDataFormat: GLenum; override;
1288
1289     function GetComponents: Integer; virtual;
1290   public
1291     property Format:       TglBitmapFormat read fFormat;
1292     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1293     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1294     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1295     property Components:   Integer         read GetComponents;
1296     property PixelSize:    Single          read fPixelSize;
1297
1298     property Range: TglBitmapColorRec read fRange;
1299     property Shift: TShiftRec         read fShift;
1300
1301     property RedMask:   QWord read GetRedMask;
1302     property GreenMask: QWord read GetGreenMask;
1303     property BlueMask:  QWord read GetBlueMask;
1304     property AlphaMask: QWord read GetAlphaMask;
1305
1306     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1307     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1308
1309     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1310     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1311
1312     function CreateMappingData: Pointer; virtual;
1313     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1314
1315     function IsEmpty:  Boolean; virtual;
1316     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1317
1318     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1319
1320     constructor Create; virtual;
1321   public
1322     class procedure Init;
1323     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1324     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1325     class procedure Clear;
1326     class procedure Finalize;
1327   end;
1328   TFormatDescriptorClass = class of TFormatDescriptor;
1329
1330   TfdEmpty = class(TFormatDescriptor);
1331
1332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1333   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336     constructor Create; override;
1337   end;
1338
1339   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342     constructor Create; override;
1343   end;
1344
1345   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1346     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1347     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1348     constructor Create; override;
1349   end;
1350
1351   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354     constructor Create; override;
1355   end;
1356
1357   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1358     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1359     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1360     constructor Create; override;
1361   end;
1362
1363   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1364     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1365     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1366     constructor Create; override;
1367   end;
1368
1369   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1370     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1371     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1372     constructor Create; override;
1373   end;
1374
1375   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1376     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1377     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1378     constructor Create; override;
1379   end;
1380
1381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1382   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385     constructor Create; override;
1386   end;
1387
1388   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1389     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1390     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1391     constructor Create; override;
1392   end;
1393
1394   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1395     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1396     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1397     constructor Create; override;
1398   end;
1399
1400   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1401     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1402     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1403     constructor Create; override;
1404   end;
1405
1406   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409     constructor Create; override;
1410   end;
1411
1412   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415     constructor Create; override;
1416   end;
1417
1418   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421     constructor Create; override;
1422   end;
1423
1424   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1425     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1426     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1427     constructor Create; override;
1428   end;
1429
1430   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1431     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1432     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1433     constructor Create; override;
1434   end;
1435
1436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1437   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1438     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1439     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1440     constructor Create; override;
1441   end;
1442
1443   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446     constructor Create; override;
1447   end;
1448
1449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1450   TfdAlpha4 = class(TfdAlpha_UB1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdAlpha8 = class(TfdAlpha_UB1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdAlpha12 = class(TfdAlpha_US1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdAlpha16 = class(TfdAlpha_US1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdLuminance4 = class(TfdLuminance_UB1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdLuminance8 = class(TfdLuminance_UB1)
1471     constructor Create; override;
1472   end;
1473
1474   TfdLuminance12 = class(TfdLuminance_US1)
1475     constructor Create; override;
1476   end;
1477
1478   TfdLuminance16 = class(TfdLuminance_US1)
1479     constructor Create; override;
1480   end;
1481
1482   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1483     constructor Create; override;
1484   end;
1485
1486   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1487     constructor Create; override;
1488   end;
1489
1490   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1491     constructor Create; override;
1492   end;
1493
1494   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1495     constructor Create; override;
1496   end;
1497
1498   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1499     constructor Create; override;
1500   end;
1501
1502   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1503     constructor Create; override;
1504   end;
1505
1506   TfdR3G3B2 = class(TfdUniversal_UB1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdRGB4 = class(TfdUniversal_US1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdR5G6B5 = class(TfdUniversal_US1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdRGB5 = class(TfdUniversal_US1)
1519     constructor Create; override;
1520   end;
1521
1522   TfdRGB8 = class(TfdRGB_UB3)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGB10 = class(TfdUniversal_UI1)
1527     constructor Create; override;
1528   end;
1529
1530   TfdRGB12 = class(TfdRGB_US3)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGB16 = class(TfdRGB_US3)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGBA2 = class(TfdRGBA_UB4)
1539     constructor Create; override;
1540   end;
1541
1542   TfdRGBA4 = class(TfdUniversal_US1)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGB5A1 = class(TfdUniversal_US1)
1547     constructor Create; override;
1548   end;
1549
1550   TfdRGBA8 = class(TfdRGBA_UB4)
1551     constructor Create; override;
1552   end;
1553
1554   TfdRGB10A2 = class(TfdUniversal_UI1)
1555     constructor Create; override;
1556   end;
1557
1558   TfdRGBA12 = class(TfdRGBA_US4)
1559     constructor Create; override;
1560   end;
1561
1562   TfdRGBA16 = class(TfdRGBA_US4)
1563     constructor Create; override;
1564   end;
1565
1566   TfdBGR4 = class(TfdUniversal_US1)
1567     constructor Create; override;
1568   end;
1569
1570   TfdB5G6R5 = class(TfdUniversal_US1)
1571     constructor Create; override;
1572   end;
1573
1574   TfdBGR5 = class(TfdUniversal_US1)
1575     constructor Create; override;
1576   end;
1577
1578   TfdBGR8 = class(TfdBGR_UB3)
1579     constructor Create; override;
1580   end;
1581
1582   TfdBGR10 = class(TfdUniversal_UI1)
1583     constructor Create; override;
1584   end;
1585
1586   TfdBGR12 = class(TfdBGR_US3)
1587     constructor Create; override;
1588   end;
1589
1590   TfdBGR16 = class(TfdBGR_US3)
1591     constructor Create; override;
1592   end;
1593
1594   TfdBGRA2 = class(TfdBGRA_UB4)
1595     constructor Create; override;
1596   end;
1597
1598   TfdBGRA4 = class(TfdUniversal_US1)
1599     constructor Create; override;
1600   end;
1601
1602   TfdBGR5A1 = class(TfdUniversal_US1)
1603     constructor Create; override;
1604   end;
1605
1606   TfdBGRA8 = class(TfdBGRA_UB4)
1607     constructor Create; override;
1608   end;
1609
1610   TfdBGR10A2 = class(TfdUniversal_UI1)
1611     constructor Create; override;
1612   end;
1613
1614   TfdBGRA12 = class(TfdBGRA_US4)
1615     constructor Create; override;
1616   end;
1617
1618   TfdBGRA16 = class(TfdBGRA_US4)
1619     constructor Create; override;
1620   end;
1621
1622   TfdDepth16 = class(TfdDepth_US1)
1623     constructor Create; override;
1624   end;
1625
1626   TfdDepth24 = class(TfdDepth_UI1)
1627     constructor Create; override;
1628   end;
1629
1630   TfdDepth32 = class(TfdDepth_UI1)
1631     constructor Create; override;
1632   end;
1633
1634   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1635     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1636     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1637     constructor Create; override;
1638   end;
1639
1640   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1641     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1642     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1643     constructor Create; override;
1644   end;
1645
1646   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1647     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1648     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1649     constructor Create; override;
1650   end;
1651
1652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1653   TbmpBitfieldFormat = class(TFormatDescriptor)
1654   private
1655     procedure SetRedMask  (const aValue: QWord);
1656     procedure SetGreenMask(const aValue: QWord);
1657     procedure SetBlueMask (const aValue: QWord);
1658     procedure SetAlphaMask(const aValue: QWord);
1659
1660     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1661   public
1662     property RedMask:   QWord read GetRedMask   write SetRedMask;
1663     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1664     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1665     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1666
1667     property PixelSize: Single read fPixelSize write fPixelSize;
1668
1669     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1670     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1671   end;
1672
1673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1674   TbmpColorTableEnty = packed record
1675     b, g, r, a: Byte;
1676   end;
1677   TbmpColorTable = array of TbmpColorTableEnty;
1678   TbmpColorTableFormat = class(TFormatDescriptor)
1679   private
1680     fColorTable: TbmpColorTable;
1681   public
1682     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1683     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1684     property Range:      TglBitmapColorRec read fRange      write fRange;
1685     property Shift:      TShiftRec         read fShift      write fShift;
1686     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1687
1688     procedure CreateColorTable;
1689
1690     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1691     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1692     destructor Destroy; override;
1693   end;
1694
1695 const
1696   LUMINANCE_WEIGHT_R = 0.30;
1697   LUMINANCE_WEIGHT_G = 0.59;
1698   LUMINANCE_WEIGHT_B = 0.11;
1699
1700   ALPHA_WEIGHT_R = 0.30;
1701   ALPHA_WEIGHT_G = 0.59;
1702   ALPHA_WEIGHT_B = 0.11;
1703
1704   DEPTH_WEIGHT_R = 0.333333333;
1705   DEPTH_WEIGHT_G = 0.333333333;
1706   DEPTH_WEIGHT_B = 0.333333333;
1707
1708   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1709
1710   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1711     TfdEmpty,
1712
1713     TfdAlpha4,
1714     TfdAlpha8,
1715     TfdAlpha12,
1716     TfdAlpha16,
1717
1718     TfdLuminance4,
1719     TfdLuminance8,
1720     TfdLuminance12,
1721     TfdLuminance16,
1722
1723     TfdLuminance4Alpha4,
1724     TfdLuminance6Alpha2,
1725     TfdLuminance8Alpha8,
1726     TfdLuminance12Alpha4,
1727     TfdLuminance12Alpha12,
1728     TfdLuminance16Alpha16,
1729
1730     TfdR3G3B2,
1731     TfdRGB4,
1732     TfdR5G6B5,
1733     TfdRGB5,
1734     TfdRGB8,
1735     TfdRGB10,
1736     TfdRGB12,
1737     TfdRGB16,
1738
1739     TfdRGBA2,
1740     TfdRGBA4,
1741     TfdRGB5A1,
1742     TfdRGBA8,
1743     TfdRGB10A2,
1744     TfdRGBA12,
1745     TfdRGBA16,
1746
1747     TfdBGR4,
1748     TfdB5G6R5,
1749     TfdBGR5,
1750     TfdBGR8,
1751     TfdBGR10,
1752     TfdBGR12,
1753     TfdBGR16,
1754
1755     TfdBGRA2,
1756     TfdBGRA4,
1757     TfdBGR5A1,
1758     TfdBGRA8,
1759     TfdBGR10A2,
1760     TfdBGRA12,
1761     TfdBGRA16,
1762
1763     TfdDepth16,
1764     TfdDepth24,
1765     TfdDepth32,
1766
1767     TfdS3tcDtx1RGBA,
1768     TfdS3tcDtx3RGBA,
1769     TfdS3tcDtx5RGBA
1770   );
1771
1772 var
1773   FormatDescriptorCS: TCriticalSection;
1774   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1775
1776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1777 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1778 begin
1779   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1780 end;
1781
1782 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1783 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1784 begin
1785   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1786 end;
1787
1788 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1789 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1790 begin
1791   result.Fields := [];
1792
1793   if X >= 0 then
1794     result.Fields := result.Fields + [ffX];
1795   if Y >= 0 then
1796     result.Fields := result.Fields + [ffY];
1797
1798   result.X := Max(0, X);
1799   result.Y := Max(0, Y);
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1804 begin
1805   result.r := r;
1806   result.g := g;
1807   result.b := b;
1808   result.a := a;
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1813 var
1814   i: Integer;
1815 begin
1816   result := false;
1817   for i := 0 to high(r1.arr) do
1818     if (r1.arr[i] <> r2.arr[i]) then
1819       exit;
1820   result := true;
1821 end;
1822
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1825 begin
1826   result.r := r;
1827   result.g := g;
1828   result.b := b;
1829   result.a := a;
1830 end;
1831
1832 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1833 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1834 begin
1835   result := [];
1836
1837   if (aFormat in [
1838         //4 bbp
1839         tfLuminance4,
1840
1841         //8bpp
1842         tfR3G3B2, tfLuminance8,
1843
1844         //16bpp
1845         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1846         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1847
1848         //24bpp
1849         tfBGR8, tfRGB8,
1850
1851         //32bpp
1852         tfRGB10, tfRGB10A2, tfRGBA8,
1853         tfBGR10, tfBGR10A2, tfBGRA8]) then
1854     result := result + [ftBMP];
1855
1856   if (aFormat in [
1857         //8 bpp
1858         tfLuminance8, tfAlpha8,
1859
1860         //16 bpp
1861         tfLuminance16, tfLuminance8Alpha8,
1862         tfRGB5, tfRGB5A1, tfRGBA4,
1863         tfBGR5, tfBGR5A1, tfBGRA4,
1864
1865         //24 bpp
1866         tfRGB8, tfBGR8,
1867
1868         //32 bpp
1869         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1870     result := result + [ftTGA];
1871
1872   if (aFormat in [
1873         //8 bpp
1874         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1875         tfR3G3B2, tfRGBA2, tfBGRA2,
1876
1877         //16 bpp
1878         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1879         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1880         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1881
1882         //24 bpp
1883         tfRGB8, tfBGR8,
1884
1885         //32 bbp
1886         tfLuminance16Alpha16,
1887         tfRGBA8, tfRGB10A2,
1888         tfBGRA8, tfBGR10A2,
1889
1890         //compressed
1891         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1892     result := result + [ftDDS];
1893
1894   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1895   if aFormat in [
1896       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1897       tfRGB8, tfRGBA8,
1898       tfBGR8, tfBGRA8] then
1899     result := result + [ftPNG];
1900   {$ENDIF}
1901
1902   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1903   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1904     result := result + [ftJPEG];
1905   {$ENDIF}
1906 end;
1907
1908 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1909 function IsPowerOfTwo(aNumber: Integer): Boolean;
1910 begin
1911   while (aNumber and 1) = 0 do
1912     aNumber := aNumber shr 1;
1913   result := aNumber = 1;
1914 end;
1915
1916 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1917 function GetTopMostBit(aBitSet: QWord): Integer;
1918 begin
1919   result := 0;
1920   while aBitSet > 0 do begin
1921     inc(result);
1922     aBitSet := aBitSet shr 1;
1923   end;
1924 end;
1925
1926 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1927 function CountSetBits(aBitSet: QWord): Integer;
1928 begin
1929   result := 0;
1930   while aBitSet > 0 do begin
1931     if (aBitSet and 1) = 1 then
1932       inc(result);
1933     aBitSet := aBitSet shr 1;
1934   end;
1935 end;
1936
1937 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1938 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1939 begin
1940   result := Trunc(
1941     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1942     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1943     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1944 end;
1945
1946 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1947 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1948 begin
1949   result := Trunc(
1950     DEPTH_WEIGHT_R * aPixel.Data.r +
1951     DEPTH_WEIGHT_G * aPixel.Data.g +
1952     DEPTH_WEIGHT_B * aPixel.Data.b);
1953 end;
1954
1955 {$IFDEF GLB_NATIVE_OGL}
1956 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1957 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1958 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1959 var
1960   GL_LibHandle: Pointer = nil;
1961
1962 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1963 begin
1964   if not Assigned(aLibHandle) then
1965     aLibHandle := GL_LibHandle;
1966
1967 {$IF DEFINED(GLB_WIN)}
1968   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1969   if Assigned(result) then
1970     exit;
1971
1972   if Assigned(wglGetProcAddress) then
1973     result := wglGetProcAddress(aProcName);
1974 {$ELSEIF DEFINED(GLB_LINUX)}
1975   if Assigned(glXGetProcAddress) then begin
1976     result := glXGetProcAddress(aProcName);
1977     if Assigned(result) then
1978       exit;
1979   end;
1980
1981   if Assigned(glXGetProcAddressARB) then begin
1982     result := glXGetProcAddressARB(aProcName);
1983     if Assigned(result) then
1984       exit;
1985   end;
1986
1987   result := dlsym(aLibHandle, aProcName);
1988 {$IFEND}
1989   if not Assigned(result) and aRaiseOnErr then
1990     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1991 end;
1992
1993 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1994 var
1995   GLU_LibHandle: Pointer = nil;
1996   OpenGLInitialized: Boolean;
1997   InitOpenGLCS: TCriticalSection;
1998
1999 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2000 procedure glbInitOpenGL;
2001
2002   ////////////////////////////////////////////////////////////////////////////////
2003   function glbLoadLibrary(const aName: PChar): Pointer;
2004   begin
2005     {$IF DEFINED(GLB_WIN)}
2006     result := {%H-}Pointer(LoadLibrary(aName));
2007     {$ELSEIF DEFINED(GLB_LINUX)}
2008     result := dlopen(Name, RTLD_LAZY);
2009     {$ELSE}
2010     result := nil;
2011     {$IFEND}
2012   end;
2013
2014   ////////////////////////////////////////////////////////////////////////////////
2015   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2016   begin
2017     result := false;
2018     if not Assigned(aLibHandle) then
2019       exit;
2020
2021     {$IF DEFINED(GLB_WIN)}
2022     Result := FreeLibrary({%H-}HINST(aLibHandle));
2023     {$ELSEIF DEFINED(GLB_LINUX)}
2024     Result := dlclose(aLibHandle) = 0;
2025     {$IFEND}
2026   end;
2027
2028 begin
2029   if Assigned(GL_LibHandle) then
2030     glbFreeLibrary(GL_LibHandle);
2031
2032   if Assigned(GLU_LibHandle) then
2033     glbFreeLibrary(GLU_LibHandle);
2034
2035   GL_LibHandle := glbLoadLibrary(libopengl);
2036   if not Assigned(GL_LibHandle) then
2037     raise EglBitmap.Create('unable to load library: ' + libopengl);
2038
2039   GLU_LibHandle := glbLoadLibrary(libglu);
2040   if not Assigned(GLU_LibHandle) then
2041     raise EglBitmap.Create('unable to load library: ' + libglu);
2042
2043 {$IF DEFINED(GLB_WIN)}
2044   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2045 {$ELSEIF DEFINED(GLB_LINUX)}
2046   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2047   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2048 {$IFEND}
2049
2050   glEnable := glbGetProcAddress('glEnable');
2051   glDisable := glbGetProcAddress('glDisable');
2052   glGetString := glbGetProcAddress('glGetString');
2053   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2054   glTexParameteri := glbGetProcAddress('glTexParameteri');
2055   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2056   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2057   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2058   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2059   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2060   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2061   glTexGeni := glbGetProcAddress('glTexGeni');
2062   glGenTextures := glbGetProcAddress('glGenTextures');
2063   glBindTexture := glbGetProcAddress('glBindTexture');
2064   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2065   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2066   glReadPixels := glbGetProcAddress('glReadPixels');
2067   glPixelStorei := glbGetProcAddress('glPixelStorei');
2068   glTexImage1D := glbGetProcAddress('glTexImage1D');
2069   glTexImage2D := glbGetProcAddress('glTexImage2D');
2070   glGetTexImage := glbGetProcAddress('glGetTexImage');
2071
2072   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2073   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2074 end;
2075 {$ENDIF}
2076
2077 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2078 procedure glbReadOpenGLExtensions;
2079 var
2080   Buffer: AnsiString;
2081   MajorVersion, MinorVersion: Integer;
2082
2083   ///////////////////////////////////////////////////////////////////////////////////////////
2084   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2085   var
2086     Separator: Integer;
2087   begin
2088     aMinor := 0;
2089     aMajor := 0;
2090
2091     Separator := Pos(AnsiString('.'), aBuffer);
2092     if (Separator > 1) and (Separator < Length(aBuffer)) and
2093        (aBuffer[Separator - 1] in ['0'..'9']) and
2094        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2095
2096       Dec(Separator);
2097       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2098         Dec(Separator);
2099
2100       Delete(aBuffer, 1, Separator);
2101       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2102
2103       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2104         Inc(Separator);
2105
2106       Delete(aBuffer, Separator, 255);
2107       Separator := Pos(AnsiString('.'), aBuffer);
2108
2109       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2110       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2111     end;
2112   end;
2113
2114   ///////////////////////////////////////////////////////////////////////////////////////////
2115   function CheckExtension(const Extension: AnsiString): Boolean;
2116   var
2117     ExtPos: Integer;
2118   begin
2119     ExtPos := Pos(Extension, Buffer);
2120     result := ExtPos > 0;
2121     if result then
2122       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2123   end;
2124
2125   ///////////////////////////////////////////////////////////////////////////////////////////
2126   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2127   begin
2128     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2129   end;
2130
2131 begin
2132 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2133   InitOpenGLCS.Enter;
2134   try
2135     if not OpenGLInitialized then begin
2136       glbInitOpenGL;
2137       OpenGLInitialized := true;
2138     end;
2139   finally
2140     InitOpenGLCS.Leave;
2141   end;
2142 {$ENDIF}
2143
2144   // Version
2145   Buffer := glGetString(GL_VERSION);
2146   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2147
2148   GL_VERSION_1_2 := CheckVersion(1, 2);
2149   GL_VERSION_1_3 := CheckVersion(1, 3);
2150   GL_VERSION_1_4 := CheckVersion(1, 4);
2151   GL_VERSION_2_0 := CheckVersion(2, 0);
2152   GL_VERSION_3_3 := CheckVersion(3, 3);
2153
2154   // Extensions
2155   Buffer := glGetString(GL_EXTENSIONS);
2156   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2157   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2158   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2159   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2160   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2161   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2162   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2163   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2164   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2165   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2166   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2167   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2168   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2169   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2170
2171   if GL_VERSION_1_3 then begin
2172     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2173     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2174     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2175   end else begin
2176     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2177     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2178     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2179   end;
2180 end;
2181 {$ENDIF}
2182
2183 {$IFDEF GLB_SDL_IMAGE}
2184 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2186 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2188 begin
2189   result := TStream(context^.unknown.data1).Seek(offset, whence);
2190 end;
2191
2192 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2193 begin
2194   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2195 end;
2196
2197 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2198 begin
2199   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2200 end;
2201
2202 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2203 begin
2204   result := 0;
2205 end;
2206
2207 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2208 begin
2209   result := SDL_AllocRW;
2210
2211   if result = nil then
2212     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2213
2214   result^.seek := glBitmapRWseek;
2215   result^.read := glBitmapRWread;
2216   result^.write := glBitmapRWwrite;
2217   result^.close := glBitmapRWclose;
2218   result^.unknown.data1 := Stream;
2219 end;
2220 {$ENDIF}
2221
2222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2223 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2224 begin
2225   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2230 begin
2231   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2232 end;
2233
2234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2235 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2236 begin
2237   glBitmapDefaultMipmap := aValue;
2238 end;
2239
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2242 begin
2243   glBitmapDefaultFormat := aFormat;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2248 begin
2249   glBitmapDefaultFilterMin := aMin;
2250   glBitmapDefaultFilterMag := aMag;
2251 end;
2252
2253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2254 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2255 begin
2256   glBitmapDefaultWrapS := S;
2257   glBitmapDefaultWrapT := T;
2258   glBitmapDefaultWrapR := R;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2263 begin
2264   glDefaultSwizzle[0] := r;
2265   glDefaultSwizzle[1] := g;
2266   glDefaultSwizzle[2] := b;
2267   glDefaultSwizzle[3] := a;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2272 begin
2273   result := glBitmapDefaultDeleteTextureOnFree;
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2278 begin
2279   result := glBitmapDefaultFreeDataAfterGenTextures;
2280 end;
2281
2282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2283 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2284 begin
2285   result := glBitmapDefaultMipmap;
2286 end;
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 function glBitmapGetDefaultFormat: TglBitmapFormat;
2290 begin
2291   result := glBitmapDefaultFormat;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2296 begin
2297   aMin := glBitmapDefaultFilterMin;
2298   aMag := glBitmapDefaultFilterMag;
2299 end;
2300
2301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2302 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2303 begin
2304   S := glBitmapDefaultWrapS;
2305   T := glBitmapDefaultWrapT;
2306   R := glBitmapDefaultWrapR;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2311 begin
2312   r := glDefaultSwizzle[0];
2313   g := glDefaultSwizzle[1];
2314   b := glDefaultSwizzle[2];
2315   a := glDefaultSwizzle[3];
2316 end;
2317
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 function TFormatDescriptor.GetRedMask: QWord;
2322 begin
2323   result := fRange.r shl fShift.r;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function TFormatDescriptor.GetGreenMask: QWord;
2328 begin
2329   result := fRange.g shl fShift.g;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function TFormatDescriptor.GetBlueMask: QWord;
2334 begin
2335   result := fRange.b shl fShift.b;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function TFormatDescriptor.GetAlphaMask: QWord;
2340 begin
2341   result := fRange.a shl fShift.a;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function TFormatDescriptor.GetIsCompressed: Boolean;
2346 begin
2347   result := fIsCompressed;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 function TFormatDescriptor.GetHasRed: Boolean;
2352 begin
2353   result := (fRange.r > 0);
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 function TFormatDescriptor.GetHasGreen: Boolean;
2358 begin
2359   result := (fRange.g > 0);
2360 end;
2361
2362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2363 function TFormatDescriptor.GetHasBlue: Boolean;
2364 begin
2365   result := (fRange.b > 0);
2366 end;
2367
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 function TFormatDescriptor.GetHasAlpha: Boolean;
2370 begin
2371   result := (fRange.a > 0);
2372 end;
2373
2374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2375 function TFormatDescriptor.GetglFormat: GLenum;
2376 begin
2377   result := fglFormat;
2378 end;
2379
2380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2381 function TFormatDescriptor.GetglInternalFormat: GLenum;
2382 begin
2383   result := fglInternalFormat;
2384 end;
2385
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 function TFormatDescriptor.GetglDataFormat: GLenum;
2388 begin
2389   result := fglDataFormat;
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 function TFormatDescriptor.GetComponents: Integer;
2394 var
2395   i: Integer;
2396 begin
2397   result := 0;
2398   for i := 0 to 3 do
2399     if (fRange.arr[i] > 0) then
2400       inc(result);
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2405 var
2406   w, h: Integer;
2407 begin
2408   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2409     w := Max(1, aSize.X);
2410     h := Max(1, aSize.Y);
2411     result := GetSize(w, h);
2412   end else
2413     result := 0;
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2418 begin
2419   result := 0;
2420   if (aWidth <= 0) or (aHeight <= 0) then
2421     exit;
2422   result := Ceil(aWidth * aHeight * fPixelSize);
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 function TFormatDescriptor.CreateMappingData: Pointer;
2427 begin
2428   result := nil;
2429 end;
2430
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2433 begin
2434   //DUMMY
2435 end;
2436
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 function TFormatDescriptor.IsEmpty: Boolean;
2439 begin
2440   result := (fFormat = tfEmpty);
2441 end;
2442
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2445 begin
2446   result := false;
2447   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2448     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2449   if (aRedMask   <> RedMask) then
2450     exit;
2451   if (aGreenMask <> GreenMask) then
2452     exit;
2453   if (aBlueMask  <> BlueMask) then
2454     exit;
2455   if (aAlphaMask <> AlphaMask) then
2456     exit;
2457   result := true;
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2462 begin
2463   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2464   aPixel.Data   := fRange;
2465   aPixel.Range  := fRange;
2466   aPixel.Format := fFormat;
2467 end;
2468
2469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2470 constructor TFormatDescriptor.Create;
2471 begin
2472   inherited Create;
2473
2474   fFormat       := tfEmpty;
2475   fWithAlpha    := tfEmpty;
2476   fWithoutAlpha := tfEmpty;
2477   fRGBInverted  := tfEmpty;
2478   fUncompressed := tfEmpty;
2479   fPixelSize    := 0.0;
2480   fIsCompressed := false;
2481
2482   fglFormat         := 0;
2483   fglInternalFormat := 0;
2484   fglDataFormat     := 0;
2485
2486   FillChar(fRange, 0, SizeOf(fRange));
2487   FillChar(fShift, 0, SizeOf(fShift));
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   aData^ := aPixel.Data.a;
2496   inc(aData);
2497 end;
2498
2499 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.r := 0;
2502   aPixel.Data.g := 0;
2503   aPixel.Data.b := 0;
2504   aPixel.Data.a := aData^;
2505   inc(aData);
2506 end;
2507
2508 constructor TfdAlpha_UB1.Create;
2509 begin
2510   inherited Create;
2511   fPixelSize        := 1.0;
2512   fRange.a          := $FF;
2513   fglFormat         := GL_ALPHA;
2514   fglDataFormat     := GL_UNSIGNED_BYTE;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2521 begin
2522   aData^ := LuminanceWeight(aPixel);
2523   inc(aData);
2524 end;
2525
2526 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2527 begin
2528   aPixel.Data.r := aData^;
2529   aPixel.Data.g := aData^;
2530   aPixel.Data.b := aData^;
2531   aPixel.Data.a := 0;
2532   inc(aData);
2533 end;
2534
2535 constructor TfdLuminance_UB1.Create;
2536 begin
2537   inherited Create;
2538   fPixelSize        := 1.0;
2539   fRange.r          := $FF;
2540   fRange.g          := $FF;
2541   fRange.b          := $FF;
2542   fglFormat         := GL_LUMINANCE;
2543   fglDataFormat     := GL_UNSIGNED_BYTE;
2544 end;
2545
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2550 var
2551   i: Integer;
2552 begin
2553   aData^ := 0;
2554   for i := 0 to 3 do
2555     if (fRange.arr[i] > 0) then
2556       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2557   inc(aData);
2558 end;
2559
2560 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2561 var
2562   i: Integer;
2563 begin
2564   for i := 0 to 3 do
2565     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2566   inc(aData);
2567 end;
2568
2569 constructor TfdUniversal_UB1.Create;
2570 begin
2571   inherited Create;
2572   fPixelSize := 1.0;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   inherited Map(aPixel, aData, aMapData);
2581   aData^ := aPixel.Data.a;
2582   inc(aData);
2583 end;
2584
2585 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2586 begin
2587   inherited Unmap(aData, aPixel, aMapData);
2588   aPixel.Data.a := aData^;
2589   inc(aData);
2590 end;
2591
2592 constructor TfdLuminanceAlpha_UB2.Create;
2593 begin
2594   inherited Create;
2595   fPixelSize        := 2.0;
2596   fRange.a          := $FF;
2597   fShift.a          :=   8;
2598   fglFormat         := GL_LUMINANCE_ALPHA;
2599   fglDataFormat     := GL_UNSIGNED_BYTE;
2600 end;
2601
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2606 begin
2607   aData^ := aPixel.Data.r;
2608   inc(aData);
2609   aData^ := aPixel.Data.g;
2610   inc(aData);
2611   aData^ := aPixel.Data.b;
2612   inc(aData);
2613 end;
2614
2615 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2616 begin
2617   aPixel.Data.r := aData^;
2618   inc(aData);
2619   aPixel.Data.g := aData^;
2620   inc(aData);
2621   aPixel.Data.b := aData^;
2622   inc(aData);
2623   aPixel.Data.a := 0;
2624 end;
2625
2626 constructor TfdRGB_UB3.Create;
2627 begin
2628   inherited Create;
2629   fPixelSize        := 3.0;
2630   fRange.r          := $FF;
2631   fRange.g          := $FF;
2632   fRange.b          := $FF;
2633   fShift.r          :=   0;
2634   fShift.g          :=   8;
2635   fShift.b          :=  16;
2636   fglFormat         := GL_RGB;
2637   fglDataFormat     := GL_UNSIGNED_BYTE;
2638 end;
2639
2640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2644 begin
2645   aData^ := aPixel.Data.b;
2646   inc(aData);
2647   aData^ := aPixel.Data.g;
2648   inc(aData);
2649   aData^ := aPixel.Data.r;
2650   inc(aData);
2651 end;
2652
2653 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2654 begin
2655   aPixel.Data.b := aData^;
2656   inc(aData);
2657   aPixel.Data.g := aData^;
2658   inc(aData);
2659   aPixel.Data.r := aData^;
2660   inc(aData);
2661   aPixel.Data.a := 0;
2662 end;
2663
2664 constructor TfdBGR_UB3.Create;
2665 begin
2666   fPixelSize        := 3.0;
2667   fRange.r          := $FF;
2668   fRange.g          := $FF;
2669   fRange.b          := $FF;
2670   fShift.r          :=  16;
2671   fShift.g          :=   8;
2672   fShift.b          :=   0;
2673   fglFormat         := GL_BGR;
2674   fglDataFormat     := GL_UNSIGNED_BYTE;
2675 end;
2676
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2681 begin
2682   inherited Map(aPixel, aData, aMapData);
2683   aData^ := aPixel.Data.a;
2684   inc(aData);
2685 end;
2686
2687 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2688 begin
2689   inherited Unmap(aData, aPixel, aMapData);
2690   aPixel.Data.a := aData^;
2691   inc(aData);
2692 end;
2693
2694 constructor TfdRGBA_UB4.Create;
2695 begin
2696   inherited Create;
2697   fPixelSize        := 4.0;
2698   fRange.a          := $FF;
2699   fShift.a          :=  24;
2700   fglFormat         := GL_RGBA;
2701   fglDataFormat     := GL_UNSIGNED_BYTE;
2702 end;
2703
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2708 begin
2709   inherited Map(aPixel, aData, aMapData);
2710   aData^ := aPixel.Data.a;
2711   inc(aData);
2712 end;
2713
2714 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2715 begin
2716   inherited Unmap(aData, aPixel, aMapData);
2717   aPixel.Data.a := aData^;
2718   inc(aData);
2719 end;
2720
2721 constructor TfdBGRA_UB4.Create;
2722 begin
2723   inherited Create;
2724   fPixelSize        := 4.0;
2725   fRange.a          := $FF;
2726   fShift.a          :=  24;
2727   fglFormat         := GL_BGRA;
2728   fglDataFormat     := GL_UNSIGNED_BYTE;
2729 end;
2730
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2735 begin
2736   PWord(aData)^ := aPixel.Data.a;
2737   inc(aData, 2);
2738 end;
2739
2740 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2741 begin
2742   aPixel.Data.r := 0;
2743   aPixel.Data.g := 0;
2744   aPixel.Data.b := 0;
2745   aPixel.Data.a := PWord(aData)^;
2746   inc(aData, 2);
2747 end;
2748
2749 constructor TfdAlpha_US1.Create;
2750 begin
2751   inherited Create;
2752   fPixelSize        := 2.0;
2753   fRange.a          := $FFFF;
2754   fglFormat         := GL_ALPHA;
2755   fglDataFormat     := GL_UNSIGNED_SHORT;
2756 end;
2757
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2762 begin
2763   PWord(aData)^ := LuminanceWeight(aPixel);
2764   inc(aData, 2);
2765 end;
2766
2767 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2768 begin
2769   aPixel.Data.r := PWord(aData)^;
2770   aPixel.Data.g := PWord(aData)^;
2771   aPixel.Data.b := PWord(aData)^;
2772   aPixel.Data.a := 0;
2773   inc(aData, 2);
2774 end;
2775
2776 constructor TfdLuminance_US1.Create;
2777 begin
2778   inherited Create;
2779   fPixelSize        := 2.0;
2780   fRange.r          := $FFFF;
2781   fRange.g          := $FFFF;
2782   fRange.b          := $FFFF;
2783   fglFormat         := GL_LUMINANCE;
2784   fglDataFormat     := GL_UNSIGNED_SHORT;
2785 end;
2786
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2791 var
2792   i: Integer;
2793 begin
2794   PWord(aData)^ := 0;
2795   for i := 0 to 3 do
2796     if (fRange.arr[i] > 0) then
2797       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2798   inc(aData, 2);
2799 end;
2800
2801 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2802 var
2803   i: Integer;
2804 begin
2805   for i := 0 to 3 do
2806     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2807   inc(aData, 2);
2808 end;
2809
2810 constructor TfdUniversal_US1.Create;
2811 begin
2812   inherited Create;
2813   fPixelSize := 2.0;
2814 end;
2815
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2820 begin
2821   PWord(aData)^ := DepthWeight(aPixel);
2822   inc(aData, 2);
2823 end;
2824
2825 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2826 begin
2827   aPixel.Data.r := PWord(aData)^;
2828   aPixel.Data.g := PWord(aData)^;
2829   aPixel.Data.b := PWord(aData)^;
2830   aPixel.Data.a := 0;
2831   inc(aData, 2);
2832 end;
2833
2834 constructor TfdDepth_US1.Create;
2835 begin
2836   inherited Create;
2837   fPixelSize        := 2.0;
2838   fRange.r          := $FFFF;
2839   fRange.g          := $FFFF;
2840   fRange.b          := $FFFF;
2841   fglFormat         := GL_DEPTH_COMPONENT;
2842   fglDataFormat     := GL_UNSIGNED_SHORT;
2843 end;
2844
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2849 begin
2850   inherited Map(aPixel, aData, aMapData);
2851   PWord(aData)^ := aPixel.Data.a;
2852   inc(aData, 2);
2853 end;
2854
2855 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2856 begin
2857   inherited Unmap(aData, aPixel, aMapData);
2858   aPixel.Data.a := PWord(aData)^;
2859   inc(aData, 2);
2860 end;
2861
2862 constructor TfdLuminanceAlpha_US2.Create;
2863 begin
2864   inherited Create;
2865   fPixelSize        :=   4.0;
2866   fRange.a          := $FFFF;
2867   fShift.a          :=    16;
2868   fglFormat         := GL_LUMINANCE_ALPHA;
2869   fglDataFormat     := GL_UNSIGNED_SHORT;
2870 end;
2871
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2876 begin
2877   PWord(aData)^ := aPixel.Data.r;
2878   inc(aData, 2);
2879   PWord(aData)^ := aPixel.Data.g;
2880   inc(aData, 2);
2881   PWord(aData)^ := aPixel.Data.b;
2882   inc(aData, 2);
2883 end;
2884
2885 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2886 begin
2887   aPixel.Data.r := PWord(aData)^;
2888   inc(aData, 2);
2889   aPixel.Data.g := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.b := PWord(aData)^;
2892   inc(aData, 2);
2893   aPixel.Data.a := 0;
2894 end;
2895
2896 constructor TfdRGB_US3.Create;
2897 begin
2898   inherited Create;
2899   fPixelSize        :=   6.0;
2900   fRange.r          := $FFFF;
2901   fRange.g          := $FFFF;
2902   fRange.b          := $FFFF;
2903   fShift.r          :=     0;
2904   fShift.g          :=    16;
2905   fShift.b          :=    32;
2906   fglFormat         := GL_RGB;
2907   fglDataFormat     := GL_UNSIGNED_SHORT;
2908 end;
2909
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2914 begin
2915   PWord(aData)^ := aPixel.Data.b;
2916   inc(aData, 2);
2917   PWord(aData)^ := aPixel.Data.g;
2918   inc(aData, 2);
2919   PWord(aData)^ := aPixel.Data.r;
2920   inc(aData, 2);
2921 end;
2922
2923 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2924 begin
2925   aPixel.Data.b := PWord(aData)^;
2926   inc(aData, 2);
2927   aPixel.Data.g := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.r := PWord(aData)^;
2930   inc(aData, 2);
2931   aPixel.Data.a := 0;
2932 end;
2933
2934 constructor TfdBGR_US3.Create;
2935 begin
2936   inherited Create;
2937   fPixelSize        :=   6.0;
2938   fRange.r          := $FFFF;
2939   fRange.g          := $FFFF;
2940   fRange.b          := $FFFF;
2941   fShift.r          :=    32;
2942   fShift.g          :=    16;
2943   fShift.b          :=     0;
2944   fglFormat         := GL_BGR;
2945   fglDataFormat     := GL_UNSIGNED_SHORT;
2946 end;
2947
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2952 begin
2953   inherited Map(aPixel, aData, aMapData);
2954   PWord(aData)^ := aPixel.Data.a;
2955   inc(aData, 2);
2956 end;
2957
2958 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2959 begin
2960   inherited Unmap(aData, aPixel, aMapData);
2961   aPixel.Data.a := PWord(aData)^;
2962   inc(aData, 2);
2963 end;
2964
2965 constructor TfdRGBA_US4.Create;
2966 begin
2967   inherited Create;
2968   fPixelSize        :=   8.0;
2969   fRange.a          := $FFFF;
2970   fShift.a          :=    48;
2971   fglFormat         := GL_RGBA;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2979 begin
2980   inherited Map(aPixel, aData, aMapData);
2981   PWord(aData)^ := aPixel.Data.a;
2982   inc(aData, 2);
2983 end;
2984
2985 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2986 begin
2987   inherited Unmap(aData, aPixel, aMapData);
2988   aPixel.Data.a := PWord(aData)^;
2989   inc(aData, 2);
2990 end;
2991
2992 constructor TfdBGRA_US4.Create;
2993 begin
2994   inherited Create;
2995   fPixelSize        :=   8.0;
2996   fRange.a          := $FFFF;
2997   fShift.a          :=    48;
2998   fglFormat         := GL_BGRA;
2999   fglDataFormat     := GL_UNSIGNED_SHORT;
3000 end;
3001
3002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3006 var
3007   i: Integer;
3008 begin
3009   PCardinal(aData)^ := 0;
3010   for i := 0 to 3 do
3011     if (fRange.arr[i] > 0) then
3012       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3013   inc(aData, 4);
3014 end;
3015
3016 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3017 var
3018   i: Integer;
3019 begin
3020   for i := 0 to 3 do
3021     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3022   inc(aData, 2);
3023 end;
3024
3025 constructor TfdUniversal_UI1.Create;
3026 begin
3027   inherited Create;
3028   fPixelSize := 4.0;
3029 end;
3030
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3035 begin
3036   PCardinal(aData)^ := DepthWeight(aPixel);
3037   inc(aData, 4);
3038 end;
3039
3040 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3041 begin
3042   aPixel.Data.r := PCardinal(aData)^;
3043   aPixel.Data.g := PCardinal(aData)^;
3044   aPixel.Data.b := PCardinal(aData)^;
3045   aPixel.Data.a := 0;
3046   inc(aData, 4);
3047 end;
3048
3049 constructor TfdDepth_UI1.Create;
3050 begin
3051   inherited Create;
3052   fPixelSize        := 4.0;
3053   fRange.r          := $FFFFFFFF;
3054   fRange.g          := $FFFFFFFF;
3055   fRange.b          := $FFFFFFFF;
3056   fglFormat         := GL_DEPTH_COMPONENT;
3057   fglDataFormat     := GL_UNSIGNED_INT;
3058 end;
3059
3060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3063 constructor TfdAlpha4.Create;
3064 begin
3065   inherited Create;
3066   fFormat           := tfAlpha4;
3067   fWithAlpha        := tfAlpha4;
3068   fglInternalFormat := GL_ALPHA4;
3069 end;
3070
3071 constructor TfdAlpha8.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfAlpha8;
3075   fWithAlpha        := tfAlpha8;
3076   fglInternalFormat := GL_ALPHA8;
3077 end;
3078
3079 constructor TfdAlpha12.Create;
3080 begin
3081   inherited Create;
3082   fFormat           := tfAlpha12;
3083   fWithAlpha        := tfAlpha12;
3084   fglInternalFormat := GL_ALPHA12;
3085 end;
3086
3087 constructor TfdAlpha16.Create;
3088 begin
3089   inherited Create;
3090   fFormat           := tfAlpha16;
3091   fWithAlpha        := tfAlpha16;
3092   fglInternalFormat := GL_ALPHA16;
3093 end;
3094
3095 constructor TfdLuminance4.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfLuminance4;
3099   fWithAlpha        := tfLuminance4Alpha4;
3100   fWithoutAlpha     := tfLuminance4;
3101   fglInternalFormat := GL_LUMINANCE4;
3102 end;
3103
3104 constructor TfdLuminance8.Create;
3105 begin
3106   inherited Create;
3107   fFormat           := tfLuminance8;
3108   fWithAlpha        := tfLuminance8Alpha8;
3109   fWithoutAlpha     := tfLuminance8;
3110   fglInternalFormat := GL_LUMINANCE8;
3111 end;
3112
3113 constructor TfdLuminance12.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfLuminance12;
3117   fWithAlpha        := tfLuminance12Alpha12;
3118   fWithoutAlpha     := tfLuminance12;
3119   fglInternalFormat := GL_LUMINANCE12;
3120 end;
3121
3122 constructor TfdLuminance16.Create;
3123 begin
3124   inherited Create;
3125   fFormat           := tfLuminance16;
3126   fWithAlpha        := tfLuminance16Alpha16;
3127   fWithoutAlpha     := tfLuminance16;
3128   fglInternalFormat := GL_LUMINANCE16;
3129 end;
3130
3131 constructor TfdLuminance4Alpha4.Create;
3132 begin
3133   inherited Create;
3134   fFormat           := tfLuminance4Alpha4;
3135   fWithAlpha        := tfLuminance4Alpha4;
3136   fWithoutAlpha     := tfLuminance4;
3137   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3138 end;
3139
3140 constructor TfdLuminance6Alpha2.Create;
3141 begin
3142   inherited Create;
3143   fFormat           := tfLuminance6Alpha2;
3144   fWithAlpha        := tfLuminance6Alpha2;
3145   fWithoutAlpha     := tfLuminance8;
3146   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3147 end;
3148
3149 constructor TfdLuminance8Alpha8.Create;
3150 begin
3151   inherited Create;
3152   fFormat           := tfLuminance8Alpha8;
3153   fWithAlpha        := tfLuminance8Alpha8;
3154   fWithoutAlpha     := tfLuminance8;
3155   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3156 end;
3157
3158 constructor TfdLuminance12Alpha4.Create;
3159 begin
3160   inherited Create;
3161   fFormat           := tfLuminance12Alpha4;
3162   fWithAlpha        := tfLuminance12Alpha4;
3163   fWithoutAlpha     := tfLuminance12;
3164   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3165 end;
3166
3167 constructor TfdLuminance12Alpha12.Create;
3168 begin
3169   inherited Create;
3170   fFormat           := tfLuminance12Alpha12;
3171   fWithAlpha        := tfLuminance12Alpha12;
3172   fWithoutAlpha     := tfLuminance12;
3173   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3174 end;
3175
3176 constructor TfdLuminance16Alpha16.Create;
3177 begin
3178   inherited Create;
3179   fFormat           := tfLuminance16Alpha16;
3180   fWithAlpha        := tfLuminance16Alpha16;
3181   fWithoutAlpha     := tfLuminance16;
3182   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3183 end;
3184
3185 constructor TfdR3G3B2.Create;
3186 begin
3187   inherited Create;
3188   fFormat           := tfR3G3B2;
3189   fWithAlpha        := tfRGBA2;
3190   fWithoutAlpha     := tfR3G3B2;
3191   fRange.r          := $7;
3192   fRange.g          := $7;
3193   fRange.b          := $3;
3194   fShift.r          :=  0;
3195   fShift.g          :=  3;
3196   fShift.b          :=  6;
3197   fglFormat         := GL_RGB;
3198   fglInternalFormat := GL_R3_G3_B2;
3199   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3200 end;
3201
3202 constructor TfdRGB4.Create;
3203 begin
3204   inherited Create;
3205   fFormat           := tfRGB4;
3206   fWithAlpha        := tfRGBA4;
3207   fWithoutAlpha     := tfRGB4;
3208   fRGBInverted      := tfBGR4;
3209   fRange.r          := $F;
3210   fRange.g          := $F;
3211   fRange.b          := $F;
3212   fShift.r          :=  0;
3213   fShift.g          :=  4;
3214   fShift.b          :=  8;
3215   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3216   fglInternalFormat := GL_RGB4;
3217   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3218 end;
3219
3220 constructor TfdR5G6B5.Create;
3221 begin
3222   inherited Create;
3223   fFormat           := tfR5G6B5;
3224   fWithAlpha        := tfRGBA4;
3225   fWithoutAlpha     := tfR5G6B5;
3226   fRGBInverted      := tfB5G6R5;
3227   fRange.r          := $1F;
3228   fRange.g          := $3F;
3229   fRange.b          := $1F;
3230   fShift.r          :=   0;
3231   fShift.g          :=   5;
3232   fShift.b          :=  11;
3233   fglFormat         := GL_RGB;
3234   fglInternalFormat := GL_RGB565;
3235   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3236 end;
3237
3238 constructor TfdRGB5.Create;
3239 begin
3240   inherited Create;
3241   fFormat           := tfRGB5;
3242   fWithAlpha        := tfRGB5A1;
3243   fWithoutAlpha     := tfRGB5;
3244   fRGBInverted      := tfBGR5;
3245   fRange.r          := $1F;
3246   fRange.g          := $1F;
3247   fRange.b          := $1F;
3248   fShift.r          :=   0;
3249   fShift.g          :=   5;
3250   fShift.b          :=  10;
3251   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3252   fglInternalFormat := GL_RGB5;
3253   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3254 end;
3255
3256 constructor TfdRGB8.Create;
3257 begin
3258   inherited Create;
3259   fFormat           := tfRGB8;
3260   fWithAlpha        := tfRGBA8;
3261   fWithoutAlpha     := tfRGB8;
3262   fRGBInverted      := tfBGR8;
3263   fglInternalFormat := GL_RGB8;
3264 end;
3265
3266 constructor TfdRGB10.Create;
3267 begin
3268   inherited Create;
3269   fFormat           := tfRGB10;
3270   fWithAlpha        := tfRGB10A2;
3271   fWithoutAlpha     := tfRGB10;
3272   fRGBInverted      := tfBGR10;
3273   fRange.r          := $3FF;
3274   fRange.g          := $3FF;
3275   fRange.b          := $3FF;
3276   fShift.r          :=    0;
3277   fShift.g          :=   10;
3278   fShift.b          :=   20;
3279   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3280   fglInternalFormat := GL_RGB10;
3281   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3282 end;
3283
3284 constructor TfdRGB12.Create;
3285 begin
3286   inherited Create;
3287   fFormat           := tfRGB12;
3288   fWithAlpha        := tfRGBA12;
3289   fWithoutAlpha     := tfRGB12;
3290   fRGBInverted      := tfBGR12;
3291   fglInternalFormat := GL_RGB12;
3292 end;
3293
3294 constructor TfdRGB16.Create;
3295 begin
3296   inherited Create;
3297   fFormat           := tfRGB16;
3298   fWithAlpha        := tfRGBA16;
3299   fWithoutAlpha     := tfRGB16;
3300   fRGBInverted      := tfBGR16;
3301   fglInternalFormat := GL_RGB16;
3302 end;
3303
3304 constructor TfdRGBA2.Create;
3305 begin
3306   inherited Create;
3307   fFormat           := tfRGBA2;
3308   fWithAlpha        := tfRGBA2;
3309   fWithoutAlpha     := tfR3G3B2;
3310   fRGBInverted      := tfBGRA2;
3311   fglInternalFormat := GL_RGBA2;
3312 end;
3313
3314 constructor TfdRGBA4.Create;
3315 begin
3316   inherited Create;
3317   fFormat           := tfRGBA4;
3318   fWithAlpha        := tfRGBA4;
3319   fWithoutAlpha     := tfRGB4;
3320   fRGBInverted      := tfBGRA4;
3321   fRange.r          := $F;
3322   fRange.g          := $F;
3323   fRange.b          := $F;
3324   fRange.a          := $F;
3325   fShift.r          :=  0;
3326   fShift.g          :=  4;
3327   fShift.b          :=  8;
3328   fShift.a          := 12;
3329   fglFormat         := GL_RGBA;
3330   fglInternalFormat := GL_RGBA4;
3331   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3332 end;
3333
3334 constructor TfdRGB5A1.Create;
3335 begin
3336   inherited Create;
3337   fFormat           := tfRGB5A1;
3338   fWithAlpha        := tfRGB5A1;
3339   fWithoutAlpha     := tfRGB5;
3340   fRGBInverted      := tfBGR5A1;
3341   fRange.r          := $1F;
3342   fRange.g          := $1F;
3343   fRange.b          := $1F;
3344   fRange.a          := $01;
3345   fShift.r          :=   0;
3346   fShift.g          :=   5;
3347   fShift.b          :=  10;
3348   fShift.a          :=  15;
3349   fglFormat         := GL_RGBA;
3350   fglInternalFormat := GL_RGB5_A1;
3351   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3352 end;
3353
3354 constructor TfdRGBA8.Create;
3355 begin
3356   inherited Create;
3357   fFormat           := tfRGBA8;
3358   fWithAlpha        := tfRGBA8;
3359   fWithoutAlpha     := tfRGB8;
3360   fRGBInverted      := tfBGRA8;
3361   fglInternalFormat := GL_RGBA8;
3362 end;
3363
3364 constructor TfdRGB10A2.Create;
3365 begin
3366   inherited Create;
3367   fFormat           := tfRGB10A2;
3368   fWithAlpha        := tfRGB10A2;
3369   fWithoutAlpha     := tfRGB10;
3370   fRGBInverted      := tfBGR10A2;
3371   fRange.r          := $3FF;
3372   fRange.g          := $3FF;
3373   fRange.b          := $3FF;
3374   fRange.a          := $003;
3375   fShift.r          :=    0;
3376   fShift.g          :=   10;
3377   fShift.b          :=   20;
3378   fShift.a          :=   30;
3379   fglFormat         := GL_RGBA;
3380   fglInternalFormat := GL_RGB10_A2;
3381   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3382 end;
3383
3384 constructor TfdRGBA12.Create;
3385 begin
3386   inherited Create;
3387   fFormat           := tfRGBA12;
3388   fWithAlpha        := tfRGBA12;
3389   fWithoutAlpha     := tfRGB12;
3390   fRGBInverted      := tfBGRA12;
3391   fglInternalFormat := GL_RGBA12;
3392 end;
3393
3394 constructor TfdRGBA16.Create;
3395 begin
3396   inherited Create;
3397   fFormat           := tfRGBA16;
3398   fWithAlpha        := tfRGBA16;
3399   fWithoutAlpha     := tfRGB16;
3400   fRGBInverted      := tfBGRA16;
3401   fglInternalFormat := GL_RGBA16;
3402 end;
3403
3404 constructor TfdBGR4.Create;
3405 begin
3406   inherited Create;
3407   fPixelSize        := 2.0;
3408   fFormat           := tfBGR4;
3409   fWithAlpha        := tfBGRA4;
3410   fWithoutAlpha     := tfBGR4;
3411   fRGBInverted      := tfRGB4;
3412   fRange.r          := $F;
3413   fRange.g          := $F;
3414   fRange.b          := $F;
3415   fRange.a          := $0;
3416   fShift.r          :=  8;
3417   fShift.g          :=  4;
3418   fShift.b          :=  0;
3419   fShift.a          :=  0;
3420   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3421   fglInternalFormat := GL_RGB4;
3422   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3423 end;
3424
3425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 constructor TfdB5G6R5.Create;
3429 begin
3430   inherited Create;
3431   fFormat           := tfB5G6R5;
3432   fWithAlpha        := tfBGRA4;
3433   fWithoutAlpha     := tfB5G6R5;
3434   fRGBInverted      := tfR5G6B5;
3435   fRange.r          := $1F;
3436   fRange.g          := $3F;
3437   fRange.b          := $1F;
3438   fShift.r          :=  11;
3439   fShift.g          :=   5;
3440   fShift.b          :=   0;
3441   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3442   fglInternalFormat := GL_RGB8;
3443   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3444 end;
3445
3446 constructor TfdBGR5.Create;
3447 begin
3448   inherited Create;
3449   fPixelSize        := 2.0;
3450   fFormat           := tfBGR5;
3451   fWithAlpha        := tfBGR5A1;
3452   fWithoutAlpha     := tfBGR5;
3453   fRGBInverted      := tfRGB5;
3454   fRange.r          := $1F;
3455   fRange.g          := $1F;
3456   fRange.b          := $1F;
3457   fRange.a          := $00;
3458   fShift.r          :=  10;
3459   fShift.g          :=   5;
3460   fShift.b          :=   0;
3461   fShift.a          :=   0;
3462   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3463   fglInternalFormat := GL_RGB5;
3464   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3465 end;
3466
3467 constructor TfdBGR8.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfBGR8;
3471   fWithAlpha        := tfBGRA8;
3472   fWithoutAlpha     := tfBGR8;
3473   fRGBInverted      := tfRGB8;
3474   fglInternalFormat := GL_RGB8;
3475 end;
3476
3477 constructor TfdBGR10.Create;
3478 begin
3479   inherited Create;
3480   fFormat           := tfBGR10;
3481   fWithAlpha        := tfBGR10A2;
3482   fWithoutAlpha     := tfBGR10;
3483   fRGBInverted      := tfRGB10;
3484   fRange.r          := $3FF;
3485   fRange.g          := $3FF;
3486   fRange.b          := $3FF;
3487   fRange.a          := $000;
3488   fShift.r          :=   20;
3489   fShift.g          :=   10;
3490   fShift.b          :=    0;
3491   fShift.a          :=    0;
3492   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3493   fglInternalFormat := GL_RGB10;
3494   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3495 end;
3496
3497 constructor TfdBGR12.Create;
3498 begin
3499   inherited Create;
3500   fFormat           := tfBGR12;
3501   fWithAlpha        := tfBGRA12;
3502   fWithoutAlpha     := tfBGR12;
3503   fRGBInverted      := tfRGB12;
3504   fglInternalFormat := GL_RGB12;
3505 end;
3506
3507 constructor TfdBGR16.Create;
3508 begin
3509   inherited Create;
3510   fFormat           := tfBGR16;
3511   fWithAlpha        := tfBGRA16;
3512   fWithoutAlpha     := tfBGR16;
3513   fRGBInverted      := tfRGB16;
3514   fglInternalFormat := GL_RGB16;
3515 end;
3516
3517 constructor TfdBGRA2.Create;
3518 begin
3519   inherited Create;
3520   fFormat           := tfBGRA2;
3521   fWithAlpha        := tfBGRA4;
3522   fWithoutAlpha     := tfBGR4;
3523   fRGBInverted      := tfRGBA2;
3524   fglInternalFormat := GL_RGBA2;
3525 end;
3526
3527 constructor TfdBGRA4.Create;
3528 begin
3529   inherited Create;
3530   fFormat           := tfBGRA4;
3531   fWithAlpha        := tfBGRA4;
3532   fWithoutAlpha     := tfBGR4;
3533   fRGBInverted      := tfRGBA4;
3534   fRange.r          := $F;
3535   fRange.g          := $F;
3536   fRange.b          := $F;
3537   fRange.a          := $F;
3538   fShift.r          :=  8;
3539   fShift.g          :=  4;
3540   fShift.b          :=  0;
3541   fShift.a          := 12;
3542   fglFormat         := GL_BGRA;
3543   fglInternalFormat := GL_RGBA4;
3544   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3545 end;
3546
3547 constructor TfdBGR5A1.Create;
3548 begin
3549   inherited Create;
3550   fFormat           := tfBGR5A1;
3551   fWithAlpha        := tfBGR5A1;
3552   fWithoutAlpha     := tfBGR5;
3553   fRGBInverted      := tfRGB5A1;
3554   fRange.r          := $1F;
3555   fRange.g          := $1F;
3556   fRange.b          := $1F;
3557   fRange.a          := $01;
3558   fShift.r          :=  10;
3559   fShift.g          :=   5;
3560   fShift.b          :=   0;
3561   fShift.a          :=  15;
3562   fglFormat         := GL_BGRA;
3563   fglInternalFormat := GL_RGB5_A1;
3564   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3565 end;
3566
3567 constructor TfdBGRA8.Create;
3568 begin
3569   inherited Create;
3570   fFormat           := tfBGRA8;
3571   fWithAlpha        := tfBGRA8;
3572   fWithoutAlpha     := tfBGR8;
3573   fRGBInverted      := tfRGBA8;
3574   fglInternalFormat := GL_RGBA8;
3575 end;
3576
3577 constructor TfdBGR10A2.Create;
3578 begin
3579   inherited Create;
3580   fFormat           := tfBGR10A2;
3581   fWithAlpha        := tfBGR10A2;
3582   fWithoutAlpha     := tfBGR10;
3583   fRGBInverted      := tfRGB10A2;
3584   fRange.r          := $3FF;
3585   fRange.g          := $3FF;
3586   fRange.b          := $3FF;
3587   fRange.a          := $003;
3588   fShift.r          :=   20;
3589   fShift.g          :=   10;
3590   fShift.b          :=    0;
3591   fShift.a          :=   30;
3592   fglFormat         := GL_BGRA;
3593   fglInternalFormat := GL_RGB10_A2;
3594   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3595 end;
3596
3597 constructor TfdBGRA12.Create;
3598 begin
3599   inherited Create;
3600   fFormat           := tfBGRA12;
3601   fWithAlpha        := tfBGRA12;
3602   fWithoutAlpha     := tfBGR12;
3603   fRGBInverted      := tfRGBA12;
3604   fglInternalFormat := GL_RGBA12;
3605 end;
3606
3607 constructor TfdBGRA16.Create;
3608 begin
3609   inherited Create;
3610   fFormat           := tfBGRA16;
3611   fWithAlpha        := tfBGRA16;
3612   fWithoutAlpha     := tfBGR16;
3613   fRGBInverted      := tfRGBA16;
3614   fglInternalFormat := GL_RGBA16;
3615 end;
3616
3617 constructor TfdDepth16.Create;
3618 begin
3619   inherited Create;
3620   fFormat           := tfDepth16;
3621   fWithAlpha        := tfEmpty;
3622   fWithoutAlpha     := tfDepth16;
3623   fglInternalFormat := GL_DEPTH_COMPONENT16;
3624 end;
3625
3626 constructor TfdDepth24.Create;
3627 begin
3628   inherited Create;
3629   fFormat           := tfDepth24;
3630   fWithAlpha        := tfEmpty;
3631   fWithoutAlpha     := tfDepth24;
3632   fglInternalFormat := GL_DEPTH_COMPONENT24;
3633 end;
3634
3635 constructor TfdDepth32.Create;
3636 begin
3637   inherited Create;
3638   fFormat           := tfDepth32;
3639   fWithAlpha        := tfEmpty;
3640   fWithoutAlpha     := tfDepth32;
3641   fglInternalFormat := GL_DEPTH_COMPONENT32;
3642 end;
3643
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3648 begin
3649   raise EglBitmap.Create('mapping for compressed formats is not supported');
3650 end;
3651
3652 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3653 begin
3654   raise EglBitmap.Create('mapping for compressed formats is not supported');
3655 end;
3656
3657 constructor TfdS3tcDtx1RGBA.Create;
3658 begin
3659   inherited Create;
3660   fFormat           := tfS3tcDtx1RGBA;
3661   fWithAlpha        := tfS3tcDtx1RGBA;
3662   fUncompressed     := tfRGB5A1;
3663   fPixelSize        := 0.5;
3664   fIsCompressed     := true;
3665   fglFormat         := GL_COMPRESSED_RGBA;
3666   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3667   fglDataFormat     := GL_UNSIGNED_BYTE;
3668 end;
3669
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3674 begin
3675   raise EglBitmap.Create('mapping for compressed formats is not supported');
3676 end;
3677
3678 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3679 begin
3680   raise EglBitmap.Create('mapping for compressed formats is not supported');
3681 end;
3682
3683 constructor TfdS3tcDtx3RGBA.Create;
3684 begin
3685   inherited Create;
3686   fFormat           := tfS3tcDtx3RGBA;
3687   fWithAlpha        := tfS3tcDtx3RGBA;
3688   fUncompressed     := tfRGBA8;
3689   fPixelSize        := 1.0;
3690   fIsCompressed     := true;
3691   fglFormat         := GL_COMPRESSED_RGBA;
3692   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3693   fglDataFormat     := GL_UNSIGNED_BYTE;
3694 end;
3695
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3700 begin
3701   raise EglBitmap.Create('mapping for compressed formats is not supported');
3702 end;
3703
3704 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3705 begin
3706   raise EglBitmap.Create('mapping for compressed formats is not supported');
3707 end;
3708
3709 constructor TfdS3tcDtx5RGBA.Create;
3710 begin
3711   inherited Create;
3712   fFormat           := tfS3tcDtx3RGBA;
3713   fWithAlpha        := tfS3tcDtx3RGBA;
3714   fUncompressed     := tfRGBA8;
3715   fPixelSize        := 1.0;
3716   fIsCompressed     := true;
3717   fglFormat         := GL_COMPRESSED_RGBA;
3718   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3719   fglDataFormat     := GL_UNSIGNED_BYTE;
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 class procedure TFormatDescriptor.Init;
3726 begin
3727   if not Assigned(FormatDescriptorCS) then
3728     FormatDescriptorCS := TCriticalSection.Create;
3729 end;
3730
3731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3733 begin
3734   FormatDescriptorCS.Enter;
3735   try
3736     result := FormatDescriptors[aFormat];
3737     if not Assigned(result) then begin
3738       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3739       FormatDescriptors[aFormat] := result;
3740     end;
3741   finally
3742     FormatDescriptorCS.Leave;
3743   end;
3744 end;
3745
3746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3748 begin
3749   result := Get(Get(aFormat).WithAlpha);
3750 end;
3751
3752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3753 class procedure TFormatDescriptor.Clear;
3754 var
3755   f: TglBitmapFormat;
3756 begin
3757   FormatDescriptorCS.Enter;
3758   try
3759     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3760       FreeAndNil(FormatDescriptors[f]);
3761   finally
3762     FormatDescriptorCS.Leave;
3763   end;
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 class procedure TFormatDescriptor.Finalize;
3768 begin
3769   Clear;
3770   FreeAndNil(FormatDescriptorCS);
3771 end;
3772
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3776 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3777 begin
3778   Update(aValue, fRange.r, fShift.r);
3779 end;
3780
3781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3783 begin
3784   Update(aValue, fRange.g, fShift.g);
3785 end;
3786
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3789 begin
3790   Update(aValue, fRange.b, fShift.b);
3791 end;
3792
3793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3794 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3795 begin
3796   Update(aValue, fRange.a, fShift.a);
3797 end;
3798
3799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3800 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3801   aShift: Byte);
3802 begin
3803   aShift := 0;
3804   aRange := 0;
3805   if (aMask = 0) then
3806     exit;
3807   while (aMask > 0) and ((aMask and 1) = 0) do begin
3808     inc(aShift);
3809     aMask := aMask shr 1;
3810   end;
3811   aRange := 1;
3812   while (aMask > 0) do begin
3813     aRange := aRange shl 1;
3814     aMask  := aMask  shr 1;
3815   end;
3816   dec(aRange);
3817
3818   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3819 end;
3820
3821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3822 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3823 var
3824   data: QWord;
3825   s: Integer;
3826 begin
3827   data :=
3828     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3829     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3830     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3831     ((aPixel.Data.a and fRange.a) shl fShift.a);
3832   s := Round(fPixelSize);
3833   case s of
3834     1:           aData^  := data;
3835     2:     PWord(aData)^ := data;
3836     4: PCardinal(aData)^ := data;
3837     8:    PQWord(aData)^ := data;
3838   else
3839     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3840   end;
3841   inc(aData, s);
3842 end;
3843
3844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3845 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3846 var
3847   data: QWord;
3848   s, i: Integer;
3849 begin
3850   s := Round(fPixelSize);
3851   case s of
3852     1: data :=           aData^;
3853     2: data :=     PWord(aData)^;
3854     4: data := PCardinal(aData)^;
3855     8: data :=    PQWord(aData)^;
3856   else
3857     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3858   end;
3859   for i := 0 to 3 do
3860     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3861   inc(aData, s);
3862 end;
3863
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3867 procedure TbmpColorTableFormat.CreateColorTable;
3868 var
3869   i: Integer;
3870 begin
3871   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3872     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3873
3874   if (Format = tfLuminance4) then
3875     SetLength(fColorTable, 16)
3876   else
3877     SetLength(fColorTable, 256);
3878
3879   case Format of
3880     tfLuminance4: begin
3881       for i := 0 to High(fColorTable) do begin
3882         fColorTable[i].r := 16 * i;
3883         fColorTable[i].g := 16 * i;
3884         fColorTable[i].b := 16 * i;
3885         fColorTable[i].a := 0;
3886       end;
3887     end;
3888
3889     tfLuminance8: begin
3890       for i := 0 to High(fColorTable) do begin
3891         fColorTable[i].r := i;
3892         fColorTable[i].g := i;
3893         fColorTable[i].b := i;
3894         fColorTable[i].a := 0;
3895       end;
3896     end;
3897
3898     tfR3G3B2: begin
3899       for i := 0 to High(fColorTable) do begin
3900         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3901         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3902         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3903         fColorTable[i].a := 0;
3904       end;
3905     end;
3906   end;
3907 end;
3908
3909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3910 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3911 var
3912   d: Byte;
3913 begin
3914   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3915     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3916
3917   case Format of
3918     tfLuminance4: begin
3919       if (aMapData = nil) then
3920         aData^ := 0;
3921       d := LuminanceWeight(aPixel) and Range.r;
3922       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3923       inc(PByte(aMapData), 4);
3924       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3925         inc(aData);
3926         aMapData := nil;
3927       end;
3928     end;
3929
3930     tfLuminance8: begin
3931       aData^ := LuminanceWeight(aPixel) and Range.r;
3932       inc(aData);
3933     end;
3934
3935     tfR3G3B2: begin
3936       aData^ := Round(
3937         ((aPixel.Data.r and Range.r) shl Shift.r) or
3938         ((aPixel.Data.g and Range.g) shl Shift.g) or
3939         ((aPixel.Data.b and Range.b) shl Shift.b));
3940       inc(aData);
3941     end;
3942   end;
3943 end;
3944
3945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3946 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3947 var
3948   idx: QWord;
3949   s: Integer;
3950   bits: Byte;
3951   f: Single;
3952 begin
3953   s    := Trunc(fPixelSize);
3954   f    := fPixelSize - s;
3955   bits := Round(8 * f);
3956   case s of
3957     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3958     1: idx :=           aData^;
3959     2: idx :=     PWord(aData)^;
3960     4: idx := PCardinal(aData)^;
3961     8: idx :=    PQWord(aData)^;
3962   else
3963     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3964   end;
3965   if (idx >= Length(fColorTable)) then
3966     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3967   with fColorTable[idx] do begin
3968     aPixel.Data.r := r;
3969     aPixel.Data.g := g;
3970     aPixel.Data.b := b;
3971     aPixel.Data.a := a;
3972   end;
3973   inc(PByte(aMapData), bits);
3974   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3975     inc(aData, 1);
3976     dec(PByte(aMapData), 8);
3977   end;
3978   inc(aData, s);
3979 end;
3980
3981 destructor TbmpColorTableFormat.Destroy;
3982 begin
3983   SetLength(fColorTable, 0);
3984   inherited Destroy;
3985 end;
3986
3987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3988 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3990 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3991 var
3992   i: Integer;
3993 begin
3994   for i := 0 to 3 do begin
3995     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3996       if (aSourceFD.Range.arr[i] > 0) then
3997         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3998       else
3999         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4000     end;
4001   end;
4002 end;
4003
4004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4005 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4006 begin
4007   with aFuncRec do begin
4008     if (Source.Range.r   > 0) then
4009       Dest.Data.r := Source.Data.r;
4010     if (Source.Range.g > 0) then
4011       Dest.Data.g := Source.Data.g;
4012     if (Source.Range.b  > 0) then
4013       Dest.Data.b := Source.Data.b;
4014     if (Source.Range.a > 0) then
4015       Dest.Data.a := Source.Data.a;
4016   end;
4017 end;
4018
4019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4020 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4021 var
4022   i: Integer;
4023 begin
4024   with aFuncRec do begin
4025     for i := 0 to 3 do
4026       if (Source.Range.arr[i] > 0) then
4027         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4028   end;
4029 end;
4030
4031 type
4032   TShiftData = packed record
4033     case Integer of
4034       0: (r, g, b, a: SmallInt);
4035       1: (arr: array[0..3] of SmallInt);
4036   end;
4037   PShiftData = ^TShiftData;
4038
4039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4040 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4041 var
4042   i: Integer;
4043 begin
4044   with aFuncRec do
4045     for i := 0 to 3 do
4046       if (Source.Range.arr[i] > 0) then
4047         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4052 begin
4053   with aFuncRec do begin
4054     Dest.Data := Source.Data;
4055     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4056       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4057       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4058       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4059     end;
4060     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4061       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4062     end;
4063   end;
4064 end;
4065
4066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4067 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4068 var
4069   i: Integer;
4070 begin
4071   with aFuncRec do begin
4072     for i := 0 to 3 do
4073       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4074   end;
4075 end;
4076
4077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4078 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4079 var
4080   Temp: Single;
4081 begin
4082   with FuncRec do begin
4083     if (FuncRec.Args = nil) then begin //source has no alpha
4084       Temp :=
4085         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4086         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4087         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4088       Dest.Data.a := Round(Dest.Range.a * Temp);
4089     end else
4090       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4091   end;
4092 end;
4093
4094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4095 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4096 type
4097   PglBitmapPixelData = ^TglBitmapPixelData;
4098 begin
4099   with FuncRec do begin
4100     Dest.Data.r := Source.Data.r;
4101     Dest.Data.g := Source.Data.g;
4102     Dest.Data.b := Source.Data.b;
4103
4104     with PglBitmapPixelData(Args)^ do
4105       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4106           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4107           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4108         Dest.Data.a := 0
4109       else
4110         Dest.Data.a := Dest.Range.a;
4111   end;
4112 end;
4113
4114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4116 begin
4117   with FuncRec do begin
4118     Dest.Data.r := Source.Data.r;
4119     Dest.Data.g := Source.Data.g;
4120     Dest.Data.b := Source.Data.b;
4121     Dest.Data.a := PCardinal(Args)^;
4122   end;
4123 end;
4124
4125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4126 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4127 type
4128   PRGBPix = ^TRGBPix;
4129   TRGBPix = array [0..2] of byte;
4130 var
4131   Temp: Byte;
4132 begin
4133   while aWidth > 0 do begin
4134     Temp := PRGBPix(aData)^[0];
4135     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4136     PRGBPix(aData)^[2] := Temp;
4137
4138     if aHasAlpha then
4139       Inc(aData, 4)
4140     else
4141       Inc(aData, 3);
4142     dec(aWidth);
4143   end;
4144 end;
4145
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4150 begin
4151   result := TFormatDescriptor.Get(Format);
4152 end;
4153
4154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 function TglBitmap.GetWidth: Integer;
4156 begin
4157   if (ffX in fDimension.Fields) then
4158     result := fDimension.X
4159   else
4160     result := -1;
4161 end;
4162
4163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4164 function TglBitmap.GetHeight: Integer;
4165 begin
4166   if (ffY in fDimension.Fields) then
4167     result := fDimension.Y
4168   else
4169     result := -1;
4170 end;
4171
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 function TglBitmap.GetFileWidth: Integer;
4174 begin
4175   result := Max(1, Width);
4176 end;
4177
4178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4179 function TglBitmap.GetFileHeight: Integer;
4180 begin
4181   result := Max(1, Height);
4182 end;
4183
4184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4185 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4186 begin
4187   if fCustomData = aValue then
4188     exit;
4189   fCustomData := aValue;
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.SetCustomName(const aValue: String);
4194 begin
4195   if fCustomName = aValue then
4196     exit;
4197   fCustomName := aValue;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4202 begin
4203   if fCustomNameW = aValue then
4204     exit;
4205   fCustomNameW := aValue;
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4210 begin
4211   if fFreeDataOnDestroy = aValue then
4212     exit;
4213   fFreeDataOnDestroy := aValue;
4214 end;
4215
4216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4217 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4218 begin
4219   if fDeleteTextureOnFree = aValue then
4220     exit;
4221   fDeleteTextureOnFree := aValue;
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4226 begin
4227   if fFormat = aValue then
4228     exit;
4229   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4230     raise EglBitmapUnsupportedFormat.Create(Format);
4231   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4232 end;
4233
4234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4235 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4236 begin
4237   if fFreeDataAfterGenTexture = aValue then
4238     exit;
4239   fFreeDataAfterGenTexture := aValue;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure TglBitmap.SetID(const aValue: Cardinal);
4244 begin
4245   if fID = aValue then
4246     exit;
4247   fID := aValue;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4252 begin
4253   if fMipMap = aValue then
4254     exit;
4255   fMipMap := aValue;
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4260 begin
4261   if fTarget = aValue then
4262     exit;
4263   fTarget := aValue;
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4268 var
4269   MaxAnisotropic: Integer;
4270 begin
4271   fAnisotropic := aValue;
4272   if (ID > 0) then begin
4273     if GL_EXT_texture_filter_anisotropic then begin
4274       if fAnisotropic > 0 then begin
4275         Bind(false);
4276         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4277         if aValue > MaxAnisotropic then
4278           fAnisotropic := MaxAnisotropic;
4279         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4280       end;
4281     end else begin
4282       fAnisotropic := 0;
4283     end;
4284   end;
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 procedure TglBitmap.CreateID;
4289 begin
4290   if (ID <> 0) then
4291     glDeleteTextures(1, @fID);
4292   glGenTextures(1, @fID);
4293   Bind(false);
4294 end;
4295
4296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4298 begin
4299   // Set Up Parameters
4300   SetWrap(fWrapS, fWrapT, fWrapR);
4301   SetFilter(fFilterMin, fFilterMag);
4302   SetAnisotropic(fAnisotropic);
4303   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4304
4305   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4306     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4307
4308   // Mip Maps Generation Mode
4309   aBuildWithGlu := false;
4310   if (MipMap = mmMipmap) then begin
4311     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4312       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4313     else
4314       aBuildWithGlu := true;
4315   end else if (MipMap = mmMipmapGlu) then
4316     aBuildWithGlu := true;
4317 end;
4318
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4321   const aWidth: Integer; const aHeight: Integer);
4322 var
4323   s: Single;
4324 begin
4325   if (Data <> aData) then begin
4326     if (Assigned(Data)) then
4327       FreeMem(Data);
4328     fData := aData;
4329   end;
4330
4331   if not Assigned(fData) then begin
4332     fPixelSize := 0;
4333     fRowSize   := 0;
4334   end else begin
4335     FillChar(fDimension, SizeOf(fDimension), 0);
4336     if aWidth <> -1 then begin
4337       fDimension.Fields := fDimension.Fields + [ffX];
4338       fDimension.X := aWidth;
4339     end;
4340
4341     if aHeight <> -1 then begin
4342       fDimension.Fields := fDimension.Fields + [ffY];
4343       fDimension.Y := aHeight;
4344     end;
4345
4346     s := TFormatDescriptor.Get(aFormat).PixelSize;
4347     fFormat    := aFormat;
4348     fPixelSize := Ceil(s);
4349     fRowSize   := Ceil(s * aWidth);
4350   end;
4351 end;
4352
4353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4354 function TglBitmap.FlipHorz: Boolean;
4355 begin
4356   result := false;
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 function TglBitmap.FlipVert: Boolean;
4361 begin
4362   result := false;
4363 end;
4364
4365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4366 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 procedure TglBitmap.AfterConstruction;
4369 begin
4370   inherited AfterConstruction;
4371
4372   fID         := 0;
4373   fTarget     := 0;
4374   fIsResident := false;
4375
4376   fMipMap                  := glBitmapDefaultMipmap;
4377   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4378   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4379
4380   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4381   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4382   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TglBitmap.BeforeDestruction;
4387 var
4388   NewData: PByte;
4389 begin
4390   if fFreeDataOnDestroy then begin
4391     NewData := nil;
4392     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4393   end;
4394   if (fID > 0) and fDeleteTextureOnFree then
4395     glDeleteTextures(1, @fID);
4396   inherited BeforeDestruction;
4397 end;
4398
4399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4400 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4401 var
4402   TempPos: Integer;
4403 begin
4404   if not Assigned(aResType) then begin
4405     TempPos   := Pos('.', aResource);
4406     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4407     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4408   end;
4409 end;
4410
4411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4412 procedure TglBitmap.LoadFromFile(const aFilename: String);
4413 var
4414   fs: TFileStream;
4415 begin
4416   if not FileExists(aFilename) then
4417     raise EglBitmap.Create('file does not exist: ' + aFilename);
4418   fFilename := aFilename;
4419   fs := TFileStream.Create(fFilename, fmOpenRead);
4420   try
4421     fs.Position := 0;
4422     LoadFromStream(fs);
4423   finally
4424     fs.Free;
4425   end;
4426 end;
4427
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4430 begin
4431   {$IFDEF GLB_SUPPORT_PNG_READ}
4432   if not LoadPNG(aStream) then
4433   {$ENDIF}
4434   {$IFDEF GLB_SUPPORT_JPEG_READ}
4435   if not LoadJPEG(aStream) then
4436   {$ENDIF}
4437   if not LoadDDS(aStream) then
4438   if not LoadTGA(aStream) then
4439   if not LoadBMP(aStream) then
4440     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4441 end;
4442
4443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4444 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4445   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4446 var
4447   tmpData: PByte;
4448   size: Integer;
4449 begin
4450   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4451   GetMem(tmpData, size);
4452   try
4453     FillChar(tmpData^, size, #$FF);
4454     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4455   except
4456     if Assigned(tmpData) then
4457       FreeMem(tmpData);
4458     raise;
4459   end;
4460   AddFunc(Self, aFunc, false, aFormat, aArgs);
4461 end;
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4465 var
4466   rs: TResourceStream;
4467 begin
4468   PrepareResType(aResource, aResType);
4469   rs := TResourceStream.Create(aInstance, aResource, aResType);
4470   try
4471     LoadFromStream(rs);
4472   finally
4473     rs.Free;
4474   end;
4475 end;
4476
4477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4478 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4479 var
4480   rs: TResourceStream;
4481 begin
4482   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4483   try
4484     LoadFromStream(rs);
4485   finally
4486     rs.Free;
4487   end;
4488 end;
4489
4490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4491 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4492 var
4493   fs: TFileStream;
4494 begin
4495   fs := TFileStream.Create(aFileName, fmCreate);
4496   try
4497     fs.Position := 0;
4498     SaveToStream(fs, aFileType);
4499   finally
4500     fs.Free;
4501   end;
4502 end;
4503
4504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4505 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4506 begin
4507   case aFileType of
4508     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4509     ftPNG:  SavePNG(aStream);
4510     {$ENDIF}
4511     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4512     ftJPEG: SaveJPEG(aStream);
4513     {$ENDIF}
4514     ftDDS:  SaveDDS(aStream);
4515     ftTGA:  SaveTGA(aStream);
4516     ftBMP:  SaveBMP(aStream);
4517   end;
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4522 begin
4523   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4524 end;
4525
4526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4527 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4528   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4529 var
4530   DestData, TmpData, SourceData: pByte;
4531   TempHeight, TempWidth: Integer;
4532   SourceFD, DestFD: TFormatDescriptor;
4533   SourceMD, DestMD: Pointer;
4534
4535   FuncRec: TglBitmapFunctionRec;
4536 begin
4537   Assert(Assigned(Data));
4538   Assert(Assigned(aSource));
4539   Assert(Assigned(aSource.Data));
4540
4541   result := false;
4542   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4543     SourceFD := TFormatDescriptor.Get(aSource.Format);
4544     DestFD   := TFormatDescriptor.Get(aFormat);
4545
4546     if (SourceFD.IsCompressed) then
4547       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4548     if (DestFD.IsCompressed) then
4549       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4550
4551     // inkompatible Formats so CreateTemp
4552     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4553       aCreateTemp := true;
4554
4555     // Values
4556     TempHeight := Max(1, aSource.Height);
4557     TempWidth  := Max(1, aSource.Width);
4558
4559     FuncRec.Sender := Self;
4560     FuncRec.Args   := aArgs;
4561
4562     TmpData := nil;
4563     if aCreateTemp then begin
4564       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4565       DestData := TmpData;
4566     end else
4567       DestData := Data;
4568
4569     try
4570       SourceFD.PreparePixel(FuncRec.Source);
4571       DestFD.PreparePixel  (FuncRec.Dest);
4572
4573       SourceMD := SourceFD.CreateMappingData;
4574       DestMD   := DestFD.CreateMappingData;
4575
4576       FuncRec.Size            := aSource.Dimension;
4577       FuncRec.Position.Fields := FuncRec.Size.Fields;
4578
4579       try
4580         SourceData := aSource.Data;
4581         FuncRec.Position.Y := 0;
4582         while FuncRec.Position.Y < TempHeight do begin
4583           FuncRec.Position.X := 0;
4584           while FuncRec.Position.X < TempWidth do begin
4585             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4586             aFunc(FuncRec);
4587             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4588             inc(FuncRec.Position.X);
4589           end;
4590           inc(FuncRec.Position.Y);
4591         end;
4592
4593         // Updating Image or InternalFormat
4594         if aCreateTemp then
4595           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4596         else if (aFormat <> fFormat) then
4597           Format := aFormat;
4598
4599         result := true;
4600       finally
4601         SourceFD.FreeMappingData(SourceMD);
4602         DestFD.FreeMappingData(DestMD);
4603       end;
4604     except
4605       if aCreateTemp and Assigned(TmpData) then
4606         FreeMem(TmpData);
4607       raise;
4608     end;
4609   end;
4610 end;
4611
4612 {$IFDEF GLB_SDL}
4613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4614 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4615 var
4616   Row, RowSize: Integer;
4617   SourceData, TmpData: PByte;
4618   TempDepth: Integer;
4619   FormatDesc: TFormatDescriptor;
4620
4621   function GetRowPointer(Row: Integer): pByte;
4622   begin
4623     result := aSurface.pixels;
4624     Inc(result, Row * RowSize);
4625   end;
4626
4627 begin
4628   result := false;
4629
4630   FormatDesc := TFormatDescriptor.Get(Format);
4631   if FormatDesc.IsCompressed then
4632     raise EglBitmapUnsupportedFormat.Create(Format);
4633
4634   if Assigned(Data) then begin
4635     case Trunc(FormatDesc.PixelSize) of
4636       1: TempDepth :=  8;
4637       2: TempDepth := 16;
4638       3: TempDepth := 24;
4639       4: TempDepth := 32;
4640     else
4641       raise EglBitmapUnsupportedFormat.Create(Format);
4642     end;
4643
4644     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4645       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4646     SourceData := Data;
4647     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4648
4649     for Row := 0 to FileHeight-1 do begin
4650       TmpData := GetRowPointer(Row);
4651       if Assigned(TmpData) then begin
4652         Move(SourceData^, TmpData^, RowSize);
4653         inc(SourceData, RowSize);
4654       end;
4655     end;
4656     result := true;
4657   end;
4658 end;
4659
4660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4661 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4662 var
4663   pSource, pData, pTempData: PByte;
4664   Row, RowSize, TempWidth, TempHeight: Integer;
4665   IntFormat: TglBitmapFormat;
4666   FormatDesc: TFormatDescriptor;
4667
4668   function GetRowPointer(Row: Integer): pByte;
4669   begin
4670     result := aSurface^.pixels;
4671     Inc(result, Row * RowSize);
4672   end;
4673
4674 begin
4675   result := false;
4676   if (Assigned(aSurface)) then begin
4677     with aSurface^.format^ do begin
4678       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4679         FormatDesc := TFormatDescriptor.Get(IntFormat);
4680         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4681           break;
4682       end;
4683       if (IntFormat = tfEmpty) then
4684         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4685     end;
4686
4687     TempWidth  := aSurface^.w;
4688     TempHeight := aSurface^.h;
4689     RowSize := FormatDesc.GetSize(TempWidth, 1);
4690     GetMem(pData, TempHeight * RowSize);
4691     try
4692       pTempData := pData;
4693       for Row := 0 to TempHeight -1 do begin
4694         pSource := GetRowPointer(Row);
4695         if (Assigned(pSource)) then begin
4696           Move(pSource^, pTempData^, RowSize);
4697           Inc(pTempData, RowSize);
4698         end;
4699       end;
4700       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4701       result := true;
4702     except
4703       if Assigned(pData) then
4704         FreeMem(pData);
4705       raise;
4706     end;
4707   end;
4708 end;
4709
4710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4711 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4712 var
4713   Row, Col, AlphaInterleave: Integer;
4714   pSource, pDest: PByte;
4715
4716   function GetRowPointer(Row: Integer): pByte;
4717   begin
4718     result := aSurface.pixels;
4719     Inc(result, Row * Width);
4720   end;
4721
4722 begin
4723   result := false;
4724   if Assigned(Data) then begin
4725     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4726       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4727
4728       AlphaInterleave := 0;
4729       case Format of
4730         tfLuminance8Alpha8:
4731           AlphaInterleave := 1;
4732         tfBGRA8, tfRGBA8:
4733           AlphaInterleave := 3;
4734       end;
4735
4736       pSource := Data;
4737       for Row := 0 to Height -1 do begin
4738         pDest := GetRowPointer(Row);
4739         if Assigned(pDest) then begin
4740           for Col := 0 to Width -1 do begin
4741             Inc(pSource, AlphaInterleave);
4742             pDest^ := pSource^;
4743             Inc(pDest);
4744             Inc(pSource);
4745           end;
4746         end;
4747       end;
4748       result := true;
4749     end;
4750   end;
4751 end;
4752
4753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4754 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4755 var
4756   bmp: TglBitmap2D;
4757 begin
4758   bmp := TglBitmap2D.Create;
4759   try
4760     bmp.AssignFromSurface(aSurface);
4761     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4762   finally
4763     bmp.Free;
4764   end;
4765 end;
4766 {$ENDIF}
4767
4768 {$IFDEF GLB_DELPHI}
4769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4770 function CreateGrayPalette: HPALETTE;
4771 var
4772   Idx: Integer;
4773   Pal: PLogPalette;
4774 begin
4775   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4776
4777   Pal.palVersion := $300;
4778   Pal.palNumEntries := 256;
4779
4780   for Idx := 0 to Pal.palNumEntries - 1 do begin
4781     Pal.palPalEntry[Idx].peRed   := Idx;
4782     Pal.palPalEntry[Idx].peGreen := Idx;
4783     Pal.palPalEntry[Idx].peBlue  := Idx;
4784     Pal.palPalEntry[Idx].peFlags := 0;
4785   end;
4786   Result := CreatePalette(Pal^);
4787   FreeMem(Pal);
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4792 var
4793   Row: Integer;
4794   pSource, pData: PByte;
4795 begin
4796   result := false;
4797   if Assigned(Data) then begin
4798     if Assigned(aBitmap) then begin
4799       aBitmap.Width  := Width;
4800       aBitmap.Height := Height;
4801
4802       case Format of
4803         tfAlpha8, tfLuminance8: begin
4804           aBitmap.PixelFormat := pf8bit;
4805           aBitmap.Palette     := CreateGrayPalette;
4806         end;
4807         tfRGB5A1:
4808           aBitmap.PixelFormat := pf15bit;
4809         tfR5G6B5:
4810           aBitmap.PixelFormat := pf16bit;
4811         tfRGB8, tfBGR8:
4812           aBitmap.PixelFormat := pf24bit;
4813         tfRGBA8, tfBGRA8:
4814           aBitmap.PixelFormat := pf32bit;
4815       else
4816         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4817       end;
4818
4819       pSource := Data;
4820       for Row := 0 to FileHeight -1 do begin
4821         pData := aBitmap.Scanline[Row];
4822         Move(pSource^, pData^, fRowSize);
4823         Inc(pSource, fRowSize);
4824         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4825           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4826       end;
4827       result := true;
4828     end;
4829   end;
4830 end;
4831
4832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4833 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4834 var
4835   pSource, pData, pTempData: PByte;
4836   Row, RowSize, TempWidth, TempHeight: Integer;
4837   IntFormat: TglBitmapFormat;
4838 begin
4839   result := false;
4840
4841   if (Assigned(aBitmap)) then begin
4842     case aBitmap.PixelFormat of
4843       pf8bit:
4844         IntFormat := tfLuminance8;
4845       pf15bit:
4846         IntFormat := tfRGB5A1;
4847       pf16bit:
4848         IntFormat := tfR5G6B5;
4849       pf24bit:
4850         IntFormat := tfBGR8;
4851       pf32bit:
4852         IntFormat := tfBGRA8;
4853     else
4854       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4855     end;
4856
4857     TempWidth  := aBitmap.Width;
4858     TempHeight := aBitmap.Height;
4859     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4860     GetMem(pData, TempHeight * RowSize);
4861     try
4862       pTempData := pData;
4863       for Row := 0 to TempHeight -1 do begin
4864         pSource := aBitmap.Scanline[Row];
4865         if (Assigned(pSource)) then begin
4866           Move(pSource^, pTempData^, RowSize);
4867           Inc(pTempData, RowSize);
4868         end;
4869       end;
4870       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4871       result := true;
4872     except
4873       if Assigned(pData) then
4874         FreeMem(pData);
4875       raise;
4876     end;
4877   end;
4878 end;
4879
4880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4881 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4882 var
4883   Row, Col, AlphaInterleave: Integer;
4884   pSource, pDest: PByte;
4885 begin
4886   result := false;
4887
4888   if Assigned(Data) then begin
4889     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4890       if Assigned(aBitmap) then begin
4891         aBitmap.PixelFormat := pf8bit;
4892         aBitmap.Palette     := CreateGrayPalette;
4893         aBitmap.Width       := Width;
4894         aBitmap.Height      := Height;
4895
4896         case Format of
4897           tfLuminance8Alpha8:
4898             AlphaInterleave := 1;
4899           tfRGBA8, tfBGRA8:
4900             AlphaInterleave := 3;
4901           else
4902             AlphaInterleave := 0;
4903         end;
4904
4905         // Copy Data
4906         pSource := Data;
4907
4908         for Row := 0 to Height -1 do begin
4909           pDest := aBitmap.Scanline[Row];
4910           if Assigned(pDest) then begin
4911             for Col := 0 to Width -1 do begin
4912               Inc(pSource, AlphaInterleave);
4913               pDest^ := pSource^;
4914               Inc(pDest);
4915               Inc(pSource);
4916             end;
4917           end;
4918         end;
4919         result := true;
4920       end;
4921     end;
4922   end;
4923 end;
4924
4925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4926 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4927 var
4928   tex: TglBitmap2D;
4929 begin
4930   tex := TglBitmap2D.Create;
4931   try
4932     tex.AssignFromBitmap(ABitmap);
4933     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4934   finally
4935     tex.Free;
4936   end;
4937 end;
4938 {$ENDIF}
4939
4940 {$IFDEF GLB_LAZARUS}
4941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4942 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4943 var
4944   rid: TRawImageDescription;
4945   FormatDesc: TFormatDescriptor;
4946 begin
4947   result := false;
4948   if not Assigned(aImage) or (Format = tfEmpty) then
4949     exit;
4950   FormatDesc := TFormatDescriptor.Get(Format);
4951   if FormatDesc.IsCompressed then
4952     exit;
4953
4954   FillChar(rid{%H-}, SizeOf(rid), 0);
4955   if (Format in [
4956        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4957        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4958        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4959     rid.Format := ricfGray
4960   else
4961     rid.Format := ricfRGBA;
4962
4963   rid.Width        := Width;
4964   rid.Height       := Height;
4965   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4966   rid.BitOrder     := riboBitsInOrder;
4967   rid.ByteOrder    := riboLSBFirst;
4968   rid.LineOrder    := riloTopToBottom;
4969   rid.LineEnd      := rileTight;
4970   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4971   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4972   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4973   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4974   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4975   rid.RedShift     := FormatDesc.Shift.r;
4976   rid.GreenShift   := FormatDesc.Shift.g;
4977   rid.BlueShift    := FormatDesc.Shift.b;
4978   rid.AlphaShift   := FormatDesc.Shift.a;
4979
4980   rid.MaskBitsPerPixel  := 0;
4981   rid.PaletteColorCount := 0;
4982
4983   aImage.DataDescription := rid;
4984   aImage.CreateData;
4985
4986   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4987
4988   result := true;
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4993 var
4994   f: TglBitmapFormat;
4995   FormatDesc: TFormatDescriptor;
4996   ImageData: PByte;
4997   ImageSize: Integer;
4998   CanCopy: Boolean;
4999
5000   procedure CopyConvert;
5001   var
5002     bfFormat: TbmpBitfieldFormat;
5003     pSourceLine, pDestLine: PByte;
5004     pSourceMD, pDestMD: Pointer;
5005     x, y: Integer;
5006     pixel: TglBitmapPixelData;
5007   begin
5008     bfFormat  := TbmpBitfieldFormat.Create;
5009     with aImage.DataDescription do begin
5010       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5011       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5012       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5013       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5014       bfFormat.PixelSize := BitsPerPixel / 8;
5015     end;
5016     pSourceMD := bfFormat.CreateMappingData;
5017     pDestMD   := FormatDesc.CreateMappingData;
5018     try
5019       for y := 0 to aImage.Height-1 do begin
5020         pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
5021         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5022         for x := 0 to aImage.Width-1 do begin
5023           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5024           FormatDesc.Map(pixel, pDestLine, pDestMD);
5025         end;
5026       end;
5027     finally
5028       FormatDesc.FreeMappingData(pDestMD);
5029       bfFormat.FreeMappingData(pSourceMD);
5030       bfFormat.Free;
5031     end;
5032   end;
5033
5034 begin
5035   result := false;
5036   if not Assigned(aImage) then
5037     exit;
5038   for f := High(f) downto Low(f) do begin
5039     FormatDesc := TFormatDescriptor.Get(f);
5040     with aImage.DataDescription do
5041       if FormatDesc.MaskMatch(
5042         (QWord(1 shl RedPrec  )-1) shl RedShift,
5043         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5044         (QWord(1 shl BluePrec )-1) shl BlueShift,
5045         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5046         break;
5047   end;
5048
5049   if (f = tfEmpty) then
5050     exit;
5051
5052   CanCopy :=
5053     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5054     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5055
5056   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5057   ImageData := GetMem(ImageSize);
5058   try
5059     if CanCopy then
5060       Move(aImage.PixelData^, ImageData^, ImageSize)
5061     else
5062       CopyConvert;
5063     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5064   except
5065     if Assigned(ImageData) then
5066       FreeMem(ImageData);
5067     raise;
5068   end;
5069
5070   result := true;
5071 end;
5072
5073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5074 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5075 var
5076   rid: TRawImageDescription;
5077   FormatDesc: TFormatDescriptor;
5078   Pixel: TglBitmapPixelData;
5079   x, y: Integer;
5080   srcMD: Pointer;
5081   src, dst: PByte;
5082 begin
5083   result := false;
5084   if not Assigned(aImage) or (Format = tfEmpty) then
5085     exit;
5086   FormatDesc := TFormatDescriptor.Get(Format);
5087   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5088     exit;
5089
5090   FillChar(rid{%H-}, SizeOf(rid), 0);
5091   rid.Format       := ricfGray;
5092   rid.Width        := Width;
5093   rid.Height       := Height;
5094   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5095   rid.BitOrder     := riboBitsInOrder;
5096   rid.ByteOrder    := riboLSBFirst;
5097   rid.LineOrder    := riloTopToBottom;
5098   rid.LineEnd      := rileTight;
5099   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5100   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5101   rid.GreenPrec    := 0;
5102   rid.BluePrec     := 0;
5103   rid.AlphaPrec    := 0;
5104   rid.RedShift     := 0;
5105   rid.GreenShift   := 0;
5106   rid.BlueShift    := 0;
5107   rid.AlphaShift   := 0;
5108
5109   rid.MaskBitsPerPixel  := 0;
5110   rid.PaletteColorCount := 0;
5111
5112   aImage.DataDescription := rid;
5113   aImage.CreateData;
5114
5115   srcMD := FormatDesc.CreateMappingData;
5116   try
5117     FormatDesc.PreparePixel(Pixel);
5118     src := Data;
5119     dst := aImage.PixelData;
5120     for y := 0 to Height-1 do
5121       for x := 0 to Width-1 do begin
5122         FormatDesc.Unmap(src, Pixel, srcMD);
5123         case rid.BitsPerPixel of
5124            8: begin
5125             dst^ := Pixel.Data.a;
5126             inc(dst);
5127           end;
5128           16: begin
5129             PWord(dst)^ := Pixel.Data.a;
5130             inc(dst, 2);
5131           end;
5132           24: begin
5133             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5134             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5135             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5136             inc(dst, 3);
5137           end;
5138           32: begin
5139             PCardinal(dst)^ := Pixel.Data.a;
5140             inc(dst, 4);
5141           end;
5142         else
5143           raise EglBitmapUnsupportedFormat.Create(Format);
5144         end;
5145       end;
5146   finally
5147     FormatDesc.FreeMappingData(srcMD);
5148   end;
5149   result := true;
5150 end;
5151
5152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5153 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5154 var
5155   tex: TglBitmap2D;
5156 begin
5157   tex := TglBitmap2D.Create;
5158   try
5159     tex.AssignFromLazIntfImage(aImage);
5160     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5161   finally
5162     tex.Free;
5163   end;
5164 end;
5165 {$ENDIF}
5166
5167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5168 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5169   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5170 var
5171   rs: TResourceStream;
5172 begin
5173   PrepareResType(aResource, aResType);
5174   rs := TResourceStream.Create(aInstance, aResource, aResType);
5175   try
5176     result := AddAlphaFromStream(rs, aFunc, aArgs);
5177   finally
5178     rs.Free;
5179   end;
5180 end;
5181
5182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5183 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5184   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5185 var
5186   rs: TResourceStream;
5187 begin
5188   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5189   try
5190     result := AddAlphaFromStream(rs, aFunc, aArgs);
5191   finally
5192     rs.Free;
5193   end;
5194 end;
5195
5196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5197 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5198 begin
5199   if TFormatDescriptor.Get(Format).IsCompressed then
5200     raise EglBitmapUnsupportedFormat.Create(Format);
5201   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5202 end;
5203
5204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5205 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5206 var
5207   FS: TFileStream;
5208 begin
5209   FS := TFileStream.Create(aFileName, fmOpenRead);
5210   try
5211     result := AddAlphaFromStream(FS, aFunc, aArgs);
5212   finally
5213     FS.Free;
5214   end;
5215 end;
5216
5217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5218 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5219 var
5220   tex: TglBitmap2D;
5221 begin
5222   tex := TglBitmap2D.Create(aStream);
5223   try
5224     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5225   finally
5226     tex.Free;
5227   end;
5228 end;
5229
5230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5231 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5232 var
5233   DestData, DestData2, SourceData: pByte;
5234   TempHeight, TempWidth: Integer;
5235   SourceFD, DestFD: TFormatDescriptor;
5236   SourceMD, DestMD, DestMD2: Pointer;
5237
5238   FuncRec: TglBitmapFunctionRec;
5239 begin
5240   result := false;
5241
5242   Assert(Assigned(Data));
5243   Assert(Assigned(aBitmap));
5244   Assert(Assigned(aBitmap.Data));
5245
5246   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5247     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5248
5249     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5250     DestFD   := TFormatDescriptor.Get(Format);
5251
5252     if not Assigned(aFunc) then begin
5253       aFunc        := glBitmapAlphaFunc;
5254       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5255     end else
5256       FuncRec.Args := aArgs;
5257
5258     // Values
5259     TempHeight := aBitmap.FileHeight;
5260     TempWidth  := aBitmap.FileWidth;
5261
5262     FuncRec.Sender          := Self;
5263     FuncRec.Size            := Dimension;
5264     FuncRec.Position.Fields := FuncRec.Size.Fields;
5265
5266     DestData   := Data;
5267     DestData2  := Data;
5268     SourceData := aBitmap.Data;
5269
5270     // Mapping
5271     SourceFD.PreparePixel(FuncRec.Source);
5272     DestFD.PreparePixel  (FuncRec.Dest);
5273
5274     SourceMD := SourceFD.CreateMappingData;
5275     DestMD   := DestFD.CreateMappingData;
5276     DestMD2  := DestFD.CreateMappingData;
5277     try
5278       FuncRec.Position.Y := 0;
5279       while FuncRec.Position.Y < TempHeight do begin
5280         FuncRec.Position.X := 0;
5281         while FuncRec.Position.X < TempWidth do begin
5282           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5283           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5284           aFunc(FuncRec);
5285           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5286           inc(FuncRec.Position.X);
5287         end;
5288         inc(FuncRec.Position.Y);
5289       end;
5290     finally
5291       SourceFD.FreeMappingData(SourceMD);
5292       DestFD.FreeMappingData(DestMD);
5293       DestFD.FreeMappingData(DestMD2);
5294     end;
5295   end;
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5300 begin
5301   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5302 end;
5303
5304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5305 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5306 var
5307   PixelData: TglBitmapPixelData;
5308 begin
5309   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5310   result := AddAlphaFromColorKeyFloat(
5311     aRed   / PixelData.Range.r,
5312     aGreen / PixelData.Range.g,
5313     aBlue  / PixelData.Range.b,
5314     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5315 end;
5316
5317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5318 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5319 var
5320   values: array[0..2] of Single;
5321   tmp: Cardinal;
5322   i: Integer;
5323   PixelData: TglBitmapPixelData;
5324 begin
5325   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5326   with PixelData do begin
5327     values[0] := aRed;
5328     values[1] := aGreen;
5329     values[2] := aBlue;
5330
5331     for i := 0 to 2 do begin
5332       tmp          := Trunc(Range.arr[i] * aDeviation);
5333       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5334       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5335     end;
5336     Data.a  := 0;
5337     Range.a := 0;
5338   end;
5339   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5340 end;
5341
5342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5343 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5344 begin
5345   result := AddAlphaFromValueFloat(aAlpha / $FF);
5346 end;
5347
5348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5349 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5350 var
5351   PixelData: TglBitmapPixelData;
5352 begin
5353   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5354   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5355 end;
5356
5357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5358 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5359 var
5360   PixelData: TglBitmapPixelData;
5361 begin
5362   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5363   with PixelData do
5364     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5365   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5366 end;
5367
5368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5369 function TglBitmap.RemoveAlpha: Boolean;
5370 var
5371   FormatDesc: TFormatDescriptor;
5372 begin
5373   result := false;
5374   FormatDesc := TFormatDescriptor.Get(Format);
5375   if Assigned(Data) then begin
5376     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5377       raise EglBitmapUnsupportedFormat.Create(Format);
5378     result := ConvertTo(FormatDesc.WithoutAlpha);
5379   end;
5380 end;
5381
5382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5383 function TglBitmap.Clone: TglBitmap;
5384 var
5385   Temp: TglBitmap;
5386   TempPtr: PByte;
5387   Size: Integer;
5388 begin
5389   result := nil;
5390   Temp := (ClassType.Create as TglBitmap);
5391   try
5392     // copy texture data if assigned
5393     if Assigned(Data) then begin
5394       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5395       GetMem(TempPtr, Size);
5396       try
5397         Move(Data^, TempPtr^, Size);
5398         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5399       except
5400         if Assigned(TempPtr) then
5401           FreeMem(TempPtr);
5402         raise;
5403       end;
5404     end else begin
5405       TempPtr := nil;
5406       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5407     end;
5408
5409         // copy properties
5410     Temp.fID                      := ID;
5411     Temp.fTarget                  := Target;
5412     Temp.fFormat                  := Format;
5413     Temp.fMipMap                  := MipMap;
5414     Temp.fAnisotropic             := Anisotropic;
5415     Temp.fBorderColor             := fBorderColor;
5416     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5417     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5418     Temp.fFilterMin               := fFilterMin;
5419     Temp.fFilterMag               := fFilterMag;
5420     Temp.fWrapS                   := fWrapS;
5421     Temp.fWrapT                   := fWrapT;
5422     Temp.fWrapR                   := fWrapR;
5423     Temp.fFilename                := fFilename;
5424     Temp.fCustomName              := fCustomName;
5425     Temp.fCustomNameW             := fCustomNameW;
5426     Temp.fCustomData              := fCustomData;
5427
5428     result := Temp;
5429   except
5430     FreeAndNil(Temp);
5431     raise;
5432   end;
5433 end;
5434
5435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5436 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5437 var
5438   SourceFD, DestFD: TFormatDescriptor;
5439   SourcePD, DestPD: TglBitmapPixelData;
5440   ShiftData: TShiftData;
5441
5442   function CanCopyDirect: Boolean;
5443   begin
5444     result :=
5445       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5446       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5447       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5448       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5449   end;
5450
5451   function CanShift: Boolean;
5452   begin
5453     result :=
5454       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5455       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5456       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5457       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5458   end;
5459
5460   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5461   begin
5462     result := 0;
5463     while (aSource > aDest) and (aSource > 0) do begin
5464       inc(result);
5465       aSource := aSource shr 1;
5466     end;
5467   end;
5468
5469 begin
5470   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5471     SourceFD := TFormatDescriptor.Get(Format);
5472     DestFD   := TFormatDescriptor.Get(aFormat);
5473
5474     SourceFD.PreparePixel(SourcePD);
5475     DestFD.PreparePixel  (DestPD);
5476
5477     if CanCopyDirect then
5478       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5479     else if CanShift then begin
5480       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5481       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5482       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5483       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5484       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5485     end else
5486       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5487   end else
5488     result := true;
5489 end;
5490
5491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5492 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5493 begin
5494   if aUseRGB or aUseAlpha then
5495     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5496       ((Byte(aUseAlpha) and 1) shl 1) or
5497        (Byte(aUseRGB)   and 1)      ));
5498 end;
5499
5500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5501 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5502 begin
5503   fBorderColor[0] := aRed;
5504   fBorderColor[1] := aGreen;
5505   fBorderColor[2] := aBlue;
5506   fBorderColor[3] := aAlpha;
5507   if (ID > 0) then begin
5508     Bind(false);
5509     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5510   end;
5511 end;
5512
5513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5514 procedure TglBitmap.FreeData;
5515 var
5516   TempPtr: PByte;
5517 begin
5518   TempPtr := nil;
5519   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5520 end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5524   const aAlpha: Byte);
5525 begin
5526   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5527 end;
5528
5529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5530 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5531 var
5532   PixelData: TglBitmapPixelData;
5533 begin
5534   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5535   FillWithColorFloat(
5536     aRed   / PixelData.Range.r,
5537     aGreen / PixelData.Range.g,
5538     aBlue  / PixelData.Range.b,
5539     aAlpha / PixelData.Range.a);
5540 end;
5541
5542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5543 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5544 var
5545   PixelData: TglBitmapPixelData;
5546 begin
5547   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5548   with PixelData do begin
5549     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5550     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5551     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5552     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5553   end;
5554   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5555 end;
5556
5557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5558 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5559 begin
5560   //check MIN filter
5561   case aMin of
5562     GL_NEAREST:
5563       fFilterMin := GL_NEAREST;
5564     GL_LINEAR:
5565       fFilterMin := GL_LINEAR;
5566     GL_NEAREST_MIPMAP_NEAREST:
5567       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5568     GL_LINEAR_MIPMAP_NEAREST:
5569       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5570     GL_NEAREST_MIPMAP_LINEAR:
5571       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5572     GL_LINEAR_MIPMAP_LINEAR:
5573       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5574     else
5575       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5576   end;
5577
5578   //check MAG filter
5579   case aMag of
5580     GL_NEAREST:
5581       fFilterMag := GL_NEAREST;
5582     GL_LINEAR:
5583       fFilterMag := GL_LINEAR;
5584     else
5585       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5586   end;
5587
5588   //apply filter
5589   if (ID > 0) then begin
5590     Bind(false);
5591     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5592
5593     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5594       case fFilterMin of
5595         GL_NEAREST, GL_LINEAR:
5596           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5597         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5598           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5599         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5600           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5601       end;
5602     end else
5603       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5604   end;
5605 end;
5606
5607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5608 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5609
5610   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5611   begin
5612     case aValue of
5613       GL_CLAMP:
5614         aTarget := GL_CLAMP;
5615
5616       GL_REPEAT:
5617         aTarget := GL_REPEAT;
5618
5619       GL_CLAMP_TO_EDGE: begin
5620         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5621           aTarget := GL_CLAMP_TO_EDGE
5622         else
5623           aTarget := GL_CLAMP;
5624       end;
5625
5626       GL_CLAMP_TO_BORDER: begin
5627         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5628           aTarget := GL_CLAMP_TO_BORDER
5629         else
5630           aTarget := GL_CLAMP;
5631       end;
5632
5633       GL_MIRRORED_REPEAT: begin
5634         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5635           aTarget := GL_MIRRORED_REPEAT
5636         else
5637           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5638       end;
5639     else
5640       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5641     end;
5642   end;
5643
5644 begin
5645   CheckAndSetWrap(S, fWrapS);
5646   CheckAndSetWrap(T, fWrapT);
5647   CheckAndSetWrap(R, fWrapR);
5648
5649   if (ID > 0) then begin
5650     Bind(false);
5651     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5652     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5653     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5654   end;
5655 end;
5656
5657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5658 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5659
5660   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5661   begin
5662     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5663        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5664       fSwizzle[aIndex] := aValue
5665     else
5666       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5667   end;
5668
5669 begin
5670   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5671     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5672   CheckAndSetValue(r, 0);
5673   CheckAndSetValue(g, 1);
5674   CheckAndSetValue(b, 2);
5675   CheckAndSetValue(a, 3);
5676
5677   if (ID > 0) then begin
5678     Bind(false);
5679     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5680   end;
5681 end;
5682
5683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5684 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5685 begin
5686   if aEnableTextureUnit then
5687     glEnable(Target);
5688   if (ID > 0) then
5689     glBindTexture(Target, ID);
5690 end;
5691
5692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5693 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5694 begin
5695   if aDisableTextureUnit then
5696     glDisable(Target);
5697   glBindTexture(Target, 0);
5698 end;
5699
5700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5701 constructor TglBitmap.Create;
5702 begin
5703   if (ClassType = TglBitmap) then
5704     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5705 {$IFDEF GLB_NATIVE_OGL}
5706   glbReadOpenGLExtensions;
5707 {$ENDIF}
5708   inherited Create;
5709   fFormat            := glBitmapGetDefaultFormat;
5710   fFreeDataOnDestroy := true;
5711 end;
5712
5713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5714 constructor TglBitmap.Create(const aFileName: String);
5715 begin
5716   Create;
5717   LoadFromFile(aFileName);
5718 end;
5719
5720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5721 constructor TglBitmap.Create(const aStream: TStream);
5722 begin
5723   Create;
5724   LoadFromStream(aStream);
5725 end;
5726
5727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5728 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5729 var
5730   ImageSize: Integer;
5731 begin
5732   Create;
5733   if not Assigned(aData) then begin
5734     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5735     GetMem(aData, ImageSize);
5736     try
5737       FillChar(aData^, ImageSize, #$FF);
5738       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5739     except
5740       if Assigned(aData) then
5741         FreeMem(aData);
5742       raise;
5743     end;
5744   end else begin
5745     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5746     fFreeDataOnDestroy := false;
5747   end;
5748 end;
5749
5750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5751 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5752 begin
5753   Create;
5754   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5755 end;
5756
5757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5758 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5759 begin
5760   Create;
5761   LoadFromResource(aInstance, aResource, aResType);
5762 end;
5763
5764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5765 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5766 begin
5767   Create;
5768   LoadFromResourceID(aInstance, aResourceID, aResType);
5769 end;
5770
5771 {$IFDEF GLB_SUPPORT_PNG_READ}
5772 {$IF DEFINED(GLB_LAZ_PNG)}
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5776 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5777 const
5778   MAGIC_LEN = 8;
5779   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5780 var
5781   reader: TLazReaderPNG;
5782   intf: TLazIntfImage;
5783   StreamPos: Int64;
5784   magic: String[MAGIC_LEN];
5785 begin
5786   result := true;
5787   StreamPos := aStream.Position;
5788
5789   SetLength(magic, MAGIC_LEN);
5790   aStream.Read(magic[1], MAGIC_LEN);
5791   aStream.Position := StreamPos;
5792   if (magic <> PNG_MAGIC) then begin
5793     result := false;
5794     exit;
5795   end;
5796
5797   intf   := TLazIntfImage.Create(0, 0);
5798   reader := TLazReaderPNG.Create;
5799   try try
5800     reader.UpdateDescription := true;
5801     reader.ImageRead(aStream, intf);
5802     AssignFromLazIntfImage(intf);
5803   except
5804     result := false;
5805     aStream.Position := StreamPos;
5806     exit;
5807   end;
5808   finally
5809     reader.Free;
5810     intf.Free;
5811   end;
5812 end;
5813
5814 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5816 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5817 var
5818   Surface: PSDL_Surface;
5819   RWops: PSDL_RWops;
5820 begin
5821   result := false;
5822   RWops := glBitmapCreateRWops(aStream);
5823   try
5824     if IMG_isPNG(RWops) > 0 then begin
5825       Surface := IMG_LoadPNG_RW(RWops);
5826       try
5827         AssignFromSurface(Surface);
5828         result := true;
5829       finally
5830         SDL_FreeSurface(Surface);
5831       end;
5832     end;
5833   finally
5834     SDL_FreeRW(RWops);
5835   end;
5836 end;
5837
5838 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5840 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5841 begin
5842   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5843 end;
5844
5845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5846 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5847 var
5848   StreamPos: Int64;
5849   signature: array [0..7] of byte;
5850   png: png_structp;
5851   png_info: png_infop;
5852
5853   TempHeight, TempWidth: Integer;
5854   Format: TglBitmapFormat;
5855
5856   png_data: pByte;
5857   png_rows: array of pByte;
5858   Row, LineSize: Integer;
5859 begin
5860   result := false;
5861
5862   if not init_libPNG then
5863     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5864
5865   try
5866     // signature
5867     StreamPos := aStream.Position;
5868     aStream.Read(signature{%H-}, 8);
5869     aStream.Position := StreamPos;
5870
5871     if png_check_sig(@signature, 8) <> 0 then begin
5872       // png read struct
5873       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5874       if png = nil then
5875         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5876
5877       // png info
5878       png_info := png_create_info_struct(png);
5879       if png_info = nil then begin
5880         png_destroy_read_struct(@png, nil, nil);
5881         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5882       end;
5883
5884       // set read callback
5885       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5886
5887       // read informations
5888       png_read_info(png, png_info);
5889
5890       // size
5891       TempHeight := png_get_image_height(png, png_info);
5892       TempWidth := png_get_image_width(png, png_info);
5893
5894       // format
5895       case png_get_color_type(png, png_info) of
5896         PNG_COLOR_TYPE_GRAY:
5897           Format := tfLuminance8;
5898         PNG_COLOR_TYPE_GRAY_ALPHA:
5899           Format := tfLuminance8Alpha8;
5900         PNG_COLOR_TYPE_RGB:
5901           Format := tfRGB8;
5902         PNG_COLOR_TYPE_RGB_ALPHA:
5903           Format := tfRGBA8;
5904         else
5905           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5906       end;
5907
5908       // cut upper 8 bit from 16 bit formats
5909       if png_get_bit_depth(png, png_info) > 8 then
5910         png_set_strip_16(png);
5911
5912       // expand bitdepth smaller than 8
5913       if png_get_bit_depth(png, png_info) < 8 then
5914         png_set_expand(png);
5915
5916       // allocating mem for scanlines
5917       LineSize := png_get_rowbytes(png, png_info);
5918       GetMem(png_data, TempHeight * LineSize);
5919       try
5920         SetLength(png_rows, TempHeight);
5921         for Row := Low(png_rows) to High(png_rows) do begin
5922           png_rows[Row] := png_data;
5923           Inc(png_rows[Row], Row * LineSize);
5924         end;
5925
5926         // read complete image into scanlines
5927         png_read_image(png, @png_rows[0]);
5928
5929         // read end
5930         png_read_end(png, png_info);
5931
5932         // destroy read struct
5933         png_destroy_read_struct(@png, @png_info, nil);
5934
5935         SetLength(png_rows, 0);
5936
5937         // set new data
5938         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5939
5940         result := true;
5941       except
5942         if Assigned(png_data) then
5943           FreeMem(png_data);
5944         raise;
5945       end;
5946     end;
5947   finally
5948     quit_libPNG;
5949   end;
5950 end;
5951
5952 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5953 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5954 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5955 var
5956   StreamPos: Int64;
5957   Png: TPNGObject;
5958   Header: String[8];
5959   Row, Col, PixSize, LineSize: Integer;
5960   NewImage, pSource, pDest, pAlpha: pByte;
5961   PngFormat: TglBitmapFormat;
5962   FormatDesc: TFormatDescriptor;
5963
5964 const
5965   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5966
5967 begin
5968   result := false;
5969
5970   StreamPos := aStream.Position;
5971   aStream.Read(Header[0], SizeOf(Header));
5972   aStream.Position := StreamPos;
5973
5974   {Test if the header matches}
5975   if Header = PngHeader then begin
5976     Png := TPNGObject.Create;
5977     try
5978       Png.LoadFromStream(aStream);
5979
5980       case Png.Header.ColorType of
5981         COLOR_GRAYSCALE:
5982           PngFormat := tfLuminance8;
5983         COLOR_GRAYSCALEALPHA:
5984           PngFormat := tfLuminance8Alpha8;
5985         COLOR_RGB:
5986           PngFormat := tfBGR8;
5987         COLOR_RGBALPHA:
5988           PngFormat := tfBGRA8;
5989         else
5990           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5991       end;
5992
5993       FormatDesc := TFormatDescriptor.Get(PngFormat);
5994       PixSize    := Round(FormatDesc.PixelSize);
5995       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5996
5997       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5998       try
5999         pDest := NewImage;
6000
6001         case Png.Header.ColorType of
6002           COLOR_RGB, COLOR_GRAYSCALE:
6003             begin
6004               for Row := 0 to Png.Height -1 do begin
6005                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6006                 Inc(pDest, LineSize);
6007               end;
6008             end;
6009           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6010             begin
6011               PixSize := PixSize -1;
6012
6013               for Row := 0 to Png.Height -1 do begin
6014                 pSource := Png.Scanline[Row];
6015                 pAlpha := pByte(Png.AlphaScanline[Row]);
6016
6017                 for Col := 0 to Png.Width -1 do begin
6018                   Move (pSource^, pDest^, PixSize);
6019                   Inc(pSource, PixSize);
6020                   Inc(pDest, PixSize);
6021
6022                   pDest^ := pAlpha^;
6023                   inc(pAlpha);
6024                   Inc(pDest);
6025                 end;
6026               end;
6027             end;
6028           else
6029             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6030         end;
6031
6032         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6033
6034         result := true;
6035       except
6036         if Assigned(NewImage) then
6037           FreeMem(NewImage);
6038         raise;
6039       end;
6040     finally
6041       Png.Free;
6042     end;
6043   end;
6044 end;
6045 {$IFEND}
6046 {$ENDIF}
6047
6048 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6049 {$IFDEF GLB_LIB_PNG}
6050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6051 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6052 begin
6053   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6054 end;
6055 {$ENDIF}
6056
6057 {$IF DEFINED(GLB_LAZ_PNG)}
6058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6059 procedure TglBitmap.SavePNG(const aStream: TStream);
6060 var
6061   png: TPortableNetworkGraphic;
6062   intf: TLazIntfImage;
6063   raw: TRawImage;
6064 begin
6065   png  := TPortableNetworkGraphic.Create;
6066   intf := TLazIntfImage.Create(0, 0);
6067   try
6068     if not AssignToLazIntfImage(intf) then
6069       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6070     intf.GetRawImage(raw);
6071     png.LoadFromRawImage(raw, false);
6072     png.SaveToStream(aStream);
6073   finally
6074     png.Free;
6075     intf.Free;
6076   end;
6077 end;
6078
6079 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 procedure TglBitmap.SavePNG(const aStream: TStream);
6082 var
6083   png: png_structp;
6084   png_info: png_infop;
6085   png_rows: array of pByte;
6086   LineSize: Integer;
6087   ColorType: Integer;
6088   Row: Integer;
6089   FormatDesc: TFormatDescriptor;
6090 begin
6091   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6092     raise EglBitmapUnsupportedFormat.Create(Format);
6093
6094   if not init_libPNG then
6095     raise Exception.Create('unable to initialize libPNG.');
6096
6097   try
6098     case Format of
6099       tfAlpha8, tfLuminance8:
6100         ColorType := PNG_COLOR_TYPE_GRAY;
6101       tfLuminance8Alpha8:
6102         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6103       tfBGR8, tfRGB8:
6104         ColorType := PNG_COLOR_TYPE_RGB;
6105       tfBGRA8, tfRGBA8:
6106         ColorType := PNG_COLOR_TYPE_RGBA;
6107       else
6108         raise EglBitmapUnsupportedFormat.Create(Format);
6109     end;
6110
6111     FormatDesc := TFormatDescriptor.Get(Format);
6112     LineSize := FormatDesc.GetSize(Width, 1);
6113
6114     // creating array for scanline
6115     SetLength(png_rows, Height);
6116     try
6117       for Row := 0 to Height - 1 do begin
6118         png_rows[Row] := Data;
6119         Inc(png_rows[Row], Row * LineSize)
6120       end;
6121
6122       // write struct
6123       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6124       if png = nil then
6125         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6126
6127       // create png info
6128       png_info := png_create_info_struct(png);
6129       if png_info = nil then begin
6130         png_destroy_write_struct(@png, nil);
6131         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6132       end;
6133
6134       // set read callback
6135       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6136
6137       // set compression
6138       png_set_compression_level(png, 6);
6139
6140       if Format in [tfBGR8, tfBGRA8] then
6141         png_set_bgr(png);
6142
6143       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6144       png_write_info(png, png_info);
6145       png_write_image(png, @png_rows[0]);
6146       png_write_end(png, png_info);
6147       png_destroy_write_struct(@png, @png_info);
6148     finally
6149       SetLength(png_rows, 0);
6150     end;
6151   finally
6152     quit_libPNG;
6153   end;
6154 end;
6155
6156 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6158 procedure TglBitmap.SavePNG(const aStream: TStream);
6159 var
6160   Png: TPNGObject;
6161
6162   pSource, pDest: pByte;
6163   X, Y, PixSize: Integer;
6164   ColorType: Cardinal;
6165   Alpha: Boolean;
6166
6167   pTemp: pByte;
6168   Temp: Byte;
6169 begin
6170   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6171     raise EglBitmapUnsupportedFormat.Create(Format);
6172
6173   case Format of
6174     tfAlpha8, tfLuminance8: begin
6175       ColorType := COLOR_GRAYSCALE;
6176       PixSize   := 1;
6177       Alpha     := false;
6178     end;
6179     tfLuminance8Alpha8: begin
6180       ColorType := COLOR_GRAYSCALEALPHA;
6181       PixSize   := 1;
6182       Alpha     := true;
6183     end;
6184     tfBGR8, tfRGB8: begin
6185       ColorType := COLOR_RGB;
6186       PixSize   := 3;
6187       Alpha     := false;
6188     end;
6189     tfBGRA8, tfRGBA8: begin
6190       ColorType := COLOR_RGBALPHA;
6191       PixSize   := 3;
6192       Alpha     := true
6193     end;
6194   else
6195     raise EglBitmapUnsupportedFormat.Create(Format);
6196   end;
6197
6198   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6199   try
6200     // Copy ImageData
6201     pSource := Data;
6202     for Y := 0 to Height -1 do begin
6203       pDest := png.ScanLine[Y];
6204       for X := 0 to Width -1 do begin
6205         Move(pSource^, pDest^, PixSize);
6206         Inc(pDest, PixSize);
6207         Inc(pSource, PixSize);
6208         if Alpha then begin
6209           png.AlphaScanline[Y]^[X] := pSource^;
6210           Inc(pSource);
6211         end;
6212       end;
6213
6214       // convert RGB line to BGR
6215       if Format in [tfRGB8, tfRGBA8] then begin
6216         pTemp := png.ScanLine[Y];
6217         for X := 0 to Width -1 do begin
6218           Temp := pByteArray(pTemp)^[0];
6219           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6220           pByteArray(pTemp)^[2] := Temp;
6221           Inc(pTemp, 3);
6222         end;
6223       end;
6224     end;
6225
6226     // Save to Stream
6227     Png.CompressionLevel := 6;
6228     Png.SaveToStream(aStream);
6229   finally
6230     FreeAndNil(Png);
6231   end;
6232 end;
6233 {$IFEND}
6234 {$ENDIF}
6235
6236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6237 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6239 {$IFDEF GLB_LIB_JPEG}
6240 type
6241   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6242   glBitmap_libJPEG_source_mgr = record
6243     pub: jpeg_source_mgr;
6244
6245     SrcStream: TStream;
6246     SrcBuffer: array [1..4096] of byte;
6247   end;
6248
6249   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6250   glBitmap_libJPEG_dest_mgr = record
6251     pub: jpeg_destination_mgr;
6252
6253     DestStream: TStream;
6254     DestBuffer: array [1..4096] of byte;
6255   end;
6256
6257 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6258 begin
6259   //DUMMY
6260 end;
6261
6262
6263 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6264 begin
6265   //DUMMY
6266 end;
6267
6268
6269 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6270 begin
6271   //DUMMY
6272 end;
6273
6274 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6275 begin
6276   //DUMMY
6277 end;
6278
6279
6280 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6281 begin
6282   //DUMMY
6283 end;
6284
6285
6286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6287 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6288 var
6289   src: glBitmap_libJPEG_source_mgr_ptr;
6290   bytes: integer;
6291 begin
6292   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6293
6294   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6295         if (bytes <= 0) then begin
6296                 src^.SrcBuffer[1] := $FF;
6297                 src^.SrcBuffer[2] := JPEG_EOI;
6298                 bytes := 2;
6299         end;
6300
6301         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6302         src^.pub.bytes_in_buffer := bytes;
6303
6304   result := true;
6305 end;
6306
6307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6308 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6309 var
6310   src: glBitmap_libJPEG_source_mgr_ptr;
6311 begin
6312   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6313
6314   if num_bytes > 0 then begin
6315     // wanted byte isn't in buffer so set stream position and read buffer
6316     if num_bytes > src^.pub.bytes_in_buffer then begin
6317       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6318       src^.pub.fill_input_buffer(cinfo);
6319     end else begin
6320       // wanted byte is in buffer so only skip
6321                 inc(src^.pub.next_input_byte, num_bytes);
6322                 dec(src^.pub.bytes_in_buffer, num_bytes);
6323     end;
6324   end;
6325 end;
6326
6327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6328 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6329 var
6330   dest: glBitmap_libJPEG_dest_mgr_ptr;
6331 begin
6332   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6333
6334   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6335     // write complete buffer
6336     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6337
6338     // reset buffer
6339     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6340     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6341   end;
6342
6343   result := true;
6344 end;
6345
6346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6347 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6348 var
6349   Idx: Integer;
6350   dest: glBitmap_libJPEG_dest_mgr_ptr;
6351 begin
6352   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6353
6354   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6355     // check for endblock
6356     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6357       // write endblock
6358       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6359
6360       // leave
6361       break;
6362     end else
6363       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6364   end;
6365 end;
6366 {$ENDIF}
6367
6368 {$IFDEF GLB_SUPPORT_JPEG_READ}
6369 {$IF DEFINED(GLB_LAZ_JPEG)}
6370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6371 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6372 const
6373   MAGIC_LEN = 2;
6374   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6375 var
6376   intf: TLazIntfImage;
6377   reader: TFPReaderJPEG;
6378   StreamPos: Int64;
6379   magic: String[MAGIC_LEN];
6380 begin
6381   result := true;
6382   StreamPos := aStream.Position;
6383
6384   SetLength(magic, MAGIC_LEN);
6385   aStream.Read(magic[1], MAGIC_LEN);
6386   aStream.Position := StreamPos;
6387   if (magic <> JPEG_MAGIC) then begin
6388     result := false;
6389     exit;
6390   end;
6391
6392   reader := TFPReaderJPEG.Create;
6393   intf := TLazIntfImage.Create(0, 0);
6394   try try
6395     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6396     reader.ImageRead(aStream, intf);
6397     AssignFromLazIntfImage(intf);
6398   except
6399     result := false;
6400     aStream.Position := StreamPos;
6401     exit;
6402   end;
6403   finally
6404     reader.Free;
6405     intf.Free;
6406   end;
6407 end;
6408
6409 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6411 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6412 var
6413   Surface: PSDL_Surface;
6414   RWops: PSDL_RWops;
6415 begin
6416   result := false;
6417
6418   RWops := glBitmapCreateRWops(aStream);
6419   try
6420     if IMG_isJPG(RWops) > 0 then begin
6421       Surface := IMG_LoadJPG_RW(RWops);
6422       try
6423         AssignFromSurface(Surface);
6424         result := true;
6425       finally
6426         SDL_FreeSurface(Surface);
6427       end;
6428     end;
6429   finally
6430     SDL_FreeRW(RWops);
6431   end;
6432 end;
6433
6434 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6436 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6437 var
6438   StreamPos: Int64;
6439   Temp: array[0..1]of Byte;
6440
6441   jpeg: jpeg_decompress_struct;
6442   jpeg_err: jpeg_error_mgr;
6443
6444   IntFormat: TglBitmapFormat;
6445   pImage: pByte;
6446   TempHeight, TempWidth: Integer;
6447
6448   pTemp: pByte;
6449   Row: Integer;
6450
6451   FormatDesc: TFormatDescriptor;
6452 begin
6453   result := false;
6454
6455   if not init_libJPEG then
6456     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6457
6458   try
6459     // reading first two bytes to test file and set cursor back to begin
6460     StreamPos := aStream.Position;
6461     aStream.Read({%H-}Temp[0], 2);
6462     aStream.Position := StreamPos;
6463
6464     // if Bitmap then read file.
6465     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6466       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6467       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6468
6469       // error managment
6470       jpeg.err := jpeg_std_error(@jpeg_err);
6471       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6472       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6473
6474       // decompression struct
6475       jpeg_create_decompress(@jpeg);
6476
6477       // allocation space for streaming methods
6478       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6479
6480       // seeting up custom functions
6481       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6482         pub.init_source       := glBitmap_libJPEG_init_source;
6483         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6484         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6485         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6486         pub.term_source       := glBitmap_libJPEG_term_source;
6487
6488         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6489         pub.next_input_byte := nil;   // until buffer loaded
6490
6491         SrcStream := aStream;
6492       end;
6493
6494       // set global decoding state
6495       jpeg.global_state := DSTATE_START;
6496
6497       // read header of jpeg
6498       jpeg_read_header(@jpeg, false);
6499
6500       // setting output parameter
6501       case jpeg.jpeg_color_space of
6502         JCS_GRAYSCALE:
6503           begin
6504             jpeg.out_color_space := JCS_GRAYSCALE;
6505             IntFormat := tfLuminance8;
6506           end;
6507         else
6508           jpeg.out_color_space := JCS_RGB;
6509           IntFormat := tfRGB8;
6510       end;
6511
6512       // reading image
6513       jpeg_start_decompress(@jpeg);
6514
6515       TempHeight := jpeg.output_height;
6516       TempWidth := jpeg.output_width;
6517
6518       FormatDesc := TFormatDescriptor.Get(IntFormat);
6519
6520       // creating new image
6521       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6522       try
6523         pTemp := pImage;
6524
6525         for Row := 0 to TempHeight -1 do begin
6526           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6527           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6528         end;
6529
6530         // finish decompression
6531         jpeg_finish_decompress(@jpeg);
6532
6533         // destroy decompression
6534         jpeg_destroy_decompress(@jpeg);
6535
6536         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6537
6538         result := true;
6539       except
6540         if Assigned(pImage) then
6541           FreeMem(pImage);
6542         raise;
6543       end;
6544     end;
6545   finally
6546     quit_libJPEG;
6547   end;
6548 end;
6549
6550 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6552 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6553 var
6554   bmp: TBitmap;
6555   jpg: TJPEGImage;
6556   StreamPos: Int64;
6557   Temp: array[0..1]of Byte;
6558 begin
6559   result := false;
6560
6561   // reading first two bytes to test file and set cursor back to begin
6562   StreamPos := aStream.Position;
6563   aStream.Read(Temp[0], 2);
6564   aStream.Position := StreamPos;
6565
6566   // if Bitmap then read file.
6567   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6568     bmp := TBitmap.Create;
6569     try
6570       jpg := TJPEGImage.Create;
6571       try
6572         jpg.LoadFromStream(aStream);
6573         bmp.Assign(jpg);
6574         result := AssignFromBitmap(bmp);
6575       finally
6576         jpg.Free;
6577       end;
6578     finally
6579       bmp.Free;
6580     end;
6581   end;
6582 end;
6583 {$IFEND}
6584 {$ENDIF}
6585
6586 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6587 {$IF DEFINED(GLB_LAZ_JPEG)}
6588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6589 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6590 var
6591   jpeg: TJPEGImage;
6592   intf: TLazIntfImage;
6593   raw: TRawImage;
6594 begin
6595   jpeg := TJPEGImage.Create;
6596   intf := TLazIntfImage.Create(0, 0);
6597   try
6598     if not AssignToLazIntfImage(intf) then
6599       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6600     intf.GetRawImage(raw);
6601     jpeg.LoadFromRawImage(raw, false);
6602     jpeg.SaveToStream(aStream);
6603   finally
6604     intf.Free;
6605     jpeg.Free;
6606   end;
6607 end;
6608
6609 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6611 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6612 var
6613   jpeg: jpeg_compress_struct;
6614   jpeg_err: jpeg_error_mgr;
6615   Row: Integer;
6616   pTemp, pTemp2: pByte;
6617
6618   procedure CopyRow(pDest, pSource: pByte);
6619   var
6620     X: Integer;
6621   begin
6622     for X := 0 to Width - 1 do begin
6623       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6624       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6625       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6626       Inc(pDest, 3);
6627       Inc(pSource, 3);
6628     end;
6629   end;
6630
6631 begin
6632   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6633     raise EglBitmapUnsupportedFormat.Create(Format);
6634
6635   if not init_libJPEG then
6636     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6637
6638   try
6639     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6640     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6641
6642     // error managment
6643     jpeg.err := jpeg_std_error(@jpeg_err);
6644     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6645     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6646
6647     // compression struct
6648     jpeg_create_compress(@jpeg);
6649
6650     // allocation space for streaming methods
6651     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6652
6653     // seeting up custom functions
6654     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6655       pub.init_destination    := glBitmap_libJPEG_init_destination;
6656       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6657       pub.term_destination    := glBitmap_libJPEG_term_destination;
6658
6659       pub.next_output_byte  := @DestBuffer[1];
6660       pub.free_in_buffer    := Length(DestBuffer);
6661
6662       DestStream := aStream;
6663     end;
6664
6665     // very important state
6666     jpeg.global_state := CSTATE_START;
6667     jpeg.image_width  := Width;
6668     jpeg.image_height := Height;
6669     case Format of
6670       tfAlpha8, tfLuminance8: begin
6671         jpeg.input_components := 1;
6672         jpeg.in_color_space   := JCS_GRAYSCALE;
6673       end;
6674       tfRGB8, tfBGR8: begin
6675         jpeg.input_components := 3;
6676         jpeg.in_color_space   := JCS_RGB;
6677       end;
6678     end;
6679
6680     jpeg_set_defaults(@jpeg);
6681     jpeg_set_quality(@jpeg, 95, true);
6682     jpeg_start_compress(@jpeg, true);
6683     pTemp := Data;
6684
6685     if Format = tfBGR8 then
6686       GetMem(pTemp2, fRowSize)
6687     else
6688       pTemp2 := pTemp;
6689
6690     try
6691       for Row := 0 to jpeg.image_height -1 do begin
6692         // prepare row
6693         if Format = tfBGR8 then
6694           CopyRow(pTemp2, pTemp)
6695         else
6696           pTemp2 := pTemp;
6697
6698         // write row
6699         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6700         inc(pTemp, fRowSize);
6701       end;
6702     finally
6703       // free memory
6704       if Format = tfBGR8 then
6705         FreeMem(pTemp2);
6706     end;
6707     jpeg_finish_compress(@jpeg);
6708     jpeg_destroy_compress(@jpeg);
6709   finally
6710     quit_libJPEG;
6711   end;
6712 end;
6713
6714 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6716 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6717 var
6718   Bmp: TBitmap;
6719   Jpg: TJPEGImage;
6720 begin
6721   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6722     raise EglBitmapUnsupportedFormat.Create(Format);
6723
6724   Bmp := TBitmap.Create;
6725   try
6726     Jpg := TJPEGImage.Create;
6727     try
6728       AssignToBitmap(Bmp);
6729       if (Format in [tfAlpha8, tfLuminance8]) then begin
6730         Jpg.Grayscale   := true;
6731         Jpg.PixelFormat := jf8Bit;
6732       end;
6733       Jpg.Assign(Bmp);
6734       Jpg.SaveToStream(aStream);
6735     finally
6736       FreeAndNil(Jpg);
6737     end;
6738   finally
6739     FreeAndNil(Bmp);
6740   end;
6741 end;
6742 {$IFEND}
6743 {$ENDIF}
6744
6745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6746 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6748 const
6749   BMP_MAGIC          = $4D42;
6750
6751   BMP_COMP_RGB       = 0;
6752   BMP_COMP_RLE8      = 1;
6753   BMP_COMP_RLE4      = 2;
6754   BMP_COMP_BITFIELDS = 3;
6755
6756 type
6757   TBMPHeader = packed record
6758     bfType: Word;
6759     bfSize: Cardinal;
6760     bfReserved1: Word;
6761     bfReserved2: Word;
6762     bfOffBits: Cardinal;
6763   end;
6764
6765   TBMPInfo = packed record
6766     biSize: Cardinal;
6767     biWidth: Longint;
6768     biHeight: Longint;
6769     biPlanes: Word;
6770     biBitCount: Word;
6771     biCompression: Cardinal;
6772     biSizeImage: Cardinal;
6773     biXPelsPerMeter: Longint;
6774     biYPelsPerMeter: Longint;
6775     biClrUsed: Cardinal;
6776     biClrImportant: Cardinal;
6777   end;
6778
6779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6780 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6781
6782   //////////////////////////////////////////////////////////////////////////////////////////////////
6783   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6784   begin
6785     result := tfEmpty;
6786     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6787     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6788
6789     //Read Compression
6790     case aInfo.biCompression of
6791       BMP_COMP_RLE4,
6792       BMP_COMP_RLE8: begin
6793         raise EglBitmap.Create('RLE compression is not supported');
6794       end;
6795       BMP_COMP_BITFIELDS: begin
6796         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6797           aStream.Read(aMask.r, SizeOf(aMask.r));
6798           aStream.Read(aMask.g, SizeOf(aMask.g));
6799           aStream.Read(aMask.b, SizeOf(aMask.b));
6800           aStream.Read(aMask.a, SizeOf(aMask.a));
6801         end else
6802           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6803       end;
6804     end;
6805
6806     //get suitable format
6807     case aInfo.biBitCount of
6808        8: result := tfLuminance8;
6809       16: result := tfBGR5;
6810       24: result := tfBGR8;
6811       32: result := tfBGRA8;
6812     end;
6813   end;
6814
6815   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6816   var
6817     i, c: Integer;
6818     ColorTable: TbmpColorTable;
6819   begin
6820     result := nil;
6821     if (aInfo.biBitCount >= 16) then
6822       exit;
6823     aFormat := tfLuminance8;
6824     c := aInfo.biClrUsed;
6825     if (c = 0) then
6826       c := 1 shl aInfo.biBitCount;
6827     SetLength(ColorTable, c);
6828     for i := 0 to c-1 do begin
6829       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6830       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6831         aFormat := tfRGB8;
6832     end;
6833
6834     result := TbmpColorTableFormat.Create;
6835     result.PixelSize  := aInfo.biBitCount / 8;
6836     result.ColorTable := ColorTable;
6837     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6838   end;
6839
6840   //////////////////////////////////////////////////////////////////////////////////////////////////
6841   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6842     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6843   var
6844     TmpFormat: TglBitmapFormat;
6845     FormatDesc: TFormatDescriptor;
6846   begin
6847     result := nil;
6848     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6849       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6850         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6851         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6852           aFormat := FormatDesc.Format;
6853           exit;
6854         end;
6855       end;
6856
6857       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6858         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6859       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6860         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6861
6862       result := TbmpBitfieldFormat.Create;
6863       result.PixelSize := aInfo.biBitCount / 8;
6864       result.RedMask   := aMask.r;
6865       result.GreenMask := aMask.g;
6866       result.BlueMask  := aMask.b;
6867       result.AlphaMask := aMask.a;
6868     end;
6869   end;
6870
6871 var
6872   //simple types
6873   StartPos: Int64;
6874   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6875   PaddingBuff: Cardinal;
6876   LineBuf, ImageData, TmpData: PByte;
6877   SourceMD, DestMD: Pointer;
6878   BmpFormat: TglBitmapFormat;
6879
6880   //records
6881   Mask: TglBitmapColorRec;
6882   Header: TBMPHeader;
6883   Info: TBMPInfo;
6884
6885   //classes
6886   SpecialFormat: TFormatDescriptor;
6887   FormatDesc: TFormatDescriptor;
6888
6889   //////////////////////////////////////////////////////////////////////////////////////////////////
6890   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6891   var
6892     i: Integer;
6893     Pixel: TglBitmapPixelData;
6894   begin
6895     aStream.Read(aLineBuf^, rbLineSize);
6896     SpecialFormat.PreparePixel(Pixel);
6897     for i := 0 to Info.biWidth-1 do begin
6898       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6899       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6900       FormatDesc.Map(Pixel, aData, DestMD);
6901     end;
6902   end;
6903
6904 begin
6905   result        := false;
6906   BmpFormat     := tfEmpty;
6907   SpecialFormat := nil;
6908   LineBuf       := nil;
6909   SourceMD      := nil;
6910   DestMD        := nil;
6911
6912   // Header
6913   StartPos := aStream.Position;
6914   aStream.Read(Header{%H-}, SizeOf(Header));
6915
6916   if Header.bfType = BMP_MAGIC then begin
6917     try try
6918       BmpFormat        := ReadInfo(Info, Mask);
6919       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6920       if not Assigned(SpecialFormat) then
6921         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6922       aStream.Position := StartPos + Header.bfOffBits;
6923
6924       if (BmpFormat <> tfEmpty) then begin
6925         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6926         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6927         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6928         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6929
6930         //get Memory
6931         DestMD    := FormatDesc.CreateMappingData;
6932         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6933         GetMem(ImageData, ImageSize);
6934         if Assigned(SpecialFormat) then begin
6935           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6936           SourceMD := SpecialFormat.CreateMappingData;
6937         end;
6938
6939         //read Data
6940         try try
6941           FillChar(ImageData^, ImageSize, $FF);
6942           TmpData := ImageData;
6943           if (Info.biHeight > 0) then
6944             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6945           for i := 0 to Abs(Info.biHeight)-1 do begin
6946             if Assigned(SpecialFormat) then
6947               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6948             else
6949               aStream.Read(TmpData^, wbLineSize);   //else only read data
6950             if (Info.biHeight > 0) then
6951               dec(TmpData, wbLineSize)
6952             else
6953               inc(TmpData, wbLineSize);
6954             aStream.Read(PaddingBuff{%H-}, Padding);
6955           end;
6956           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6957           result := true;
6958         finally
6959           if Assigned(LineBuf) then
6960             FreeMem(LineBuf);
6961           if Assigned(SourceMD) then
6962             SpecialFormat.FreeMappingData(SourceMD);
6963           FormatDesc.FreeMappingData(DestMD);
6964         end;
6965         except
6966           if Assigned(ImageData) then
6967             FreeMem(ImageData);
6968           raise;
6969         end;
6970       end else
6971         raise EglBitmap.Create('LoadBMP - No suitable format found');
6972     except
6973       aStream.Position := StartPos;
6974       raise;
6975     end;
6976     finally
6977       FreeAndNil(SpecialFormat);
6978     end;
6979   end
6980     else aStream.Position := StartPos;
6981 end;
6982
6983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6984 procedure TglBitmap.SaveBMP(const aStream: TStream);
6985 var
6986   Header: TBMPHeader;
6987   Info: TBMPInfo;
6988   Converter: TFormatDescriptor;
6989   FormatDesc: TFormatDescriptor;
6990   SourceFD, DestFD: Pointer;
6991   pData, srcData, dstData, ConvertBuffer: pByte;
6992
6993   Pixel: TglBitmapPixelData;
6994   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6995   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6996
6997   PaddingBuff: Cardinal;
6998
6999   function GetLineWidth : Integer;
7000   begin
7001     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7002   end;
7003
7004 begin
7005   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7006     raise EglBitmapUnsupportedFormat.Create(Format);
7007
7008   Converter  := nil;
7009   FormatDesc := TFormatDescriptor.Get(Format);
7010   ImageSize  := FormatDesc.GetSize(Dimension);
7011
7012   FillChar(Header{%H-}, SizeOf(Header), 0);
7013   Header.bfType      := BMP_MAGIC;
7014   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7015   Header.bfReserved1 := 0;
7016   Header.bfReserved2 := 0;
7017   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7018
7019   FillChar(Info{%H-}, SizeOf(Info), 0);
7020   Info.biSize        := SizeOf(Info);
7021   Info.biWidth       := Width;
7022   Info.biHeight      := Height;
7023   Info.biPlanes      := 1;
7024   Info.biCompression := BMP_COMP_RGB;
7025   Info.biSizeImage   := ImageSize;
7026
7027   try
7028     case Format of
7029       tfLuminance4: begin
7030         Info.biBitCount  := 4;
7031         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7032         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7033         Converter := TbmpColorTableFormat.Create;
7034         with (Converter as TbmpColorTableFormat) do begin
7035           PixelSize := 0.5;
7036           Format    := Format;
7037           Range     := glBitmapColorRec($F, $F, $F, $0);
7038           CreateColorTable;
7039         end;
7040       end;
7041
7042       tfR3G3B2, tfLuminance8: begin
7043         Info.biBitCount  :=  8;
7044         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7045         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7046         Converter := TbmpColorTableFormat.Create;
7047         with (Converter as TbmpColorTableFormat) do begin
7048           PixelSize := 1;
7049           Format    := Format;
7050           if (Format = tfR3G3B2) then begin
7051             Range := glBitmapColorRec($7, $7, $3, $0);
7052             Shift := glBitmapShiftRec(0, 3, 6, 0);
7053           end else
7054             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7055           CreateColorTable;
7056         end;
7057       end;
7058
7059       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7060       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7061         Info.biBitCount    := 16;
7062         Info.biCompression := BMP_COMP_BITFIELDS;
7063       end;
7064
7065       tfBGR8, tfRGB8: begin
7066         Info.biBitCount := 24;
7067         if (Format = tfRGB8) then
7068           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7069       end;
7070
7071       tfRGB10, tfRGB10A2, tfRGBA8,
7072       tfBGR10, tfBGR10A2, tfBGRA8: begin
7073         Info.biBitCount    := 32;
7074         Info.biCompression := BMP_COMP_BITFIELDS;
7075       end;
7076     else
7077       raise EglBitmapUnsupportedFormat.Create(Format);
7078     end;
7079     Info.biXPelsPerMeter := 2835;
7080     Info.biYPelsPerMeter := 2835;
7081
7082     // prepare bitmasks
7083     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7084       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7085       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7086
7087       RedMask    := FormatDesc.RedMask;
7088       GreenMask  := FormatDesc.GreenMask;
7089       BlueMask   := FormatDesc.BlueMask;
7090       AlphaMask  := FormatDesc.AlphaMask;
7091     end;
7092
7093     // headers
7094     aStream.Write(Header, SizeOf(Header));
7095     aStream.Write(Info, SizeOf(Info));
7096
7097     // colortable
7098     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7099       with (Converter as TbmpColorTableFormat) do
7100         aStream.Write(ColorTable[0].b,
7101           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7102
7103     // bitmasks
7104     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7105       aStream.Write(RedMask,   SizeOf(Cardinal));
7106       aStream.Write(GreenMask, SizeOf(Cardinal));
7107       aStream.Write(BlueMask,  SizeOf(Cardinal));
7108       aStream.Write(AlphaMask, SizeOf(Cardinal));
7109     end;
7110
7111     // image data
7112     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7113     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7114     Padding     := GetLineWidth - wbLineSize;
7115     PaddingBuff := 0;
7116
7117     pData := Data;
7118     inc(pData, (Height-1) * rbLineSize);
7119
7120     // prepare row buffer. But only for RGB because RGBA supports color masks
7121     // so it's possible to change color within the image.
7122     if Assigned(Converter) then begin
7123       FormatDesc.PreparePixel(Pixel);
7124       GetMem(ConvertBuffer, wbLineSize);
7125       SourceFD := FormatDesc.CreateMappingData;
7126       DestFD   := Converter.CreateMappingData;
7127     end else
7128       ConvertBuffer := nil;
7129
7130     try
7131       for LineIdx := 0 to Height - 1 do begin
7132         // preparing row
7133         if Assigned(Converter) then begin
7134           srcData := pData;
7135           dstData := ConvertBuffer;
7136           for PixelIdx := 0 to Info.biWidth-1 do begin
7137             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7138             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7139             Converter.Map(Pixel, dstData, DestFD);
7140           end;
7141           aStream.Write(ConvertBuffer^, wbLineSize);
7142         end else begin
7143           aStream.Write(pData^, rbLineSize);
7144         end;
7145         dec(pData, rbLineSize);
7146         if (Padding > 0) then
7147           aStream.Write(PaddingBuff, Padding);
7148       end;
7149     finally
7150       // destroy row buffer
7151       if Assigned(ConvertBuffer) then begin
7152         FormatDesc.FreeMappingData(SourceFD);
7153         Converter.FreeMappingData(DestFD);
7154         FreeMem(ConvertBuffer);
7155       end;
7156     end;
7157   finally
7158     if Assigned(Converter) then
7159       Converter.Free;
7160   end;
7161 end;
7162
7163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7164 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7166 type
7167   TTGAHeader = packed record
7168     ImageID: Byte;
7169     ColorMapType: Byte;
7170     ImageType: Byte;
7171     //ColorMapSpec: Array[0..4] of Byte;
7172     ColorMapStart: Word;
7173     ColorMapLength: Word;
7174     ColorMapEntrySize: Byte;
7175     OrigX: Word;
7176     OrigY: Word;
7177     Width: Word;
7178     Height: Word;
7179     Bpp: Byte;
7180     ImageDesc: Byte;
7181   end;
7182
7183 const
7184   TGA_UNCOMPRESSED_RGB  =  2;
7185   TGA_UNCOMPRESSED_GRAY =  3;
7186   TGA_COMPRESSED_RGB    = 10;
7187   TGA_COMPRESSED_GRAY   = 11;
7188
7189   TGA_NONE_COLOR_TABLE  = 0;
7190
7191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7192 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7193 var
7194   Header: TTGAHeader;
7195   ImageData: System.PByte;
7196   StartPosition: Int64;
7197   PixelSize, LineSize: Integer;
7198   tgaFormat: TglBitmapFormat;
7199   FormatDesc: TFormatDescriptor;
7200   Counter: packed record
7201     X, Y: packed record
7202       low, high, dir: Integer;
7203     end;
7204   end;
7205
7206 const
7207   CACHE_SIZE = $4000;
7208
7209   ////////////////////////////////////////////////////////////////////////////////////////
7210   procedure ReadUncompressed;
7211   var
7212     i, j: Integer;
7213     buf, tmp1, tmp2: System.PByte;
7214   begin
7215     buf := nil;
7216     if (Counter.X.dir < 0) then
7217       GetMem(buf, LineSize);
7218     try
7219       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7220         tmp1 := ImageData;
7221         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7222         if (Counter.X.dir < 0) then begin               //flip X
7223           aStream.Read(buf^, LineSize);
7224           tmp2 := buf;
7225           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7226           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7227             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7228               tmp1^ := tmp2^;
7229               inc(tmp1);
7230               inc(tmp2);
7231             end;
7232             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7233           end;
7234         end else
7235           aStream.Read(tmp1^, LineSize);
7236         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7237       end;
7238     finally
7239       if Assigned(buf) then
7240         FreeMem(buf);
7241     end;
7242   end;
7243
7244   ////////////////////////////////////////////////////////////////////////////////////////
7245   procedure ReadCompressed;
7246
7247     /////////////////////////////////////////////////////////////////
7248     var
7249       TmpData: System.PByte;
7250       LinePixelsRead: Integer;
7251     procedure CheckLine;
7252     begin
7253       if (LinePixelsRead >= Header.Width) then begin
7254         LinePixelsRead := 0;
7255         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7256         TmpData := ImageData;
7257         inc(TmpData, Counter.Y.low * LineSize);           //set line
7258         if (Counter.X.dir < 0) then                       //if x flipped then
7259           inc(TmpData, LineSize - PixelSize);             //set last pixel
7260       end;
7261     end;
7262
7263     /////////////////////////////////////////////////////////////////
7264     var
7265       Cache: PByte;
7266       CacheSize, CachePos: Integer;
7267     procedure CachedRead(out Buffer; Count: Integer);
7268     var
7269       BytesRead: Integer;
7270     begin
7271       if (CachePos + Count > CacheSize) then begin
7272         //if buffer overflow save non read bytes
7273         BytesRead := 0;
7274         if (CacheSize - CachePos > 0) then begin
7275           BytesRead := CacheSize - CachePos;
7276           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7277           inc(CachePos, BytesRead);
7278         end;
7279
7280         //load cache from file
7281         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7282         aStream.Read(Cache^, CacheSize);
7283         CachePos := 0;
7284
7285         //read rest of requested bytes
7286         if (Count - BytesRead > 0) then begin
7287           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7288           inc(CachePos, Count - BytesRead);
7289         end;
7290       end else begin
7291         //if no buffer overflow just read the data
7292         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7293         inc(CachePos, Count);
7294       end;
7295     end;
7296
7297     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7298     begin
7299       case PixelSize of
7300         1: begin
7301           aBuffer^ := aData^;
7302           inc(aBuffer, Counter.X.dir);
7303         end;
7304         2: begin
7305           PWord(aBuffer)^ := PWord(aData)^;
7306           inc(aBuffer, 2 * Counter.X.dir);
7307         end;
7308         3: begin
7309           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7310           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7311           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7312           inc(aBuffer, 3 * Counter.X.dir);
7313         end;
7314         4: begin
7315           PCardinal(aBuffer)^ := PCardinal(aData)^;
7316           inc(aBuffer, 4 * Counter.X.dir);
7317         end;
7318       end;
7319     end;
7320
7321   var
7322     TotalPixelsToRead, TotalPixelsRead: Integer;
7323     Temp: Byte;
7324     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7325     PixelRepeat: Boolean;
7326     PixelsToRead, PixelCount: Integer;
7327   begin
7328     CacheSize := 0;
7329     CachePos  := 0;
7330
7331     TotalPixelsToRead := Header.Width * Header.Height;
7332     TotalPixelsRead   := 0;
7333     LinePixelsRead    := 0;
7334
7335     GetMem(Cache, CACHE_SIZE);
7336     try
7337       TmpData := ImageData;
7338       inc(TmpData, Counter.Y.low * LineSize);           //set line
7339       if (Counter.X.dir < 0) then                       //if x flipped then
7340         inc(TmpData, LineSize - PixelSize);             //set last pixel
7341
7342       repeat
7343         //read CommandByte
7344         CachedRead(Temp, 1);
7345         PixelRepeat  := (Temp and $80) > 0;
7346         PixelsToRead := (Temp and $7F) + 1;
7347         inc(TotalPixelsRead, PixelsToRead);
7348
7349         if PixelRepeat then
7350           CachedRead(buf[0], PixelSize);
7351         while (PixelsToRead > 0) do begin
7352           CheckLine;
7353           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7354           while (PixelCount > 0) do begin
7355             if not PixelRepeat then
7356               CachedRead(buf[0], PixelSize);
7357             PixelToBuffer(@buf[0], TmpData);
7358             inc(LinePixelsRead);
7359             dec(PixelsToRead);
7360             dec(PixelCount);
7361           end;
7362         end;
7363       until (TotalPixelsRead >= TotalPixelsToRead);
7364     finally
7365       FreeMem(Cache);
7366     end;
7367   end;
7368
7369   function IsGrayFormat: Boolean;
7370   begin
7371     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7372   end;
7373
7374 begin
7375   result := false;
7376
7377   // reading header to test file and set cursor back to begin
7378   StartPosition := aStream.Position;
7379   aStream.Read(Header{%H-}, SizeOf(Header));
7380
7381   // no colormapped files
7382   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7383     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7384   begin
7385     try
7386       if Header.ImageID <> 0 then       // skip image ID
7387         aStream.Position := aStream.Position + Header.ImageID;
7388
7389       tgaFormat := tfEmpty;
7390       case Header.Bpp of
7391          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7392                0: tgaFormat := tfLuminance8;
7393                8: tgaFormat := tfAlpha8;
7394             end;
7395
7396         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7397                0: tgaFormat := tfLuminance16;
7398                8: tgaFormat := tfLuminance8Alpha8;
7399             end else case (Header.ImageDesc and $F) of
7400                0: tgaFormat := tfBGR5;
7401                1: tgaFormat := tfBGR5A1;
7402                4: tgaFormat := tfBGRA4;
7403             end;
7404
7405         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7406                0: tgaFormat := tfBGR8;
7407             end;
7408
7409         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7410                2: tgaFormat := tfBGR10A2;
7411                8: tgaFormat := tfBGRA8;
7412             end;
7413       end;
7414
7415       if (tgaFormat = tfEmpty) then
7416         raise EglBitmap.Create('LoadTga - unsupported format');
7417
7418       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7419       PixelSize  := FormatDesc.GetSize(1, 1);
7420       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7421
7422       GetMem(ImageData, LineSize * Header.Height);
7423       try
7424         //column direction
7425         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7426           Counter.X.low  := Header.Height-1;;
7427           Counter.X.high := 0;
7428           Counter.X.dir  := -1;
7429         end else begin
7430           Counter.X.low  := 0;
7431           Counter.X.high := Header.Height-1;
7432           Counter.X.dir  := 1;
7433         end;
7434
7435         // Row direction
7436         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7437           Counter.Y.low  := 0;
7438           Counter.Y.high := Header.Height-1;
7439           Counter.Y.dir  := 1;
7440         end else begin
7441           Counter.Y.low  := Header.Height-1;;
7442           Counter.Y.high := 0;
7443           Counter.Y.dir  := -1;
7444         end;
7445
7446         // Read Image
7447         case Header.ImageType of
7448           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7449             ReadUncompressed;
7450           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7451             ReadCompressed;
7452         end;
7453
7454         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7455         result := true;
7456       except
7457         if Assigned(ImageData) then
7458           FreeMem(ImageData);
7459         raise;
7460       end;
7461     finally
7462       aStream.Position := StartPosition;
7463     end;
7464   end
7465     else aStream.Position := StartPosition;
7466 end;
7467
7468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7469 procedure TglBitmap.SaveTGA(const aStream: TStream);
7470 var
7471   Header: TTGAHeader;
7472   LineSize, Size, x, y: Integer;
7473   Pixel: TglBitmapPixelData;
7474   LineBuf, SourceData, DestData: PByte;
7475   SourceMD, DestMD: Pointer;
7476   FormatDesc: TFormatDescriptor;
7477   Converter: TFormatDescriptor;
7478 begin
7479   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7480     raise EglBitmapUnsupportedFormat.Create(Format);
7481
7482   //prepare header
7483   FillChar(Header{%H-}, SizeOf(Header), 0);
7484
7485   //set ImageType
7486   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7487                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7488     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7489   else
7490     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7491
7492   //set BitsPerPixel
7493   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7494     Header.Bpp := 8
7495   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7496                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7497     Header.Bpp := 16
7498   else if (Format in [tfBGR8, tfRGB8]) then
7499     Header.Bpp := 24
7500   else
7501     Header.Bpp := 32;
7502
7503   //set AlphaBitCount
7504   case Format of
7505     tfRGB5A1, tfBGR5A1:
7506       Header.ImageDesc := 1 and $F;
7507     tfRGB10A2, tfBGR10A2:
7508       Header.ImageDesc := 2 and $F;
7509     tfRGBA4, tfBGRA4:
7510       Header.ImageDesc := 4 and $F;
7511     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7512       Header.ImageDesc := 8 and $F;
7513   end;
7514
7515   Header.Width     := Width;
7516   Header.Height    := Height;
7517   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7518   aStream.Write(Header, SizeOf(Header));
7519
7520   // convert RGB(A) to BGR(A)
7521   Converter  := nil;
7522   FormatDesc := TFormatDescriptor.Get(Format);
7523   Size       := FormatDesc.GetSize(Dimension);
7524   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7525     if (FormatDesc.RGBInverted = tfEmpty) then
7526       raise EglBitmap.Create('inverted RGB format is empty');
7527     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7528     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7529        (Converter.PixelSize <> FormatDesc.PixelSize) then
7530       raise EglBitmap.Create('invalid inverted RGB format');
7531   end;
7532
7533   if Assigned(Converter) then begin
7534     LineSize := FormatDesc.GetSize(Width, 1);
7535     GetMem(LineBuf, LineSize);
7536     SourceMD := FormatDesc.CreateMappingData;
7537     DestMD   := Converter.CreateMappingData;
7538     try
7539       SourceData := Data;
7540       for y := 0 to Height-1 do begin
7541         DestData := LineBuf;
7542         for x := 0 to Width-1 do begin
7543           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7544           Converter.Map(Pixel, DestData, DestMD);
7545         end;
7546         aStream.Write(LineBuf^, LineSize);
7547       end;
7548     finally
7549       FreeMem(LineBuf);
7550       FormatDesc.FreeMappingData(SourceMD);
7551       FormatDesc.FreeMappingData(DestMD);
7552     end;
7553   end else
7554     aStream.Write(Data^, Size);
7555 end;
7556
7557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7558 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7560 const
7561   DDS_MAGIC: Cardinal         = $20534444;
7562
7563   // DDS_header.dwFlags
7564   DDSD_CAPS                   = $00000001;
7565   DDSD_HEIGHT                 = $00000002;
7566   DDSD_WIDTH                  = $00000004;
7567   DDSD_PIXELFORMAT            = $00001000;
7568
7569   // DDS_header.sPixelFormat.dwFlags
7570   DDPF_ALPHAPIXELS            = $00000001;
7571   DDPF_ALPHA                  = $00000002;
7572   DDPF_FOURCC                 = $00000004;
7573   DDPF_RGB                    = $00000040;
7574   DDPF_LUMINANCE              = $00020000;
7575
7576   // DDS_header.sCaps.dwCaps1
7577   DDSCAPS_TEXTURE             = $00001000;
7578
7579   // DDS_header.sCaps.dwCaps2
7580   DDSCAPS2_CUBEMAP            = $00000200;
7581
7582   D3DFMT_DXT1                 = $31545844;
7583   D3DFMT_DXT3                 = $33545844;
7584   D3DFMT_DXT5                 = $35545844;
7585
7586 type
7587   TDDSPixelFormat = packed record
7588     dwSize: Cardinal;
7589     dwFlags: Cardinal;
7590     dwFourCC: Cardinal;
7591     dwRGBBitCount: Cardinal;
7592     dwRBitMask: Cardinal;
7593     dwGBitMask: Cardinal;
7594     dwBBitMask: Cardinal;
7595     dwABitMask: Cardinal;
7596   end;
7597
7598   TDDSCaps = packed record
7599     dwCaps1: Cardinal;
7600     dwCaps2: Cardinal;
7601     dwDDSX: Cardinal;
7602     dwReserved: Cardinal;
7603   end;
7604
7605   TDDSHeader = packed record
7606     dwSize: Cardinal;
7607     dwFlags: Cardinal;
7608     dwHeight: Cardinal;
7609     dwWidth: Cardinal;
7610     dwPitchOrLinearSize: Cardinal;
7611     dwDepth: Cardinal;
7612     dwMipMapCount: Cardinal;
7613     dwReserved: array[0..10] of Cardinal;
7614     PixelFormat: TDDSPixelFormat;
7615     Caps: TDDSCaps;
7616     dwReserved2: Cardinal;
7617   end;
7618
7619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7620 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7621 var
7622   Header: TDDSHeader;
7623   Converter: TbmpBitfieldFormat;
7624
7625   function GetDDSFormat: TglBitmapFormat;
7626   var
7627     fd: TFormatDescriptor;
7628     i: Integer;
7629     Range: TglBitmapColorRec;
7630     match: Boolean;
7631   begin
7632     result := tfEmpty;
7633     with Header.PixelFormat do begin
7634       // Compresses
7635       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7636         case Header.PixelFormat.dwFourCC of
7637           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7638           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7639           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7640         end;
7641       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7642
7643         //find matching format
7644         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7645           fd := TFormatDescriptor.Get(result);
7646           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7647              (8 * fd.PixelSize = dwRGBBitCount) then
7648             exit;
7649         end;
7650
7651         //find format with same Range
7652         Range.r := dwRBitMask;
7653         Range.g := dwGBitMask;
7654         Range.b := dwBBitMask;
7655         Range.a := dwABitMask;
7656         for i := 0 to 3 do begin
7657           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7658             Range.arr[i] := Range.arr[i] shr 1;
7659         end;
7660         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7661           fd := TFormatDescriptor.Get(result);
7662           match := true;
7663           for i := 0 to 3 do
7664             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7665               match := false;
7666               break;
7667             end;
7668           if match then
7669             break;
7670         end;
7671
7672         //no format with same range found -> use default
7673         if (result = tfEmpty) then begin
7674           if (dwABitMask > 0) then
7675             result := tfBGRA8
7676           else
7677             result := tfBGR8;
7678         end;
7679
7680         Converter := TbmpBitfieldFormat.Create;
7681         Converter.RedMask   := dwRBitMask;
7682         Converter.GreenMask := dwGBitMask;
7683         Converter.BlueMask  := dwBBitMask;
7684         Converter.AlphaMask := dwABitMask;
7685         Converter.PixelSize := dwRGBBitCount / 8;
7686       end;
7687     end;
7688   end;
7689
7690 var
7691   StreamPos: Int64;
7692   x, y, LineSize, RowSize, Magic: Cardinal;
7693   NewImage, TmpData, RowData, SrcData: System.PByte;
7694   SourceMD, DestMD: Pointer;
7695   Pixel: TglBitmapPixelData;
7696   ddsFormat: TglBitmapFormat;
7697   FormatDesc: TFormatDescriptor;
7698
7699 begin
7700   result    := false;
7701   Converter := nil;
7702   StreamPos := aStream.Position;
7703
7704   // Magic
7705   aStream.Read(Magic{%H-}, sizeof(Magic));
7706   if (Magic <> DDS_MAGIC) then begin
7707     aStream.Position := StreamPos;
7708     exit;
7709   end;
7710
7711   //Header
7712   aStream.Read(Header{%H-}, sizeof(Header));
7713   if (Header.dwSize <> SizeOf(Header)) or
7714      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7715         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7716   begin
7717     aStream.Position := StreamPos;
7718     exit;
7719   end;
7720
7721   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7722     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7723
7724   ddsFormat := GetDDSFormat;
7725   try
7726     if (ddsFormat = tfEmpty) then
7727       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7728
7729     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7730     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7731     GetMem(NewImage, Header.dwHeight * LineSize);
7732     try
7733       TmpData := NewImage;
7734
7735       //Converter needed
7736       if Assigned(Converter) then begin
7737         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7738         GetMem(RowData, RowSize);
7739         SourceMD := Converter.CreateMappingData;
7740         DestMD   := FormatDesc.CreateMappingData;
7741         try
7742           for y := 0 to Header.dwHeight-1 do begin
7743             TmpData := NewImage;
7744             inc(TmpData, y * LineSize);
7745             SrcData := RowData;
7746             aStream.Read(SrcData^, RowSize);
7747             for x := 0 to Header.dwWidth-1 do begin
7748               Converter.Unmap(SrcData, Pixel, SourceMD);
7749               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7750               FormatDesc.Map(Pixel, TmpData, DestMD);
7751             end;
7752           end;
7753         finally
7754           Converter.FreeMappingData(SourceMD);
7755           FormatDesc.FreeMappingData(DestMD);
7756           FreeMem(RowData);
7757         end;
7758       end else
7759
7760       // Compressed
7761       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7762         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7763         for Y := 0 to Header.dwHeight-1 do begin
7764           aStream.Read(TmpData^, RowSize);
7765           Inc(TmpData, LineSize);
7766         end;
7767       end else
7768
7769       // Uncompressed
7770       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7771         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7772         for Y := 0 to Header.dwHeight-1 do begin
7773           aStream.Read(TmpData^, RowSize);
7774           Inc(TmpData, LineSize);
7775         end;
7776       end else
7777         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7778
7779       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7780       result := true;
7781     except
7782       if Assigned(NewImage) then
7783         FreeMem(NewImage);
7784       raise;
7785     end;
7786   finally
7787     FreeAndNil(Converter);
7788   end;
7789 end;
7790
7791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7792 procedure TglBitmap.SaveDDS(const aStream: TStream);
7793 var
7794   Header: TDDSHeader;
7795   FormatDesc: TFormatDescriptor;
7796 begin
7797   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7798     raise EglBitmapUnsupportedFormat.Create(Format);
7799
7800   FormatDesc := TFormatDescriptor.Get(Format);
7801
7802   // Generell
7803   FillChar(Header{%H-}, SizeOf(Header), 0);
7804   Header.dwSize  := SizeOf(Header);
7805   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7806
7807   Header.dwWidth  := Max(1, Width);
7808   Header.dwHeight := Max(1, Height);
7809
7810   // Caps
7811   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7812
7813   // Pixelformat
7814   Header.PixelFormat.dwSize := sizeof(Header);
7815   if (FormatDesc.IsCompressed) then begin
7816     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7817     case Format of
7818       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7819       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7820       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7821     end;
7822   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7823     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7824     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7825     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7826   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7827     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7828     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7829     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7830     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7831   end else begin
7832     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7833     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7834     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7835     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7836     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7837     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7838   end;
7839
7840   if (FormatDesc.HasAlpha) then
7841     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7842
7843   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7844   aStream.Write(Header, SizeOf(Header));
7845   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7846 end;
7847
7848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7849 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7851 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7852   const aWidth: Integer; const aHeight: Integer);
7853 var
7854   pTemp: pByte;
7855   Size: Integer;
7856 begin
7857   if (aHeight > 1) then begin
7858     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7859     GetMem(pTemp, Size);
7860     try
7861       Move(aData^, pTemp^, Size);
7862       FreeMem(aData);
7863       aData := nil;
7864     except
7865       FreeMem(pTemp);
7866       raise;
7867     end;
7868   end else
7869     pTemp := aData;
7870   inherited SetDataPointer(pTemp, aFormat, aWidth);
7871 end;
7872
7873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7874 function TglBitmap1D.FlipHorz: Boolean;
7875 var
7876   Col: Integer;
7877   pTempDest, pDest, pSource: PByte;
7878 begin
7879   result := inherited FlipHorz;
7880   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7881     pSource := Data;
7882     GetMem(pDest, fRowSize);
7883     try
7884       pTempDest := pDest;
7885       Inc(pTempDest, fRowSize);
7886       for Col := 0 to Width-1 do begin
7887         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7888         Move(pSource^, pTempDest^, fPixelSize);
7889         Inc(pSource, fPixelSize);
7890       end;
7891       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7892       result := true;
7893     except
7894       if Assigned(pDest) then
7895         FreeMem(pDest);
7896       raise;
7897     end;
7898   end;
7899 end;
7900
7901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7902 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7903 var
7904   FormatDesc: TFormatDescriptor;
7905 begin
7906   // Upload data
7907   FormatDesc := TFormatDescriptor.Get(Format);
7908   if FormatDesc.IsCompressed then begin
7909     if not Assigned(glCompressedTexImage1D) then
7910       raise EglBitmap.Create('compressed formats not supported by video adapter');
7911     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7912   end else if aBuildWithGlu then
7913     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7914   else
7915     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7916
7917   // Free Data
7918   if (FreeDataAfterGenTexture) then
7919     FreeData;
7920 end;
7921
7922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7923 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7924 var
7925   BuildWithGlu, TexRec: Boolean;
7926   TexSize: Integer;
7927 begin
7928   if Assigned(Data) then begin
7929     // Check Texture Size
7930     if (aTestTextureSize) then begin
7931       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7932
7933       if (Width > TexSize) then
7934         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7935
7936       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7937                 (Target = GL_TEXTURE_RECTANGLE);
7938       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7939         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7940     end;
7941
7942     CreateId;
7943     SetupParameters(BuildWithGlu);
7944     UploadData(BuildWithGlu);
7945     glAreTexturesResident(1, @fID, @fIsResident);
7946   end;
7947 end;
7948
7949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7950 procedure TglBitmap1D.AfterConstruction;
7951 begin
7952   inherited;
7953   Target := GL_TEXTURE_1D;
7954 end;
7955
7956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7957 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7959 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7960 begin
7961   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7962     result := fLines[aIndex]
7963   else
7964     result := nil;
7965 end;
7966
7967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7968 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7969   const aWidth: Integer; const aHeight: Integer);
7970 var
7971   Idx, LineWidth: Integer;
7972 begin
7973   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7974
7975   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7976     // Assigning Data
7977     if Assigned(Data) then begin
7978       SetLength(fLines, GetHeight);
7979       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7980
7981       for Idx := 0 to GetHeight-1 do begin
7982         fLines[Idx] := Data;
7983         Inc(fLines[Idx], Idx * LineWidth);
7984       end;
7985     end
7986       else SetLength(fLines, 0);
7987   end else begin
7988     SetLength(fLines, 0);
7989   end;
7990 end;
7991
7992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7993 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7994 var
7995   FormatDesc: TFormatDescriptor;
7996 begin
7997   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7998
7999   FormatDesc := TFormatDescriptor.Get(Format);
8000   if FormatDesc.IsCompressed then begin
8001     if not Assigned(glCompressedTexImage2D) then
8002       raise EglBitmap.Create('compressed formats not supported by video adapter');
8003     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8004   end else if aBuildWithGlu then begin
8005     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8006       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8007   end else begin
8008     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8009       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8010   end;
8011
8012   // Freigeben
8013   if (FreeDataAfterGenTexture) then
8014     FreeData;
8015 end;
8016
8017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8018 procedure TglBitmap2D.AfterConstruction;
8019 begin
8020   inherited;
8021   Target := GL_TEXTURE_2D;
8022 end;
8023
8024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8025 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8026 var
8027   Temp: pByte;
8028   Size, w, h: Integer;
8029   FormatDesc: TFormatDescriptor;
8030 begin
8031   FormatDesc := TFormatDescriptor.Get(aFormat);
8032   if FormatDesc.IsCompressed then
8033     raise EglBitmapUnsupportedFormat.Create(aFormat);
8034
8035   w    := aRight  - aLeft;
8036   h    := aBottom - aTop;
8037   Size := FormatDesc.GetSize(w, h);
8038   GetMem(Temp, Size);
8039   try
8040     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8041     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8042     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8043     FlipVert;
8044   except
8045     if Assigned(Temp) then
8046       FreeMem(Temp);
8047     raise;
8048   end;
8049 end;
8050
8051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8052 procedure TglBitmap2D.GetDataFromTexture;
8053 var
8054   Temp: PByte;
8055   TempWidth, TempHeight: Integer;
8056   TempIntFormat: GLint;
8057   IntFormat, f: TglBitmapFormat;
8058   FormatDesc: TFormatDescriptor;
8059 begin
8060   Bind;
8061
8062   // Request Data
8063   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8064   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8065   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8066
8067   IntFormat := tfEmpty;
8068   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8069     FormatDesc := TFormatDescriptor.Get(f);
8070     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8071       IntFormat := FormatDesc.Format;
8072       break;
8073     end;
8074   end;
8075
8076   // Getting data from OpenGL
8077   FormatDesc := TFormatDescriptor.Get(IntFormat);
8078   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8079   try
8080     if FormatDesc.IsCompressed then begin
8081       if not Assigned(glGetCompressedTexImage) then
8082         raise EglBitmap.Create('compressed formats not supported by video adapter');
8083       glGetCompressedTexImage(Target, 0, Temp)
8084     end else
8085       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8086     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8087   except
8088     if Assigned(Temp) then
8089       FreeMem(Temp);
8090     raise;
8091   end;
8092 end;
8093
8094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8095 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8096 var
8097   BuildWithGlu, PotTex, TexRec: Boolean;
8098   TexSize: Integer;
8099 begin
8100   if Assigned(Data) then begin
8101     // Check Texture Size
8102     if (aTestTextureSize) then begin
8103       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8104
8105       if ((Height > TexSize) or (Width > TexSize)) then
8106         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8107
8108       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8109       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8110       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8111         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8112     end;
8113
8114     CreateId;
8115     SetupParameters(BuildWithGlu);
8116     UploadData(Target, BuildWithGlu);
8117     glAreTexturesResident(1, @fID, @fIsResident);
8118   end;
8119 end;
8120
8121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8122 function TglBitmap2D.FlipHorz: Boolean;
8123 var
8124   Col, Row: Integer;
8125   TempDestData, DestData, SourceData: PByte;
8126   ImgSize: Integer;
8127 begin
8128   result := inherited FlipHorz;
8129   if Assigned(Data) then begin
8130     SourceData := Data;
8131     ImgSize := Height * fRowSize;
8132     GetMem(DestData, ImgSize);
8133     try
8134       TempDestData := DestData;
8135       Dec(TempDestData, fRowSize + fPixelSize);
8136       for Row := 0 to Height -1 do begin
8137         Inc(TempDestData, fRowSize * 2);
8138         for Col := 0 to Width -1 do begin
8139           Move(SourceData^, TempDestData^, fPixelSize);
8140           Inc(SourceData, fPixelSize);
8141           Dec(TempDestData, fPixelSize);
8142         end;
8143       end;
8144       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8145       result := true;
8146     except
8147       if Assigned(DestData) then
8148         FreeMem(DestData);
8149       raise;
8150     end;
8151   end;
8152 end;
8153
8154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8155 function TglBitmap2D.FlipVert: Boolean;
8156 var
8157   Row: Integer;
8158   TempDestData, DestData, SourceData: PByte;
8159 begin
8160   result := inherited FlipVert;
8161   if Assigned(Data) then begin
8162     SourceData := Data;
8163     GetMem(DestData, Height * fRowSize);
8164     try
8165       TempDestData := DestData;
8166       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8167       for Row := 0 to Height -1 do begin
8168         Move(SourceData^, TempDestData^, fRowSize);
8169         Dec(TempDestData, fRowSize);
8170         Inc(SourceData, fRowSize);
8171       end;
8172       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8173       result := true;
8174     except
8175       if Assigned(DestData) then
8176         FreeMem(DestData);
8177       raise;
8178     end;
8179   end;
8180 end;
8181
8182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8183 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8185 type
8186   TMatrixItem = record
8187     X, Y: Integer;
8188     W: Single;
8189   end;
8190
8191   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8192   TglBitmapToNormalMapRec = Record
8193     Scale: Single;
8194     Heights: array of Single;
8195     MatrixU : array of TMatrixItem;
8196     MatrixV : array of TMatrixItem;
8197   end;
8198
8199 const
8200   ONE_OVER_255 = 1 / 255;
8201
8202   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8203 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8204 var
8205   Val: Single;
8206 begin
8207   with FuncRec do begin
8208     Val :=
8209       Source.Data.r * LUMINANCE_WEIGHT_R +
8210       Source.Data.g * LUMINANCE_WEIGHT_G +
8211       Source.Data.b * LUMINANCE_WEIGHT_B;
8212     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8213   end;
8214 end;
8215
8216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8217 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8218 begin
8219   with FuncRec do
8220     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8221 end;
8222
8223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8224 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8225 type
8226   TVec = Array[0..2] of Single;
8227 var
8228   Idx: Integer;
8229   du, dv: Double;
8230   Len: Single;
8231   Vec: TVec;
8232
8233   function GetHeight(X, Y: Integer): Single;
8234   begin
8235     with FuncRec do begin
8236       X := Max(0, Min(Size.X -1, X));
8237       Y := Max(0, Min(Size.Y -1, Y));
8238       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8239     end;
8240   end;
8241
8242 begin
8243   with FuncRec do begin
8244     with PglBitmapToNormalMapRec(Args)^ do begin
8245       du := 0;
8246       for Idx := Low(MatrixU) to High(MatrixU) do
8247         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8248
8249       dv := 0;
8250       for Idx := Low(MatrixU) to High(MatrixU) do
8251         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8252
8253       Vec[0] := -du * Scale;
8254       Vec[1] := -dv * Scale;
8255       Vec[2] := 1;
8256     end;
8257
8258     // Normalize
8259     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8260     if Len <> 0 then begin
8261       Vec[0] := Vec[0] * Len;
8262       Vec[1] := Vec[1] * Len;
8263       Vec[2] := Vec[2] * Len;
8264     end;
8265
8266     // Farbe zuweisem
8267     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8268     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8269     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8270   end;
8271 end;
8272
8273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8274 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8275 var
8276   Rec: TglBitmapToNormalMapRec;
8277
8278   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8279   begin
8280     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8281       Matrix[Index].X := X;
8282       Matrix[Index].Y := Y;
8283       Matrix[Index].W := W;
8284     end;
8285   end;
8286
8287 begin
8288   if TFormatDescriptor.Get(Format).IsCompressed then
8289     raise EglBitmapUnsupportedFormat.Create(Format);
8290
8291   if aScale > 100 then
8292     Rec.Scale := 100
8293   else if aScale < -100 then
8294     Rec.Scale := -100
8295   else
8296     Rec.Scale := aScale;
8297
8298   SetLength(Rec.Heights, Width * Height);
8299   try
8300     case aFunc of
8301       nm4Samples: begin
8302         SetLength(Rec.MatrixU, 2);
8303         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8304         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8305
8306         SetLength(Rec.MatrixV, 2);
8307         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8308         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8309       end;
8310
8311       nmSobel: begin
8312         SetLength(Rec.MatrixU, 6);
8313         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8314         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8315         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8316         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8317         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8318         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8319
8320         SetLength(Rec.MatrixV, 6);
8321         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8322         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8323         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8324         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8325         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8326         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8327       end;
8328
8329       nm3x3: begin
8330         SetLength(Rec.MatrixU, 6);
8331         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8332         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8333         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8334         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8335         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8336         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8337
8338         SetLength(Rec.MatrixV, 6);
8339         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8340         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8341         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8342         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8343         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8344         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8345       end;
8346
8347       nm5x5: begin
8348         SetLength(Rec.MatrixU, 20);
8349         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8350         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8351         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8352         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8353         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8354         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8355         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8356         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8357         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8358         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8359         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8360         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8361         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8362         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8363         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8364         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8365         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8366         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8367         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8368         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8369
8370         SetLength(Rec.MatrixV, 20);
8371         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8372         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8373         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8374         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8375         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8376         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8377         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8378         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8379         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8380         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8381         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8382         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8383         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8384         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8385         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8386         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8387         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8388         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8389         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8390         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8391       end;
8392     end;
8393
8394     // Daten Sammeln
8395     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8396       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8397     else
8398       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8399     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8400   finally
8401     SetLength(Rec.Heights, 0);
8402   end;
8403 end;
8404
8405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8406 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8408 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8409 begin
8410   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8411 end;
8412
8413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8414 procedure TglBitmapCubeMap.AfterConstruction;
8415 begin
8416   inherited;
8417
8418   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8419     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8420
8421   SetWrap;
8422   Target   := GL_TEXTURE_CUBE_MAP;
8423   fGenMode := GL_REFLECTION_MAP;
8424 end;
8425
8426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8427 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8428 var
8429   BuildWithGlu: Boolean;
8430   TexSize: Integer;
8431 begin
8432   if (aTestTextureSize) then begin
8433     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8434
8435     if (Height > TexSize) or (Width > TexSize) then
8436       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8437
8438     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8439       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8440   end;
8441
8442   if (ID = 0) then
8443     CreateID;
8444   SetupParameters(BuildWithGlu);
8445   UploadData(aCubeTarget, BuildWithGlu);
8446 end;
8447
8448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8449 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8450 begin
8451   inherited Bind (aEnableTextureUnit);
8452   if aEnableTexCoordsGen then begin
8453     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8454     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8455     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8456     glEnable(GL_TEXTURE_GEN_S);
8457     glEnable(GL_TEXTURE_GEN_T);
8458     glEnable(GL_TEXTURE_GEN_R);
8459   end;
8460 end;
8461
8462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8463 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8464 begin
8465   inherited Unbind(aDisableTextureUnit);
8466   if aDisableTexCoordsGen then begin
8467     glDisable(GL_TEXTURE_GEN_S);
8468     glDisable(GL_TEXTURE_GEN_T);
8469     glDisable(GL_TEXTURE_GEN_R);
8470   end;
8471 end;
8472
8473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8474 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8476 type
8477   TVec = Array[0..2] of Single;
8478   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8479
8480   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8481   TglBitmapNormalMapRec = record
8482     HalfSize : Integer;
8483     Func: TglBitmapNormalMapGetVectorFunc;
8484   end;
8485
8486   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8487 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8488 begin
8489   aVec[0] := aHalfSize;
8490   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8491   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8492 end;
8493
8494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8495 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8496 begin
8497   aVec[0] := - aHalfSize;
8498   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8499   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8500 end;
8501
8502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8503 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8504 begin
8505   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8506   aVec[1] := aHalfSize;
8507   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8508 end;
8509
8510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8511 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8512 begin
8513   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8514   aVec[1] := - aHalfSize;
8515   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8516 end;
8517
8518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8519 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8520 begin
8521   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8522   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8523   aVec[2] := aHalfSize;
8524 end;
8525
8526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8527 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8528 begin
8529   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8530   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8531   aVec[2] := - aHalfSize;
8532 end;
8533
8534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8535 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8536 var
8537   i: Integer;
8538   Vec: TVec;
8539   Len: Single;
8540 begin
8541   with FuncRec do begin
8542     with PglBitmapNormalMapRec(Args)^ do begin
8543       Func(Vec, Position, HalfSize);
8544
8545       // Normalize
8546       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8547       if Len <> 0 then begin
8548         Vec[0] := Vec[0] * Len;
8549         Vec[1] := Vec[1] * Len;
8550         Vec[2] := Vec[2] * Len;
8551       end;
8552
8553       // Scale Vector and AddVectro
8554       Vec[0] := Vec[0] * 0.5 + 0.5;
8555       Vec[1] := Vec[1] * 0.5 + 0.5;
8556       Vec[2] := Vec[2] * 0.5 + 0.5;
8557     end;
8558
8559     // Set Color
8560     for i := 0 to 2 do
8561       Dest.Data.arr[i] := Round(Vec[i] * 255);
8562   end;
8563 end;
8564
8565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8566 procedure TglBitmapNormalMap.AfterConstruction;
8567 begin
8568   inherited;
8569   fGenMode := GL_NORMAL_MAP;
8570 end;
8571
8572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8573 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8574 var
8575   Rec: TglBitmapNormalMapRec;
8576   SizeRec: TglBitmapPixelPosition;
8577 begin
8578   Rec.HalfSize := aSize div 2;
8579   FreeDataAfterGenTexture := false;
8580
8581   SizeRec.Fields := [ffX, ffY];
8582   SizeRec.X := aSize;
8583   SizeRec.Y := aSize;
8584
8585   // Positive X
8586   Rec.Func := glBitmapNormalMapPosX;
8587   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8588   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8589
8590   // Negative X
8591   Rec.Func := glBitmapNormalMapNegX;
8592   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8593   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8594
8595   // Positive Y
8596   Rec.Func := glBitmapNormalMapPosY;
8597   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8598   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8599
8600   // Negative Y
8601   Rec.Func := glBitmapNormalMapNegY;
8602   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8603   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8604
8605   // Positive Z
8606   Rec.Func := glBitmapNormalMapPosZ;
8607   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8608   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8609
8610   // Negative Z
8611   Rec.Func := glBitmapNormalMapNegZ;
8612   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8613   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8614 end;
8615
8616
8617 initialization
8618   glBitmapSetDefaultFormat (tfEmpty);
8619   glBitmapSetDefaultMipmap (mmMipmap);
8620   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8621   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8622   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8623
8624   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8625   glBitmapSetDefaultDeleteTextureOnFree    (true);
8626
8627   TFormatDescriptor.Init;
8628
8629 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8630   OpenGLInitialized := false;
8631   InitOpenGLCS := TCriticalSection.Create;
8632 {$ENDIF}
8633
8634 finalization
8635   TFormatDescriptor.Finalize;
8636
8637 {$IFDEF GLB_NATIVE_OGL}
8638   if Assigned(GL_LibHandle) then
8639     glbFreeLibrary(GL_LibHandle);
8640
8641 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8642   if Assigned(GLU_LibHandle) then
8643     glbFreeLibrary(GLU_LibHandle);
8644   FreeAndNil(InitOpenGLCS);
8645 {$ENDIF}
8646 {$ENDIF}
8647
8648 end.