glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {.$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {.$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {.$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     tfAlpha12,
 782     tfAlpha16,
 783
 784     tfLuminance4,
 785     tfLuminance8,
 786     tfLuminance12,
 787     tfLuminance16,
 788
 789     tfLuminance4Alpha4,
 790     tfLuminance6Alpha2,
 791     tfLuminance8Alpha8,
 792     tfLuminance12Alpha4,
 793     tfLuminance12Alpha12,
 794     tfLuminance16Alpha16,
 795
 796     tfR3G3B2,
 797     tfRGB4,
 798     tfR5G6B5,
 799     tfRGB5,
 800     tfRGB8,
 801     tfRGB10,
 802     tfRGB12,
 803     tfRGB16,
 804
 805     tfRGBA2,
 806     tfRGBA4,
 807     tfRGB5A1,
 808     tfRGBA8,
 809     tfRGB10A2,
 810     tfRGBA12,
 811     tfRGBA16,
 812
 813     tfBGR4,
 814     tfB5G6R5,
 815     tfBGR5,
 816     tfBGR8,
 817     tfBGR10,
 818     tfBGR12,
 819     tfBGR16,
 820
 821     tfBGRA2,
 822     tfBGRA4,
 823     tfBGR5A1,
 824     tfBGRA8,
 825     tfBGR10A2,
 826     tfBGRA12,
 827     tfBGRA16,
 828
 829     tfDepth16,
 830     tfDepth24,
 831     tfDepth32,
 832
 833     tfS3tcDtx1RGBA,
 834     tfS3tcDtx3RGBA,
 835     tfS3tcDtx5RGBA
 836   );
 837
 838   TglBitmapFileType = (
 839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 841      ftDDS,
 842      ftTGA,
 843      ftBMP);
 844    TglBitmapFileTypes = set of TglBitmapFileType;
 845
 846    TglBitmapMipMap = (
 847      mmNone,
 848      mmMipmap,
 849      mmMipmapGlu);
 850
 851    TglBitmapNormalMapFunc = (
 852      nm4Samples,
 853      nmSobel,
 854      nm3x3,
 855      nm5x5);
 856
 857  ////////////////////////////////////////////////////////////////////////////////////////////////////
 858    EglBitmap                  = class(Exception);
 859    EglBitmapNotSupported      = class(Exception);
 860    EglBitmapSizeToLarge       = class(EglBitmap);
 861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 862    EglBitmapUnsupportedFormat = class(EglBitmap)
 863    public
 864      constructor Create(const aFormat: TglBitmapFormat); overload;
 865      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 866    end;
 867
 868 ////////////////////////////////////////////////////////////////////////////////////////////////////
 869   TglBitmapColorRec = packed record
 870   case Integer of
 871     0: (r, g, b, a: Cardinal);
 872     1: (arr: array[0..3] of Cardinal);
 873   end;
 874
 875   TglBitmapPixelData = packed record
 876     Data, Range: TglBitmapColorRec;
 877     Format: TglBitmapFormat;
 878   end;
 879   PglBitmapPixelData = ^TglBitmapPixelData;
 880
 881 ////////////////////////////////////////////////////////////////////////////////////////////////////
 882   TglBitmapPixelPositionFields = set of (ffX, ffY);
 883   TglBitmapPixelPosition = record
 884     Fields : TglBitmapPixelPositionFields;
 885     X : Word;
 886     Y : Word;
 887   end;
 888
 889   TglBitmapFormatDescriptor = class(TObject)
 890   protected
 891     function GetIsCompressed: Boolean; virtual; abstract;
 892     function 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   {$IFDEF GLB_DELPHI}, Types{$ENDIF}
1240   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1241
1242 type
1243 {$IFNDEF fpc}
1244   QWord   = System.UInt64;
1245   PQWord  = ^QWord;
1246
1247   PtrInt  = Longint;
1248   PtrUInt = DWord;
1249 {$ENDIF}
1250
1251 ////////////////////////////////////////////////////////////////////////////////////////////////////
1252   TShiftRec = packed record
1253   case Integer of
1254     0: (r, g, b, a: Byte);
1255     1: (arr: array[0..3] of Byte);
1256   end;
1257
1258   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1259   private
1260     function GetRedMask: QWord;
1261     function GetGreenMask: QWord;
1262     function GetBlueMask: QWord;
1263     function GetAlphaMask: QWord;
1264   protected
1265     fFormat: TglBitmapFormat;
1266     fWithAlpha: TglBitmapFormat;
1267     fWithoutAlpha: TglBitmapFormat;
1268     fRGBInverted: TglBitmapFormat;
1269     fUncompressed: TglBitmapFormat;
1270     fPixelSize: Single;
1271     fIsCompressed: Boolean;
1272
1273     fRange: TglBitmapColorRec;
1274     fShift: TShiftRec;
1275
1276     fglFormat:         GLenum;
1277     fglInternalFormat: GLenum;
1278     fglDataFormat:     GLenum;
1279
1280     function GetIsCompressed: Boolean; override;
1281     function GetHasRed: Boolean; override;
1282     function GetHasGreen: Boolean; override;
1283     function GetHasBlue: Boolean; override;
1284     function GetHasAlpha: Boolean; override;
1285
1286     function GetglFormat: GLenum; override;
1287     function GetglInternalFormat: GLenum; override;
1288     function GetglDataFormat: GLenum; override;
1289
1290     function GetComponents: Integer; virtual;
1291   public
1292     property Format:       TglBitmapFormat read fFormat;
1293     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1294     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1295     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1296     property Components:   Integer         read GetComponents;
1297     property PixelSize:    Single          read fPixelSize;
1298
1299     property Range: TglBitmapColorRec read fRange;
1300     property Shift: TShiftRec         read fShift;
1301
1302     property RedMask:   QWord read GetRedMask;
1303     property GreenMask: QWord read GetGreenMask;
1304     property BlueMask:  QWord read GetBlueMask;
1305     property AlphaMask: QWord read GetAlphaMask;
1306
1307     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1308     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1309
1310     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1311     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1312
1313     function CreateMappingData: Pointer; virtual;
1314     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1315
1316     function IsEmpty:  Boolean; virtual;
1317     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1318
1319     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1320
1321     constructor Create; virtual;
1322   public
1323     class procedure Init;
1324     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1325     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1326     class procedure Clear;
1327     class procedure Finalize;
1328   end;
1329   TFormatDescriptorClass = class of TFormatDescriptor;
1330
1331   TfdEmpty = class(TFormatDescriptor);
1332
1333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1334   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1335     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1336     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1337     constructor Create; override;
1338   end;
1339
1340   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1341     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1342     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1343     constructor Create; override;
1344   end;
1345
1346   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1347     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1348     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1349     constructor Create; override;
1350   end;
1351
1352   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1353     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1354     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1355     constructor Create; override;
1356   end;
1357
1358   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1359     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1360     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1361     constructor Create; override;
1362   end;
1363
1364   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1365     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1366     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1367     constructor Create; override;
1368   end;
1369
1370   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1371     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1372     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1373     constructor Create; override;
1374   end;
1375
1376   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379     constructor Create; override;
1380   end;
1381
1382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1383   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1384     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1385     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1386     constructor Create; override;
1387   end;
1388
1389   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1390     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1391     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1392     constructor Create; override;
1393   end;
1394
1395   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1396     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1397     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1398     constructor Create; override;
1399   end;
1400
1401   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1402     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1403     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1404     constructor Create; override;
1405   end;
1406
1407   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1408     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1409     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1410     constructor Create; override;
1411   end;
1412
1413   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1414     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1415     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1416     constructor Create; override;
1417   end;
1418
1419   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1420     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1421     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1422     constructor Create; override;
1423   end;
1424
1425   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1426     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1427     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1428     constructor Create; override;
1429   end;
1430
1431   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1432     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1433     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1434     constructor Create; override;
1435   end;
1436
1437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1438   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441     constructor Create; override;
1442   end;
1443
1444   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1445     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1446     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1447     constructor Create; override;
1448   end;
1449
1450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1451   TfdAlpha4 = class(TfdAlpha_UB1)
1452     constructor Create; override;
1453   end;
1454
1455   TfdAlpha8 = class(TfdAlpha_UB1)
1456     constructor Create; override;
1457   end;
1458
1459   TfdAlpha12 = class(TfdAlpha_US1)
1460     constructor Create; override;
1461   end;
1462
1463   TfdAlpha16 = class(TfdAlpha_US1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdLuminance4 = class(TfdLuminance_UB1)
1468     constructor Create; override;
1469   end;
1470
1471   TfdLuminance8 = class(TfdLuminance_UB1)
1472     constructor Create; override;
1473   end;
1474
1475   TfdLuminance12 = class(TfdLuminance_US1)
1476     constructor Create; override;
1477   end;
1478
1479   TfdLuminance16 = class(TfdLuminance_US1)
1480     constructor Create; override;
1481   end;
1482
1483   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1484     constructor Create; override;
1485   end;
1486
1487   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1488     constructor Create; override;
1489   end;
1490
1491   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1492     constructor Create; override;
1493   end;
1494
1495   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1496     constructor Create; override;
1497   end;
1498
1499   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1500     constructor Create; override;
1501   end;
1502
1503   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1504     constructor Create; override;
1505   end;
1506
1507   TfdR3G3B2 = class(TfdUniversal_UB1)
1508     constructor Create; override;
1509   end;
1510
1511   TfdRGB4 = class(TfdUniversal_US1)
1512     constructor Create; override;
1513   end;
1514
1515   TfdR5G6B5 = class(TfdUniversal_US1)
1516     constructor Create; override;
1517   end;
1518
1519   TfdRGB5 = class(TfdUniversal_US1)
1520     constructor Create; override;
1521   end;
1522
1523   TfdRGB8 = class(TfdRGB_UB3)
1524     constructor Create; override;
1525   end;
1526
1527   TfdRGB10 = class(TfdUniversal_UI1)
1528     constructor Create; override;
1529   end;
1530
1531   TfdRGB12 = class(TfdRGB_US3)
1532     constructor Create; override;
1533   end;
1534
1535   TfdRGB16 = class(TfdRGB_US3)
1536     constructor Create; override;
1537   end;
1538
1539   TfdRGBA2 = class(TfdRGBA_UB4)
1540     constructor Create; override;
1541   end;
1542
1543   TfdRGBA4 = class(TfdUniversal_US1)
1544     constructor Create; override;
1545   end;
1546
1547   TfdRGB5A1 = class(TfdUniversal_US1)
1548     constructor Create; override;
1549   end;
1550
1551   TfdRGBA8 = class(TfdRGBA_UB4)
1552     constructor Create; override;
1553   end;
1554
1555   TfdRGB10A2 = class(TfdUniversal_UI1)
1556     constructor Create; override;
1557   end;
1558
1559   TfdRGBA12 = class(TfdRGBA_US4)
1560     constructor Create; override;
1561   end;
1562
1563   TfdRGBA16 = class(TfdRGBA_US4)
1564     constructor Create; override;
1565   end;
1566
1567   TfdBGR4 = class(TfdUniversal_US1)
1568     constructor Create; override;
1569   end;
1570
1571   TfdB5G6R5 = class(TfdUniversal_US1)
1572     constructor Create; override;
1573   end;
1574
1575   TfdBGR5 = class(TfdUniversal_US1)
1576     constructor Create; override;
1577   end;
1578
1579   TfdBGR8 = class(TfdBGR_UB3)
1580     constructor Create; override;
1581   end;
1582
1583   TfdBGR10 = class(TfdUniversal_UI1)
1584     constructor Create; override;
1585   end;
1586
1587   TfdBGR12 = class(TfdBGR_US3)
1588     constructor Create; override;
1589   end;
1590
1591   TfdBGR16 = class(TfdBGR_US3)
1592     constructor Create; override;
1593   end;
1594
1595   TfdBGRA2 = class(TfdBGRA_UB4)
1596     constructor Create; override;
1597   end;
1598
1599   TfdBGRA4 = class(TfdUniversal_US1)
1600     constructor Create; override;
1601   end;
1602
1603   TfdBGR5A1 = class(TfdUniversal_US1)
1604     constructor Create; override;
1605   end;
1606
1607   TfdBGRA8 = class(TfdBGRA_UB4)
1608     constructor Create; override;
1609   end;
1610
1611   TfdBGR10A2 = class(TfdUniversal_UI1)
1612     constructor Create; override;
1613   end;
1614
1615   TfdBGRA12 = class(TfdBGRA_US4)
1616     constructor Create; override;
1617   end;
1618
1619   TfdBGRA16 = class(TfdBGRA_US4)
1620     constructor Create; override;
1621   end;
1622
1623   TfdDepth16 = class(TfdDepth_US1)
1624     constructor Create; override;
1625   end;
1626
1627   TfdDepth24 = class(TfdDepth_UI1)
1628     constructor Create; override;
1629   end;
1630
1631   TfdDepth32 = class(TfdDepth_UI1)
1632     constructor Create; override;
1633   end;
1634
1635   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1636     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1637     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1638     constructor Create; override;
1639   end;
1640
1641   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1642     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1643     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1644     constructor Create; override;
1645   end;
1646
1647   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1648     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1649     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1650     constructor Create; override;
1651   end;
1652
1653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1654   TbmpBitfieldFormat = class(TFormatDescriptor)
1655   private
1656     procedure SetRedMask  (const aValue: QWord);
1657     procedure SetGreenMask(const aValue: QWord);
1658     procedure SetBlueMask (const aValue: QWord);
1659     procedure SetAlphaMask(const aValue: QWord);
1660
1661     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1662   public
1663     property RedMask:   QWord read GetRedMask   write SetRedMask;
1664     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1665     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1666     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1667
1668     property PixelSize: Single read fPixelSize write fPixelSize;
1669
1670     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1671     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1672   end;
1673
1674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1675   TbmpColorTableEnty = packed record
1676     b, g, r, a: Byte;
1677   end;
1678   TbmpColorTable = array of TbmpColorTableEnty;
1679   TbmpColorTableFormat = class(TFormatDescriptor)
1680   private
1681     fColorTable: TbmpColorTable;
1682   public
1683     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1684     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1685     property Range:      TglBitmapColorRec read fRange      write fRange;
1686     property Shift:      TShiftRec         read fShift      write fShift;
1687     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1688
1689     procedure CreateColorTable;
1690
1691     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1692     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1693     destructor Destroy; override;
1694   end;
1695
1696 const
1697   LUMINANCE_WEIGHT_R = 0.30;
1698   LUMINANCE_WEIGHT_G = 0.59;
1699   LUMINANCE_WEIGHT_B = 0.11;
1700
1701   ALPHA_WEIGHT_R = 0.30;
1702   ALPHA_WEIGHT_G = 0.59;
1703   ALPHA_WEIGHT_B = 0.11;
1704
1705   DEPTH_WEIGHT_R = 0.333333333;
1706   DEPTH_WEIGHT_G = 0.333333333;
1707   DEPTH_WEIGHT_B = 0.333333333;
1708
1709   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1710
1711   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1712     TfdEmpty,
1713
1714     TfdAlpha4,
1715     TfdAlpha8,
1716     TfdAlpha12,
1717     TfdAlpha16,
1718
1719     TfdLuminance4,
1720     TfdLuminance8,
1721     TfdLuminance12,
1722     TfdLuminance16,
1723
1724     TfdLuminance4Alpha4,
1725     TfdLuminance6Alpha2,
1726     TfdLuminance8Alpha8,
1727     TfdLuminance12Alpha4,
1728     TfdLuminance12Alpha12,
1729     TfdLuminance16Alpha16,
1730
1731     TfdR3G3B2,
1732     TfdRGB4,
1733     TfdR5G6B5,
1734     TfdRGB5,
1735     TfdRGB8,
1736     TfdRGB10,
1737     TfdRGB12,
1738     TfdRGB16,
1739
1740     TfdRGBA2,
1741     TfdRGBA4,
1742     TfdRGB5A1,
1743     TfdRGBA8,
1744     TfdRGB10A2,
1745     TfdRGBA12,
1746     TfdRGBA16,
1747
1748     TfdBGR4,
1749     TfdB5G6R5,
1750     TfdBGR5,
1751     TfdBGR8,
1752     TfdBGR10,
1753     TfdBGR12,
1754     TfdBGR16,
1755
1756     TfdBGRA2,
1757     TfdBGRA4,
1758     TfdBGR5A1,
1759     TfdBGRA8,
1760     TfdBGR10A2,
1761     TfdBGRA12,
1762     TfdBGRA16,
1763
1764     TfdDepth16,
1765     TfdDepth24,
1766     TfdDepth32,
1767
1768     TfdS3tcDtx1RGBA,
1769     TfdS3tcDtx3RGBA,
1770     TfdS3tcDtx5RGBA
1771   );
1772
1773 var
1774   FormatDescriptorCS: TCriticalSection;
1775   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1776
1777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1778 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1779 begin
1780   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1781 end;
1782
1783 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1784 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1785 begin
1786   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1787 end;
1788
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1791 begin
1792   result.Fields := [];
1793
1794   if X >= 0 then
1795     result.Fields := result.Fields + [ffX];
1796   if Y >= 0 then
1797     result.Fields := result.Fields + [ffY];
1798
1799   result.X := Max(0, X);
1800   result.Y := Max(0, Y);
1801 end;
1802
1803 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1804 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1805 begin
1806   result.r := r;
1807   result.g := g;
1808   result.b := b;
1809   result.a := a;
1810 end;
1811
1812 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1813 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1814 var
1815   i: Integer;
1816 begin
1817   result := false;
1818   for i := 0 to high(r1.arr) do
1819     if (r1.arr[i] <> r2.arr[i]) then
1820       exit;
1821   result := true;
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1826 begin
1827   result.r := r;
1828   result.g := g;
1829   result.b := b;
1830   result.a := a;
1831 end;
1832
1833 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1834 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1835 begin
1836   result := [];
1837
1838   if (aFormat in [
1839         //4 bbp
1840         tfLuminance4,
1841
1842         //8bpp
1843         tfR3G3B2, tfLuminance8,
1844
1845         //16bpp
1846         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1847         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1848
1849         //24bpp
1850         tfBGR8, tfRGB8,
1851
1852         //32bpp
1853         tfRGB10, tfRGB10A2, tfRGBA8,
1854         tfBGR10, tfBGR10A2, tfBGRA8]) then
1855     result := result + [ftBMP];
1856
1857   if (aFormat in [
1858         //8 bpp
1859         tfLuminance8, tfAlpha8,
1860
1861         //16 bpp
1862         tfLuminance16, tfLuminance8Alpha8,
1863         tfRGB5, tfRGB5A1, tfRGBA4,
1864         tfBGR5, tfBGR5A1, tfBGRA4,
1865
1866         //24 bpp
1867         tfRGB8, tfBGR8,
1868
1869         //32 bpp
1870         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1871     result := result + [ftTGA];
1872
1873   if (aFormat in [
1874         //8 bpp
1875         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1876         tfR3G3B2, tfRGBA2, tfBGRA2,
1877
1878         //16 bpp
1879         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1880         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1881         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1882
1883         //24 bpp
1884         tfRGB8, tfBGR8,
1885
1886         //32 bbp
1887         tfLuminance16Alpha16,
1888         tfRGBA8, tfRGB10A2,
1889         tfBGRA8, tfBGR10A2,
1890
1891         //compressed
1892         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1893     result := result + [ftDDS];
1894
1895   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1896   if aFormat in [
1897       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1898       tfRGB8, tfRGBA8,
1899       tfBGR8, tfBGRA8] then
1900     result := result + [ftPNG];
1901   {$ENDIF}
1902
1903   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1904   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1905     result := result + [ftJPEG];
1906   {$ENDIF}
1907 end;
1908
1909 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1910 function IsPowerOfTwo(aNumber: Integer): Boolean;
1911 begin
1912   while (aNumber and 1) = 0 do
1913     aNumber := aNumber shr 1;
1914   result := aNumber = 1;
1915 end;
1916
1917 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1918 function GetTopMostBit(aBitSet: QWord): Integer;
1919 begin
1920   result := 0;
1921   while aBitSet > 0 do begin
1922     inc(result);
1923     aBitSet := aBitSet shr 1;
1924   end;
1925 end;
1926
1927 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1928 function CountSetBits(aBitSet: QWord): Integer;
1929 begin
1930   result := 0;
1931   while aBitSet > 0 do begin
1932     if (aBitSet and 1) = 1 then
1933       inc(result);
1934     aBitSet := aBitSet shr 1;
1935   end;
1936 end;
1937
1938 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1939 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1940 begin
1941   result := Trunc(
1942     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1943     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1944     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1945 end;
1946
1947 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1948 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1949 begin
1950   result := Trunc(
1951     DEPTH_WEIGHT_R * aPixel.Data.r +
1952     DEPTH_WEIGHT_G * aPixel.Data.g +
1953     DEPTH_WEIGHT_B * aPixel.Data.b);
1954 end;
1955
1956 {$IFDEF GLB_NATIVE_OGL}
1957 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1958 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1959 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1960 var
1961   GL_LibHandle: Pointer = nil;
1962
1963 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1964 begin
1965   if not Assigned(aLibHandle) then
1966     aLibHandle := GL_LibHandle;
1967
1968 {$IF DEFINED(GLB_WIN)}
1969   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1970   if Assigned(result) then
1971     exit;
1972
1973   if Assigned(wglGetProcAddress) then
1974     result := wglGetProcAddress(aProcName);
1975 {$ELSEIF DEFINED(GLB_LINUX)}
1976   if Assigned(glXGetProcAddress) then begin
1977     result := glXGetProcAddress(aProcName);
1978     if Assigned(result) then
1979       exit;
1980   end;
1981
1982   if Assigned(glXGetProcAddressARB) then begin
1983     result := glXGetProcAddressARB(aProcName);
1984     if Assigned(result) then
1985       exit;
1986   end;
1987
1988   result := dlsym(aLibHandle, aProcName);
1989 {$IFEND}
1990   if not Assigned(result) and aRaiseOnErr then
1991     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1992 end;
1993
1994 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1995 var
1996   GLU_LibHandle: Pointer = nil;
1997   OpenGLInitialized: Boolean;
1998   InitOpenGLCS: TCriticalSection;
1999
2000 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2001 procedure glbInitOpenGL;
2002
2003   ////////////////////////////////////////////////////////////////////////////////
2004   function glbLoadLibrary(const aName: PChar): Pointer;
2005   begin
2006     {$IF DEFINED(GLB_WIN)}
2007     result := {%H-}Pointer(LoadLibrary(aName));
2008     {$ELSEIF DEFINED(GLB_LINUX)}
2009     result := dlopen(Name, RTLD_LAZY);
2010     {$ELSE}
2011     result := nil;
2012     {$IFEND}
2013   end;
2014
2015   ////////////////////////////////////////////////////////////////////////////////
2016   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2017   begin
2018     result := false;
2019     if not Assigned(aLibHandle) then
2020       exit;
2021
2022     {$IF DEFINED(GLB_WIN)}
2023     Result := FreeLibrary({%H-}HINST(aLibHandle));
2024     {$ELSEIF DEFINED(GLB_LINUX)}
2025     Result := dlclose(aLibHandle) = 0;
2026     {$IFEND}
2027   end;
2028
2029 begin
2030   if Assigned(GL_LibHandle) then
2031     glbFreeLibrary(GL_LibHandle);
2032
2033   if Assigned(GLU_LibHandle) then
2034     glbFreeLibrary(GLU_LibHandle);
2035
2036   GL_LibHandle := glbLoadLibrary(libopengl);
2037   if not Assigned(GL_LibHandle) then
2038     raise EglBitmap.Create('unable to load library: ' + libopengl);
2039
2040   GLU_LibHandle := glbLoadLibrary(libglu);
2041   if not Assigned(GLU_LibHandle) then
2042     raise EglBitmap.Create('unable to load library: ' + libglu);
2043
2044 {$IF DEFINED(GLB_WIN)}
2045   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2046 {$ELSEIF DEFINED(GLB_LINUX)}
2047   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2048   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2049 {$IFEND}
2050
2051   glEnable := glbGetProcAddress('glEnable');
2052   glDisable := glbGetProcAddress('glDisable');
2053   glGetString := glbGetProcAddress('glGetString');
2054   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2055   glTexParameteri := glbGetProcAddress('glTexParameteri');
2056   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2057   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2058   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2059   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2060   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2061   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2062   glTexGeni := glbGetProcAddress('glTexGeni');
2063   glGenTextures := glbGetProcAddress('glGenTextures');
2064   glBindTexture := glbGetProcAddress('glBindTexture');
2065   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2066   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2067   glReadPixels := glbGetProcAddress('glReadPixels');
2068   glPixelStorei := glbGetProcAddress('glPixelStorei');
2069   glTexImage1D := glbGetProcAddress('glTexImage1D');
2070   glTexImage2D := glbGetProcAddress('glTexImage2D');
2071   glGetTexImage := glbGetProcAddress('glGetTexImage');
2072
2073   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2074   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2075 end;
2076 {$ENDIF}
2077
2078 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2079 procedure glbReadOpenGLExtensions;
2080 var
2081   Buffer: AnsiString;
2082   MajorVersion, MinorVersion: Integer;
2083
2084   ///////////////////////////////////////////////////////////////////////////////////////////
2085   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2086   var
2087     Separator: Integer;
2088   begin
2089     aMinor := 0;
2090     aMajor := 0;
2091
2092     Separator := Pos(AnsiString('.'), aBuffer);
2093     if (Separator > 1) and (Separator < Length(aBuffer)) and
2094        (aBuffer[Separator - 1] in ['0'..'9']) and
2095        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2096
2097       Dec(Separator);
2098       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2099         Dec(Separator);
2100
2101       Delete(aBuffer, 1, Separator);
2102       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2103
2104       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2105         Inc(Separator);
2106
2107       Delete(aBuffer, Separator, 255);
2108       Separator := Pos(AnsiString('.'), aBuffer);
2109
2110       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2111       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2112     end;
2113   end;
2114
2115   ///////////////////////////////////////////////////////////////////////////////////////////
2116   function CheckExtension(const Extension: AnsiString): Boolean;
2117   var
2118     ExtPos: Integer;
2119   begin
2120     ExtPos := Pos(Extension, Buffer);
2121     result := ExtPos > 0;
2122     if result then
2123       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2124   end;
2125
2126   ///////////////////////////////////////////////////////////////////////////////////////////
2127   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2128   begin
2129     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2130   end;
2131
2132 begin
2133 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2134   InitOpenGLCS.Enter;
2135   try
2136     if not OpenGLInitialized then begin
2137       glbInitOpenGL;
2138       OpenGLInitialized := true;
2139     end;
2140   finally
2141     InitOpenGLCS.Leave;
2142   end;
2143 {$ENDIF}
2144
2145   // Version
2146   Buffer := glGetString(GL_VERSION);
2147   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2148
2149   GL_VERSION_1_2 := CheckVersion(1, 2);
2150   GL_VERSION_1_3 := CheckVersion(1, 3);
2151   GL_VERSION_1_4 := CheckVersion(1, 4);
2152   GL_VERSION_2_0 := CheckVersion(2, 0);
2153   GL_VERSION_3_3 := CheckVersion(3, 3);
2154
2155   // Extensions
2156   Buffer := glGetString(GL_EXTENSIONS);
2157   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2158   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2159   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2160   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2161   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2162   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2163   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2164   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2165   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2166   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2167   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2168   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2169   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2170   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2171
2172   if GL_VERSION_1_3 then begin
2173     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2174     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2175     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2176   end else begin
2177     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2178     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2179     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2180   end;
2181 end;
2182 {$ENDIF}
2183
2184 {$IFDEF GLB_SDL_IMAGE}
2185 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2186 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2189 begin
2190   result := TStream(context^.unknown.data1).Seek(offset, whence);
2191 end;
2192
2193 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2194 begin
2195   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2196 end;
2197
2198 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2199 begin
2200   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2201 end;
2202
2203 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2204 begin
2205   result := 0;
2206 end;
2207
2208 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2209 begin
2210   result := SDL_AllocRW;
2211
2212   if result = nil then
2213     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2214
2215   result^.seek := glBitmapRWseek;
2216   result^.read := glBitmapRWread;
2217   result^.write := glBitmapRWwrite;
2218   result^.close := glBitmapRWclose;
2219   result^.unknown.data1 := Stream;
2220 end;
2221 {$ENDIF}
2222
2223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2224 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2225 begin
2226   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2227 end;
2228
2229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2230 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2231 begin
2232   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2233 end;
2234
2235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2236 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2237 begin
2238   glBitmapDefaultMipmap := aValue;
2239 end;
2240
2241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2242 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2243 begin
2244   glBitmapDefaultFormat := aFormat;
2245 end;
2246
2247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2249 begin
2250   glBitmapDefaultFilterMin := aMin;
2251   glBitmapDefaultFilterMag := aMag;
2252 end;
2253
2254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2255 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2256 begin
2257   glBitmapDefaultWrapS := S;
2258   glBitmapDefaultWrapT := T;
2259   glBitmapDefaultWrapR := R;
2260 end;
2261
2262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2263 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2264 begin
2265   glDefaultSwizzle[0] := r;
2266   glDefaultSwizzle[1] := g;
2267   glDefaultSwizzle[2] := b;
2268   glDefaultSwizzle[3] := a;
2269 end;
2270
2271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2272 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2273 begin
2274   result := glBitmapDefaultDeleteTextureOnFree;
2275 end;
2276
2277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2278 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2279 begin
2280   result := glBitmapDefaultFreeDataAfterGenTextures;
2281 end;
2282
2283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2284 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2285 begin
2286   result := glBitmapDefaultMipmap;
2287 end;
2288
2289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2290 function glBitmapGetDefaultFormat: TglBitmapFormat;
2291 begin
2292   result := glBitmapDefaultFormat;
2293 end;
2294
2295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2297 begin
2298   aMin := glBitmapDefaultFilterMin;
2299   aMag := glBitmapDefaultFilterMag;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2304 begin
2305   S := glBitmapDefaultWrapS;
2306   T := glBitmapDefaultWrapT;
2307   R := glBitmapDefaultWrapR;
2308 end;
2309
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2312 begin
2313   r := glDefaultSwizzle[0];
2314   g := glDefaultSwizzle[1];
2315   b := glDefaultSwizzle[2];
2316   a := glDefaultSwizzle[3];
2317 end;
2318
2319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2322 function TFormatDescriptor.GetRedMask: QWord;
2323 begin
2324   result := fRange.r shl fShift.r;
2325 end;
2326
2327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2328 function TFormatDescriptor.GetGreenMask: QWord;
2329 begin
2330   result := fRange.g shl fShift.g;
2331 end;
2332
2333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 function TFormatDescriptor.GetBlueMask: QWord;
2335 begin
2336   result := fRange.b shl fShift.b;
2337 end;
2338
2339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2340 function TFormatDescriptor.GetAlphaMask: QWord;
2341 begin
2342   result := fRange.a shl fShift.a;
2343 end;
2344
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 function TFormatDescriptor.GetIsCompressed: Boolean;
2347 begin
2348   result := fIsCompressed;
2349 end;
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 function TFormatDescriptor.GetHasRed: Boolean;
2353 begin
2354   result := (fRange.r > 0);
2355 end;
2356
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 function TFormatDescriptor.GetHasGreen: Boolean;
2359 begin
2360   result := (fRange.g > 0);
2361 end;
2362
2363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2364 function TFormatDescriptor.GetHasBlue: Boolean;
2365 begin
2366   result := (fRange.b > 0);
2367 end;
2368
2369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 function TFormatDescriptor.GetHasAlpha: Boolean;
2371 begin
2372   result := (fRange.a > 0);
2373 end;
2374
2375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 function TFormatDescriptor.GetglFormat: GLenum;
2377 begin
2378   result := fglFormat;
2379 end;
2380
2381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2382 function TFormatDescriptor.GetglInternalFormat: GLenum;
2383 begin
2384   result := fglInternalFormat;
2385 end;
2386
2387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2388 function TFormatDescriptor.GetglDataFormat: GLenum;
2389 begin
2390   result := fglDataFormat;
2391 end;
2392
2393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2394 function TFormatDescriptor.GetComponents: Integer;
2395 var
2396   i: Integer;
2397 begin
2398   result := 0;
2399   for i := 0 to 3 do
2400     if (fRange.arr[i] > 0) then
2401       inc(result);
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2406 var
2407   w, h: Integer;
2408 begin
2409   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2410     w := Max(1, aSize.X);
2411     h := Max(1, aSize.Y);
2412     result := GetSize(w, h);
2413   end else
2414     result := 0;
2415 end;
2416
2417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2418 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2419 begin
2420   result := 0;
2421   if (aWidth <= 0) or (aHeight <= 0) then
2422     exit;
2423   result := Ceil(aWidth * aHeight * fPixelSize);
2424 end;
2425
2426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 function TFormatDescriptor.CreateMappingData: Pointer;
2428 begin
2429   result := nil;
2430 end;
2431
2432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2433 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2434 begin
2435   //DUMMY
2436 end;
2437
2438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2439 function TFormatDescriptor.IsEmpty: Boolean;
2440 begin
2441   result := (fFormat = tfEmpty);
2442 end;
2443
2444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2445 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2446 begin
2447   result := false;
2448   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2449     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2450   if (aRedMask   <> RedMask) then
2451     exit;
2452   if (aGreenMask <> GreenMask) then
2453     exit;
2454   if (aBlueMask  <> BlueMask) then
2455     exit;
2456   if (aAlphaMask <> AlphaMask) then
2457     exit;
2458   result := true;
2459 end;
2460
2461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2462 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2463 begin
2464   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2465   aPixel.Data   := fRange;
2466   aPixel.Range  := fRange;
2467   aPixel.Format := fFormat;
2468 end;
2469
2470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2471 constructor TFormatDescriptor.Create;
2472 begin
2473   inherited Create;
2474
2475   fFormat       := tfEmpty;
2476   fWithAlpha    := tfEmpty;
2477   fWithoutAlpha := tfEmpty;
2478   fRGBInverted  := tfEmpty;
2479   fUncompressed := tfEmpty;
2480   fPixelSize    := 0.0;
2481   fIsCompressed := false;
2482
2483   fglFormat         := 0;
2484   fglInternalFormat := 0;
2485   fglDataFormat     := 0;
2486
2487   FillChar(fRange, 0, SizeOf(fRange));
2488   FillChar(fShift, 0, SizeOf(fShift));
2489 end;
2490
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2495 begin
2496   aData^ := aPixel.Data.a;
2497   inc(aData);
2498 end;
2499
2500 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2501 begin
2502   aPixel.Data.r := 0;
2503   aPixel.Data.g := 0;
2504   aPixel.Data.b := 0;
2505   aPixel.Data.a := aData^;
2506   inc(aData);
2507 end;
2508
2509 constructor TfdAlpha_UB1.Create;
2510 begin
2511   inherited Create;
2512   fPixelSize        := 1.0;
2513   fRange.a          := $FF;
2514   fglFormat         := GL_ALPHA;
2515   fglDataFormat     := GL_UNSIGNED_BYTE;
2516 end;
2517
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2522 begin
2523   aData^ := LuminanceWeight(aPixel);
2524   inc(aData);
2525 end;
2526
2527 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2528 begin
2529   aPixel.Data.r := aData^;
2530   aPixel.Data.g := aData^;
2531   aPixel.Data.b := aData^;
2532   aPixel.Data.a := 0;
2533   inc(aData);
2534 end;
2535
2536 constructor TfdLuminance_UB1.Create;
2537 begin
2538   inherited Create;
2539   fPixelSize        := 1.0;
2540   fRange.r          := $FF;
2541   fRange.g          := $FF;
2542   fRange.b          := $FF;
2543   fglFormat         := GL_LUMINANCE;
2544   fglDataFormat     := GL_UNSIGNED_BYTE;
2545 end;
2546
2547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2551 var
2552   i: Integer;
2553 begin
2554   aData^ := 0;
2555   for i := 0 to 3 do
2556     if (fRange.arr[i] > 0) then
2557       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2558   inc(aData);
2559 end;
2560
2561 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2562 var
2563   i: Integer;
2564 begin
2565   for i := 0 to 3 do
2566     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2567   inc(aData);
2568 end;
2569
2570 constructor TfdUniversal_UB1.Create;
2571 begin
2572   inherited Create;
2573   fPixelSize := 1.0;
2574 end;
2575
2576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2580 begin
2581   inherited Map(aPixel, aData, aMapData);
2582   aData^ := aPixel.Data.a;
2583   inc(aData);
2584 end;
2585
2586 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2587 begin
2588   inherited Unmap(aData, aPixel, aMapData);
2589   aPixel.Data.a := aData^;
2590   inc(aData);
2591 end;
2592
2593 constructor TfdLuminanceAlpha_UB2.Create;
2594 begin
2595   inherited Create;
2596   fPixelSize        := 2.0;
2597   fRange.a          := $FF;
2598   fShift.a          :=   8;
2599   fglFormat         := GL_LUMINANCE_ALPHA;
2600   fglDataFormat     := GL_UNSIGNED_BYTE;
2601 end;
2602
2603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2606 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2607 begin
2608   aData^ := aPixel.Data.r;
2609   inc(aData);
2610   aData^ := aPixel.Data.g;
2611   inc(aData);
2612   aData^ := aPixel.Data.b;
2613   inc(aData);
2614 end;
2615
2616 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2617 begin
2618   aPixel.Data.r := aData^;
2619   inc(aData);
2620   aPixel.Data.g := aData^;
2621   inc(aData);
2622   aPixel.Data.b := aData^;
2623   inc(aData);
2624   aPixel.Data.a := 0;
2625 end;
2626
2627 constructor TfdRGB_UB3.Create;
2628 begin
2629   inherited Create;
2630   fPixelSize        := 3.0;
2631   fRange.r          := $FF;
2632   fRange.g          := $FF;
2633   fRange.b          := $FF;
2634   fShift.r          :=   0;
2635   fShift.g          :=   8;
2636   fShift.b          :=  16;
2637   fglFormat         := GL_RGB;
2638   fglDataFormat     := GL_UNSIGNED_BYTE;
2639 end;
2640
2641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2645 begin
2646   aData^ := aPixel.Data.b;
2647   inc(aData);
2648   aData^ := aPixel.Data.g;
2649   inc(aData);
2650   aData^ := aPixel.Data.r;
2651   inc(aData);
2652 end;
2653
2654 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2655 begin
2656   aPixel.Data.b := aData^;
2657   inc(aData);
2658   aPixel.Data.g := aData^;
2659   inc(aData);
2660   aPixel.Data.r := aData^;
2661   inc(aData);
2662   aPixel.Data.a := 0;
2663 end;
2664
2665 constructor TfdBGR_UB3.Create;
2666 begin
2667   fPixelSize        := 3.0;
2668   fRange.r          := $FF;
2669   fRange.g          := $FF;
2670   fRange.b          := $FF;
2671   fShift.r          :=  16;
2672   fShift.g          :=   8;
2673   fShift.b          :=   0;
2674   fglFormat         := GL_BGR;
2675   fglDataFormat     := GL_UNSIGNED_BYTE;
2676 end;
2677
2678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2682 begin
2683   inherited Map(aPixel, aData, aMapData);
2684   aData^ := aPixel.Data.a;
2685   inc(aData);
2686 end;
2687
2688 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2689 begin
2690   inherited Unmap(aData, aPixel, aMapData);
2691   aPixel.Data.a := aData^;
2692   inc(aData);
2693 end;
2694
2695 constructor TfdRGBA_UB4.Create;
2696 begin
2697   inherited Create;
2698   fPixelSize        := 4.0;
2699   fRange.a          := $FF;
2700   fShift.a          :=  24;
2701   fglFormat         := GL_RGBA;
2702   fglDataFormat     := GL_UNSIGNED_BYTE;
2703 end;
2704
2705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2709 begin
2710   inherited Map(aPixel, aData, aMapData);
2711   aData^ := aPixel.Data.a;
2712   inc(aData);
2713 end;
2714
2715 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2716 begin
2717   inherited Unmap(aData, aPixel, aMapData);
2718   aPixel.Data.a := aData^;
2719   inc(aData);
2720 end;
2721
2722 constructor TfdBGRA_UB4.Create;
2723 begin
2724   inherited Create;
2725   fPixelSize        := 4.0;
2726   fRange.a          := $FF;
2727   fShift.a          :=  24;
2728   fglFormat         := GL_BGRA;
2729   fglDataFormat     := GL_UNSIGNED_BYTE;
2730 end;
2731
2732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2736 begin
2737   PWord(aData)^ := aPixel.Data.a;
2738   inc(aData, 2);
2739 end;
2740
2741 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2742 begin
2743   aPixel.Data.r := 0;
2744   aPixel.Data.g := 0;
2745   aPixel.Data.b := 0;
2746   aPixel.Data.a := PWord(aData)^;
2747   inc(aData, 2);
2748 end;
2749
2750 constructor TfdAlpha_US1.Create;
2751 begin
2752   inherited Create;
2753   fPixelSize        := 2.0;
2754   fRange.a          := $FFFF;
2755   fglFormat         := GL_ALPHA;
2756   fglDataFormat     := GL_UNSIGNED_SHORT;
2757 end;
2758
2759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2763 begin
2764   PWord(aData)^ := LuminanceWeight(aPixel);
2765   inc(aData, 2);
2766 end;
2767
2768 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2769 begin
2770   aPixel.Data.r := PWord(aData)^;
2771   aPixel.Data.g := PWord(aData)^;
2772   aPixel.Data.b := PWord(aData)^;
2773   aPixel.Data.a := 0;
2774   inc(aData, 2);
2775 end;
2776
2777 constructor TfdLuminance_US1.Create;
2778 begin
2779   inherited Create;
2780   fPixelSize        := 2.0;
2781   fRange.r          := $FFFF;
2782   fRange.g          := $FFFF;
2783   fRange.b          := $FFFF;
2784   fglFormat         := GL_LUMINANCE;
2785   fglDataFormat     := GL_UNSIGNED_SHORT;
2786 end;
2787
2788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2792 var
2793   i: Integer;
2794 begin
2795   PWord(aData)^ := 0;
2796   for i := 0 to 3 do
2797     if (fRange.arr[i] > 0) then
2798       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2799   inc(aData, 2);
2800 end;
2801
2802 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2803 var
2804   i: Integer;
2805 begin
2806   for i := 0 to 3 do
2807     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2808   inc(aData, 2);
2809 end;
2810
2811 constructor TfdUniversal_US1.Create;
2812 begin
2813   inherited Create;
2814   fPixelSize := 2.0;
2815 end;
2816
2817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2821 begin
2822   PWord(aData)^ := DepthWeight(aPixel);
2823   inc(aData, 2);
2824 end;
2825
2826 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2827 begin
2828   aPixel.Data.r := PWord(aData)^;
2829   aPixel.Data.g := PWord(aData)^;
2830   aPixel.Data.b := PWord(aData)^;
2831   aPixel.Data.a := 0;
2832   inc(aData, 2);
2833 end;
2834
2835 constructor TfdDepth_US1.Create;
2836 begin
2837   inherited Create;
2838   fPixelSize        := 2.0;
2839   fRange.r          := $FFFF;
2840   fRange.g          := $FFFF;
2841   fRange.b          := $FFFF;
2842   fglFormat         := GL_DEPTH_COMPONENT;
2843   fglDataFormat     := GL_UNSIGNED_SHORT;
2844 end;
2845
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2850 begin
2851   inherited Map(aPixel, aData, aMapData);
2852   PWord(aData)^ := aPixel.Data.a;
2853   inc(aData, 2);
2854 end;
2855
2856 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2857 begin
2858   inherited Unmap(aData, aPixel, aMapData);
2859   aPixel.Data.a := PWord(aData)^;
2860   inc(aData, 2);
2861 end;
2862
2863 constructor TfdLuminanceAlpha_US2.Create;
2864 begin
2865   inherited Create;
2866   fPixelSize        :=   4.0;
2867   fRange.a          := $FFFF;
2868   fShift.a          :=    16;
2869   fglFormat         := GL_LUMINANCE_ALPHA;
2870   fglDataFormat     := GL_UNSIGNED_SHORT;
2871 end;
2872
2873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2876 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2877 begin
2878   PWord(aData)^ := aPixel.Data.r;
2879   inc(aData, 2);
2880   PWord(aData)^ := aPixel.Data.g;
2881   inc(aData, 2);
2882   PWord(aData)^ := aPixel.Data.b;
2883   inc(aData, 2);
2884 end;
2885
2886 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2887 begin
2888   aPixel.Data.r := PWord(aData)^;
2889   inc(aData, 2);
2890   aPixel.Data.g := PWord(aData)^;
2891   inc(aData, 2);
2892   aPixel.Data.b := PWord(aData)^;
2893   inc(aData, 2);
2894   aPixel.Data.a := 0;
2895 end;
2896
2897 constructor TfdRGB_US3.Create;
2898 begin
2899   inherited Create;
2900   fPixelSize        :=   6.0;
2901   fRange.r          := $FFFF;
2902   fRange.g          := $FFFF;
2903   fRange.b          := $FFFF;
2904   fShift.r          :=     0;
2905   fShift.g          :=    16;
2906   fShift.b          :=    32;
2907   fglFormat         := GL_RGB;
2908   fglDataFormat     := GL_UNSIGNED_SHORT;
2909 end;
2910
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2915 begin
2916   PWord(aData)^ := aPixel.Data.b;
2917   inc(aData, 2);
2918   PWord(aData)^ := aPixel.Data.g;
2919   inc(aData, 2);
2920   PWord(aData)^ := aPixel.Data.r;
2921   inc(aData, 2);
2922 end;
2923
2924 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2925 begin
2926   aPixel.Data.b := PWord(aData)^;
2927   inc(aData, 2);
2928   aPixel.Data.g := PWord(aData)^;
2929   inc(aData, 2);
2930   aPixel.Data.r := PWord(aData)^;
2931   inc(aData, 2);
2932   aPixel.Data.a := 0;
2933 end;
2934
2935 constructor TfdBGR_US3.Create;
2936 begin
2937   inherited Create;
2938   fPixelSize        :=   6.0;
2939   fRange.r          := $FFFF;
2940   fRange.g          := $FFFF;
2941   fRange.b          := $FFFF;
2942   fShift.r          :=    32;
2943   fShift.g          :=    16;
2944   fShift.b          :=     0;
2945   fglFormat         := GL_BGR;
2946   fglDataFormat     := GL_UNSIGNED_SHORT;
2947 end;
2948
2949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2952 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2953 begin
2954   inherited Map(aPixel, aData, aMapData);
2955   PWord(aData)^ := aPixel.Data.a;
2956   inc(aData, 2);
2957 end;
2958
2959 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2960 begin
2961   inherited Unmap(aData, aPixel, aMapData);
2962   aPixel.Data.a := PWord(aData)^;
2963   inc(aData, 2);
2964 end;
2965
2966 constructor TfdRGBA_US4.Create;
2967 begin
2968   inherited Create;
2969   fPixelSize        :=   8.0;
2970   fRange.a          := $FFFF;
2971   fShift.a          :=    48;
2972   fglFormat         := GL_RGBA;
2973   fglDataFormat     := GL_UNSIGNED_SHORT;
2974 end;
2975
2976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2979 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2980 begin
2981   inherited Map(aPixel, aData, aMapData);
2982   PWord(aData)^ := aPixel.Data.a;
2983   inc(aData, 2);
2984 end;
2985
2986 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2987 begin
2988   inherited Unmap(aData, aPixel, aMapData);
2989   aPixel.Data.a := PWord(aData)^;
2990   inc(aData, 2);
2991 end;
2992
2993 constructor TfdBGRA_US4.Create;
2994 begin
2995   inherited Create;
2996   fPixelSize        :=   8.0;
2997   fRange.a          := $FFFF;
2998   fShift.a          :=    48;
2999   fglFormat         := GL_BGRA;
3000   fglDataFormat     := GL_UNSIGNED_SHORT;
3001 end;
3002
3003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3004 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3007 var
3008   i: Integer;
3009 begin
3010   PCardinal(aData)^ := 0;
3011   for i := 0 to 3 do
3012     if (fRange.arr[i] > 0) then
3013       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3014   inc(aData, 4);
3015 end;
3016
3017 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3018 var
3019   i: Integer;
3020 begin
3021   for i := 0 to 3 do
3022     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3023   inc(aData, 2);
3024 end;
3025
3026 constructor TfdUniversal_UI1.Create;
3027 begin
3028   inherited Create;
3029   fPixelSize := 4.0;
3030 end;
3031
3032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3033 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3036 begin
3037   PCardinal(aData)^ := DepthWeight(aPixel);
3038   inc(aData, 4);
3039 end;
3040
3041 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3042 begin
3043   aPixel.Data.r := PCardinal(aData)^;
3044   aPixel.Data.g := PCardinal(aData)^;
3045   aPixel.Data.b := PCardinal(aData)^;
3046   aPixel.Data.a := 0;
3047   inc(aData, 4);
3048 end;
3049
3050 constructor TfdDepth_UI1.Create;
3051 begin
3052   inherited Create;
3053   fPixelSize        := 4.0;
3054   fRange.r          := $FFFFFFFF;
3055   fRange.g          := $FFFFFFFF;
3056   fRange.b          := $FFFFFFFF;
3057   fglFormat         := GL_DEPTH_COMPONENT;
3058   fglDataFormat     := GL_UNSIGNED_INT;
3059 end;
3060
3061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3064 constructor TfdAlpha4.Create;
3065 begin
3066   inherited Create;
3067   fFormat           := tfAlpha4;
3068   fWithAlpha        := tfAlpha4;
3069   fglInternalFormat := GL_ALPHA4;
3070 end;
3071
3072 constructor TfdAlpha8.Create;
3073 begin
3074   inherited Create;
3075   fFormat           := tfAlpha8;
3076   fWithAlpha        := tfAlpha8;
3077   fglInternalFormat := GL_ALPHA8;
3078 end;
3079
3080 constructor TfdAlpha12.Create;
3081 begin
3082   inherited Create;
3083   fFormat           := tfAlpha12;
3084   fWithAlpha        := tfAlpha12;
3085   fglInternalFormat := GL_ALPHA12;
3086 end;
3087
3088 constructor TfdAlpha16.Create;
3089 begin
3090   inherited Create;
3091   fFormat           := tfAlpha16;
3092   fWithAlpha        := tfAlpha16;
3093   fglInternalFormat := GL_ALPHA16;
3094 end;
3095
3096 constructor TfdLuminance4.Create;
3097 begin
3098   inherited Create;
3099   fFormat           := tfLuminance4;
3100   fWithAlpha        := tfLuminance4Alpha4;
3101   fWithoutAlpha     := tfLuminance4;
3102   fglInternalFormat := GL_LUMINANCE4;
3103 end;
3104
3105 constructor TfdLuminance8.Create;
3106 begin
3107   inherited Create;
3108   fFormat           := tfLuminance8;
3109   fWithAlpha        := tfLuminance8Alpha8;
3110   fWithoutAlpha     := tfLuminance8;
3111   fglInternalFormat := GL_LUMINANCE8;
3112 end;
3113
3114 constructor TfdLuminance12.Create;
3115 begin
3116   inherited Create;
3117   fFormat           := tfLuminance12;
3118   fWithAlpha        := tfLuminance12Alpha12;
3119   fWithoutAlpha     := tfLuminance12;
3120   fglInternalFormat := GL_LUMINANCE12;
3121 end;
3122
3123 constructor TfdLuminance16.Create;
3124 begin
3125   inherited Create;
3126   fFormat           := tfLuminance16;
3127   fWithAlpha        := tfLuminance16Alpha16;
3128   fWithoutAlpha     := tfLuminance16;
3129   fglInternalFormat := GL_LUMINANCE16;
3130 end;
3131
3132 constructor TfdLuminance4Alpha4.Create;
3133 begin
3134   inherited Create;
3135   fFormat           := tfLuminance4Alpha4;
3136   fWithAlpha        := tfLuminance4Alpha4;
3137   fWithoutAlpha     := tfLuminance4;
3138   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3139 end;
3140
3141 constructor TfdLuminance6Alpha2.Create;
3142 begin
3143   inherited Create;
3144   fFormat           := tfLuminance6Alpha2;
3145   fWithAlpha        := tfLuminance6Alpha2;
3146   fWithoutAlpha     := tfLuminance8;
3147   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3148 end;
3149
3150 constructor TfdLuminance8Alpha8.Create;
3151 begin
3152   inherited Create;
3153   fFormat           := tfLuminance8Alpha8;
3154   fWithAlpha        := tfLuminance8Alpha8;
3155   fWithoutAlpha     := tfLuminance8;
3156   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3157 end;
3158
3159 constructor TfdLuminance12Alpha4.Create;
3160 begin
3161   inherited Create;
3162   fFormat           := tfLuminance12Alpha4;
3163   fWithAlpha        := tfLuminance12Alpha4;
3164   fWithoutAlpha     := tfLuminance12;
3165   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3166 end;
3167
3168 constructor TfdLuminance12Alpha12.Create;
3169 begin
3170   inherited Create;
3171   fFormat           := tfLuminance12Alpha12;
3172   fWithAlpha        := tfLuminance12Alpha12;
3173   fWithoutAlpha     := tfLuminance12;
3174   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3175 end;
3176
3177 constructor TfdLuminance16Alpha16.Create;
3178 begin
3179   inherited Create;
3180   fFormat           := tfLuminance16Alpha16;
3181   fWithAlpha        := tfLuminance16Alpha16;
3182   fWithoutAlpha     := tfLuminance16;
3183   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3184 end;
3185
3186 constructor TfdR3G3B2.Create;
3187 begin
3188   inherited Create;
3189   fFormat           := tfR3G3B2;
3190   fWithAlpha        := tfRGBA2;
3191   fWithoutAlpha     := tfR3G3B2;
3192   fRange.r          := $7;
3193   fRange.g          := $7;
3194   fRange.b          := $3;
3195   fShift.r          :=  0;
3196   fShift.g          :=  3;
3197   fShift.b          :=  6;
3198   fglFormat         := GL_RGB;
3199   fglInternalFormat := GL_R3_G3_B2;
3200   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3201 end;
3202
3203 constructor TfdRGB4.Create;
3204 begin
3205   inherited Create;
3206   fFormat           := tfRGB4;
3207   fWithAlpha        := tfRGBA4;
3208   fWithoutAlpha     := tfRGB4;
3209   fRGBInverted      := tfBGR4;
3210   fRange.r          := $F;
3211   fRange.g          := $F;
3212   fRange.b          := $F;
3213   fShift.r          :=  0;
3214   fShift.g          :=  4;
3215   fShift.b          :=  8;
3216   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3217   fglInternalFormat := GL_RGB4;
3218   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3219 end;
3220
3221 constructor TfdR5G6B5.Create;
3222 begin
3223   inherited Create;
3224   fFormat           := tfR5G6B5;
3225   fWithAlpha        := tfRGBA4;
3226   fWithoutAlpha     := tfR5G6B5;
3227   fRGBInverted      := tfB5G6R5;
3228   fRange.r          := $1F;
3229   fRange.g          := $3F;
3230   fRange.b          := $1F;
3231   fShift.r          :=   0;
3232   fShift.g          :=   5;
3233   fShift.b          :=  11;
3234   fglFormat         := GL_RGB;
3235   fglInternalFormat := GL_RGB565;
3236   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3237 end;
3238
3239 constructor TfdRGB5.Create;
3240 begin
3241   inherited Create;
3242   fFormat           := tfRGB5;
3243   fWithAlpha        := tfRGB5A1;
3244   fWithoutAlpha     := tfRGB5;
3245   fRGBInverted      := tfBGR5;
3246   fRange.r          := $1F;
3247   fRange.g          := $1F;
3248   fRange.b          := $1F;
3249   fShift.r          :=   0;
3250   fShift.g          :=   5;
3251   fShift.b          :=  10;
3252   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3253   fglInternalFormat := GL_RGB5;
3254   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3255 end;
3256
3257 constructor TfdRGB8.Create;
3258 begin
3259   inherited Create;
3260   fFormat           := tfRGB8;
3261   fWithAlpha        := tfRGBA8;
3262   fWithoutAlpha     := tfRGB8;
3263   fRGBInverted      := tfBGR8;
3264   fglInternalFormat := GL_RGB8;
3265 end;
3266
3267 constructor TfdRGB10.Create;
3268 begin
3269   inherited Create;
3270   fFormat           := tfRGB10;
3271   fWithAlpha        := tfRGB10A2;
3272   fWithoutAlpha     := tfRGB10;
3273   fRGBInverted      := tfBGR10;
3274   fRange.r          := $3FF;
3275   fRange.g          := $3FF;
3276   fRange.b          := $3FF;
3277   fShift.r          :=    0;
3278   fShift.g          :=   10;
3279   fShift.b          :=   20;
3280   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3281   fglInternalFormat := GL_RGB10;
3282   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3283 end;
3284
3285 constructor TfdRGB12.Create;
3286 begin
3287   inherited Create;
3288   fFormat           := tfRGB12;
3289   fWithAlpha        := tfRGBA12;
3290   fWithoutAlpha     := tfRGB12;
3291   fRGBInverted      := tfBGR12;
3292   fglInternalFormat := GL_RGB12;
3293 end;
3294
3295 constructor TfdRGB16.Create;
3296 begin
3297   inherited Create;
3298   fFormat           := tfRGB16;
3299   fWithAlpha        := tfRGBA16;
3300   fWithoutAlpha     := tfRGB16;
3301   fRGBInverted      := tfBGR16;
3302   fglInternalFormat := GL_RGB16;
3303 end;
3304
3305 constructor TfdRGBA2.Create;
3306 begin
3307   inherited Create;
3308   fFormat           := tfRGBA2;
3309   fWithAlpha        := tfRGBA2;
3310   fWithoutAlpha     := tfR3G3B2;
3311   fRGBInverted      := tfBGRA2;
3312   fglInternalFormat := GL_RGBA2;
3313 end;
3314
3315 constructor TfdRGBA4.Create;
3316 begin
3317   inherited Create;
3318   fFormat           := tfRGBA4;
3319   fWithAlpha        := tfRGBA4;
3320   fWithoutAlpha     := tfRGB4;
3321   fRGBInverted      := tfBGRA4;
3322   fRange.r          := $F;
3323   fRange.g          := $F;
3324   fRange.b          := $F;
3325   fRange.a          := $F;
3326   fShift.r          :=  0;
3327   fShift.g          :=  4;
3328   fShift.b          :=  8;
3329   fShift.a          := 12;
3330   fglFormat         := GL_RGBA;
3331   fglInternalFormat := GL_RGBA4;
3332   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3333 end;
3334
3335 constructor TfdRGB5A1.Create;
3336 begin
3337   inherited Create;
3338   fFormat           := tfRGB5A1;
3339   fWithAlpha        := tfRGB5A1;
3340   fWithoutAlpha     := tfRGB5;
3341   fRGBInverted      := tfBGR5A1;
3342   fRange.r          := $1F;
3343   fRange.g          := $1F;
3344   fRange.b          := $1F;
3345   fRange.a          := $01;
3346   fShift.r          :=   0;
3347   fShift.g          :=   5;
3348   fShift.b          :=  10;
3349   fShift.a          :=  15;
3350   fglFormat         := GL_RGBA;
3351   fglInternalFormat := GL_RGB5_A1;
3352   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3353 end;
3354
3355 constructor TfdRGBA8.Create;
3356 begin
3357   inherited Create;
3358   fFormat           := tfRGBA8;
3359   fWithAlpha        := tfRGBA8;
3360   fWithoutAlpha     := tfRGB8;
3361   fRGBInverted      := tfBGRA8;
3362   fglInternalFormat := GL_RGBA8;
3363 end;
3364
3365 constructor TfdRGB10A2.Create;
3366 begin
3367   inherited Create;
3368   fFormat           := tfRGB10A2;
3369   fWithAlpha        := tfRGB10A2;
3370   fWithoutAlpha     := tfRGB10;
3371   fRGBInverted      := tfBGR10A2;
3372   fRange.r          := $3FF;
3373   fRange.g          := $3FF;
3374   fRange.b          := $3FF;
3375   fRange.a          := $003;
3376   fShift.r          :=    0;
3377   fShift.g          :=   10;
3378   fShift.b          :=   20;
3379   fShift.a          :=   30;
3380   fglFormat         := GL_RGBA;
3381   fglInternalFormat := GL_RGB10_A2;
3382   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3383 end;
3384
3385 constructor TfdRGBA12.Create;
3386 begin
3387   inherited Create;
3388   fFormat           := tfRGBA12;
3389   fWithAlpha        := tfRGBA12;
3390   fWithoutAlpha     := tfRGB12;
3391   fRGBInverted      := tfBGRA12;
3392   fglInternalFormat := GL_RGBA12;
3393 end;
3394
3395 constructor TfdRGBA16.Create;
3396 begin
3397   inherited Create;
3398   fFormat           := tfRGBA16;
3399   fWithAlpha        := tfRGBA16;
3400   fWithoutAlpha     := tfRGB16;
3401   fRGBInverted      := tfBGRA16;
3402   fglInternalFormat := GL_RGBA16;
3403 end;
3404
3405 constructor TfdBGR4.Create;
3406 begin
3407   inherited Create;
3408   fPixelSize        := 2.0;
3409   fFormat           := tfBGR4;
3410   fWithAlpha        := tfBGRA4;
3411   fWithoutAlpha     := tfBGR4;
3412   fRGBInverted      := tfRGB4;
3413   fRange.r          := $F;
3414   fRange.g          := $F;
3415   fRange.b          := $F;
3416   fRange.a          := $0;
3417   fShift.r          :=  8;
3418   fShift.g          :=  4;
3419   fShift.b          :=  0;
3420   fShift.a          :=  0;
3421   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3422   fglInternalFormat := GL_RGB4;
3423   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3424 end;
3425
3426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3429 constructor TfdB5G6R5.Create;
3430 begin
3431   inherited Create;
3432   fFormat           := tfB5G6R5;
3433   fWithAlpha        := tfBGRA4;
3434   fWithoutAlpha     := tfB5G6R5;
3435   fRGBInverted      := tfR5G6B5;
3436   fRange.r          := $1F;
3437   fRange.g          := $3F;
3438   fRange.b          := $1F;
3439   fShift.r          :=  11;
3440   fShift.g          :=   5;
3441   fShift.b          :=   0;
3442   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3443   fglInternalFormat := GL_RGB8;
3444   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3445 end;
3446
3447 constructor TfdBGR5.Create;
3448 begin
3449   inherited Create;
3450   fPixelSize        := 2.0;
3451   fFormat           := tfBGR5;
3452   fWithAlpha        := tfBGR5A1;
3453   fWithoutAlpha     := tfBGR5;
3454   fRGBInverted      := tfRGB5;
3455   fRange.r          := $1F;
3456   fRange.g          := $1F;
3457   fRange.b          := $1F;
3458   fRange.a          := $00;
3459   fShift.r          :=  10;
3460   fShift.g          :=   5;
3461   fShift.b          :=   0;
3462   fShift.a          :=   0;
3463   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3464   fglInternalFormat := GL_RGB5;
3465   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3466 end;
3467
3468 constructor TfdBGR8.Create;
3469 begin
3470   inherited Create;
3471   fFormat           := tfBGR8;
3472   fWithAlpha        := tfBGRA8;
3473   fWithoutAlpha     := tfBGR8;
3474   fRGBInverted      := tfRGB8;
3475   fglInternalFormat := GL_RGB8;
3476 end;
3477
3478 constructor TfdBGR10.Create;
3479 begin
3480   inherited Create;
3481   fFormat           := tfBGR10;
3482   fWithAlpha        := tfBGR10A2;
3483   fWithoutAlpha     := tfBGR10;
3484   fRGBInverted      := tfRGB10;
3485   fRange.r          := $3FF;
3486   fRange.g          := $3FF;
3487   fRange.b          := $3FF;
3488   fRange.a          := $000;
3489   fShift.r          :=   20;
3490   fShift.g          :=   10;
3491   fShift.b          :=    0;
3492   fShift.a          :=    0;
3493   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3494   fglInternalFormat := GL_RGB10;
3495   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3496 end;
3497
3498 constructor TfdBGR12.Create;
3499 begin
3500   inherited Create;
3501   fFormat           := tfBGR12;
3502   fWithAlpha        := tfBGRA12;
3503   fWithoutAlpha     := tfBGR12;
3504   fRGBInverted      := tfRGB12;
3505   fglInternalFormat := GL_RGB12;
3506 end;
3507
3508 constructor TfdBGR16.Create;
3509 begin
3510   inherited Create;
3511   fFormat           := tfBGR16;
3512   fWithAlpha        := tfBGRA16;
3513   fWithoutAlpha     := tfBGR16;
3514   fRGBInverted      := tfRGB16;
3515   fglInternalFormat := GL_RGB16;
3516 end;
3517
3518 constructor TfdBGRA2.Create;
3519 begin
3520   inherited Create;
3521   fFormat           := tfBGRA2;
3522   fWithAlpha        := tfBGRA4;
3523   fWithoutAlpha     := tfBGR4;
3524   fRGBInverted      := tfRGBA2;
3525   fglInternalFormat := GL_RGBA2;
3526 end;
3527
3528 constructor TfdBGRA4.Create;
3529 begin
3530   inherited Create;
3531   fFormat           := tfBGRA4;
3532   fWithAlpha        := tfBGRA4;
3533   fWithoutAlpha     := tfBGR4;
3534   fRGBInverted      := tfRGBA4;
3535   fRange.r          := $F;
3536   fRange.g          := $F;
3537   fRange.b          := $F;
3538   fRange.a          := $F;
3539   fShift.r          :=  8;
3540   fShift.g          :=  4;
3541   fShift.b          :=  0;
3542   fShift.a          := 12;
3543   fglFormat         := GL_BGRA;
3544   fglInternalFormat := GL_RGBA4;
3545   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3546 end;
3547
3548 constructor TfdBGR5A1.Create;
3549 begin
3550   inherited Create;
3551   fFormat           := tfBGR5A1;
3552   fWithAlpha        := tfBGR5A1;
3553   fWithoutAlpha     := tfBGR5;
3554   fRGBInverted      := tfRGB5A1;
3555   fRange.r          := $1F;
3556   fRange.g          := $1F;
3557   fRange.b          := $1F;
3558   fRange.a          := $01;
3559   fShift.r          :=  10;
3560   fShift.g          :=   5;
3561   fShift.b          :=   0;
3562   fShift.a          :=  15;
3563   fglFormat         := GL_BGRA;
3564   fglInternalFormat := GL_RGB5_A1;
3565   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3566 end;
3567
3568 constructor TfdBGRA8.Create;
3569 begin
3570   inherited Create;
3571   fFormat           := tfBGRA8;
3572   fWithAlpha        := tfBGRA8;
3573   fWithoutAlpha     := tfBGR8;
3574   fRGBInverted      := tfRGBA8;
3575   fglInternalFormat := GL_RGBA8;
3576 end;
3577
3578 constructor TfdBGR10A2.Create;
3579 begin
3580   inherited Create;
3581   fFormat           := tfBGR10A2;
3582   fWithAlpha        := tfBGR10A2;
3583   fWithoutAlpha     := tfBGR10;
3584   fRGBInverted      := tfRGB10A2;
3585   fRange.r          := $3FF;
3586   fRange.g          := $3FF;
3587   fRange.b          := $3FF;
3588   fRange.a          := $003;
3589   fShift.r          :=   20;
3590   fShift.g          :=   10;
3591   fShift.b          :=    0;
3592   fShift.a          :=   30;
3593   fglFormat         := GL_BGRA;
3594   fglInternalFormat := GL_RGB10_A2;
3595   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3596 end;
3597
3598 constructor TfdBGRA12.Create;
3599 begin
3600   inherited Create;
3601   fFormat           := tfBGRA12;
3602   fWithAlpha        := tfBGRA12;
3603   fWithoutAlpha     := tfBGR12;
3604   fRGBInverted      := tfRGBA12;
3605   fglInternalFormat := GL_RGBA12;
3606 end;
3607
3608 constructor TfdBGRA16.Create;
3609 begin
3610   inherited Create;
3611   fFormat           := tfBGRA16;
3612   fWithAlpha        := tfBGRA16;
3613   fWithoutAlpha     := tfBGR16;
3614   fRGBInverted      := tfRGBA16;
3615   fglInternalFormat := GL_RGBA16;
3616 end;
3617
3618 constructor TfdDepth16.Create;
3619 begin
3620   inherited Create;
3621   fFormat           := tfDepth16;
3622   fWithAlpha        := tfEmpty;
3623   fWithoutAlpha     := tfDepth16;
3624   fglInternalFormat := GL_DEPTH_COMPONENT16;
3625 end;
3626
3627 constructor TfdDepth24.Create;
3628 begin
3629   inherited Create;
3630   fFormat           := tfDepth24;
3631   fWithAlpha        := tfEmpty;
3632   fWithoutAlpha     := tfDepth24;
3633   fglInternalFormat := GL_DEPTH_COMPONENT24;
3634 end;
3635
3636 constructor TfdDepth32.Create;
3637 begin
3638   inherited Create;
3639   fFormat           := tfDepth32;
3640   fWithAlpha        := tfEmpty;
3641   fWithoutAlpha     := tfDepth32;
3642   fglInternalFormat := GL_DEPTH_COMPONENT32;
3643 end;
3644
3645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3648 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3649 begin
3650   raise EglBitmap.Create('mapping for compressed formats is not supported');
3651 end;
3652
3653 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3654 begin
3655   raise EglBitmap.Create('mapping for compressed formats is not supported');
3656 end;
3657
3658 constructor TfdS3tcDtx1RGBA.Create;
3659 begin
3660   inherited Create;
3661   fFormat           := tfS3tcDtx1RGBA;
3662   fWithAlpha        := tfS3tcDtx1RGBA;
3663   fUncompressed     := tfRGB5A1;
3664   fPixelSize        := 0.5;
3665   fIsCompressed     := true;
3666   fglFormat         := GL_COMPRESSED_RGBA;
3667   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3668   fglDataFormat     := GL_UNSIGNED_BYTE;
3669 end;
3670
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3674 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3675 begin
3676   raise EglBitmap.Create('mapping for compressed formats is not supported');
3677 end;
3678
3679 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3680 begin
3681   raise EglBitmap.Create('mapping for compressed formats is not supported');
3682 end;
3683
3684 constructor TfdS3tcDtx3RGBA.Create;
3685 begin
3686   inherited Create;
3687   fFormat           := tfS3tcDtx3RGBA;
3688   fWithAlpha        := tfS3tcDtx3RGBA;
3689   fUncompressed     := tfRGBA8;
3690   fPixelSize        := 1.0;
3691   fIsCompressed     := true;
3692   fglFormat         := GL_COMPRESSED_RGBA;
3693   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3694   fglDataFormat     := GL_UNSIGNED_BYTE;
3695 end;
3696
3697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3700 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3701 begin
3702   raise EglBitmap.Create('mapping for compressed formats is not supported');
3703 end;
3704
3705 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3706 begin
3707   raise EglBitmap.Create('mapping for compressed formats is not supported');
3708 end;
3709
3710 constructor TfdS3tcDtx5RGBA.Create;
3711 begin
3712   inherited Create;
3713   fFormat           := tfS3tcDtx3RGBA;
3714   fWithAlpha        := tfS3tcDtx3RGBA;
3715   fUncompressed     := tfRGBA8;
3716   fPixelSize        := 1.0;
3717   fIsCompressed     := true;
3718   fglFormat         := GL_COMPRESSED_RGBA;
3719   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3720   fglDataFormat     := GL_UNSIGNED_BYTE;
3721 end;
3722
3723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 class procedure TFormatDescriptor.Init;
3727 begin
3728   if not Assigned(FormatDescriptorCS) then
3729     FormatDescriptorCS := TCriticalSection.Create;
3730 end;
3731
3732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3733 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3734 begin
3735   FormatDescriptorCS.Enter;
3736   try
3737     result := FormatDescriptors[aFormat];
3738     if not Assigned(result) then begin
3739       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3740       FormatDescriptors[aFormat] := result;
3741     end;
3742   finally
3743     FormatDescriptorCS.Leave;
3744   end;
3745 end;
3746
3747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3749 begin
3750   result := Get(Get(aFormat).WithAlpha);
3751 end;
3752
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 class procedure TFormatDescriptor.Clear;
3755 var
3756   f: TglBitmapFormat;
3757 begin
3758   FormatDescriptorCS.Enter;
3759   try
3760     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3761       FreeAndNil(FormatDescriptors[f]);
3762   finally
3763     FormatDescriptorCS.Leave;
3764   end;
3765 end;
3766
3767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3768 class procedure TFormatDescriptor.Finalize;
3769 begin
3770   Clear;
3771   FreeAndNil(FormatDescriptorCS);
3772 end;
3773
3774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3775 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3777 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3778 begin
3779   Update(aValue, fRange.r, fShift.r);
3780 end;
3781
3782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3784 begin
3785   Update(aValue, fRange.g, fShift.g);
3786 end;
3787
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3790 begin
3791   Update(aValue, fRange.b, fShift.b);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3796 begin
3797   Update(aValue, fRange.a, fShift.a);
3798 end;
3799
3800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3801 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3802   aShift: Byte);
3803 begin
3804   aShift := 0;
3805   aRange := 0;
3806   if (aMask = 0) then
3807     exit;
3808   while (aMask > 0) and ((aMask and 1) = 0) do begin
3809     inc(aShift);
3810     aMask := aMask shr 1;
3811   end;
3812   aRange := 1;
3813   while (aMask > 0) do begin
3814     aRange := aRange shl 1;
3815     aMask  := aMask  shr 1;
3816   end;
3817   dec(aRange);
3818
3819   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3820 end;
3821
3822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3823 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3824 var
3825   data: QWord;
3826   s: Integer;
3827 begin
3828   data :=
3829     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3830     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3831     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3832     ((aPixel.Data.a and fRange.a) shl fShift.a);
3833   s := Round(fPixelSize);
3834   case s of
3835     1:           aData^  := data;
3836     2:     PWord(aData)^ := data;
3837     4: PCardinal(aData)^ := data;
3838     8:    PQWord(aData)^ := data;
3839   else
3840     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3841   end;
3842   inc(aData, s);
3843 end;
3844
3845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3846 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3847 var
3848   data: QWord;
3849   s, i: Integer;
3850 begin
3851   s := Round(fPixelSize);
3852   case s of
3853     1: data :=           aData^;
3854     2: data :=     PWord(aData)^;
3855     4: data := PCardinal(aData)^;
3856     8: data :=    PQWord(aData)^;
3857   else
3858     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3859   end;
3860   for i := 0 to 3 do
3861     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3862   inc(aData, s);
3863 end;
3864
3865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3868 procedure TbmpColorTableFormat.CreateColorTable;
3869 var
3870   i: Integer;
3871 begin
3872   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3873     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3874
3875   if (Format = tfLuminance4) then
3876     SetLength(fColorTable, 16)
3877   else
3878     SetLength(fColorTable, 256);
3879
3880   case Format of
3881     tfLuminance4: begin
3882       for i := 0 to High(fColorTable) do begin
3883         fColorTable[i].r := 16 * i;
3884         fColorTable[i].g := 16 * i;
3885         fColorTable[i].b := 16 * i;
3886         fColorTable[i].a := 0;
3887       end;
3888     end;
3889
3890     tfLuminance8: begin
3891       for i := 0 to High(fColorTable) do begin
3892         fColorTable[i].r := i;
3893         fColorTable[i].g := i;
3894         fColorTable[i].b := i;
3895         fColorTable[i].a := 0;
3896       end;
3897     end;
3898
3899     tfR3G3B2: begin
3900       for i := 0 to High(fColorTable) do begin
3901         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3902         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3903         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3904         fColorTable[i].a := 0;
3905       end;
3906     end;
3907   end;
3908 end;
3909
3910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3912 var
3913   d: Byte;
3914 begin
3915   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3916     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3917
3918   case Format of
3919     tfLuminance4: begin
3920       if (aMapData = nil) then
3921         aData^ := 0;
3922       d := LuminanceWeight(aPixel) and Range.r;
3923       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3924       inc(PByte(aMapData), 4);
3925       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3926         inc(aData);
3927         aMapData := nil;
3928       end;
3929     end;
3930
3931     tfLuminance8: begin
3932       aData^ := LuminanceWeight(aPixel) and Range.r;
3933       inc(aData);
3934     end;
3935
3936     tfR3G3B2: begin
3937       aData^ := Round(
3938         ((aPixel.Data.r and Range.r) shl Shift.r) or
3939         ((aPixel.Data.g and Range.g) shl Shift.g) or
3940         ((aPixel.Data.b and Range.b) shl Shift.b));
3941       inc(aData);
3942     end;
3943   end;
3944 end;
3945
3946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3947 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3948 var
3949   idx: QWord;
3950   s: Integer;
3951   bits: Byte;
3952   f: Single;
3953 begin
3954   s    := Trunc(fPixelSize);
3955   f    := fPixelSize - s;
3956   bits := Round(8 * f);
3957   case s of
3958     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3959     1: idx :=           aData^;
3960     2: idx :=     PWord(aData)^;
3961     4: idx := PCardinal(aData)^;
3962     8: idx :=    PQWord(aData)^;
3963   else
3964     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3965   end;
3966   if (idx >= Length(fColorTable)) then
3967     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3968   with fColorTable[idx] do begin
3969     aPixel.Data.r := r;
3970     aPixel.Data.g := g;
3971     aPixel.Data.b := b;
3972     aPixel.Data.a := a;
3973   end;
3974   inc(PByte(aMapData), bits);
3975   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3976     inc(aData, 1);
3977     dec(PByte(aMapData), 8);
3978   end;
3979   inc(aData, s);
3980 end;
3981
3982 destructor TbmpColorTableFormat.Destroy;
3983 begin
3984   SetLength(fColorTable, 0);
3985   inherited Destroy;
3986 end;
3987
3988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3991 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3992 var
3993   i: Integer;
3994 begin
3995   for i := 0 to 3 do begin
3996     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3997       if (aSourceFD.Range.arr[i] > 0) then
3998         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3999       else
4000         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4001     end;
4002   end;
4003 end;
4004
4005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4006 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4007 begin
4008   with aFuncRec do begin
4009     if (Source.Range.r   > 0) then
4010       Dest.Data.r := Source.Data.r;
4011     if (Source.Range.g > 0) then
4012       Dest.Data.g := Source.Data.g;
4013     if (Source.Range.b  > 0) then
4014       Dest.Data.b := Source.Data.b;
4015     if (Source.Range.a > 0) then
4016       Dest.Data.a := Source.Data.a;
4017   end;
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4022 var
4023   i: Integer;
4024 begin
4025   with aFuncRec do begin
4026     for i := 0 to 3 do
4027       if (Source.Range.arr[i] > 0) then
4028         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4029   end;
4030 end;
4031
4032 type
4033   TShiftData = packed record
4034     case Integer of
4035       0: (r, g, b, a: SmallInt);
4036       1: (arr: array[0..3] of SmallInt);
4037   end;
4038   PShiftData = ^TShiftData;
4039
4040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4041 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4042 var
4043   i: Integer;
4044 begin
4045   with aFuncRec do
4046     for i := 0 to 3 do
4047       if (Source.Range.arr[i] > 0) then
4048         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4049 end;
4050
4051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4052 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4053 begin
4054   with aFuncRec do begin
4055     Dest.Data := Source.Data;
4056     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4057       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4058       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4059       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4060     end;
4061     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4062       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4063     end;
4064   end;
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4069 var
4070   i: Integer;
4071 begin
4072   with aFuncRec do begin
4073     for i := 0 to 3 do
4074       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4075   end;
4076 end;
4077
4078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4079 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4080 var
4081   Temp: Single;
4082 begin
4083   with FuncRec do begin
4084     if (FuncRec.Args = nil) then begin //source has no alpha
4085       Temp :=
4086         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4087         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4088         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4089       Dest.Data.a := Round(Dest.Range.a * Temp);
4090     end else
4091       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4092   end;
4093 end;
4094
4095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4096 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4097 type
4098   PglBitmapPixelData = ^TglBitmapPixelData;
4099 begin
4100   with FuncRec do begin
4101     Dest.Data.r := Source.Data.r;
4102     Dest.Data.g := Source.Data.g;
4103     Dest.Data.b := Source.Data.b;
4104
4105     with PglBitmapPixelData(Args)^ do
4106       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4107           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4108           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4109         Dest.Data.a := 0
4110       else
4111         Dest.Data.a := Dest.Range.a;
4112   end;
4113 end;
4114
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4117 begin
4118   with FuncRec do begin
4119     Dest.Data.r := Source.Data.r;
4120     Dest.Data.g := Source.Data.g;
4121     Dest.Data.b := Source.Data.b;
4122     Dest.Data.a := PCardinal(Args)^;
4123   end;
4124 end;
4125
4126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4127 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4128 type
4129   PRGBPix = ^TRGBPix;
4130   TRGBPix = array [0..2] of byte;
4131 var
4132   Temp: Byte;
4133 begin
4134   while aWidth > 0 do begin
4135     Temp := PRGBPix(aData)^[0];
4136     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4137     PRGBPix(aData)^[2] := Temp;
4138
4139     if aHasAlpha then
4140       Inc(aData, 4)
4141     else
4142       Inc(aData, 3);
4143     dec(aWidth);
4144   end;
4145 end;
4146
4147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4150 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4151 begin
4152   result := TFormatDescriptor.Get(Format);
4153 end;
4154
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 function TglBitmap.GetWidth: Integer;
4157 begin
4158   if (ffX in fDimension.Fields) then
4159     result := fDimension.X
4160   else
4161     result := -1;
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 function TglBitmap.GetHeight: Integer;
4166 begin
4167   if (ffY in fDimension.Fields) then
4168     result := fDimension.Y
4169   else
4170     result := -1;
4171 end;
4172
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 function TglBitmap.GetFileWidth: Integer;
4175 begin
4176   result := Max(1, Width);
4177 end;
4178
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 function TglBitmap.GetFileHeight: Integer;
4181 begin
4182   result := Max(1, Height);
4183 end;
4184
4185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4186 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4187 begin
4188   if fCustomData = aValue then
4189     exit;
4190   fCustomData := aValue;
4191 end;
4192
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 procedure TglBitmap.SetCustomName(const aValue: String);
4195 begin
4196   if fCustomName = aValue then
4197     exit;
4198   fCustomName := aValue;
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4203 begin
4204   if fCustomNameW = aValue then
4205     exit;
4206   fCustomNameW := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4211 begin
4212   if fFreeDataOnDestroy = aValue then
4213     exit;
4214   fFreeDataOnDestroy := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4219 begin
4220   if fDeleteTextureOnFree = aValue then
4221     exit;
4222   fDeleteTextureOnFree := aValue;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4227 begin
4228   if fFormat = aValue then
4229     exit;
4230   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4231     raise EglBitmapUnsupportedFormat.Create(Format);
4232   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4233 end;
4234
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4237 begin
4238   if fFreeDataAfterGenTexture = aValue then
4239     exit;
4240   fFreeDataAfterGenTexture := aValue;
4241 end;
4242
4243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4244 procedure TglBitmap.SetID(const aValue: Cardinal);
4245 begin
4246   if fID = aValue then
4247     exit;
4248   fID := aValue;
4249 end;
4250
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4253 begin
4254   if fMipMap = aValue then
4255     exit;
4256   fMipMap := aValue;
4257 end;
4258
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4261 begin
4262   if fTarget = aValue then
4263     exit;
4264   fTarget := aValue;
4265 end;
4266
4267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4268 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4269 var
4270   MaxAnisotropic: Integer;
4271 begin
4272   fAnisotropic := aValue;
4273   if (ID > 0) then begin
4274     if GL_EXT_texture_filter_anisotropic then begin
4275       if fAnisotropic > 0 then begin
4276         Bind(false);
4277         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4278         if aValue > MaxAnisotropic then
4279           fAnisotropic := MaxAnisotropic;
4280         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4281       end;
4282     end else begin
4283       fAnisotropic := 0;
4284     end;
4285   end;
4286 end;
4287
4288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4289 procedure TglBitmap.CreateID;
4290 begin
4291   if (ID <> 0) then
4292     glDeleteTextures(1, @fID);
4293   glGenTextures(1, @fID);
4294   Bind(false);
4295 end;
4296
4297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4298 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4299 begin
4300   // Set Up Parameters
4301   SetWrap(fWrapS, fWrapT, fWrapR);
4302   SetFilter(fFilterMin, fFilterMag);
4303   SetAnisotropic(fAnisotropic);
4304   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4305
4306   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4307     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4308
4309   // Mip Maps Generation Mode
4310   aBuildWithGlu := false;
4311   if (MipMap = mmMipmap) then begin
4312     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4313       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4314     else
4315       aBuildWithGlu := true;
4316   end else if (MipMap = mmMipmapGlu) then
4317     aBuildWithGlu := true;
4318 end;
4319
4320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4321 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4322   const aWidth: Integer; const aHeight: Integer);
4323 var
4324   s: Single;
4325 begin
4326   if (Data <> aData) then begin
4327     if (Assigned(Data)) then
4328       FreeMem(Data);
4329     fData := aData;
4330   end;
4331
4332   if not Assigned(fData) then begin
4333     fPixelSize := 0;
4334     fRowSize   := 0;
4335   end else begin
4336     FillChar(fDimension, SizeOf(fDimension), 0);
4337     if aWidth <> -1 then begin
4338       fDimension.Fields := fDimension.Fields + [ffX];
4339       fDimension.X := aWidth;
4340     end;
4341
4342     if aHeight <> -1 then begin
4343       fDimension.Fields := fDimension.Fields + [ffY];
4344       fDimension.Y := aHeight;
4345     end;
4346
4347     s := TFormatDescriptor.Get(aFormat).PixelSize;
4348     fFormat    := aFormat;
4349     fPixelSize := Ceil(s);
4350     fRowSize   := Ceil(s * aWidth);
4351   end;
4352 end;
4353
4354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4355 function TglBitmap.FlipHorz: Boolean;
4356 begin
4357   result := false;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 function TglBitmap.FlipVert: Boolean;
4362 begin
4363   result := false;
4364 end;
4365
4366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4369 procedure TglBitmap.AfterConstruction;
4370 begin
4371   inherited AfterConstruction;
4372
4373   fID         := 0;
4374   fTarget     := 0;
4375   fIsResident := false;
4376
4377   fMipMap                  := glBitmapDefaultMipmap;
4378   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4379   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4380
4381   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4382   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4383   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4384 end;
4385
4386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4387 procedure TglBitmap.BeforeDestruction;
4388 var
4389   NewData: PByte;
4390 begin
4391   if fFreeDataOnDestroy then begin
4392     NewData := nil;
4393     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4394   end;
4395   if (fID > 0) and fDeleteTextureOnFree then
4396     glDeleteTextures(1, @fID);
4397   inherited BeforeDestruction;
4398 end;
4399
4400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4401 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4402 var
4403   TempPos: Integer;
4404 begin
4405   if not Assigned(aResType) then begin
4406     TempPos   := Pos('.', aResource);
4407     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4408     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4409   end;
4410 end;
4411
4412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4413 procedure TglBitmap.LoadFromFile(const aFilename: String);
4414 var
4415   fs: TFileStream;
4416 begin
4417   if not FileExists(aFilename) then
4418     raise EglBitmap.Create('file does not exist: ' + aFilename);
4419   fFilename := aFilename;
4420   fs := TFileStream.Create(fFilename, fmOpenRead);
4421   try
4422     fs.Position := 0;
4423     LoadFromStream(fs);
4424   finally
4425     fs.Free;
4426   end;
4427 end;
4428
4429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4430 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4431 begin
4432   {$IFDEF GLB_SUPPORT_PNG_READ}
4433   if not LoadPNG(aStream) then
4434   {$ENDIF}
4435   {$IFDEF GLB_SUPPORT_JPEG_READ}
4436   if not LoadJPEG(aStream) then
4437   {$ENDIF}
4438   if not LoadDDS(aStream) then
4439   if not LoadTGA(aStream) then
4440   if not LoadBMP(aStream) then
4441     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4442 end;
4443
4444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4445 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4446   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4447 var
4448   tmpData: PByte;
4449   size: Integer;
4450 begin
4451   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4452   GetMem(tmpData, size);
4453   try
4454     FillChar(tmpData^, size, #$FF);
4455     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4456   except
4457     if Assigned(tmpData) then
4458       FreeMem(tmpData);
4459     raise;
4460   end;
4461   AddFunc(Self, aFunc, false, aFormat, aArgs);
4462 end;
4463
4464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4465 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4466 var
4467   rs: TResourceStream;
4468 begin
4469   PrepareResType(aResource, aResType);
4470   rs := TResourceStream.Create(aInstance, aResource, aResType);
4471   try
4472     LoadFromStream(rs);
4473   finally
4474     rs.Free;
4475   end;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4480 var
4481   rs: TResourceStream;
4482 begin
4483   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4484   try
4485     LoadFromStream(rs);
4486   finally
4487     rs.Free;
4488   end;
4489 end;
4490
4491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4492 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4493 var
4494   fs: TFileStream;
4495 begin
4496   fs := TFileStream.Create(aFileName, fmCreate);
4497   try
4498     fs.Position := 0;
4499     SaveToStream(fs, aFileType);
4500   finally
4501     fs.Free;
4502   end;
4503 end;
4504
4505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4506 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4507 begin
4508   case aFileType of
4509     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4510     ftPNG:  SavePNG(aStream);
4511     {$ENDIF}
4512     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4513     ftJPEG: SaveJPEG(aStream);
4514     {$ENDIF}
4515     ftDDS:  SaveDDS(aStream);
4516     ftTGA:  SaveTGA(aStream);
4517     ftBMP:  SaveBMP(aStream);
4518   end;
4519 end;
4520
4521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4522 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4523 begin
4524   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4525 end;
4526
4527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4528 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4529   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4530 var
4531   DestData, TmpData, SourceData: pByte;
4532   TempHeight, TempWidth: Integer;
4533   SourceFD, DestFD: TFormatDescriptor;
4534   SourceMD, DestMD: Pointer;
4535
4536   FuncRec: TglBitmapFunctionRec;
4537 begin
4538   Assert(Assigned(Data));
4539   Assert(Assigned(aSource));
4540   Assert(Assigned(aSource.Data));
4541
4542   result := false;
4543   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4544     SourceFD := TFormatDescriptor.Get(aSource.Format);
4545     DestFD   := TFormatDescriptor.Get(aFormat);
4546
4547     if (SourceFD.IsCompressed) then
4548       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4549     if (DestFD.IsCompressed) then
4550       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4551
4552     // inkompatible Formats so CreateTemp
4553     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4554       aCreateTemp := true;
4555
4556     // Values
4557     TempHeight := Max(1, aSource.Height);
4558     TempWidth  := Max(1, aSource.Width);
4559
4560     FuncRec.Sender := Self;
4561     FuncRec.Args   := aArgs;
4562
4563     TmpData := nil;
4564     if aCreateTemp then begin
4565       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4566       DestData := TmpData;
4567     end else
4568       DestData := Data;
4569
4570     try
4571       SourceFD.PreparePixel(FuncRec.Source);
4572       DestFD.PreparePixel  (FuncRec.Dest);
4573
4574       SourceMD := SourceFD.CreateMappingData;
4575       DestMD   := DestFD.CreateMappingData;
4576
4577       FuncRec.Size            := aSource.Dimension;
4578       FuncRec.Position.Fields := FuncRec.Size.Fields;
4579
4580       try
4581         SourceData := aSource.Data;
4582         FuncRec.Position.Y := 0;
4583         while FuncRec.Position.Y < TempHeight do begin
4584           FuncRec.Position.X := 0;
4585           while FuncRec.Position.X < TempWidth do begin
4586             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4587             aFunc(FuncRec);
4588             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4589             inc(FuncRec.Position.X);
4590           end;
4591           inc(FuncRec.Position.Y);
4592         end;
4593
4594         // Updating Image or InternalFormat
4595         if aCreateTemp then
4596           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4597         else if (aFormat <> fFormat) then
4598           Format := aFormat;
4599
4600         result := true;
4601       finally
4602         SourceFD.FreeMappingData(SourceMD);
4603         DestFD.FreeMappingData(DestMD);
4604       end;
4605     except
4606       if aCreateTemp and Assigned(TmpData) then
4607         FreeMem(TmpData);
4608       raise;
4609     end;
4610   end;
4611 end;
4612
4613 {$IFDEF GLB_SDL}
4614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4615 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4616 var
4617   Row, RowSize: Integer;
4618   SourceData, TmpData: PByte;
4619   TempDepth: Integer;
4620   FormatDesc: TFormatDescriptor;
4621
4622   function GetRowPointer(Row: Integer): pByte;
4623   begin
4624     result := aSurface.pixels;
4625     Inc(result, Row * RowSize);
4626   end;
4627
4628 begin
4629   result := false;
4630
4631   FormatDesc := TFormatDescriptor.Get(Format);
4632   if FormatDesc.IsCompressed then
4633     raise EglBitmapUnsupportedFormat.Create(Format);
4634
4635   if Assigned(Data) then begin
4636     case Trunc(FormatDesc.PixelSize) of
4637       1: TempDepth :=  8;
4638       2: TempDepth := 16;
4639       3: TempDepth := 24;
4640       4: TempDepth := 32;
4641     else
4642       raise EglBitmapUnsupportedFormat.Create(Format);
4643     end;
4644
4645     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4646       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4647     SourceData := Data;
4648     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4649
4650     for Row := 0 to FileHeight-1 do begin
4651       TmpData := GetRowPointer(Row);
4652       if Assigned(TmpData) then begin
4653         Move(SourceData^, TmpData^, RowSize);
4654         inc(SourceData, RowSize);
4655       end;
4656     end;
4657     result := true;
4658   end;
4659 end;
4660
4661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4662 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4663 var
4664   pSource, pData, pTempData: PByte;
4665   Row, RowSize, TempWidth, TempHeight: Integer;
4666   IntFormat: TglBitmapFormat;
4667   FormatDesc: TFormatDescriptor;
4668
4669   function GetRowPointer(Row: Integer): pByte;
4670   begin
4671     result := aSurface^.pixels;
4672     Inc(result, Row * RowSize);
4673   end;
4674
4675 begin
4676   result := false;
4677   if (Assigned(aSurface)) then begin
4678     with aSurface^.format^ do begin
4679       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4680         FormatDesc := TFormatDescriptor.Get(IntFormat);
4681         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4682           break;
4683       end;
4684       if (IntFormat = tfEmpty) then
4685         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4686     end;
4687
4688     TempWidth  := aSurface^.w;
4689     TempHeight := aSurface^.h;
4690     RowSize := FormatDesc.GetSize(TempWidth, 1);
4691     GetMem(pData, TempHeight * RowSize);
4692     try
4693       pTempData := pData;
4694       for Row := 0 to TempHeight -1 do begin
4695         pSource := GetRowPointer(Row);
4696         if (Assigned(pSource)) then begin
4697           Move(pSource^, pTempData^, RowSize);
4698           Inc(pTempData, RowSize);
4699         end;
4700       end;
4701       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4702       result := true;
4703     except
4704       if Assigned(pData) then
4705         FreeMem(pData);
4706       raise;
4707     end;
4708   end;
4709 end;
4710
4711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4712 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4713 var
4714   Row, Col, AlphaInterleave: Integer;
4715   pSource, pDest: PByte;
4716
4717   function GetRowPointer(Row: Integer): pByte;
4718   begin
4719     result := aSurface.pixels;
4720     Inc(result, Row * Width);
4721   end;
4722
4723 begin
4724   result := false;
4725   if Assigned(Data) then begin
4726     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4727       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4728
4729       AlphaInterleave := 0;
4730       case Format of
4731         tfLuminance8Alpha8:
4732           AlphaInterleave := 1;
4733         tfBGRA8, tfRGBA8:
4734           AlphaInterleave := 3;
4735       end;
4736
4737       pSource := Data;
4738       for Row := 0 to Height -1 do begin
4739         pDest := GetRowPointer(Row);
4740         if Assigned(pDest) then begin
4741           for Col := 0 to Width -1 do begin
4742             Inc(pSource, AlphaInterleave);
4743             pDest^ := pSource^;
4744             Inc(pDest);
4745             Inc(pSource);
4746           end;
4747         end;
4748       end;
4749       result := true;
4750     end;
4751   end;
4752 end;
4753
4754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4755 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4756 var
4757   bmp: TglBitmap2D;
4758 begin
4759   bmp := TglBitmap2D.Create;
4760   try
4761     bmp.AssignFromSurface(aSurface);
4762     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4763   finally
4764     bmp.Free;
4765   end;
4766 end;
4767 {$ENDIF}
4768
4769 {$IFDEF GLB_DELPHI}
4770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4771 function CreateGrayPalette: HPALETTE;
4772 var
4773   Idx: Integer;
4774   Pal: PLogPalette;
4775 begin
4776   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4777
4778   Pal.palVersion := $300;
4779   Pal.palNumEntries := 256;
4780
4781   for Idx := 0 to Pal.palNumEntries - 1 do begin
4782     Pal.palPalEntry[Idx].peRed   := Idx;
4783     Pal.palPalEntry[Idx].peGreen := Idx;
4784     Pal.palPalEntry[Idx].peBlue  := Idx;
4785     Pal.palPalEntry[Idx].peFlags := 0;
4786   end;
4787   Result := CreatePalette(Pal^);
4788   FreeMem(Pal);
4789 end;
4790
4791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4792 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4793 var
4794   Row: Integer;
4795   pSource, pData: PByte;
4796 begin
4797   result := false;
4798   if Assigned(Data) then begin
4799     if Assigned(aBitmap) then begin
4800       aBitmap.Width  := Width;
4801       aBitmap.Height := Height;
4802
4803       case Format of
4804         tfAlpha8, tfLuminance8: begin
4805           aBitmap.PixelFormat := pf8bit;
4806           aBitmap.Palette     := CreateGrayPalette;
4807         end;
4808         tfRGB5A1:
4809           aBitmap.PixelFormat := pf15bit;
4810         tfR5G6B5:
4811           aBitmap.PixelFormat := pf16bit;
4812         tfRGB8, tfBGR8:
4813           aBitmap.PixelFormat := pf24bit;
4814         tfRGBA8, tfBGRA8:
4815           aBitmap.PixelFormat := pf32bit;
4816       else
4817         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4818       end;
4819
4820       pSource := Data;
4821       for Row := 0 to FileHeight -1 do begin
4822         pData := aBitmap.Scanline[Row];
4823         Move(pSource^, pData^, fRowSize);
4824         Inc(pSource, fRowSize);
4825         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4826           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4827       end;
4828       result := true;
4829     end;
4830   end;
4831 end;
4832
4833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4834 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4835 var
4836   pSource, pData, pTempData: PByte;
4837   Row, RowSize, TempWidth, TempHeight: Integer;
4838   IntFormat: TglBitmapFormat;
4839 begin
4840   result := false;
4841
4842   if (Assigned(aBitmap)) then begin
4843     case aBitmap.PixelFormat of
4844       pf8bit:
4845         IntFormat := tfLuminance8;
4846       pf15bit:
4847         IntFormat := tfRGB5A1;
4848       pf16bit:
4849         IntFormat := tfR5G6B5;
4850       pf24bit:
4851         IntFormat := tfBGR8;
4852       pf32bit:
4853         IntFormat := tfBGRA8;
4854     else
4855       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4856     end;
4857
4858     TempWidth  := aBitmap.Width;
4859     TempHeight := aBitmap.Height;
4860     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4861     GetMem(pData, TempHeight * RowSize);
4862     try
4863       pTempData := pData;
4864       for Row := 0 to TempHeight -1 do begin
4865         pSource := aBitmap.Scanline[Row];
4866         if (Assigned(pSource)) then begin
4867           Move(pSource^, pTempData^, RowSize);
4868           Inc(pTempData, RowSize);
4869         end;
4870       end;
4871       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4872       result := true;
4873     except
4874       if Assigned(pData) then
4875         FreeMem(pData);
4876       raise;
4877     end;
4878   end;
4879 end;
4880
4881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4882 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4883 var
4884   Row, Col, AlphaInterleave: Integer;
4885   pSource, pDest: PByte;
4886 begin
4887   result := false;
4888
4889   if Assigned(Data) then begin
4890     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4891       if Assigned(aBitmap) then begin
4892         aBitmap.PixelFormat := pf8bit;
4893         aBitmap.Palette     := CreateGrayPalette;
4894         aBitmap.Width       := Width;
4895         aBitmap.Height      := Height;
4896
4897         case Format of
4898           tfLuminance8Alpha8:
4899             AlphaInterleave := 1;
4900           tfRGBA8, tfBGRA8:
4901             AlphaInterleave := 3;
4902           else
4903             AlphaInterleave := 0;
4904         end;
4905
4906         // Copy Data
4907         pSource := Data;
4908
4909         for Row := 0 to Height -1 do begin
4910           pDest := aBitmap.Scanline[Row];
4911           if Assigned(pDest) then begin
4912             for Col := 0 to Width -1 do begin
4913               Inc(pSource, AlphaInterleave);
4914               pDest^ := pSource^;
4915               Inc(pDest);
4916               Inc(pSource);
4917             end;
4918           end;
4919         end;
4920         result := true;
4921       end;
4922     end;
4923   end;
4924 end;
4925
4926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4927 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4928 var
4929   tex: TglBitmap2D;
4930 begin
4931   tex := TglBitmap2D.Create;
4932   try
4933     tex.AssignFromBitmap(ABitmap);
4934     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4935   finally
4936     tex.Free;
4937   end;
4938 end;
4939 {$ENDIF}
4940
4941 {$IFDEF GLB_LAZARUS}
4942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4943 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4944 var
4945   rid: TRawImageDescription;
4946   FormatDesc: TFormatDescriptor;
4947 begin
4948   result := false;
4949   if not Assigned(aImage) or (Format = tfEmpty) then
4950     exit;
4951   FormatDesc := TFormatDescriptor.Get(Format);
4952   if FormatDesc.IsCompressed then
4953     exit;
4954
4955   FillChar(rid{%H-}, SizeOf(rid), 0);
4956   if (Format in [
4957        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4958        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4959        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4960     rid.Format := ricfGray
4961   else
4962     rid.Format := ricfRGBA;
4963
4964   rid.Width        := Width;
4965   rid.Height       := Height;
4966   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4967   rid.BitOrder     := riboBitsInOrder;
4968   rid.ByteOrder    := riboLSBFirst;
4969   rid.LineOrder    := riloTopToBottom;
4970   rid.LineEnd      := rileTight;
4971   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4972   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4973   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4974   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4975   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4976   rid.RedShift     := FormatDesc.Shift.r;
4977   rid.GreenShift   := FormatDesc.Shift.g;
4978   rid.BlueShift    := FormatDesc.Shift.b;
4979   rid.AlphaShift   := FormatDesc.Shift.a;
4980
4981   rid.MaskBitsPerPixel  := 0;
4982   rid.PaletteColorCount := 0;
4983
4984   aImage.DataDescription := rid;
4985   aImage.CreateData;
4986
4987   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4988
4989   result := true;
4990 end;
4991
4992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4993 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4994 var
4995   f: TglBitmapFormat;
4996   FormatDesc: TFormatDescriptor;
4997   ImageData: PByte;
4998   ImageSize: Integer;
4999   CanCopy: Boolean;
5000
5001   procedure CopyConvert;
5002   var
5003     bfFormat: TbmpBitfieldFormat;
5004     pSourceLine, pDestLine: PByte;
5005     pSourceMD, pDestMD: Pointer;
5006     x, y: Integer;
5007     pixel: TglBitmapPixelData;
5008   begin
5009     bfFormat  := TbmpBitfieldFormat.Create;
5010     with aImage.DataDescription do begin
5011       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5012       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5013       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5014       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5015       bfFormat.PixelSize := BitsPerPixel / 8;
5016     end;
5017     pSourceMD := bfFormat.CreateMappingData;
5018     pDestMD   := FormatDesc.CreateMappingData;
5019     try
5020       for y := 0 to aImage.Height-1 do begin
5021         pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
5022         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5023         for x := 0 to aImage.Width-1 do begin
5024           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5025           FormatDesc.Map(pixel, pDestLine, pDestMD);
5026         end;
5027       end;
5028     finally
5029       FormatDesc.FreeMappingData(pDestMD);
5030       bfFormat.FreeMappingData(pSourceMD);
5031       bfFormat.Free;
5032     end;
5033   end;
5034
5035 begin
5036   result := false;
5037   if not Assigned(aImage) then
5038     exit;
5039   for f := High(f) downto Low(f) do begin
5040     FormatDesc := TFormatDescriptor.Get(f);
5041     with aImage.DataDescription do
5042       if FormatDesc.MaskMatch(
5043         (QWord(1 shl RedPrec  )-1) shl RedShift,
5044         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5045         (QWord(1 shl BluePrec )-1) shl BlueShift,
5046         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5047         break;
5048   end;
5049
5050   if (f = tfEmpty) then
5051     exit;
5052
5053   CanCopy :=
5054     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5055     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5056
5057   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5058   ImageData := GetMem(ImageSize);
5059   try
5060     if CanCopy then
5061       Move(aImage.PixelData^, ImageData^, ImageSize)
5062     else
5063       CopyConvert;
5064     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5065   except
5066     if Assigned(ImageData) then
5067       FreeMem(ImageData);
5068     raise;
5069   end;
5070
5071   result := true;
5072 end;
5073
5074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5075 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5076 var
5077   rid: TRawImageDescription;
5078   FormatDesc: TFormatDescriptor;
5079   Pixel: TglBitmapPixelData;
5080   x, y: Integer;
5081   srcMD: Pointer;
5082   src, dst: PByte;
5083 begin
5084   result := false;
5085   if not Assigned(aImage) or (Format = tfEmpty) then
5086     exit;
5087   FormatDesc := TFormatDescriptor.Get(Format);
5088   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5089     exit;
5090
5091   FillChar(rid{%H-}, SizeOf(rid), 0);
5092   rid.Format       := ricfGray;
5093   rid.Width        := Width;
5094   rid.Height       := Height;
5095   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5096   rid.BitOrder     := riboBitsInOrder;
5097   rid.ByteOrder    := riboLSBFirst;
5098   rid.LineOrder    := riloTopToBottom;
5099   rid.LineEnd      := rileTight;
5100   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5101   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5102   rid.GreenPrec    := 0;
5103   rid.BluePrec     := 0;
5104   rid.AlphaPrec    := 0;
5105   rid.RedShift     := 0;
5106   rid.GreenShift   := 0;
5107   rid.BlueShift    := 0;
5108   rid.AlphaShift   := 0;
5109
5110   rid.MaskBitsPerPixel  := 0;
5111   rid.PaletteColorCount := 0;
5112
5113   aImage.DataDescription := rid;
5114   aImage.CreateData;
5115
5116   srcMD := FormatDesc.CreateMappingData;
5117   try
5118     FormatDesc.PreparePixel(Pixel);
5119     src := Data;
5120     dst := aImage.PixelData;
5121     for y := 0 to Height-1 do
5122       for x := 0 to Width-1 do begin
5123         FormatDesc.Unmap(src, Pixel, srcMD);
5124         case rid.BitsPerPixel of
5125            8: begin
5126             dst^ := Pixel.Data.a;
5127             inc(dst);
5128           end;
5129           16: begin
5130             PWord(dst)^ := Pixel.Data.a;
5131             inc(dst, 2);
5132           end;
5133           24: begin
5134             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5135             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5136             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5137             inc(dst, 3);
5138           end;
5139           32: begin
5140             PCardinal(dst)^ := Pixel.Data.a;
5141             inc(dst, 4);
5142           end;
5143         else
5144           raise EglBitmapUnsupportedFormat.Create(Format);
5145         end;
5146       end;
5147   finally
5148     FormatDesc.FreeMappingData(srcMD);
5149   end;
5150   result := true;
5151 end;
5152
5153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5154 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5155 var
5156   tex: TglBitmap2D;
5157 begin
5158   tex := TglBitmap2D.Create;
5159   try
5160     tex.AssignFromLazIntfImage(aImage);
5161     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5162   finally
5163     tex.Free;
5164   end;
5165 end;
5166 {$ENDIF}
5167
5168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5169 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5170   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5171 var
5172   rs: TResourceStream;
5173 begin
5174   PrepareResType(aResource, aResType);
5175   rs := TResourceStream.Create(aInstance, aResource, aResType);
5176   try
5177     result := AddAlphaFromStream(rs, aFunc, aArgs);
5178   finally
5179     rs.Free;
5180   end;
5181 end;
5182
5183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5184 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5185   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5186 var
5187   rs: TResourceStream;
5188 begin
5189   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5190   try
5191     result := AddAlphaFromStream(rs, aFunc, aArgs);
5192   finally
5193     rs.Free;
5194   end;
5195 end;
5196
5197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5198 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5199 begin
5200   if TFormatDescriptor.Get(Format).IsCompressed then
5201     raise EglBitmapUnsupportedFormat.Create(Format);
5202   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5203 end;
5204
5205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5206 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5207 var
5208   FS: TFileStream;
5209 begin
5210   FS := TFileStream.Create(aFileName, fmOpenRead);
5211   try
5212     result := AddAlphaFromStream(FS, aFunc, aArgs);
5213   finally
5214     FS.Free;
5215   end;
5216 end;
5217
5218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5219 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5220 var
5221   tex: TglBitmap2D;
5222 begin
5223   tex := TglBitmap2D.Create(aStream);
5224   try
5225     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5226   finally
5227     tex.Free;
5228   end;
5229 end;
5230
5231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5232 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5233 var
5234   DestData, DestData2, SourceData: pByte;
5235   TempHeight, TempWidth: Integer;
5236   SourceFD, DestFD: TFormatDescriptor;
5237   SourceMD, DestMD, DestMD2: Pointer;
5238
5239   FuncRec: TglBitmapFunctionRec;
5240 begin
5241   result := false;
5242
5243   Assert(Assigned(Data));
5244   Assert(Assigned(aBitmap));
5245   Assert(Assigned(aBitmap.Data));
5246
5247   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5248     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5249
5250     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5251     DestFD   := TFormatDescriptor.Get(Format);
5252
5253     if not Assigned(aFunc) then begin
5254       aFunc        := glBitmapAlphaFunc;
5255       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5256     end else
5257       FuncRec.Args := aArgs;
5258
5259     // Values
5260     TempHeight := aBitmap.FileHeight;
5261     TempWidth  := aBitmap.FileWidth;
5262
5263     FuncRec.Sender          := Self;
5264     FuncRec.Size            := Dimension;
5265     FuncRec.Position.Fields := FuncRec.Size.Fields;
5266
5267     DestData   := Data;
5268     DestData2  := Data;
5269     SourceData := aBitmap.Data;
5270
5271     // Mapping
5272     SourceFD.PreparePixel(FuncRec.Source);
5273     DestFD.PreparePixel  (FuncRec.Dest);
5274
5275     SourceMD := SourceFD.CreateMappingData;
5276     DestMD   := DestFD.CreateMappingData;
5277     DestMD2  := DestFD.CreateMappingData;
5278     try
5279       FuncRec.Position.Y := 0;
5280       while FuncRec.Position.Y < TempHeight do begin
5281         FuncRec.Position.X := 0;
5282         while FuncRec.Position.X < TempWidth do begin
5283           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5284           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5285           aFunc(FuncRec);
5286           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5287           inc(FuncRec.Position.X);
5288         end;
5289         inc(FuncRec.Position.Y);
5290       end;
5291     finally
5292       SourceFD.FreeMappingData(SourceMD);
5293       DestFD.FreeMappingData(DestMD);
5294       DestFD.FreeMappingData(DestMD2);
5295     end;
5296   end;
5297 end;
5298
5299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5300 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5301 begin
5302   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5303 end;
5304
5305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5306 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5307 var
5308   PixelData: TglBitmapPixelData;
5309 begin
5310   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5311   result := AddAlphaFromColorKeyFloat(
5312     aRed   / PixelData.Range.r,
5313     aGreen / PixelData.Range.g,
5314     aBlue  / PixelData.Range.b,
5315     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5316 end;
5317
5318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5319 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5320 var
5321   values: array[0..2] of Single;
5322   tmp: Cardinal;
5323   i: Integer;
5324   PixelData: TglBitmapPixelData;
5325 begin
5326   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5327   with PixelData do begin
5328     values[0] := aRed;
5329     values[1] := aGreen;
5330     values[2] := aBlue;
5331
5332     for i := 0 to 2 do begin
5333       tmp          := Trunc(Range.arr[i] * aDeviation);
5334       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5335       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5336     end;
5337     Data.a  := 0;
5338     Range.a := 0;
5339   end;
5340   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5341 end;
5342
5343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5344 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5345 begin
5346   result := AddAlphaFromValueFloat(aAlpha / $FF);
5347 end;
5348
5349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5350 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5351 var
5352   PixelData: TglBitmapPixelData;
5353 begin
5354   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5355   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5356 end;
5357
5358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5359 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5360 var
5361   PixelData: TglBitmapPixelData;
5362 begin
5363   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5364   with PixelData do
5365     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5366   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5367 end;
5368
5369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5370 function TglBitmap.RemoveAlpha: Boolean;
5371 var
5372   FormatDesc: TFormatDescriptor;
5373 begin
5374   result := false;
5375   FormatDesc := TFormatDescriptor.Get(Format);
5376   if Assigned(Data) then begin
5377     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5378       raise EglBitmapUnsupportedFormat.Create(Format);
5379     result := ConvertTo(FormatDesc.WithoutAlpha);
5380   end;
5381 end;
5382
5383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5384 function TglBitmap.Clone: TglBitmap;
5385 var
5386   Temp: TglBitmap;
5387   TempPtr: PByte;
5388   Size: Integer;
5389 begin
5390   result := nil;
5391   Temp := (ClassType.Create as TglBitmap);
5392   try
5393     // copy texture data if assigned
5394     if Assigned(Data) then begin
5395       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5396       GetMem(TempPtr, Size);
5397       try
5398         Move(Data^, TempPtr^, Size);
5399         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5400       except
5401         if Assigned(TempPtr) then
5402           FreeMem(TempPtr);
5403         raise;
5404       end;
5405     end else begin
5406       TempPtr := nil;
5407       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5408     end;
5409
5410         // copy properties
5411     Temp.fID                      := ID;
5412     Temp.fTarget                  := Target;
5413     Temp.fFormat                  := Format;
5414     Temp.fMipMap                  := MipMap;
5415     Temp.fAnisotropic             := Anisotropic;
5416     Temp.fBorderColor             := fBorderColor;
5417     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5418     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5419     Temp.fFilterMin               := fFilterMin;
5420     Temp.fFilterMag               := fFilterMag;
5421     Temp.fWrapS                   := fWrapS;
5422     Temp.fWrapT                   := fWrapT;
5423     Temp.fWrapR                   := fWrapR;
5424     Temp.fFilename                := fFilename;
5425     Temp.fCustomName              := fCustomName;
5426     Temp.fCustomNameW             := fCustomNameW;
5427     Temp.fCustomData              := fCustomData;
5428
5429     result := Temp;
5430   except
5431     FreeAndNil(Temp);
5432     raise;
5433   end;
5434 end;
5435
5436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5437 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5438 var
5439   SourceFD, DestFD: TFormatDescriptor;
5440   SourcePD, DestPD: TglBitmapPixelData;
5441   ShiftData: TShiftData;
5442
5443   function CanCopyDirect: Boolean;
5444   begin
5445     result :=
5446       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5447       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5448       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5449       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5450   end;
5451
5452   function CanShift: Boolean;
5453   begin
5454     result :=
5455       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5456       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5457       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5458       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5459   end;
5460
5461   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5462   begin
5463     result := 0;
5464     while (aSource > aDest) and (aSource > 0) do begin
5465       inc(result);
5466       aSource := aSource shr 1;
5467     end;
5468   end;
5469
5470 begin
5471   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5472     SourceFD := TFormatDescriptor.Get(Format);
5473     DestFD   := TFormatDescriptor.Get(aFormat);
5474
5475     SourceFD.PreparePixel(SourcePD);
5476     DestFD.PreparePixel  (DestPD);
5477
5478     if CanCopyDirect then
5479       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5480     else if CanShift then begin
5481       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5482       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5483       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5484       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5485       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5486     end else
5487       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5488   end else
5489     result := true;
5490 end;
5491
5492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5493 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5494 begin
5495   if aUseRGB or aUseAlpha then
5496     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5497       ((Byte(aUseAlpha) and 1) shl 1) or
5498        (Byte(aUseRGB)   and 1)      ));
5499 end;
5500
5501 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5502 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5503 begin
5504   fBorderColor[0] := aRed;
5505   fBorderColor[1] := aGreen;
5506   fBorderColor[2] := aBlue;
5507   fBorderColor[3] := aAlpha;
5508   if (ID > 0) then begin
5509     Bind(false);
5510     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5511   end;
5512 end;
5513
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 procedure TglBitmap.FreeData;
5516 var
5517   TempPtr: PByte;
5518 begin
5519   TempPtr := nil;
5520   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5521 end;
5522
5523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5524 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5525   const aAlpha: Byte);
5526 begin
5527   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5528 end;
5529
5530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5531 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5532 var
5533   PixelData: TglBitmapPixelData;
5534 begin
5535   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5536   FillWithColorFloat(
5537     aRed   / PixelData.Range.r,
5538     aGreen / PixelData.Range.g,
5539     aBlue  / PixelData.Range.b,
5540     aAlpha / PixelData.Range.a);
5541 end;
5542
5543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5544 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5545 var
5546   PixelData: TglBitmapPixelData;
5547 begin
5548   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5549   with PixelData do begin
5550     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5551     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5552     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5553     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5554   end;
5555   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5556 end;
5557
5558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5559 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5560 begin
5561   //check MIN filter
5562   case aMin of
5563     GL_NEAREST:
5564       fFilterMin := GL_NEAREST;
5565     GL_LINEAR:
5566       fFilterMin := GL_LINEAR;
5567     GL_NEAREST_MIPMAP_NEAREST:
5568       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5569     GL_LINEAR_MIPMAP_NEAREST:
5570       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5571     GL_NEAREST_MIPMAP_LINEAR:
5572       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5573     GL_LINEAR_MIPMAP_LINEAR:
5574       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5575     else
5576       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5577   end;
5578
5579   //check MAG filter
5580   case aMag of
5581     GL_NEAREST:
5582       fFilterMag := GL_NEAREST;
5583     GL_LINEAR:
5584       fFilterMag := GL_LINEAR;
5585     else
5586       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5587   end;
5588
5589   //apply filter
5590   if (ID > 0) then begin
5591     Bind(false);
5592     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5593
5594     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5595       case fFilterMin of
5596         GL_NEAREST, GL_LINEAR:
5597           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5598         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5599           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5600         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5601           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5602       end;
5603     end else
5604       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5605   end;
5606 end;
5607
5608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5609 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5610
5611   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5612   begin
5613     case aValue of
5614       GL_CLAMP:
5615         aTarget := GL_CLAMP;
5616
5617       GL_REPEAT:
5618         aTarget := GL_REPEAT;
5619
5620       GL_CLAMP_TO_EDGE: begin
5621         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5622           aTarget := GL_CLAMP_TO_EDGE
5623         else
5624           aTarget := GL_CLAMP;
5625       end;
5626
5627       GL_CLAMP_TO_BORDER: begin
5628         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5629           aTarget := GL_CLAMP_TO_BORDER
5630         else
5631           aTarget := GL_CLAMP;
5632       end;
5633
5634       GL_MIRRORED_REPEAT: begin
5635         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5636           aTarget := GL_MIRRORED_REPEAT
5637         else
5638           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5639       end;
5640     else
5641       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5642     end;
5643   end;
5644
5645 begin
5646   CheckAndSetWrap(S, fWrapS);
5647   CheckAndSetWrap(T, fWrapT);
5648   CheckAndSetWrap(R, fWrapR);
5649
5650   if (ID > 0) then begin
5651     Bind(false);
5652     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5653     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5654     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5655   end;
5656 end;
5657
5658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5659 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5660
5661   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5662   begin
5663     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5664        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5665       fSwizzle[aIndex] := aValue
5666     else
5667       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5668   end;
5669
5670 begin
5671   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5672     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5673   CheckAndSetValue(r, 0);
5674   CheckAndSetValue(g, 1);
5675   CheckAndSetValue(b, 2);
5676   CheckAndSetValue(a, 3);
5677
5678   if (ID > 0) then begin
5679     Bind(false);
5680     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5681   end;
5682 end;
5683
5684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5685 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5686 begin
5687   if aEnableTextureUnit then
5688     glEnable(Target);
5689   if (ID > 0) then
5690     glBindTexture(Target, ID);
5691 end;
5692
5693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5694 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5695 begin
5696   if aDisableTextureUnit then
5697     glDisable(Target);
5698   glBindTexture(Target, 0);
5699 end;
5700
5701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5702 constructor TglBitmap.Create;
5703 begin
5704   if (ClassType = TglBitmap) then
5705     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5706 {$IFDEF GLB_NATIVE_OGL}
5707   glbReadOpenGLExtensions;
5708 {$ENDIF}
5709   inherited Create;
5710   fFormat            := glBitmapGetDefaultFormat;
5711   fFreeDataOnDestroy := true;
5712 end;
5713
5714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5715 constructor TglBitmap.Create(const aFileName: String);
5716 begin
5717   Create;
5718   LoadFromFile(aFileName);
5719 end;
5720
5721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5722 constructor TglBitmap.Create(const aStream: TStream);
5723 begin
5724   Create;
5725   LoadFromStream(aStream);
5726 end;
5727
5728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5729 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5730 var
5731   ImageSize: Integer;
5732 begin
5733   Create;
5734   if not Assigned(aData) then begin
5735     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5736     GetMem(aData, ImageSize);
5737     try
5738       FillChar(aData^, ImageSize, #$FF);
5739       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5740     except
5741       if Assigned(aData) then
5742         FreeMem(aData);
5743       raise;
5744     end;
5745   end else begin
5746     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5747     fFreeDataOnDestroy := false;
5748   end;
5749 end;
5750
5751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5752 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5753 begin
5754   Create;
5755   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5756 end;
5757
5758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5759 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5760 begin
5761   Create;
5762   LoadFromResource(aInstance, aResource, aResType);
5763 end;
5764
5765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5766 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5767 begin
5768   Create;
5769   LoadFromResourceID(aInstance, aResourceID, aResType);
5770 end;
5771
5772 {$IFDEF GLB_SUPPORT_PNG_READ}
5773 {$IF DEFINED(GLB_LAZ_PNG)}
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5777 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5778 const
5779   MAGIC_LEN = 8;
5780   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5781 var
5782   reader: TLazReaderPNG;
5783   intf: TLazIntfImage;
5784   StreamPos: Int64;
5785   magic: String[MAGIC_LEN];
5786 begin
5787   result := true;
5788   StreamPos := aStream.Position;
5789
5790   SetLength(magic, MAGIC_LEN);
5791   aStream.Read(magic[1], MAGIC_LEN);
5792   aStream.Position := StreamPos;
5793   if (magic <> PNG_MAGIC) then begin
5794     result := false;
5795     exit;
5796   end;
5797
5798   intf   := TLazIntfImage.Create(0, 0);
5799   reader := TLazReaderPNG.Create;
5800   try try
5801     reader.UpdateDescription := true;
5802     reader.ImageRead(aStream, intf);
5803     AssignFromLazIntfImage(intf);
5804   except
5805     result := false;
5806     aStream.Position := StreamPos;
5807     exit;
5808   end;
5809   finally
5810     reader.Free;
5811     intf.Free;
5812   end;
5813 end;
5814
5815 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5817 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5818 var
5819   Surface: PSDL_Surface;
5820   RWops: PSDL_RWops;
5821 begin
5822   result := false;
5823   RWops := glBitmapCreateRWops(aStream);
5824   try
5825     if IMG_isPNG(RWops) > 0 then begin
5826       Surface := IMG_LoadPNG_RW(RWops);
5827       try
5828         AssignFromSurface(Surface);
5829         result := true;
5830       finally
5831         SDL_FreeSurface(Surface);
5832       end;
5833     end;
5834   finally
5835     SDL_FreeRW(RWops);
5836   end;
5837 end;
5838
5839 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5841 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5842 begin
5843   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5844 end;
5845
5846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5847 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5848 var
5849   StreamPos: Int64;
5850   signature: array [0..7] of byte;
5851   png: png_structp;
5852   png_info: png_infop;
5853
5854   TempHeight, TempWidth: Integer;
5855   Format: TglBitmapFormat;
5856
5857   png_data: pByte;
5858   png_rows: array of pByte;
5859   Row, LineSize: Integer;
5860 begin
5861   result := false;
5862
5863   if not init_libPNG then
5864     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5865
5866   try
5867     // signature
5868     StreamPos := aStream.Position;
5869     aStream.Read(signature{%H-}, 8);
5870     aStream.Position := StreamPos;
5871
5872     if png_check_sig(@signature, 8) <> 0 then begin
5873       // png read struct
5874       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5875       if png = nil then
5876         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5877
5878       // png info
5879       png_info := png_create_info_struct(png);
5880       if png_info = nil then begin
5881         png_destroy_read_struct(@png, nil, nil);
5882         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5883       end;
5884
5885       // set read callback
5886       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5887
5888       // read informations
5889       png_read_info(png, png_info);
5890
5891       // size
5892       TempHeight := png_get_image_height(png, png_info);
5893       TempWidth := png_get_image_width(png, png_info);
5894
5895       // format
5896       case png_get_color_type(png, png_info) of
5897         PNG_COLOR_TYPE_GRAY:
5898           Format := tfLuminance8;
5899         PNG_COLOR_TYPE_GRAY_ALPHA:
5900           Format := tfLuminance8Alpha8;
5901         PNG_COLOR_TYPE_RGB:
5902           Format := tfRGB8;
5903         PNG_COLOR_TYPE_RGB_ALPHA:
5904           Format := tfRGBA8;
5905         else
5906           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5907       end;
5908
5909       // cut upper 8 bit from 16 bit formats
5910       if png_get_bit_depth(png, png_info) > 8 then
5911         png_set_strip_16(png);
5912
5913       // expand bitdepth smaller than 8
5914       if png_get_bit_depth(png, png_info) < 8 then
5915         png_set_expand(png);
5916
5917       // allocating mem for scanlines
5918       LineSize := png_get_rowbytes(png, png_info);
5919       GetMem(png_data, TempHeight * LineSize);
5920       try
5921         SetLength(png_rows, TempHeight);
5922         for Row := Low(png_rows) to High(png_rows) do begin
5923           png_rows[Row] := png_data;
5924           Inc(png_rows[Row], Row * LineSize);
5925         end;
5926
5927         // read complete image into scanlines
5928         png_read_image(png, @png_rows[0]);
5929
5930         // read end
5931         png_read_end(png, png_info);
5932
5933         // destroy read struct
5934         png_destroy_read_struct(@png, @png_info, nil);
5935
5936         SetLength(png_rows, 0);
5937
5938         // set new data
5939         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5940
5941         result := true;
5942       except
5943         if Assigned(png_data) then
5944           FreeMem(png_data);
5945         raise;
5946       end;
5947     end;
5948   finally
5949     quit_libPNG;
5950   end;
5951 end;
5952
5953 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5955 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5956 var
5957   StreamPos: Int64;
5958   Png: TPNGObject;
5959   Header: String[8];
5960   Row, Col, PixSize, LineSize: Integer;
5961   NewImage, pSource, pDest, pAlpha: pByte;
5962   PngFormat: TglBitmapFormat;
5963   FormatDesc: TFormatDescriptor;
5964
5965 const
5966   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5967
5968 begin
5969   result := false;
5970
5971   StreamPos := aStream.Position;
5972   aStream.Read(Header[0], SizeOf(Header));
5973   aStream.Position := StreamPos;
5974
5975   {Test if the header matches}
5976   if Header = PngHeader then begin
5977     Png := TPNGObject.Create;
5978     try
5979       Png.LoadFromStream(aStream);
5980
5981       case Png.Header.ColorType of
5982         COLOR_GRAYSCALE:
5983           PngFormat := tfLuminance8;
5984         COLOR_GRAYSCALEALPHA:
5985           PngFormat := tfLuminance8Alpha8;
5986         COLOR_RGB:
5987           PngFormat := tfBGR8;
5988         COLOR_RGBALPHA:
5989           PngFormat := tfBGRA8;
5990         else
5991           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5992       end;
5993
5994       FormatDesc := TFormatDescriptor.Get(PngFormat);
5995       PixSize    := Round(FormatDesc.PixelSize);
5996       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5997
5998       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5999       try
6000         pDest := NewImage;
6001
6002         case Png.Header.ColorType of
6003           COLOR_RGB, COLOR_GRAYSCALE:
6004             begin
6005               for Row := 0 to Png.Height -1 do begin
6006                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6007                 Inc(pDest, LineSize);
6008               end;
6009             end;
6010           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6011             begin
6012               PixSize := PixSize -1;
6013
6014               for Row := 0 to Png.Height -1 do begin
6015                 pSource := Png.Scanline[Row];
6016                 pAlpha := pByte(Png.AlphaScanline[Row]);
6017
6018                 for Col := 0 to Png.Width -1 do begin
6019                   Move (pSource^, pDest^, PixSize);
6020                   Inc(pSource, PixSize);
6021                   Inc(pDest, PixSize);
6022
6023                   pDest^ := pAlpha^;
6024                   inc(pAlpha);
6025                   Inc(pDest);
6026                 end;
6027               end;
6028             end;
6029           else
6030             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6031         end;
6032
6033         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6034
6035         result := true;
6036       except
6037         if Assigned(NewImage) then
6038           FreeMem(NewImage);
6039         raise;
6040       end;
6041     finally
6042       Png.Free;
6043     end;
6044   end;
6045 end;
6046 {$IFEND}
6047 {$ENDIF}
6048
6049 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6050 {$IFDEF GLB_LIB_PNG}
6051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6052 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6053 begin
6054   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6055 end;
6056 {$ENDIF}
6057
6058 {$IF DEFINED(GLB_LAZ_PNG)}
6059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6060 procedure TglBitmap.SavePNG(const aStream: TStream);
6061 var
6062   png: TPortableNetworkGraphic;
6063   intf: TLazIntfImage;
6064   raw: TRawImage;
6065 begin
6066   png  := TPortableNetworkGraphic.Create;
6067   intf := TLazIntfImage.Create(0, 0);
6068   try
6069     if not AssignToLazIntfImage(intf) then
6070       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6071     intf.GetRawImage(raw);
6072     png.LoadFromRawImage(raw, false);
6073     png.SaveToStream(aStream);
6074   finally
6075     png.Free;
6076     intf.Free;
6077   end;
6078 end;
6079
6080 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6082 procedure TglBitmap.SavePNG(const aStream: TStream);
6083 var
6084   png: png_structp;
6085   png_info: png_infop;
6086   png_rows: array of pByte;
6087   LineSize: Integer;
6088   ColorType: Integer;
6089   Row: Integer;
6090   FormatDesc: TFormatDescriptor;
6091 begin
6092   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6093     raise EglBitmapUnsupportedFormat.Create(Format);
6094
6095   if not init_libPNG then
6096     raise Exception.Create('unable to initialize libPNG.');
6097
6098   try
6099     case Format of
6100       tfAlpha8, tfLuminance8:
6101         ColorType := PNG_COLOR_TYPE_GRAY;
6102       tfLuminance8Alpha8:
6103         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6104       tfBGR8, tfRGB8:
6105         ColorType := PNG_COLOR_TYPE_RGB;
6106       tfBGRA8, tfRGBA8:
6107         ColorType := PNG_COLOR_TYPE_RGBA;
6108       else
6109         raise EglBitmapUnsupportedFormat.Create(Format);
6110     end;
6111
6112     FormatDesc := TFormatDescriptor.Get(Format);
6113     LineSize := FormatDesc.GetSize(Width, 1);
6114
6115     // creating array for scanline
6116     SetLength(png_rows, Height);
6117     try
6118       for Row := 0 to Height - 1 do begin
6119         png_rows[Row] := Data;
6120         Inc(png_rows[Row], Row * LineSize)
6121       end;
6122
6123       // write struct
6124       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6125       if png = nil then
6126         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6127
6128       // create png info
6129       png_info := png_create_info_struct(png);
6130       if png_info = nil then begin
6131         png_destroy_write_struct(@png, nil);
6132         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6133       end;
6134
6135       // set read callback
6136       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6137
6138       // set compression
6139       png_set_compression_level(png, 6);
6140
6141       if Format in [tfBGR8, tfBGRA8] then
6142         png_set_bgr(png);
6143
6144       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6145       png_write_info(png, png_info);
6146       png_write_image(png, @png_rows[0]);
6147       png_write_end(png, png_info);
6148       png_destroy_write_struct(@png, @png_info);
6149     finally
6150       SetLength(png_rows, 0);
6151     end;
6152   finally
6153     quit_libPNG;
6154   end;
6155 end;
6156
6157 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6159 procedure TglBitmap.SavePNG(const aStream: TStream);
6160 var
6161   Png: TPNGObject;
6162
6163   pSource, pDest: pByte;
6164   X, Y, PixSize: Integer;
6165   ColorType: Cardinal;
6166   Alpha: Boolean;
6167
6168   pTemp: pByte;
6169   Temp: Byte;
6170 begin
6171   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6172     raise EglBitmapUnsupportedFormat.Create(Format);
6173
6174   case Format of
6175     tfAlpha8, tfLuminance8: begin
6176       ColorType := COLOR_GRAYSCALE;
6177       PixSize   := 1;
6178       Alpha     := false;
6179     end;
6180     tfLuminance8Alpha8: begin
6181       ColorType := COLOR_GRAYSCALEALPHA;
6182       PixSize   := 1;
6183       Alpha     := true;
6184     end;
6185     tfBGR8, tfRGB8: begin
6186       ColorType := COLOR_RGB;
6187       PixSize   := 3;
6188       Alpha     := false;
6189     end;
6190     tfBGRA8, tfRGBA8: begin
6191       ColorType := COLOR_RGBALPHA;
6192       PixSize   := 3;
6193       Alpha     := true
6194     end;
6195   else
6196     raise EglBitmapUnsupportedFormat.Create(Format);
6197   end;
6198
6199   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6200   try
6201     // Copy ImageData
6202     pSource := Data;
6203     for Y := 0 to Height -1 do begin
6204       pDest := png.ScanLine[Y];
6205       for X := 0 to Width -1 do begin
6206         Move(pSource^, pDest^, PixSize);
6207         Inc(pDest, PixSize);
6208         Inc(pSource, PixSize);
6209         if Alpha then begin
6210           png.AlphaScanline[Y]^[X] := pSource^;
6211           Inc(pSource);
6212         end;
6213       end;
6214
6215       // convert RGB line to BGR
6216       if Format in [tfRGB8, tfRGBA8] then begin
6217         pTemp := png.ScanLine[Y];
6218         for X := 0 to Width -1 do begin
6219           Temp := pByteArray(pTemp)^[0];
6220           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6221           pByteArray(pTemp)^[2] := Temp;
6222           Inc(pTemp, 3);
6223         end;
6224       end;
6225     end;
6226
6227     // Save to Stream
6228     Png.CompressionLevel := 6;
6229     Png.SaveToStream(aStream);
6230   finally
6231     FreeAndNil(Png);
6232   end;
6233 end;
6234 {$IFEND}
6235 {$ENDIF}
6236
6237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6238 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6240 {$IFDEF GLB_LIB_JPEG}
6241 type
6242   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6243   glBitmap_libJPEG_source_mgr = record
6244     pub: jpeg_source_mgr;
6245
6246     SrcStream: TStream;
6247     SrcBuffer: array [1..4096] of byte;
6248   end;
6249
6250   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6251   glBitmap_libJPEG_dest_mgr = record
6252     pub: jpeg_destination_mgr;
6253
6254     DestStream: TStream;
6255     DestBuffer: array [1..4096] of byte;
6256   end;
6257
6258 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6259 begin
6260   //DUMMY
6261 end;
6262
6263
6264 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6265 begin
6266   //DUMMY
6267 end;
6268
6269
6270 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6271 begin
6272   //DUMMY
6273 end;
6274
6275 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6276 begin
6277   //DUMMY
6278 end;
6279
6280
6281 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6282 begin
6283   //DUMMY
6284 end;
6285
6286
6287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6288 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6289 var
6290   src: glBitmap_libJPEG_source_mgr_ptr;
6291   bytes: integer;
6292 begin
6293   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6294
6295   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6296         if (bytes <= 0) then begin
6297                 src^.SrcBuffer[1] := $FF;
6298                 src^.SrcBuffer[2] := JPEG_EOI;
6299                 bytes := 2;
6300         end;
6301
6302         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6303         src^.pub.bytes_in_buffer := bytes;
6304
6305   result := true;
6306 end;
6307
6308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6309 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6310 var
6311   src: glBitmap_libJPEG_source_mgr_ptr;
6312 begin
6313   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6314
6315   if num_bytes > 0 then begin
6316     // wanted byte isn't in buffer so set stream position and read buffer
6317     if num_bytes > src^.pub.bytes_in_buffer then begin
6318       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6319       src^.pub.fill_input_buffer(cinfo);
6320     end else begin
6321       // wanted byte is in buffer so only skip
6322                 inc(src^.pub.next_input_byte, num_bytes);
6323                 dec(src^.pub.bytes_in_buffer, num_bytes);
6324     end;
6325   end;
6326 end;
6327
6328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6329 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6330 var
6331   dest: glBitmap_libJPEG_dest_mgr_ptr;
6332 begin
6333   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6334
6335   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6336     // write complete buffer
6337     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6338
6339     // reset buffer
6340     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6341     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6342   end;
6343
6344   result := true;
6345 end;
6346
6347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6348 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6349 var
6350   Idx: Integer;
6351   dest: glBitmap_libJPEG_dest_mgr_ptr;
6352 begin
6353   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6354
6355   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6356     // check for endblock
6357     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6358       // write endblock
6359       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6360
6361       // leave
6362       break;
6363     end else
6364       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6365   end;
6366 end;
6367 {$ENDIF}
6368
6369 {$IFDEF GLB_SUPPORT_JPEG_READ}
6370 {$IF DEFINED(GLB_LAZ_JPEG)}
6371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6372 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6373 const
6374   MAGIC_LEN = 2;
6375   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6376 var
6377   intf: TLazIntfImage;
6378   reader: TFPReaderJPEG;
6379   StreamPos: Int64;
6380   magic: String[MAGIC_LEN];
6381 begin
6382   result := true;
6383   StreamPos := aStream.Position;
6384
6385   SetLength(magic, MAGIC_LEN);
6386   aStream.Read(magic[1], MAGIC_LEN);
6387   aStream.Position := StreamPos;
6388   if (magic <> JPEG_MAGIC) then begin
6389     result := false;
6390     exit;
6391   end;
6392
6393   reader := TFPReaderJPEG.Create;
6394   intf := TLazIntfImage.Create(0, 0);
6395   try try
6396     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6397     reader.ImageRead(aStream, intf);
6398     AssignFromLazIntfImage(intf);
6399   except
6400     result := false;
6401     aStream.Position := StreamPos;
6402     exit;
6403   end;
6404   finally
6405     reader.Free;
6406     intf.Free;
6407   end;
6408 end;
6409
6410 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6412 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6413 var
6414   Surface: PSDL_Surface;
6415   RWops: PSDL_RWops;
6416 begin
6417   result := false;
6418
6419   RWops := glBitmapCreateRWops(aStream);
6420   try
6421     if IMG_isJPG(RWops) > 0 then begin
6422       Surface := IMG_LoadJPG_RW(RWops);
6423       try
6424         AssignFromSurface(Surface);
6425         result := true;
6426       finally
6427         SDL_FreeSurface(Surface);
6428       end;
6429     end;
6430   finally
6431     SDL_FreeRW(RWops);
6432   end;
6433 end;
6434
6435 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6437 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6438 var
6439   StreamPos: Int64;
6440   Temp: array[0..1]of Byte;
6441
6442   jpeg: jpeg_decompress_struct;
6443   jpeg_err: jpeg_error_mgr;
6444
6445   IntFormat: TglBitmapFormat;
6446   pImage: pByte;
6447   TempHeight, TempWidth: Integer;
6448
6449   pTemp: pByte;
6450   Row: Integer;
6451
6452   FormatDesc: TFormatDescriptor;
6453 begin
6454   result := false;
6455
6456   if not init_libJPEG then
6457     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6458
6459   try
6460     // reading first two bytes to test file and set cursor back to begin
6461     StreamPos := aStream.Position;
6462     aStream.Read({%H-}Temp[0], 2);
6463     aStream.Position := StreamPos;
6464
6465     // if Bitmap then read file.
6466     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6467       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6468       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6469
6470       // error managment
6471       jpeg.err := jpeg_std_error(@jpeg_err);
6472       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6473       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6474
6475       // decompression struct
6476       jpeg_create_decompress(@jpeg);
6477
6478       // allocation space for streaming methods
6479       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6480
6481       // seeting up custom functions
6482       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6483         pub.init_source       := glBitmap_libJPEG_init_source;
6484         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6485         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6486         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6487         pub.term_source       := glBitmap_libJPEG_term_source;
6488
6489         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6490         pub.next_input_byte := nil;   // until buffer loaded
6491
6492         SrcStream := aStream;
6493       end;
6494
6495       // set global decoding state
6496       jpeg.global_state := DSTATE_START;
6497
6498       // read header of jpeg
6499       jpeg_read_header(@jpeg, false);
6500
6501       // setting output parameter
6502       case jpeg.jpeg_color_space of
6503         JCS_GRAYSCALE:
6504           begin
6505             jpeg.out_color_space := JCS_GRAYSCALE;
6506             IntFormat := tfLuminance8;
6507           end;
6508         else
6509           jpeg.out_color_space := JCS_RGB;
6510           IntFormat := tfRGB8;
6511       end;
6512
6513       // reading image
6514       jpeg_start_decompress(@jpeg);
6515
6516       TempHeight := jpeg.output_height;
6517       TempWidth := jpeg.output_width;
6518
6519       FormatDesc := TFormatDescriptor.Get(IntFormat);
6520
6521       // creating new image
6522       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6523       try
6524         pTemp := pImage;
6525
6526         for Row := 0 to TempHeight -1 do begin
6527           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6528           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6529         end;
6530
6531         // finish decompression
6532         jpeg_finish_decompress(@jpeg);
6533
6534         // destroy decompression
6535         jpeg_destroy_decompress(@jpeg);
6536
6537         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6538
6539         result := true;
6540       except
6541         if Assigned(pImage) then
6542           FreeMem(pImage);
6543         raise;
6544       end;
6545     end;
6546   finally
6547     quit_libJPEG;
6548   end;
6549 end;
6550
6551 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6553 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6554 var
6555   bmp: TBitmap;
6556   jpg: TJPEGImage;
6557   StreamPos: Int64;
6558   Temp: array[0..1]of Byte;
6559 begin
6560   result := false;
6561
6562   // reading first two bytes to test file and set cursor back to begin
6563   StreamPos := aStream.Position;
6564   aStream.Read(Temp[0], 2);
6565   aStream.Position := StreamPos;
6566
6567   // if Bitmap then read file.
6568   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6569     bmp := TBitmap.Create;
6570     try
6571       jpg := TJPEGImage.Create;
6572       try
6573         jpg.LoadFromStream(aStream);
6574         bmp.Assign(jpg);
6575         result := AssignFromBitmap(bmp);
6576       finally
6577         jpg.Free;
6578       end;
6579     finally
6580       bmp.Free;
6581     end;
6582   end;
6583 end;
6584 {$IFEND}
6585 {$ENDIF}
6586
6587 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6588 {$IF DEFINED(GLB_LAZ_JPEG)}
6589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6590 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6591 var
6592   jpeg: TJPEGImage;
6593   intf: TLazIntfImage;
6594   raw: TRawImage;
6595 begin
6596   jpeg := TJPEGImage.Create;
6597   intf := TLazIntfImage.Create(0, 0);
6598   try
6599     if not AssignToLazIntfImage(intf) then
6600       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6601     intf.GetRawImage(raw);
6602     jpeg.LoadFromRawImage(raw, false);
6603     jpeg.SaveToStream(aStream);
6604   finally
6605     intf.Free;
6606     jpeg.Free;
6607   end;
6608 end;
6609
6610 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6612 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6613 var
6614   jpeg: jpeg_compress_struct;
6615   jpeg_err: jpeg_error_mgr;
6616   Row: Integer;
6617   pTemp, pTemp2: pByte;
6618
6619   procedure CopyRow(pDest, pSource: pByte);
6620   var
6621     X: Integer;
6622   begin
6623     for X := 0 to Width - 1 do begin
6624       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6625       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6626       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6627       Inc(pDest, 3);
6628       Inc(pSource, 3);
6629     end;
6630   end;
6631
6632 begin
6633   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6634     raise EglBitmapUnsupportedFormat.Create(Format);
6635
6636   if not init_libJPEG then
6637     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6638
6639   try
6640     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6641     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6642
6643     // error managment
6644     jpeg.err := jpeg_std_error(@jpeg_err);
6645     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6646     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6647
6648     // compression struct
6649     jpeg_create_compress(@jpeg);
6650
6651     // allocation space for streaming methods
6652     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6653
6654     // seeting up custom functions
6655     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6656       pub.init_destination    := glBitmap_libJPEG_init_destination;
6657       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6658       pub.term_destination    := glBitmap_libJPEG_term_destination;
6659
6660       pub.next_output_byte  := @DestBuffer[1];
6661       pub.free_in_buffer    := Length(DestBuffer);
6662
6663       DestStream := aStream;
6664     end;
6665
6666     // very important state
6667     jpeg.global_state := CSTATE_START;
6668     jpeg.image_width  := Width;
6669     jpeg.image_height := Height;
6670     case Format of
6671       tfAlpha8, tfLuminance8: begin
6672         jpeg.input_components := 1;
6673         jpeg.in_color_space   := JCS_GRAYSCALE;
6674       end;
6675       tfRGB8, tfBGR8: begin
6676         jpeg.input_components := 3;
6677         jpeg.in_color_space   := JCS_RGB;
6678       end;
6679     end;
6680
6681     jpeg_set_defaults(@jpeg);
6682     jpeg_set_quality(@jpeg, 95, true);
6683     jpeg_start_compress(@jpeg, true);
6684     pTemp := Data;
6685
6686     if Format = tfBGR8 then
6687       GetMem(pTemp2, fRowSize)
6688     else
6689       pTemp2 := pTemp;
6690
6691     try
6692       for Row := 0 to jpeg.image_height -1 do begin
6693         // prepare row
6694         if Format = tfBGR8 then
6695           CopyRow(pTemp2, pTemp)
6696         else
6697           pTemp2 := pTemp;
6698
6699         // write row
6700         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6701         inc(pTemp, fRowSize);
6702       end;
6703     finally
6704       // free memory
6705       if Format = tfBGR8 then
6706         FreeMem(pTemp2);
6707     end;
6708     jpeg_finish_compress(@jpeg);
6709     jpeg_destroy_compress(@jpeg);
6710   finally
6711     quit_libJPEG;
6712   end;
6713 end;
6714
6715 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6717 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6718 var
6719   Bmp: TBitmap;
6720   Jpg: TJPEGImage;
6721 begin
6722   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6723     raise EglBitmapUnsupportedFormat.Create(Format);
6724
6725   Bmp := TBitmap.Create;
6726   try
6727     Jpg := TJPEGImage.Create;
6728     try
6729       AssignToBitmap(Bmp);
6730       if (Format in [tfAlpha8, tfLuminance8]) then begin
6731         Jpg.Grayscale   := true;
6732         Jpg.PixelFormat := jf8Bit;
6733       end;
6734       Jpg.Assign(Bmp);
6735       Jpg.SaveToStream(aStream);
6736     finally
6737       FreeAndNil(Jpg);
6738     end;
6739   finally
6740     FreeAndNil(Bmp);
6741   end;
6742 end;
6743 {$IFEND}
6744 {$ENDIF}
6745
6746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6747 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6749 const
6750   BMP_MAGIC          = $4D42;
6751
6752   BMP_COMP_RGB       = 0;
6753   BMP_COMP_RLE8      = 1;
6754   BMP_COMP_RLE4      = 2;
6755   BMP_COMP_BITFIELDS = 3;
6756
6757 type
6758   TBMPHeader = packed record
6759     bfType: Word;
6760     bfSize: Cardinal;
6761     bfReserved1: Word;
6762     bfReserved2: Word;
6763     bfOffBits: Cardinal;
6764   end;
6765
6766   TBMPInfo = packed record
6767     biSize: Cardinal;
6768     biWidth: Longint;
6769     biHeight: Longint;
6770     biPlanes: Word;
6771     biBitCount: Word;
6772     biCompression: Cardinal;
6773     biSizeImage: Cardinal;
6774     biXPelsPerMeter: Longint;
6775     biYPelsPerMeter: Longint;
6776     biClrUsed: Cardinal;
6777     biClrImportant: Cardinal;
6778   end;
6779
6780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6781 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6782
6783   //////////////////////////////////////////////////////////////////////////////////////////////////
6784   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6785   begin
6786     result := tfEmpty;
6787     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6788     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6789
6790     //Read Compression
6791     case aInfo.biCompression of
6792       BMP_COMP_RLE4,
6793       BMP_COMP_RLE8: begin
6794         raise EglBitmap.Create('RLE compression is not supported');
6795       end;
6796       BMP_COMP_BITFIELDS: begin
6797         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6798           aStream.Read(aMask.r, SizeOf(aMask.r));
6799           aStream.Read(aMask.g, SizeOf(aMask.g));
6800           aStream.Read(aMask.b, SizeOf(aMask.b));
6801           aStream.Read(aMask.a, SizeOf(aMask.a));
6802         end else
6803           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6804       end;
6805     end;
6806
6807     //get suitable format
6808     case aInfo.biBitCount of
6809        8: result := tfLuminance8;
6810       16: result := tfBGR5;
6811       24: result := tfBGR8;
6812       32: result := tfBGRA8;
6813     end;
6814   end;
6815
6816   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6817   var
6818     i, c: Integer;
6819     ColorTable: TbmpColorTable;
6820   begin
6821     result := nil;
6822     if (aInfo.biBitCount >= 16) then
6823       exit;
6824     aFormat := tfLuminance8;
6825     c := aInfo.biClrUsed;
6826     if (c = 0) then
6827       c := 1 shl aInfo.biBitCount;
6828     SetLength(ColorTable, c);
6829     for i := 0 to c-1 do begin
6830       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6831       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6832         aFormat := tfRGB8;
6833     end;
6834
6835     result := TbmpColorTableFormat.Create;
6836     result.PixelSize  := aInfo.biBitCount / 8;
6837     result.ColorTable := ColorTable;
6838     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6839   end;
6840
6841   //////////////////////////////////////////////////////////////////////////////////////////////////
6842   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6843     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6844   var
6845     TmpFormat: TglBitmapFormat;
6846     FormatDesc: TFormatDescriptor;
6847   begin
6848     result := nil;
6849     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6850       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6851         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6852         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6853           aFormat := FormatDesc.Format;
6854           exit;
6855         end;
6856       end;
6857
6858       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6859         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6860       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6861         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6862
6863       result := TbmpBitfieldFormat.Create;
6864       result.PixelSize := aInfo.biBitCount / 8;
6865       result.RedMask   := aMask.r;
6866       result.GreenMask := aMask.g;
6867       result.BlueMask  := aMask.b;
6868       result.AlphaMask := aMask.a;
6869     end;
6870   end;
6871
6872 var
6873   //simple types
6874   StartPos: Int64;
6875   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6876   PaddingBuff: Cardinal;
6877   LineBuf, ImageData, TmpData: PByte;
6878   SourceMD, DestMD: Pointer;
6879   BmpFormat: TglBitmapFormat;
6880
6881   //records
6882   Mask: TglBitmapColorRec;
6883   Header: TBMPHeader;
6884   Info: TBMPInfo;
6885
6886   //classes
6887   SpecialFormat: TFormatDescriptor;
6888   FormatDesc: TFormatDescriptor;
6889
6890   //////////////////////////////////////////////////////////////////////////////////////////////////
6891   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6892   var
6893     i: Integer;
6894     Pixel: TglBitmapPixelData;
6895   begin
6896     aStream.Read(aLineBuf^, rbLineSize);
6897     SpecialFormat.PreparePixel(Pixel);
6898     for i := 0 to Info.biWidth-1 do begin
6899       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6900       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6901       FormatDesc.Map(Pixel, aData, DestMD);
6902     end;
6903   end;
6904
6905 begin
6906   result        := false;
6907   BmpFormat     := tfEmpty;
6908   SpecialFormat := nil;
6909   LineBuf       := nil;
6910   SourceMD      := nil;
6911   DestMD        := nil;
6912
6913   // Header
6914   StartPos := aStream.Position;
6915   aStream.Read(Header{%H-}, SizeOf(Header));
6916
6917   if Header.bfType = BMP_MAGIC then begin
6918     try try
6919       BmpFormat        := ReadInfo(Info, Mask);
6920       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6921       if not Assigned(SpecialFormat) then
6922         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6923       aStream.Position := StartPos + Header.bfOffBits;
6924
6925       if (BmpFormat <> tfEmpty) then begin
6926         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6927         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6928         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6929         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6930
6931         //get Memory
6932         DestMD    := FormatDesc.CreateMappingData;
6933         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6934         GetMem(ImageData, ImageSize);
6935         if Assigned(SpecialFormat) then begin
6936           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6937           SourceMD := SpecialFormat.CreateMappingData;
6938         end;
6939
6940         //read Data
6941         try try
6942           FillChar(ImageData^, ImageSize, $FF);
6943           TmpData := ImageData;
6944           if (Info.biHeight > 0) then
6945             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6946           for i := 0 to Abs(Info.biHeight)-1 do begin
6947             if Assigned(SpecialFormat) then
6948               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6949             else
6950               aStream.Read(TmpData^, wbLineSize);   //else only read data
6951             if (Info.biHeight > 0) then
6952               dec(TmpData, wbLineSize)
6953             else
6954               inc(TmpData, wbLineSize);
6955             aStream.Read(PaddingBuff{%H-}, Padding);
6956           end;
6957           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6958           result := true;
6959         finally
6960           if Assigned(LineBuf) then
6961             FreeMem(LineBuf);
6962           if Assigned(SourceMD) then
6963             SpecialFormat.FreeMappingData(SourceMD);
6964           FormatDesc.FreeMappingData(DestMD);
6965         end;
6966         except
6967           if Assigned(ImageData) then
6968             FreeMem(ImageData);
6969           raise;
6970         end;
6971       end else
6972         raise EglBitmap.Create('LoadBMP - No suitable format found');
6973     except
6974       aStream.Position := StartPos;
6975       raise;
6976     end;
6977     finally
6978       FreeAndNil(SpecialFormat);
6979     end;
6980   end
6981     else aStream.Position := StartPos;
6982 end;
6983
6984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6985 procedure TglBitmap.SaveBMP(const aStream: TStream);
6986 var
6987   Header: TBMPHeader;
6988   Info: TBMPInfo;
6989   Converter: TFormatDescriptor;
6990   FormatDesc: TFormatDescriptor;
6991   SourceFD, DestFD: Pointer;
6992   pData, srcData, dstData, ConvertBuffer: pByte;
6993
6994   Pixel: TglBitmapPixelData;
6995   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6996   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6997
6998   PaddingBuff: Cardinal;
6999
7000   function GetLineWidth : Integer;
7001   begin
7002     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7003   end;
7004
7005 begin
7006   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7007     raise EglBitmapUnsupportedFormat.Create(Format);
7008
7009   Converter  := nil;
7010   FormatDesc := TFormatDescriptor.Get(Format);
7011   ImageSize  := FormatDesc.GetSize(Dimension);
7012
7013   FillChar(Header{%H-}, SizeOf(Header), 0);
7014   Header.bfType      := BMP_MAGIC;
7015   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7016   Header.bfReserved1 := 0;
7017   Header.bfReserved2 := 0;
7018   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7019
7020   FillChar(Info{%H-}, SizeOf(Info), 0);
7021   Info.biSize        := SizeOf(Info);
7022   Info.biWidth       := Width;
7023   Info.biHeight      := Height;
7024   Info.biPlanes      := 1;
7025   Info.biCompression := BMP_COMP_RGB;
7026   Info.biSizeImage   := ImageSize;
7027
7028   try
7029     case Format of
7030       tfLuminance4: begin
7031         Info.biBitCount  := 4;
7032         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7033         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7034         Converter := TbmpColorTableFormat.Create;
7035         with (Converter as TbmpColorTableFormat) do begin
7036           PixelSize := 0.5;
7037           Format    := Format;
7038           Range     := glBitmapColorRec($F, $F, $F, $0);
7039           CreateColorTable;
7040         end;
7041       end;
7042
7043       tfR3G3B2, tfLuminance8: begin
7044         Info.biBitCount  :=  8;
7045         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7046         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7047         Converter := TbmpColorTableFormat.Create;
7048         with (Converter as TbmpColorTableFormat) do begin
7049           PixelSize := 1;
7050           Format    := Format;
7051           if (Format = tfR3G3B2) then begin
7052             Range := glBitmapColorRec($7, $7, $3, $0);
7053             Shift := glBitmapShiftRec(0, 3, 6, 0);
7054           end else
7055             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7056           CreateColorTable;
7057         end;
7058       end;
7059
7060       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7061       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7062         Info.biBitCount    := 16;
7063         Info.biCompression := BMP_COMP_BITFIELDS;
7064       end;
7065
7066       tfBGR8, tfRGB8: begin
7067         Info.biBitCount := 24;
7068         if (Format = tfRGB8) then
7069           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7070       end;
7071
7072       tfRGB10, tfRGB10A2, tfRGBA8,
7073       tfBGR10, tfBGR10A2, tfBGRA8: begin
7074         Info.biBitCount    := 32;
7075         Info.biCompression := BMP_COMP_BITFIELDS;
7076       end;
7077     else
7078       raise EglBitmapUnsupportedFormat.Create(Format);
7079     end;
7080     Info.biXPelsPerMeter := 2835;
7081     Info.biYPelsPerMeter := 2835;
7082
7083     // prepare bitmasks
7084     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7085       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7086       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7087
7088       RedMask    := FormatDesc.RedMask;
7089       GreenMask  := FormatDesc.GreenMask;
7090       BlueMask   := FormatDesc.BlueMask;
7091       AlphaMask  := FormatDesc.AlphaMask;
7092     end;
7093
7094     // headers
7095     aStream.Write(Header, SizeOf(Header));
7096     aStream.Write(Info, SizeOf(Info));
7097
7098     // colortable
7099     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7100       with (Converter as TbmpColorTableFormat) do
7101         aStream.Write(ColorTable[0].b,
7102           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7103
7104     // bitmasks
7105     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7106       aStream.Write(RedMask,   SizeOf(Cardinal));
7107       aStream.Write(GreenMask, SizeOf(Cardinal));
7108       aStream.Write(BlueMask,  SizeOf(Cardinal));
7109       aStream.Write(AlphaMask, SizeOf(Cardinal));
7110     end;
7111
7112     // image data
7113     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7114     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7115     Padding     := GetLineWidth - wbLineSize;
7116     PaddingBuff := 0;
7117
7118     pData := Data;
7119     inc(pData, (Height-1) * rbLineSize);
7120
7121     // prepare row buffer. But only for RGB because RGBA supports color masks
7122     // so it's possible to change color within the image.
7123     if Assigned(Converter) then begin
7124       FormatDesc.PreparePixel(Pixel);
7125       GetMem(ConvertBuffer, wbLineSize);
7126       SourceFD := FormatDesc.CreateMappingData;
7127       DestFD   := Converter.CreateMappingData;
7128     end else
7129       ConvertBuffer := nil;
7130
7131     try
7132       for LineIdx := 0 to Height - 1 do begin
7133         // preparing row
7134         if Assigned(Converter) then begin
7135           srcData := pData;
7136           dstData := ConvertBuffer;
7137           for PixelIdx := 0 to Info.biWidth-1 do begin
7138             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7139             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7140             Converter.Map(Pixel, dstData, DestFD);
7141           end;
7142           aStream.Write(ConvertBuffer^, wbLineSize);
7143         end else begin
7144           aStream.Write(pData^, rbLineSize);
7145         end;
7146         dec(pData, rbLineSize);
7147         if (Padding > 0) then
7148           aStream.Write(PaddingBuff, Padding);
7149       end;
7150     finally
7151       // destroy row buffer
7152       if Assigned(ConvertBuffer) then begin
7153         FormatDesc.FreeMappingData(SourceFD);
7154         Converter.FreeMappingData(DestFD);
7155         FreeMem(ConvertBuffer);
7156       end;
7157     end;
7158   finally
7159     if Assigned(Converter) then
7160       Converter.Free;
7161   end;
7162 end;
7163
7164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7165 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7167 type
7168   TTGAHeader = packed record
7169     ImageID: Byte;
7170     ColorMapType: Byte;
7171     ImageType: Byte;
7172     //ColorMapSpec: Array[0..4] of Byte;
7173     ColorMapStart: Word;
7174     ColorMapLength: Word;
7175     ColorMapEntrySize: Byte;
7176     OrigX: Word;
7177     OrigY: Word;
7178     Width: Word;
7179     Height: Word;
7180     Bpp: Byte;
7181     ImageDesc: Byte;
7182   end;
7183
7184 const
7185   TGA_UNCOMPRESSED_RGB  =  2;
7186   TGA_UNCOMPRESSED_GRAY =  3;
7187   TGA_COMPRESSED_RGB    = 10;
7188   TGA_COMPRESSED_GRAY   = 11;
7189
7190   TGA_NONE_COLOR_TABLE  = 0;
7191
7192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7193 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7194 var
7195   Header: TTGAHeader;
7196   ImageData: System.PByte;
7197   StartPosition: Int64;
7198   PixelSize, LineSize: Integer;
7199   tgaFormat: TglBitmapFormat;
7200   FormatDesc: TFormatDescriptor;
7201   Counter: packed record
7202     X, Y: packed record
7203       low, high, dir: Integer;
7204     end;
7205   end;
7206
7207 const
7208   CACHE_SIZE = $4000;
7209
7210   ////////////////////////////////////////////////////////////////////////////////////////
7211   procedure ReadUncompressed;
7212   var
7213     i, j: Integer;
7214     buf, tmp1, tmp2: System.PByte;
7215   begin
7216     buf := nil;
7217     if (Counter.X.dir < 0) then
7218       GetMem(buf, LineSize);
7219     try
7220       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7221         tmp1 := ImageData;
7222         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7223         if (Counter.X.dir < 0) then begin               //flip X
7224           aStream.Read(buf^, LineSize);
7225           tmp2 := buf;
7226           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7227           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7228             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7229               tmp1^ := tmp2^;
7230               inc(tmp1);
7231               inc(tmp2);
7232             end;
7233             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7234           end;
7235         end else
7236           aStream.Read(tmp1^, LineSize);
7237         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7238       end;
7239     finally
7240       if Assigned(buf) then
7241         FreeMem(buf);
7242     end;
7243   end;
7244
7245   ////////////////////////////////////////////////////////////////////////////////////////
7246   procedure ReadCompressed;
7247
7248     /////////////////////////////////////////////////////////////////
7249     var
7250       TmpData: System.PByte;
7251       LinePixelsRead: Integer;
7252     procedure CheckLine;
7253     begin
7254       if (LinePixelsRead >= Header.Width) then begin
7255         LinePixelsRead := 0;
7256         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7257         TmpData := ImageData;
7258         inc(TmpData, Counter.Y.low * LineSize);           //set line
7259         if (Counter.X.dir < 0) then                       //if x flipped then
7260           inc(TmpData, LineSize - PixelSize);             //set last pixel
7261       end;
7262     end;
7263
7264     /////////////////////////////////////////////////////////////////
7265     var
7266       Cache: PByte;
7267       CacheSize, CachePos: Integer;
7268     procedure CachedRead(out Buffer; Count: Integer);
7269     var
7270       BytesRead: Integer;
7271     begin
7272       if (CachePos + Count > CacheSize) then begin
7273         //if buffer overflow save non read bytes
7274         BytesRead := 0;
7275         if (CacheSize - CachePos > 0) then begin
7276           BytesRead := CacheSize - CachePos;
7277           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7278           inc(CachePos, BytesRead);
7279         end;
7280
7281         //load cache from file
7282         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7283         aStream.Read(Cache^, CacheSize);
7284         CachePos := 0;
7285
7286         //read rest of requested bytes
7287         if (Count - BytesRead > 0) then begin
7288           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7289           inc(CachePos, Count - BytesRead);
7290         end;
7291       end else begin
7292         //if no buffer overflow just read the data
7293         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7294         inc(CachePos, Count);
7295       end;
7296     end;
7297
7298     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7299     begin
7300       case PixelSize of
7301         1: begin
7302           aBuffer^ := aData^;
7303           inc(aBuffer, Counter.X.dir);
7304         end;
7305         2: begin
7306           PWord(aBuffer)^ := PWord(aData)^;
7307           inc(aBuffer, 2 * Counter.X.dir);
7308         end;
7309         3: begin
7310           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7311           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7312           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7313           inc(aBuffer, 3 * Counter.X.dir);
7314         end;
7315         4: begin
7316           PCardinal(aBuffer)^ := PCardinal(aData)^;
7317           inc(aBuffer, 4 * Counter.X.dir);
7318         end;
7319       end;
7320     end;
7321
7322   var
7323     TotalPixelsToRead, TotalPixelsRead: Integer;
7324     Temp: Byte;
7325     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7326     PixelRepeat: Boolean;
7327     PixelsToRead, PixelCount: Integer;
7328   begin
7329     CacheSize := 0;
7330     CachePos  := 0;
7331
7332     TotalPixelsToRead := Header.Width * Header.Height;
7333     TotalPixelsRead   := 0;
7334     LinePixelsRead    := 0;
7335
7336     GetMem(Cache, CACHE_SIZE);
7337     try
7338       TmpData := ImageData;
7339       inc(TmpData, Counter.Y.low * LineSize);           //set line
7340       if (Counter.X.dir < 0) then                       //if x flipped then
7341         inc(TmpData, LineSize - PixelSize);             //set last pixel
7342
7343       repeat
7344         //read CommandByte
7345         CachedRead(Temp, 1);
7346         PixelRepeat  := (Temp and $80) > 0;
7347         PixelsToRead := (Temp and $7F) + 1;
7348         inc(TotalPixelsRead, PixelsToRead);
7349
7350         if PixelRepeat then
7351           CachedRead(buf[0], PixelSize);
7352         while (PixelsToRead > 0) do begin
7353           CheckLine;
7354           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7355           while (PixelCount > 0) do begin
7356             if not PixelRepeat then
7357               CachedRead(buf[0], PixelSize);
7358             PixelToBuffer(@buf[0], TmpData);
7359             inc(LinePixelsRead);
7360             dec(PixelsToRead);
7361             dec(PixelCount);
7362           end;
7363         end;
7364       until (TotalPixelsRead >= TotalPixelsToRead);
7365     finally
7366       FreeMem(Cache);
7367     end;
7368   end;
7369
7370   function IsGrayFormat: Boolean;
7371   begin
7372     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7373   end;
7374
7375 begin
7376   result := false;
7377
7378   // reading header to test file and set cursor back to begin
7379   StartPosition := aStream.Position;
7380   aStream.Read(Header{%H-}, SizeOf(Header));
7381
7382   // no colormapped files
7383   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7384     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7385   begin
7386     try
7387       if Header.ImageID <> 0 then       // skip image ID
7388         aStream.Position := aStream.Position + Header.ImageID;
7389
7390       tgaFormat := tfEmpty;
7391       case Header.Bpp of
7392          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7393                0: tgaFormat := tfLuminance8;
7394                8: tgaFormat := tfAlpha8;
7395             end;
7396
7397         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7398                0: tgaFormat := tfLuminance16;
7399                8: tgaFormat := tfLuminance8Alpha8;
7400             end else case (Header.ImageDesc and $F) of
7401                0: tgaFormat := tfBGR5;
7402                1: tgaFormat := tfBGR5A1;
7403                4: tgaFormat := tfBGRA4;
7404             end;
7405
7406         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7407                0: tgaFormat := tfBGR8;
7408             end;
7409
7410         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7411                2: tgaFormat := tfBGR10A2;
7412                8: tgaFormat := tfBGRA8;
7413             end;
7414       end;
7415
7416       if (tgaFormat = tfEmpty) then
7417         raise EglBitmap.Create('LoadTga - unsupported format');
7418
7419       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7420       PixelSize  := FormatDesc.GetSize(1, 1);
7421       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7422
7423       GetMem(ImageData, LineSize * Header.Height);
7424       try
7425         //column direction
7426         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7427           Counter.X.low  := Header.Height-1;;
7428           Counter.X.high := 0;
7429           Counter.X.dir  := -1;
7430         end else begin
7431           Counter.X.low  := 0;
7432           Counter.X.high := Header.Height-1;
7433           Counter.X.dir  := 1;
7434         end;
7435
7436         // Row direction
7437         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7438           Counter.Y.low  := 0;
7439           Counter.Y.high := Header.Height-1;
7440           Counter.Y.dir  := 1;
7441         end else begin
7442           Counter.Y.low  := Header.Height-1;;
7443           Counter.Y.high := 0;
7444           Counter.Y.dir  := -1;
7445         end;
7446
7447         // Read Image
7448         case Header.ImageType of
7449           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7450             ReadUncompressed;
7451           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7452             ReadCompressed;
7453         end;
7454
7455         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7456         result := true;
7457       except
7458         if Assigned(ImageData) then
7459           FreeMem(ImageData);
7460         raise;
7461       end;
7462     finally
7463       aStream.Position := StartPosition;
7464     end;
7465   end
7466     else aStream.Position := StartPosition;
7467 end;
7468
7469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7470 procedure TglBitmap.SaveTGA(const aStream: TStream);
7471 var
7472   Header: TTGAHeader;
7473   LineSize, Size, x, y: Integer;
7474   Pixel: TglBitmapPixelData;
7475   LineBuf, SourceData, DestData: PByte;
7476   SourceMD, DestMD: Pointer;
7477   FormatDesc: TFormatDescriptor;
7478   Converter: TFormatDescriptor;
7479 begin
7480   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7481     raise EglBitmapUnsupportedFormat.Create(Format);
7482
7483   //prepare header
7484   FillChar(Header{%H-}, SizeOf(Header), 0);
7485
7486   //set ImageType
7487   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7488                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7489     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7490   else
7491     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7492
7493   //set BitsPerPixel
7494   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7495     Header.Bpp := 8
7496   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7497                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7498     Header.Bpp := 16
7499   else if (Format in [tfBGR8, tfRGB8]) then
7500     Header.Bpp := 24
7501   else
7502     Header.Bpp := 32;
7503
7504   //set AlphaBitCount
7505   case Format of
7506     tfRGB5A1, tfBGR5A1:
7507       Header.ImageDesc := 1 and $F;
7508     tfRGB10A2, tfBGR10A2:
7509       Header.ImageDesc := 2 and $F;
7510     tfRGBA4, tfBGRA4:
7511       Header.ImageDesc := 4 and $F;
7512     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7513       Header.ImageDesc := 8 and $F;
7514   end;
7515
7516   Header.Width     := Width;
7517   Header.Height    := Height;
7518   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7519   aStream.Write(Header, SizeOf(Header));
7520
7521   // convert RGB(A) to BGR(A)
7522   Converter  := nil;
7523   FormatDesc := TFormatDescriptor.Get(Format);
7524   Size       := FormatDesc.GetSize(Dimension);
7525   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7526     if (FormatDesc.RGBInverted = tfEmpty) then
7527       raise EglBitmap.Create('inverted RGB format is empty');
7528     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7529     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7530        (Converter.PixelSize <> FormatDesc.PixelSize) then
7531       raise EglBitmap.Create('invalid inverted RGB format');
7532   end;
7533
7534   if Assigned(Converter) then begin
7535     LineSize := FormatDesc.GetSize(Width, 1);
7536     GetMem(LineBuf, LineSize);
7537     SourceMD := FormatDesc.CreateMappingData;
7538     DestMD   := Converter.CreateMappingData;
7539     try
7540       SourceData := Data;
7541       for y := 0 to Height-1 do begin
7542         DestData := LineBuf;
7543         for x := 0 to Width-1 do begin
7544           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7545           Converter.Map(Pixel, DestData, DestMD);
7546         end;
7547         aStream.Write(LineBuf^, LineSize);
7548       end;
7549     finally
7550       FreeMem(LineBuf);
7551       FormatDesc.FreeMappingData(SourceMD);
7552       FormatDesc.FreeMappingData(DestMD);
7553     end;
7554   end else
7555     aStream.Write(Data^, Size);
7556 end;
7557
7558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7559 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7561 const
7562   DDS_MAGIC: Cardinal         = $20534444;
7563
7564   // DDS_header.dwFlags
7565   DDSD_CAPS                   = $00000001;
7566   DDSD_HEIGHT                 = $00000002;
7567   DDSD_WIDTH                  = $00000004;
7568   DDSD_PIXELFORMAT            = $00001000;
7569
7570   // DDS_header.sPixelFormat.dwFlags
7571   DDPF_ALPHAPIXELS            = $00000001;
7572   DDPF_ALPHA                  = $00000002;
7573   DDPF_FOURCC                 = $00000004;
7574   DDPF_RGB                    = $00000040;
7575   DDPF_LUMINANCE              = $00020000;
7576
7577   // DDS_header.sCaps.dwCaps1
7578   DDSCAPS_TEXTURE             = $00001000;
7579
7580   // DDS_header.sCaps.dwCaps2
7581   DDSCAPS2_CUBEMAP            = $00000200;
7582
7583   D3DFMT_DXT1                 = $31545844;
7584   D3DFMT_DXT3                 = $33545844;
7585   D3DFMT_DXT5                 = $35545844;
7586
7587 type
7588   TDDSPixelFormat = packed record
7589     dwSize: Cardinal;
7590     dwFlags: Cardinal;
7591     dwFourCC: Cardinal;
7592     dwRGBBitCount: Cardinal;
7593     dwRBitMask: Cardinal;
7594     dwGBitMask: Cardinal;
7595     dwBBitMask: Cardinal;
7596     dwABitMask: Cardinal;
7597   end;
7598
7599   TDDSCaps = packed record
7600     dwCaps1: Cardinal;
7601     dwCaps2: Cardinal;
7602     dwDDSX: Cardinal;
7603     dwReserved: Cardinal;
7604   end;
7605
7606   TDDSHeader = packed record
7607     dwSize: Cardinal;
7608     dwFlags: Cardinal;
7609     dwHeight: Cardinal;
7610     dwWidth: Cardinal;
7611     dwPitchOrLinearSize: Cardinal;
7612     dwDepth: Cardinal;
7613     dwMipMapCount: Cardinal;
7614     dwReserved: array[0..10] of Cardinal;
7615     PixelFormat: TDDSPixelFormat;
7616     Caps: TDDSCaps;
7617     dwReserved2: Cardinal;
7618   end;
7619
7620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7621 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7622 var
7623   Header: TDDSHeader;
7624   Converter: TbmpBitfieldFormat;
7625
7626   function GetDDSFormat: TglBitmapFormat;
7627   var
7628     fd: TFormatDescriptor;
7629     i: Integer;
7630     Range: TglBitmapColorRec;
7631     match: Boolean;
7632   begin
7633     result := tfEmpty;
7634     with Header.PixelFormat do begin
7635       // Compresses
7636       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7637         case Header.PixelFormat.dwFourCC of
7638           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7639           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7640           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7641         end;
7642       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7643
7644         //find matching format
7645         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7646           fd := TFormatDescriptor.Get(result);
7647           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7648              (8 * fd.PixelSize = dwRGBBitCount) then
7649             exit;
7650         end;
7651
7652         //find format with same Range
7653         Range.r := dwRBitMask;
7654         Range.g := dwGBitMask;
7655         Range.b := dwBBitMask;
7656         Range.a := dwABitMask;
7657         for i := 0 to 3 do begin
7658           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7659             Range.arr[i] := Range.arr[i] shr 1;
7660         end;
7661         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7662           fd := TFormatDescriptor.Get(result);
7663           match := true;
7664           for i := 0 to 3 do
7665             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7666               match := false;
7667               break;
7668             end;
7669           if match then
7670             break;
7671         end;
7672
7673         //no format with same range found -> use default
7674         if (result = tfEmpty) then begin
7675           if (dwABitMask > 0) then
7676             result := tfBGRA8
7677           else
7678             result := tfBGR8;
7679         end;
7680
7681         Converter := TbmpBitfieldFormat.Create;
7682         Converter.RedMask   := dwRBitMask;
7683         Converter.GreenMask := dwGBitMask;
7684         Converter.BlueMask  := dwBBitMask;
7685         Converter.AlphaMask := dwABitMask;
7686         Converter.PixelSize := dwRGBBitCount / 8;
7687       end;
7688     end;
7689   end;
7690
7691 var
7692   StreamPos: Int64;
7693   x, y, LineSize, RowSize, Magic: Cardinal;
7694   NewImage, TmpData, RowData, SrcData: System.PByte;
7695   SourceMD, DestMD: Pointer;
7696   Pixel: TglBitmapPixelData;
7697   ddsFormat: TglBitmapFormat;
7698   FormatDesc: TFormatDescriptor;
7699
7700 begin
7701   result    := false;
7702   Converter := nil;
7703   StreamPos := aStream.Position;
7704
7705   // Magic
7706   aStream.Read(Magic{%H-}, sizeof(Magic));
7707   if (Magic <> DDS_MAGIC) then begin
7708     aStream.Position := StreamPos;
7709     exit;
7710   end;
7711
7712   //Header
7713   aStream.Read(Header{%H-}, sizeof(Header));
7714   if (Header.dwSize <> SizeOf(Header)) or
7715      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7716         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7717   begin
7718     aStream.Position := StreamPos;
7719     exit;
7720   end;
7721
7722   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7723     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7724
7725   ddsFormat := GetDDSFormat;
7726   try
7727     if (ddsFormat = tfEmpty) then
7728       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7729
7730     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7731     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7732     GetMem(NewImage, Header.dwHeight * LineSize);
7733     try
7734       TmpData := NewImage;
7735
7736       //Converter needed
7737       if Assigned(Converter) then begin
7738         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7739         GetMem(RowData, RowSize);
7740         SourceMD := Converter.CreateMappingData;
7741         DestMD   := FormatDesc.CreateMappingData;
7742         try
7743           for y := 0 to Header.dwHeight-1 do begin
7744             TmpData := NewImage;
7745             inc(TmpData, y * LineSize);
7746             SrcData := RowData;
7747             aStream.Read(SrcData^, RowSize);
7748             for x := 0 to Header.dwWidth-1 do begin
7749               Converter.Unmap(SrcData, Pixel, SourceMD);
7750               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7751               FormatDesc.Map(Pixel, TmpData, DestMD);
7752             end;
7753           end;
7754         finally
7755           Converter.FreeMappingData(SourceMD);
7756           FormatDesc.FreeMappingData(DestMD);
7757           FreeMem(RowData);
7758         end;
7759       end else
7760
7761       // Compressed
7762       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7763         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7764         for Y := 0 to Header.dwHeight-1 do begin
7765           aStream.Read(TmpData^, RowSize);
7766           Inc(TmpData, LineSize);
7767         end;
7768       end else
7769
7770       // Uncompressed
7771       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7772         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7773         for Y := 0 to Header.dwHeight-1 do begin
7774           aStream.Read(TmpData^, RowSize);
7775           Inc(TmpData, LineSize);
7776         end;
7777       end else
7778         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7779
7780       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7781       result := true;
7782     except
7783       if Assigned(NewImage) then
7784         FreeMem(NewImage);
7785       raise;
7786     end;
7787   finally
7788     FreeAndNil(Converter);
7789   end;
7790 end;
7791
7792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7793 procedure TglBitmap.SaveDDS(const aStream: TStream);
7794 var
7795   Header: TDDSHeader;
7796   FormatDesc: TFormatDescriptor;
7797 begin
7798   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7799     raise EglBitmapUnsupportedFormat.Create(Format);
7800
7801   FormatDesc := TFormatDescriptor.Get(Format);
7802
7803   // Generell
7804   FillChar(Header{%H-}, SizeOf(Header), 0);
7805   Header.dwSize  := SizeOf(Header);
7806   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7807
7808   Header.dwWidth  := Max(1, Width);
7809   Header.dwHeight := Max(1, Height);
7810
7811   // Caps
7812   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7813
7814   // Pixelformat
7815   Header.PixelFormat.dwSize := sizeof(Header);
7816   if (FormatDesc.IsCompressed) then begin
7817     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7818     case Format of
7819       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7820       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7821       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7822     end;
7823   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7824     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7825     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7826     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7827   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7828     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7829     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7830     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7831     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7832   end else begin
7833     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7834     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7835     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7836     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7837     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7838     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7839   end;
7840
7841   if (FormatDesc.HasAlpha) then
7842     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7843
7844   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7845   aStream.Write(Header, SizeOf(Header));
7846   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7847 end;
7848
7849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7850 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7852 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7853   const aWidth: Integer; const aHeight: Integer);
7854 var
7855   pTemp: pByte;
7856   Size: Integer;
7857 begin
7858   if (aHeight > 1) then begin
7859     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7860     GetMem(pTemp, Size);
7861     try
7862       Move(aData^, pTemp^, Size);
7863       FreeMem(aData);
7864       aData := nil;
7865     except
7866       FreeMem(pTemp);
7867       raise;
7868     end;
7869   end else
7870     pTemp := aData;
7871   inherited SetDataPointer(pTemp, aFormat, aWidth);
7872 end;
7873
7874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7875 function TglBitmap1D.FlipHorz: Boolean;
7876 var
7877   Col: Integer;
7878   pTempDest, pDest, pSource: PByte;
7879 begin
7880   result := inherited FlipHorz;
7881   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7882     pSource := Data;
7883     GetMem(pDest, fRowSize);
7884     try
7885       pTempDest := pDest;
7886       Inc(pTempDest, fRowSize);
7887       for Col := 0 to Width-1 do begin
7888         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7889         Move(pSource^, pTempDest^, fPixelSize);
7890         Inc(pSource, fPixelSize);
7891       end;
7892       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7893       result := true;
7894     except
7895       if Assigned(pDest) then
7896         FreeMem(pDest);
7897       raise;
7898     end;
7899   end;
7900 end;
7901
7902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7903 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7904 var
7905   FormatDesc: TFormatDescriptor;
7906 begin
7907   // Upload data
7908   FormatDesc := TFormatDescriptor.Get(Format);
7909   if FormatDesc.IsCompressed then begin
7910     if not Assigned(glCompressedTexImage1D) then
7911       raise EglBitmap.Create('compressed formats not supported by video adapter');
7912     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7913   end else if aBuildWithGlu then
7914     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7915   else
7916     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7917
7918   // Free Data
7919   if (FreeDataAfterGenTexture) then
7920     FreeData;
7921 end;
7922
7923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7924 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7925 var
7926   BuildWithGlu, TexRec: Boolean;
7927   TexSize: Integer;
7928 begin
7929   if Assigned(Data) then begin
7930     // Check Texture Size
7931     if (aTestTextureSize) then begin
7932       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7933
7934       if (Width > TexSize) then
7935         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7936
7937       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7938                 (Target = GL_TEXTURE_RECTANGLE);
7939       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7940         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7941     end;
7942
7943     CreateId;
7944     SetupParameters(BuildWithGlu);
7945     UploadData(BuildWithGlu);
7946     glAreTexturesResident(1, @fID, @fIsResident);
7947   end;
7948 end;
7949
7950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7951 procedure TglBitmap1D.AfterConstruction;
7952 begin
7953   inherited;
7954   Target := GL_TEXTURE_1D;
7955 end;
7956
7957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7958 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7960 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7961 begin
7962   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7963     result := fLines[aIndex]
7964   else
7965     result := nil;
7966 end;
7967
7968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7969 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7970   const aWidth: Integer; const aHeight: Integer);
7971 var
7972   Idx, LineWidth: Integer;
7973 begin
7974   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7975
7976   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7977     // Assigning Data
7978     if Assigned(Data) then begin
7979       SetLength(fLines, GetHeight);
7980       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7981
7982       for Idx := 0 to GetHeight-1 do begin
7983         fLines[Idx] := Data;
7984         Inc(fLines[Idx], Idx * LineWidth);
7985       end;
7986     end
7987       else SetLength(fLines, 0);
7988   end else begin
7989     SetLength(fLines, 0);
7990   end;
7991 end;
7992
7993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7994 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7995 var
7996   FormatDesc: TFormatDescriptor;
7997 begin
7998   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7999
8000   FormatDesc := TFormatDescriptor.Get(Format);
8001   if FormatDesc.IsCompressed then begin
8002     if not Assigned(glCompressedTexImage2D) then
8003       raise EglBitmap.Create('compressed formats not supported by video adapter');
8004     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8005   end else if aBuildWithGlu then begin
8006     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8007       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8008   end else begin
8009     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8010       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8011   end;
8012
8013   // Freigeben
8014   if (FreeDataAfterGenTexture) then
8015     FreeData;
8016 end;
8017
8018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8019 procedure TglBitmap2D.AfterConstruction;
8020 begin
8021   inherited;
8022   Target := GL_TEXTURE_2D;
8023 end;
8024
8025 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8026 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8027 var
8028   Temp: pByte;
8029   Size, w, h: Integer;
8030   FormatDesc: TFormatDescriptor;
8031 begin
8032   FormatDesc := TFormatDescriptor.Get(aFormat);
8033   if FormatDesc.IsCompressed then
8034     raise EglBitmapUnsupportedFormat.Create(aFormat);
8035
8036   w    := aRight  - aLeft;
8037   h    := aBottom - aTop;
8038   Size := FormatDesc.GetSize(w, h);
8039   GetMem(Temp, Size);
8040   try
8041     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8042     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8043     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8044     FlipVert;
8045   except
8046     if Assigned(Temp) then
8047       FreeMem(Temp);
8048     raise;
8049   end;
8050 end;
8051
8052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8053 procedure TglBitmap2D.GetDataFromTexture;
8054 var
8055   Temp: PByte;
8056   TempWidth, TempHeight: Integer;
8057   TempIntFormat: GLint;
8058   IntFormat, f: TglBitmapFormat;
8059   FormatDesc: TFormatDescriptor;
8060 begin
8061   Bind;
8062
8063   // Request Data
8064   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8065   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8066   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8067
8068   IntFormat := tfEmpty;
8069   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8070     FormatDesc := TFormatDescriptor.Get(f);
8071     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8072       IntFormat := FormatDesc.Format;
8073       break;
8074     end;
8075   end;
8076
8077   // Getting data from OpenGL
8078   FormatDesc := TFormatDescriptor.Get(IntFormat);
8079   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8080   try
8081     if FormatDesc.IsCompressed then begin
8082       if not Assigned(glGetCompressedTexImage) then
8083         raise EglBitmap.Create('compressed formats not supported by video adapter');
8084       glGetCompressedTexImage(Target, 0, Temp)
8085     end else
8086       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8087     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8088   except
8089     if Assigned(Temp) then
8090       FreeMem(Temp);
8091     raise;
8092   end;
8093 end;
8094
8095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8096 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8097 var
8098   BuildWithGlu, PotTex, TexRec: Boolean;
8099   TexSize: Integer;
8100 begin
8101   if Assigned(Data) then begin
8102     // Check Texture Size
8103     if (aTestTextureSize) then begin
8104       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8105
8106       if ((Height > TexSize) or (Width > TexSize)) then
8107         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8108
8109       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8110       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8111       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8112         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8113     end;
8114
8115     CreateId;
8116     SetupParameters(BuildWithGlu);
8117     UploadData(Target, BuildWithGlu);
8118     glAreTexturesResident(1, @fID, @fIsResident);
8119   end;
8120 end;
8121
8122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8123 function TglBitmap2D.FlipHorz: Boolean;
8124 var
8125   Col, Row: Integer;
8126   TempDestData, DestData, SourceData: PByte;
8127   ImgSize: Integer;
8128 begin
8129   result := inherited FlipHorz;
8130   if Assigned(Data) then begin
8131     SourceData := Data;
8132     ImgSize := Height * fRowSize;
8133     GetMem(DestData, ImgSize);
8134     try
8135       TempDestData := DestData;
8136       Dec(TempDestData, fRowSize + fPixelSize);
8137       for Row := 0 to Height -1 do begin
8138         Inc(TempDestData, fRowSize * 2);
8139         for Col := 0 to Width -1 do begin
8140           Move(SourceData^, TempDestData^, fPixelSize);
8141           Inc(SourceData, fPixelSize);
8142           Dec(TempDestData, fPixelSize);
8143         end;
8144       end;
8145       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8146       result := true;
8147     except
8148       if Assigned(DestData) then
8149         FreeMem(DestData);
8150       raise;
8151     end;
8152   end;
8153 end;
8154
8155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8156 function TglBitmap2D.FlipVert: Boolean;
8157 var
8158   Row: Integer;
8159   TempDestData, DestData, SourceData: PByte;
8160 begin
8161   result := inherited FlipVert;
8162   if Assigned(Data) then begin
8163     SourceData := Data;
8164     GetMem(DestData, Height * fRowSize);
8165     try
8166       TempDestData := DestData;
8167       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8168       for Row := 0 to Height -1 do begin
8169         Move(SourceData^, TempDestData^, fRowSize);
8170         Dec(TempDestData, fRowSize);
8171         Inc(SourceData, fRowSize);
8172       end;
8173       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8174       result := true;
8175     except
8176       if Assigned(DestData) then
8177         FreeMem(DestData);
8178       raise;
8179     end;
8180   end;
8181 end;
8182
8183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8184 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8186 type
8187   TMatrixItem = record
8188     X, Y: Integer;
8189     W: Single;
8190   end;
8191
8192   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8193   TglBitmapToNormalMapRec = Record
8194     Scale: Single;
8195     Heights: array of Single;
8196     MatrixU : array of TMatrixItem;
8197     MatrixV : array of TMatrixItem;
8198   end;
8199
8200 const
8201   ONE_OVER_255 = 1 / 255;
8202
8203   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8204 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8205 var
8206   Val: Single;
8207 begin
8208   with FuncRec do begin
8209     Val :=
8210       Source.Data.r * LUMINANCE_WEIGHT_R +
8211       Source.Data.g * LUMINANCE_WEIGHT_G +
8212       Source.Data.b * LUMINANCE_WEIGHT_B;
8213     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8214   end;
8215 end;
8216
8217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8218 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8219 begin
8220   with FuncRec do
8221     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8222 end;
8223
8224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8225 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8226 type
8227   TVec = Array[0..2] of Single;
8228 var
8229   Idx: Integer;
8230   du, dv: Double;
8231   Len: Single;
8232   Vec: TVec;
8233
8234   function GetHeight(X, Y: Integer): Single;
8235   begin
8236     with FuncRec do begin
8237       X := Max(0, Min(Size.X -1, X));
8238       Y := Max(0, Min(Size.Y -1, Y));
8239       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8240     end;
8241   end;
8242
8243 begin
8244   with FuncRec do begin
8245     with PglBitmapToNormalMapRec(Args)^ do begin
8246       du := 0;
8247       for Idx := Low(MatrixU) to High(MatrixU) do
8248         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8249
8250       dv := 0;
8251       for Idx := Low(MatrixU) to High(MatrixU) do
8252         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8253
8254       Vec[0] := -du * Scale;
8255       Vec[1] := -dv * Scale;
8256       Vec[2] := 1;
8257     end;
8258
8259     // Normalize
8260     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8261     if Len <> 0 then begin
8262       Vec[0] := Vec[0] * Len;
8263       Vec[1] := Vec[1] * Len;
8264       Vec[2] := Vec[2] * Len;
8265     end;
8266
8267     // Farbe zuweisem
8268     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8269     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8270     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8271   end;
8272 end;
8273
8274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8275 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8276 var
8277   Rec: TglBitmapToNormalMapRec;
8278
8279   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8280   begin
8281     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8282       Matrix[Index].X := X;
8283       Matrix[Index].Y := Y;
8284       Matrix[Index].W := W;
8285     end;
8286   end;
8287
8288 begin
8289   if TFormatDescriptor.Get(Format).IsCompressed then
8290     raise EglBitmapUnsupportedFormat.Create(Format);
8291
8292   if aScale > 100 then
8293     Rec.Scale := 100
8294   else if aScale < -100 then
8295     Rec.Scale := -100
8296   else
8297     Rec.Scale := aScale;
8298
8299   SetLength(Rec.Heights, Width * Height);
8300   try
8301     case aFunc of
8302       nm4Samples: begin
8303         SetLength(Rec.MatrixU, 2);
8304         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8305         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8306
8307         SetLength(Rec.MatrixV, 2);
8308         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8309         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8310       end;
8311
8312       nmSobel: begin
8313         SetLength(Rec.MatrixU, 6);
8314         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8315         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8316         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8317         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8318         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8319         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8320
8321         SetLength(Rec.MatrixV, 6);
8322         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8323         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8324         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8325         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8326         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8327         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8328       end;
8329
8330       nm3x3: begin
8331         SetLength(Rec.MatrixU, 6);
8332         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8333         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8334         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8335         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8336         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8337         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8338
8339         SetLength(Rec.MatrixV, 6);
8340         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8341         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8342         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8343         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8344         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8345         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8346       end;
8347
8348       nm5x5: begin
8349         SetLength(Rec.MatrixU, 20);
8350         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8351         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8352         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8353         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8354         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8355         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8356         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8357         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8358         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8359         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8360         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8361         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8362         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8363         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8364         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8365         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8366         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8367         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8368         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8369         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8370
8371         SetLength(Rec.MatrixV, 20);
8372         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8373         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8374         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8375         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8376         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8377         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8378         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8379         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8380         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8381         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8382         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8383         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8384         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8385         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8386         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8387         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8388         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8389         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8390         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8391         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8392       end;
8393     end;
8394
8395     // Daten Sammeln
8396     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8397       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8398     else
8399       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8400     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8401   finally
8402     SetLength(Rec.Heights, 0);
8403   end;
8404 end;
8405
8406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8407 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8409 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8410 begin
8411   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8412 end;
8413
8414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8415 procedure TglBitmapCubeMap.AfterConstruction;
8416 begin
8417   inherited;
8418
8419   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8420     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8421
8422   SetWrap;
8423   Target   := GL_TEXTURE_CUBE_MAP;
8424   fGenMode := GL_REFLECTION_MAP;
8425 end;
8426
8427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8428 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8429 var
8430   BuildWithGlu: Boolean;
8431   TexSize: Integer;
8432 begin
8433   if (aTestTextureSize) then begin
8434     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8435
8436     if (Height > TexSize) or (Width > TexSize) then
8437       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8438
8439     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8440       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8441   end;
8442
8443   if (ID = 0) then
8444     CreateID;
8445   SetupParameters(BuildWithGlu);
8446   UploadData(aCubeTarget, BuildWithGlu);
8447 end;
8448
8449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8450 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8451 begin
8452   inherited Bind (aEnableTextureUnit);
8453   if aEnableTexCoordsGen then begin
8454     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8455     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8456     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8457     glEnable(GL_TEXTURE_GEN_S);
8458     glEnable(GL_TEXTURE_GEN_T);
8459     glEnable(GL_TEXTURE_GEN_R);
8460   end;
8461 end;
8462
8463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8464 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8465 begin
8466   inherited Unbind(aDisableTextureUnit);
8467   if aDisableTexCoordsGen then begin
8468     glDisable(GL_TEXTURE_GEN_S);
8469     glDisable(GL_TEXTURE_GEN_T);
8470     glDisable(GL_TEXTURE_GEN_R);
8471   end;
8472 end;
8473
8474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8477 type
8478   TVec = Array[0..2] of Single;
8479   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8480
8481   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8482   TglBitmapNormalMapRec = record
8483     HalfSize : Integer;
8484     Func: TglBitmapNormalMapGetVectorFunc;
8485   end;
8486
8487   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8488 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8489 begin
8490   aVec[0] := aHalfSize;
8491   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8492   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8493 end;
8494
8495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8496 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8497 begin
8498   aVec[0] := - aHalfSize;
8499   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8500   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8501 end;
8502
8503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8504 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8505 begin
8506   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8507   aVec[1] := aHalfSize;
8508   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8509 end;
8510
8511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8512 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8513 begin
8514   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8515   aVec[1] := - aHalfSize;
8516   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8517 end;
8518
8519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8520 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8521 begin
8522   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8523   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8524   aVec[2] := aHalfSize;
8525 end;
8526
8527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8528 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8529 begin
8530   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8531   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8532   aVec[2] := - aHalfSize;
8533 end;
8534
8535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8536 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8537 var
8538   i: Integer;
8539   Vec: TVec;
8540   Len: Single;
8541 begin
8542   with FuncRec do begin
8543     with PglBitmapNormalMapRec(Args)^ do begin
8544       Func(Vec, Position, HalfSize);
8545
8546       // Normalize
8547       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8548       if Len <> 0 then begin
8549         Vec[0] := Vec[0] * Len;
8550         Vec[1] := Vec[1] * Len;
8551         Vec[2] := Vec[2] * Len;
8552       end;
8553
8554       // Scale Vector and AddVectro
8555       Vec[0] := Vec[0] * 0.5 + 0.5;
8556       Vec[1] := Vec[1] * 0.5 + 0.5;
8557       Vec[2] := Vec[2] * 0.5 + 0.5;
8558     end;
8559
8560     // Set Color
8561     for i := 0 to 2 do
8562       Dest.Data.arr[i] := Round(Vec[i] * 255);
8563   end;
8564 end;
8565
8566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8567 procedure TglBitmapNormalMap.AfterConstruction;
8568 begin
8569   inherited;
8570   fGenMode := GL_NORMAL_MAP;
8571 end;
8572
8573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8574 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8575 var
8576   Rec: TglBitmapNormalMapRec;
8577   SizeRec: TglBitmapPixelPosition;
8578 begin
8579   Rec.HalfSize := aSize div 2;
8580   FreeDataAfterGenTexture := false;
8581
8582   SizeRec.Fields := [ffX, ffY];
8583   SizeRec.X := aSize;
8584   SizeRec.Y := aSize;
8585
8586   // Positive X
8587   Rec.Func := glBitmapNormalMapPosX;
8588   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8589   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8590
8591   // Negative X
8592   Rec.Func := glBitmapNormalMapNegX;
8593   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8594   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8595
8596   // Positive Y
8597   Rec.Func := glBitmapNormalMapPosY;
8598   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8599   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8600
8601   // Negative Y
8602   Rec.Func := glBitmapNormalMapNegY;
8603   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8604   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8605
8606   // Positive Z
8607   Rec.Func := glBitmapNormalMapPosZ;
8608   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8609   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8610
8611   // Negative Z
8612   Rec.Func := glBitmapNormalMapNegZ;
8613   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8614   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8615 end;
8616
8617
8618 initialization
8619   glBitmapSetDefaultFormat (tfEmpty);
8620   glBitmapSetDefaultMipmap (mmMipmap);
8621   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8622   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8623   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8624
8625   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8626   glBitmapSetDefaultDeleteTextureOnFree    (true);
8627
8628   TFormatDescriptor.Init;
8629
8630 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8631   OpenGLInitialized := false;
8632   InitOpenGLCS := TCriticalSection.Create;
8633 {$ENDIF}
8634
8635 finalization
8636   TFormatDescriptor.Finalize;
8637
8638 {$IFDEF GLB_NATIVE_OGL}
8639   if Assigned(GL_LibHandle) then
8640     glbFreeLibrary(GL_LibHandle);
8641
8642 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8643   if Assigned(GLU_LibHandle) then
8644     glbFreeLibrary(GLU_LibHandle);
8645   FreeAndNil(InitOpenGLCS);
8646 {$ENDIF}
8647 {$ENDIF}
8648
8649 end.