glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.1
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {.$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {.$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {.$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     tfAlpha12,
 782     tfAlpha16,
 783
 784     tfLuminance4,
 785     tfLuminance8,
 786     tfLuminance12,
 787     tfLuminance16,
 788
 789     tfLuminance4Alpha4,
 790     tfLuminance6Alpha2,
 791     tfLuminance8Alpha8,
 792     tfLuminance12Alpha4,
 793     tfLuminance12Alpha12,
 794     tfLuminance16Alpha16,
 795
 796     tfR3G3B2,
 797     tfRGB4,
 798     tfR5G6B5,
 799     tfRGB5,
 800     tfRGB8,
 801     tfRGB10,
 802     tfRGB12,
 803     tfRGB16,
 804
 805     tfRGBA2,
 806     tfRGBA4,
 807     tfRGB5A1,
 808     tfRGBA8,
 809     tfRGB10A2,
 810     tfRGBA12,
 811     tfRGBA16,
 812
 813     tfBGR4,
 814     tfB5G6R5,
 815     tfBGR5,
 816     tfBGR8,
 817     tfBGR10,
 818     tfBGR12,
 819     tfBGR16,
 820
 821     tfBGRA2,
 822     tfBGRA4,
 823     tfBGR5A1,
 824     tfBGRA8,
 825     tfBGR10A2,
 826     tfBGRA12,
 827     tfBGRA16,
 828
 829     tfDepth16,
 830     tfDepth24,
 831     tfDepth32,
 832
 833     tfS3tcDtx1RGBA,
 834     tfS3tcDtx3RGBA,
 835     tfS3tcDtx5RGBA
 836   );
 837
 838   TglBitmapFileType = (
 839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 841      ftDDS,
 842      ftTGA,
 843      ftBMP);
 844    TglBitmapFileTypes = set of TglBitmapFileType;
 845
 846    TglBitmapMipMap = (
 847      mmNone,
 848      mmMipmap,
 849      mmMipmapGlu);
 850
 851    TglBitmapNormalMapFunc = (
 852      nm4Samples,
 853      nmSobel,
 854      nm3x3,
 855      nm5x5);
 856
 857  ////////////////////////////////////////////////////////////////////////////////////////////////////
 858    EglBitmap                  = class(Exception);
 859    EglBitmapNotSupported      = class(Exception);
 860    EglBitmapSizeToLarge       = class(EglBitmap);
 861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 862    EglBitmapUnsupportedFormat = class(EglBitmap)
 863    public
 864      constructor Create(const aFormat: TglBitmapFormat); overload;
 865      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 866    end;
 867
 868 ////////////////////////////////////////////////////////////////////////////////////////////////////
 869   TglBitmapColorRec = packed record
 870   case Integer of
 871     0: (r, g, b, a: Cardinal);
 872     1: (arr: array[0..3] of Cardinal);
 873   end;
 874
 875   TglBitmapPixelData = packed record
 876     Data, Range: TglBitmapColorRec;
 877     Format: TglBitmapFormat;
 878   end;
 879   PglBitmapPixelData = ^TglBitmapPixelData;
 880
 881 ////////////////////////////////////////////////////////////////////////////////////////////////////
 882   TglBitmapPixelPositionFields = set of (ffX, ffY);
 883   TglBitmapPixelPosition = record
 884     Fields : TglBitmapPixelPositionFields;
 885     X : Word;
 886     Y : Word;
 887   end;
 888
 889   TglBitmapFormatDescriptor = class(TObject)
 890   protected
 891     function GetIsCompressed: Boolean; virtual; abstract;
 892     function GetHasRed:       Boolean; virtual; abstract;
 893     function GetHasGreen:     Boolean; virtual; abstract;
 894     function GetHasBlue:      Boolean; virtual; abstract;
 895     function GetHasAlpha:     Boolean; virtual; abstract;
 896
 897     function GetglDataFormat:     GLenum;  virtual; abstract;
 898     function GetglFormat:         GLenum;  virtual; abstract;
 899     function GetglInternalFormat: GLenum;  virtual; abstract;
 900   public
 901     property IsCompressed: Boolean read GetIsCompressed;
 902     property HasRed:       Boolean read GetHasRed;
 903     property HasGreen:     Boolean read GetHasGreen;
 904     property HasBlue:      Boolean read GetHasBlue;
 905     property HasAlpha:     Boolean read GetHasAlpha;
 906
 907     property glFormat:         GLenum  read GetglFormat;
 908     property glInternalFormat: GLenum  read GetglInternalFormat;
 909     property glDataFormat:     GLenum  read GetglDataFormat;
 910   end;
 911
 912 ////////////////////////////////////////////////////////////////////////////////////////////////////
 913   TglBitmap = class;
 914   TglBitmapFunctionRec = record
 915     Sender:   TglBitmap;
 916     Size:     TglBitmapPixelPosition;
 917     Position: TglBitmapPixelPosition;
 918     Source:   TglBitmapPixelData;
 919     Dest:     TglBitmapPixelData;
 920     Args:     Pointer;
 921   end;
 922   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 923
 924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 925   TglBitmap = class
 926   private
 927     function GetFormatDesc: TglBitmapFormatDescriptor;
 928   protected
 929     fID: GLuint;
 930     fTarget: GLuint;
 931     fAnisotropic: Integer;
 932     fDeleteTextureOnFree: Boolean;
 933     fFreeDataOnDestroy: Boolean;
 934     fFreeDataAfterGenTexture: Boolean;
 935     fData: PByte;
 936     fIsResident: GLboolean;
 937     fBorderColor: array[0..3] of Single;
 938
 939     fDimension: TglBitmapPixelPosition;
 940     fMipMap: TglBitmapMipMap;
 941     fFormat: TglBitmapFormat;
 942
 943     // Mapping
 944     fPixelSize: Integer;
 945     fRowSize: Integer;
 946
 947     // Filtering
 948     fFilterMin: GLenum;
 949     fFilterMag: GLenum;
 950
 951     // TexturWarp
 952     fWrapS: GLenum;
 953     fWrapT: GLenum;
 954     fWrapR: GLenum;
 955
 956     //Swizzle
 957     fSwizzle: array[0..3] of GLenum;
 958
 959     // CustomData
 960     fFilename: String;
 961     fCustomName: String;
 962     fCustomNameW: WideString;
 963     fCustomData: Pointer;
 964
 965     //Getter
 966     function GetWidth:  Integer; virtual;
 967     function GetHeight: Integer; virtual;
 968
 969     function GetFileWidth:  Integer; virtual;
 970     function GetFileHeight: Integer; virtual;
 971
 972     //Setter
 973     procedure SetCustomData(const aValue: Pointer);
 974     procedure SetCustomName(const aValue: String);
 975     procedure SetCustomNameW(const aValue: WideString);
 976     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 977     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 978     procedure SetFormat(const aValue: TglBitmapFormat);
 979     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 980     procedure SetID(const aValue: Cardinal);
 981     procedure SetMipMap(const aValue: TglBitmapMipMap);
 982     procedure SetTarget(const aValue: Cardinal);
 983     procedure SetAnisotropic(const aValue: Integer);
 984
 985     procedure CreateID;
 986     procedure SetupParameters(out aBuildWithGlu: Boolean);
 987     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 988       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 989     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 990
 991     function FlipHorz: Boolean; virtual;
 992     function FlipVert: Boolean; virtual;
 993
 994     property Width:  Integer read GetWidth;
 995     property Height: Integer read GetHeight;
 996
 997     property FileWidth:  Integer read GetFileWidth;
 998     property FileHeight: Integer read GetFileHeight;
 999   public
1000     //Properties
1001     property ID:           Cardinal        read fID          write SetID;
1002     property Target:       Cardinal        read fTarget      write SetTarget;
1003     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1004     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1005     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1006
1007     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1008
1009     property Filename:    String     read fFilename;
1010     property CustomName:  String     read fCustomName  write SetCustomName;
1011     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1012     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1013
1014     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1015     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1016     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1017
1018     property Dimension:  TglBitmapPixelPosition  read fDimension;
1019     property Data:       PByte                   read fData;
1020     property IsResident: GLboolean               read fIsResident;
1021
1022     procedure AfterConstruction; override;
1023     procedure BeforeDestruction; override;
1024
1025     procedure PrepareResType(var aResource: String; var aResType: PChar);
1026
1027     //Load
1028     procedure LoadFromFile(const aFilename: String);
1029     procedure LoadFromStream(const aStream: TStream); virtual;
1030     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1031       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1032     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1033     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1034
1035     //Save
1036     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1037     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1038
1039     //Convert
1040     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1041     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1042       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1043   public
1044     //Alpha & Co
1045     {$IFDEF GLB_SDL}
1046     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1047     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1048     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1049     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1050       const aArgs: Pointer = nil): Boolean;
1051     {$ENDIF}
1052
1053     {$IFDEF GLB_DELPHI}
1054     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1055     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1056     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1057     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1058       const aArgs: Pointer = nil): Boolean;
1059     {$ENDIF}
1060
1061     {$IFDEF GLB_LAZARUS}
1062     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1063     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1064     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1065     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1066       const aArgs: Pointer = nil): Boolean;
1067     {$ENDIF}
1068
1069     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1070       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1071     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1072       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1073
1074     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1075     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1076     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1077     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1078
1079     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1080     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1081     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1082
1083     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1084     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1085     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1086
1087     function RemoveAlpha: Boolean; virtual;
1088   public
1089     //Common
1090     function Clone: TglBitmap;
1091     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1092     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1093     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1094     procedure FreeData;
1095
1096     //ColorFill
1097     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1098     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1099     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1100
1101     //TexParameters
1102     procedure SetFilter(const aMin, aMag: GLenum);
1103     procedure SetWrap(
1104       const S: GLenum = GL_CLAMP_TO_EDGE;
1105       const T: GLenum = GL_CLAMP_TO_EDGE;
1106       const R: GLenum = GL_CLAMP_TO_EDGE);
1107     procedure SetSwizzle(const r, g, b, a: GLenum);
1108
1109     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1110     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1111
1112     //Constructors
1113     constructor Create; overload;
1114     constructor Create(const aFileName: String); overload;
1115     constructor Create(const aStream: TStream); overload;
1116     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1117     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1118     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1119     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1120   private
1121     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1122     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1123
1124     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1125     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1126
1127     function LoadBMP(const aStream: TStream): Boolean; virtual;
1128     procedure SaveBMP(const aStream: TStream); virtual;
1129
1130     function LoadTGA(const aStream: TStream): Boolean; virtual;
1131     procedure SaveTGA(const aStream: TStream); virtual;
1132
1133     function LoadDDS(const aStream: TStream): Boolean; virtual;
1134     procedure SaveDDS(const aStream: TStream); virtual;
1135   end;
1136
1137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1138   TglBitmap1D = class(TglBitmap)
1139   protected
1140     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1141       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1142     procedure UploadData(const aBuildWithGlu: Boolean);
1143   public
1144     property Width;
1145     procedure AfterConstruction; override;
1146     function FlipHorz: Boolean; override;
1147     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1148   end;
1149
1150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1151   TglBitmap2D = class(TglBitmap)
1152   protected
1153     fLines: array of PByte;
1154     function GetScanline(const aIndex: Integer): Pointer;
1155     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1156       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1157     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1158   public
1159     property Width;
1160     property Height;
1161     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1162
1163     procedure AfterConstruction; override;
1164
1165     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1166     procedure GetDataFromTexture;
1167     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1168
1169     function FlipHorz: Boolean; override;
1170     function FlipVert: Boolean; override;
1171
1172     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1173       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1174   end;
1175
1176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1177   TglBitmapCubeMap = class(TglBitmap2D)
1178   protected
1179     fGenMode: Integer;
1180     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1181   public
1182     procedure AfterConstruction; override;
1183     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1184     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1185     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1186   end;
1187
1188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1189   TglBitmapNormalMap = class(TglBitmapCubeMap)
1190   public
1191     procedure AfterConstruction; override;
1192     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1193   end;
1194
1195 const
1196   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1197
1198 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1199 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1200 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1201 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1202 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1203 procedure glBitmapSetDefaultWrap(
1204   const S: Cardinal = GL_CLAMP_TO_EDGE;
1205   const T: Cardinal = GL_CLAMP_TO_EDGE;
1206   const R: Cardinal = GL_CLAMP_TO_EDGE);
1207
1208 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1209 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1210 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1211 function glBitmapGetDefaultFormat: TglBitmapFormat;
1212 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1213 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1214
1215 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1216 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1217 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1218
1219 var
1220   glBitmapDefaultDeleteTextureOnFree: Boolean;
1221   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1222   glBitmapDefaultFormat: TglBitmapFormat;
1223   glBitmapDefaultMipmap: TglBitmapMipMap;
1224   glBitmapDefaultFilterMin: Cardinal;
1225   glBitmapDefaultFilterMag: Cardinal;
1226   glBitmapDefaultWrapS: Cardinal;
1227   glBitmapDefaultWrapT: Cardinal;
1228   glBitmapDefaultWrapR: Cardinal;
1229   glDefaultSwizzle: array[0..3] of GLenum;
1230
1231 {$IFDEF GLB_DELPHI}
1232 function CreateGrayPalette: HPALETTE;
1233 {$ENDIF}
1234
1235 implementation
1236
1237 uses
1238   Math, syncobjs, typinfo
1239   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1240
1241 type
1242 {$IFNDEF fpc}
1243   QWord   = System.UInt64;
1244   PQWord  = ^QWord;
1245
1246   PtrInt  = Longint;
1247   PtrUInt = DWord;
1248 {$ENDIF}
1249
1250 ////////////////////////////////////////////////////////////////////////////////////////////////////
1251   TShiftRec = packed record
1252   case Integer of
1253     0: (r, g, b, a: Byte);
1254     1: (arr: array[0..3] of Byte);
1255   end;
1256
1257   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1258   private
1259     function GetRedMask: QWord;
1260     function GetGreenMask: QWord;
1261     function GetBlueMask: QWord;
1262     function GetAlphaMask: QWord;
1263   protected
1264     fFormat: TglBitmapFormat;
1265     fWithAlpha: TglBitmapFormat;
1266     fWithoutAlpha: TglBitmapFormat;
1267     fRGBInverted: TglBitmapFormat;
1268     fUncompressed: TglBitmapFormat;
1269     fPixelSize: Single;
1270     fIsCompressed: Boolean;
1271
1272     fRange: TglBitmapColorRec;
1273     fShift: TShiftRec;
1274
1275     fglFormat:         GLenum;
1276     fglInternalFormat: GLenum;
1277     fglDataFormat:     GLenum;
1278
1279     function GetIsCompressed: Boolean; override;
1280     function GetHasRed: Boolean; override;
1281     function GetHasGreen: Boolean; override;
1282     function GetHasBlue: Boolean; override;
1283     function GetHasAlpha: Boolean; override;
1284
1285     function GetglFormat: GLenum; override;
1286     function GetglInternalFormat: GLenum; override;
1287     function GetglDataFormat: GLenum; override;
1288
1289     function GetComponents: Integer; virtual;
1290   public
1291     property Format:       TglBitmapFormat read fFormat;
1292     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1293     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1294     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1295     property Components:   Integer         read GetComponents;
1296     property PixelSize:    Single          read fPixelSize;
1297
1298     property Range: TglBitmapColorRec read fRange;
1299     property Shift: TShiftRec         read fShift;
1300
1301     property RedMask:   QWord read GetRedMask;
1302     property GreenMask: QWord read GetGreenMask;
1303     property BlueMask:  QWord read GetBlueMask;
1304     property AlphaMask: QWord read GetAlphaMask;
1305
1306     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1307     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1308
1309     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1310     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1311
1312     function CreateMappingData: Pointer; virtual;
1313     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1314
1315     function IsEmpty:  Boolean; virtual;
1316     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1317
1318     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1319
1320     constructor Create; virtual;
1321   public
1322     class procedure Init;
1323     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1324     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1325     class procedure Clear;
1326     class procedure Finalize;
1327   end;
1328   TFormatDescriptorClass = class of TFormatDescriptor;
1329
1330   TfdEmpty = class(TFormatDescriptor);
1331
1332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1333   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336     constructor Create; override;
1337   end;
1338
1339   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342     constructor Create; override;
1343   end;
1344
1345   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1346     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1347     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1348     constructor Create; override;
1349   end;
1350
1351   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354     constructor Create; override;
1355   end;
1356
1357   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1358     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1359     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1360     constructor Create; override;
1361   end;
1362
1363   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1364     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1365     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1366     constructor Create; override;
1367   end;
1368
1369   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1370     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1371     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1372     constructor Create; override;
1373   end;
1374
1375   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1376     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1377     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1378     constructor Create; override;
1379   end;
1380
1381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1382   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385     constructor Create; override;
1386   end;
1387
1388   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1389     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1390     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1391     constructor Create; override;
1392   end;
1393
1394   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1395     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1396     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1397     constructor Create; override;
1398   end;
1399
1400   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1401     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1402     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1403     constructor Create; override;
1404   end;
1405
1406   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409     constructor Create; override;
1410   end;
1411
1412   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415     constructor Create; override;
1416   end;
1417
1418   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421     constructor Create; override;
1422   end;
1423
1424   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1425     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1426     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1427     constructor Create; override;
1428   end;
1429
1430   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1431     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1432     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1433     constructor Create; override;
1434   end;
1435
1436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1437   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1438     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1439     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1440     constructor Create; override;
1441   end;
1442
1443   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446     constructor Create; override;
1447   end;
1448
1449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1450   TfdAlpha4 = class(TfdAlpha_UB1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdAlpha8 = class(TfdAlpha_UB1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdAlpha12 = class(TfdAlpha_US1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdAlpha16 = class(TfdAlpha_US1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdLuminance4 = class(TfdLuminance_UB1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdLuminance8 = class(TfdLuminance_UB1)
1471     constructor Create; override;
1472   end;
1473
1474   TfdLuminance12 = class(TfdLuminance_US1)
1475     constructor Create; override;
1476   end;
1477
1478   TfdLuminance16 = class(TfdLuminance_US1)
1479     constructor Create; override;
1480   end;
1481
1482   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1483     constructor Create; override;
1484   end;
1485
1486   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1487     constructor Create; override;
1488   end;
1489
1490   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1491     constructor Create; override;
1492   end;
1493
1494   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1495     constructor Create; override;
1496   end;
1497
1498   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1499     constructor Create; override;
1500   end;
1501
1502   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1503     constructor Create; override;
1504   end;
1505
1506   TfdR3G3B2 = class(TfdUniversal_UB1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdRGB4 = class(TfdUniversal_US1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdR5G6B5 = class(TfdUniversal_US1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdRGB5 = class(TfdUniversal_US1)
1519     constructor Create; override;
1520   end;
1521
1522   TfdRGB8 = class(TfdRGB_UB3)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGB10 = class(TfdUniversal_UI1)
1527     constructor Create; override;
1528   end;
1529
1530   TfdRGB12 = class(TfdRGB_US3)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGB16 = class(TfdRGB_US3)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGBA2 = class(TfdRGBA_UB4)
1539     constructor Create; override;
1540   end;
1541
1542   TfdRGBA4 = class(TfdUniversal_US1)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGB5A1 = class(TfdUniversal_US1)
1547     constructor Create; override;
1548   end;
1549
1550   TfdRGBA8 = class(TfdRGBA_UB4)
1551     constructor Create; override;
1552   end;
1553
1554   TfdRGB10A2 = class(TfdUniversal_UI1)
1555     constructor Create; override;
1556   end;
1557
1558   TfdRGBA12 = class(TfdRGBA_US4)
1559     constructor Create; override;
1560   end;
1561
1562   TfdRGBA16 = class(TfdRGBA_US4)
1563     constructor Create; override;
1564   end;
1565
1566   TfdBGR4 = class(TfdUniversal_US1)
1567     constructor Create; override;
1568   end;
1569
1570   TfdB5G6R5 = class(TfdUniversal_US1)
1571     constructor Create; override;
1572   end;
1573
1574   TfdBGR5 = class(TfdUniversal_US1)
1575     constructor Create; override;
1576   end;
1577
1578   TfdBGR8 = class(TfdBGR_UB3)
1579     constructor Create; override;
1580   end;
1581
1582   TfdBGR10 = class(TfdUniversal_UI1)
1583     constructor Create; override;
1584   end;
1585
1586   TfdBGR12 = class(TfdBGR_US3)
1587     constructor Create; override;
1588   end;
1589
1590   TfdBGR16 = class(TfdBGR_US3)
1591     constructor Create; override;
1592   end;
1593
1594   TfdBGRA2 = class(TfdBGRA_UB4)
1595     constructor Create; override;
1596   end;
1597
1598   TfdBGRA4 = class(TfdUniversal_US1)
1599     constructor Create; override;
1600   end;
1601
1602   TfdBGR5A1 = class(TfdUniversal_US1)
1603     constructor Create; override;
1604   end;
1605
1606   TfdBGRA8 = class(TfdBGRA_UB4)
1607     constructor Create; override;
1608   end;
1609
1610   TfdBGR10A2 = class(TfdUniversal_UI1)
1611     constructor Create; override;
1612   end;
1613
1614   TfdBGRA12 = class(TfdBGRA_US4)
1615     constructor Create; override;
1616   end;
1617
1618   TfdBGRA16 = class(TfdBGRA_US4)
1619     constructor Create; override;
1620   end;
1621
1622   TfdDepth16 = class(TfdDepth_US1)
1623     constructor Create; override;
1624   end;
1625
1626   TfdDepth24 = class(TfdDepth_UI1)
1627     constructor Create; override;
1628   end;
1629
1630   TfdDepth32 = class(TfdDepth_UI1)
1631     constructor Create; override;
1632   end;
1633
1634   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1635     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1636     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1637     constructor Create; override;
1638   end;
1639
1640   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1641     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1642     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1643     constructor Create; override;
1644   end;
1645
1646   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1647     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1648     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1649     constructor Create; override;
1650   end;
1651
1652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1653   TbmpBitfieldFormat = class(TFormatDescriptor)
1654   private
1655     procedure SetRedMask  (const aValue: QWord);
1656     procedure SetGreenMask(const aValue: QWord);
1657     procedure SetBlueMask (const aValue: QWord);
1658     procedure SetAlphaMask(const aValue: QWord);
1659
1660     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1661   public
1662     property RedMask:   QWord read GetRedMask   write SetRedMask;
1663     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1664     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1665     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1666
1667     property PixelSize: Single read fPixelSize write fPixelSize;
1668
1669     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1670     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1671   end;
1672
1673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1674   TbmpColorTableEnty = packed record
1675     b, g, r, a: Byte;
1676   end;
1677   TbmpColorTable = array of TbmpColorTableEnty;
1678   TbmpColorTableFormat = class(TFormatDescriptor)
1679   private
1680     fColorTable: TbmpColorTable;
1681   public
1682     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1683     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1684     property Range:      TglBitmapColorRec read fRange      write fRange;
1685     property Shift:      TShiftRec         read fShift      write fShift;
1686     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1687
1688     procedure CreateColorTable;
1689
1690     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1691     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1692     destructor Destroy; override;
1693   end;
1694
1695 const
1696   LUMINANCE_WEIGHT_R = 0.30;
1697   LUMINANCE_WEIGHT_G = 0.59;
1698   LUMINANCE_WEIGHT_B = 0.11;
1699
1700   ALPHA_WEIGHT_R = 0.30;
1701   ALPHA_WEIGHT_G = 0.59;
1702   ALPHA_WEIGHT_B = 0.11;
1703
1704   DEPTH_WEIGHT_R = 0.333333333;
1705   DEPTH_WEIGHT_G = 0.333333333;
1706   DEPTH_WEIGHT_B = 0.333333333;
1707
1708   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1709
1710   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1711     TfdEmpty,
1712
1713     TfdAlpha4,
1714     TfdAlpha8,
1715     TfdAlpha12,
1716     TfdAlpha16,
1717
1718     TfdLuminance4,
1719     TfdLuminance8,
1720     TfdLuminance12,
1721     TfdLuminance16,
1722
1723     TfdLuminance4Alpha4,
1724     TfdLuminance6Alpha2,
1725     TfdLuminance8Alpha8,
1726     TfdLuminance12Alpha4,
1727     TfdLuminance12Alpha12,
1728     TfdLuminance16Alpha16,
1729
1730     TfdR3G3B2,
1731     TfdRGB4,
1732     TfdR5G6B5,
1733     TfdRGB5,
1734     TfdRGB8,
1735     TfdRGB10,
1736     TfdRGB12,
1737     TfdRGB16,
1738
1739     TfdRGBA2,
1740     TfdRGBA4,
1741     TfdRGB5A1,
1742     TfdRGBA8,
1743     TfdRGB10A2,
1744     TfdRGBA12,
1745     TfdRGBA16,
1746
1747     TfdBGR4,
1748     TfdB5G6R5,
1749     TfdBGR5,
1750     TfdBGR8,
1751     TfdBGR10,
1752     TfdBGR12,
1753     TfdBGR16,
1754
1755     TfdBGRA2,
1756     TfdBGRA4,
1757     TfdBGR5A1,
1758     TfdBGRA8,
1759     TfdBGR10A2,
1760     TfdBGRA12,
1761     TfdBGRA16,
1762
1763     TfdDepth16,
1764     TfdDepth24,
1765     TfdDepth32,
1766
1767     TfdS3tcDtx1RGBA,
1768     TfdS3tcDtx3RGBA,
1769     TfdS3tcDtx5RGBA
1770   );
1771
1772 var
1773   FormatDescriptorCS: TCriticalSection;
1774   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1775
1776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1777 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1778 begin
1779   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1780 end;
1781
1782 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1783 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1784 begin
1785   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1786 end;
1787
1788 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1789 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1790 begin
1791   result.Fields := [];
1792
1793   if X >= 0 then
1794     result.Fields := result.Fields + [ffX];
1795   if Y >= 0 then
1796     result.Fields := result.Fields + [ffY];
1797
1798   result.X := Max(0, X);
1799   result.Y := Max(0, Y);
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1804 begin
1805   result.r := r;
1806   result.g := g;
1807   result.b := b;
1808   result.a := a;
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1813 var
1814   i: Integer;
1815 begin
1816   result := false;
1817   for i := 0 to high(r1.arr) do
1818     if (r1.arr[i] <> r2.arr[i]) then
1819       exit;
1820   result := true;
1821 end;
1822
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1825 begin
1826   result.r := r;
1827   result.g := g;
1828   result.b := b;
1829   result.a := a;
1830 end;
1831
1832 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1833 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1834 begin
1835   result := [];
1836
1837   if (aFormat in [
1838         //4 bbp
1839         tfLuminance4,
1840
1841         //8bpp
1842         tfR3G3B2, tfLuminance8,
1843
1844         //16bpp
1845         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1846         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1847
1848         //24bpp
1849         tfBGR8, tfRGB8,
1850
1851         //32bpp
1852         tfRGB10, tfRGB10A2, tfRGBA8,
1853         tfBGR10, tfBGR10A2, tfBGRA8]) then
1854     result := result + [ftBMP];
1855
1856   if (aFormat in [
1857         //8 bpp
1858         tfLuminance8, tfAlpha8,
1859
1860         //16 bpp
1861         tfLuminance16, tfLuminance8Alpha8,
1862         tfRGB5, tfRGB5A1, tfRGBA4,
1863         tfBGR5, tfBGR5A1, tfBGRA4,
1864
1865         //24 bpp
1866         tfRGB8, tfBGR8,
1867
1868         //32 bpp
1869         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1870     result := result + [ftTGA];
1871
1872   if (aFormat in [
1873         //8 bpp
1874         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1875         tfR3G3B2, tfRGBA2, tfBGRA2,
1876
1877         //16 bpp
1878         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1879         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1880         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1881
1882         //24 bpp
1883         tfRGB8, tfBGR8,
1884
1885         //32 bbp
1886         tfLuminance16Alpha16,
1887         tfRGBA8, tfRGB10A2,
1888         tfBGRA8, tfBGR10A2,
1889
1890         //compressed
1891         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1892     result := result + [ftDDS];
1893
1894   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1895   if aFormat in [
1896       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1897       tfRGB8, tfRGBA8,
1898       tfBGR8, tfBGRA8] then
1899     result := result + [ftPNG];
1900   {$ENDIF}
1901
1902   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1903   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1904     result := result + [ftJPEG];
1905   {$ENDIF}
1906 end;
1907
1908 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1909 function IsPowerOfTwo(aNumber: Integer): Boolean;
1910 begin
1911   while (aNumber and 1) = 0 do
1912     aNumber := aNumber shr 1;
1913   result := aNumber = 1;
1914 end;
1915
1916 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1917 function GetTopMostBit(aBitSet: QWord): Integer;
1918 begin
1919   result := 0;
1920   while aBitSet > 0 do begin
1921     inc(result);
1922     aBitSet := aBitSet shr 1;
1923   end;
1924 end;
1925
1926 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1927 function CountSetBits(aBitSet: QWord): Integer;
1928 begin
1929   result := 0;
1930   while aBitSet > 0 do begin
1931     if (aBitSet and 1) = 1 then
1932       inc(result);
1933     aBitSet := aBitSet shr 1;
1934   end;
1935 end;
1936
1937 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1938 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1939 begin
1940   result := Trunc(
1941     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1942     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1943     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1944 end;
1945
1946 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1947 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1948 begin
1949   result := Trunc(
1950     DEPTH_WEIGHT_R * aPixel.Data.r +
1951     DEPTH_WEIGHT_G * aPixel.Data.g +
1952     DEPTH_WEIGHT_B * aPixel.Data.b);
1953 end;
1954
1955 {$IFDEF GLB_NATIVE_OGL}
1956 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1957 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1958 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1959 var
1960   GL_LibHandle: Pointer = nil;
1961
1962 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1963 begin
1964   if not Assigned(aLibHandle) then
1965     aLibHandle := GL_LibHandle;
1966
1967 {$IF DEFINED(GLB_WIN)}
1968   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1969   if Assigned(result) then
1970     exit;
1971
1972   if Assigned(wglGetProcAddress) then
1973     result := wglGetProcAddress(aProcName);
1974 {$ELSEIF DEFINED(GLB_LINUX)}
1975   if Assigned(glXGetProcAddress) then begin
1976     result := glXGetProcAddress(aProcName);
1977     if Assigned(result) then
1978       exit;
1979   end;
1980
1981   if Assigned(glXGetProcAddressARB) then begin
1982     result := glXGetProcAddressARB(aProcName);
1983     if Assigned(result) then
1984       exit;
1985   end;
1986
1987   result := dlsym(aLibHandle, aProcName);
1988 {$IFEND}
1989   if not Assigned(result) and aRaiseOnErr then
1990     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1991 end;
1992
1993 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1994 var
1995   GLU_LibHandle: Pointer = nil;
1996   OpenGLInitialized: Boolean;
1997   InitOpenGLCS: TCriticalSection;
1998
1999 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2000 procedure glbInitOpenGL;
2001
2002   ////////////////////////////////////////////////////////////////////////////////
2003   function glbLoadLibrary(const aName: PChar): Pointer;
2004   begin
2005     {$IF DEFINED(GLB_WIN)}
2006     result := {%H-}Pointer(LoadLibrary(aName));
2007     {$ELSEIF DEFINED(GLB_LINUX)}
2008     result := dlopen(Name, RTLD_LAZY);
2009     {$ELSE}
2010     result := nil;
2011     {$IFEND}
2012   end;
2013
2014   ////////////////////////////////////////////////////////////////////////////////
2015   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2016   begin
2017     result := false;
2018     if not Assigned(aLibHandle) then
2019       exit;
2020
2021     {$IF DEFINED(GLB_WIN)}
2022     Result := FreeLibrary({%H-}HINST(aLibHandle));
2023     {$ELSEIF DEFINED(GLB_LINUX)}
2024     Result := dlclose(aLibHandle) = 0;
2025     {$IFEND}
2026   end;
2027
2028 begin
2029   if Assigned(GL_LibHandle) then
2030     glbFreeLibrary(GL_LibHandle);
2031
2032   if Assigned(GLU_LibHandle) then
2033     glbFreeLibrary(GLU_LibHandle);
2034
2035   GL_LibHandle := glbLoadLibrary(libopengl);
2036   if not Assigned(GL_LibHandle) then
2037     raise EglBitmap.Create('unable to load library: ' + libopengl);
2038
2039   GLU_LibHandle := glbLoadLibrary(libglu);
2040   if not Assigned(GLU_LibHandle) then
2041     raise EglBitmap.Create('unable to load library: ' + libglu);
2042
2043 {$IF DEFINED(GLB_WIN)}
2044   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2045 {$ELSEIF DEFINED(GLB_LINUX)}
2046   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2047   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2048 {$IFEND}
2049
2050   glEnable := glbGetProcAddress('glEnable');
2051   glDisable := glbGetProcAddress('glDisable');
2052   glGetString := glbGetProcAddress('glGetString');
2053   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2054   glTexParameteri := glbGetProcAddress('glTexParameteri');
2055   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2056   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2057   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2058   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2059   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2060   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2061   glTexGeni := glbGetProcAddress('glTexGeni');
2062   glGenTextures := glbGetProcAddress('glGenTextures');
2063   glBindTexture := glbGetProcAddress('glBindTexture');
2064   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2065   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2066   glReadPixels := glbGetProcAddress('glReadPixels');
2067   glPixelStorei := glbGetProcAddress('glPixelStorei');
2068   glTexImage1D := glbGetProcAddress('glTexImage1D');
2069   glTexImage2D := glbGetProcAddress('glTexImage2D');
2070   glGetTexImage := glbGetProcAddress('glGetTexImage');
2071
2072   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2073   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2074 end;
2075 {$ENDIF}
2076
2077 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2078 procedure glbReadOpenGLExtensions;
2079 var
2080   Buffer: AnsiString;
2081   MajorVersion, MinorVersion: Integer;
2082
2083   ///////////////////////////////////////////////////////////////////////////////////////////
2084   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2085   var
2086     Separator: Integer;
2087   begin
2088     aMinor := 0;
2089     aMajor := 0;
2090
2091     Separator := Pos(AnsiString('.'), aBuffer);
2092     if (Separator > 1) and (Separator < Length(aBuffer)) and
2093        (aBuffer[Separator - 1] in ['0'..'9']) and
2094        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2095
2096       Dec(Separator);
2097       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2098         Dec(Separator);
2099
2100       Delete(aBuffer, 1, Separator);
2101       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2102
2103       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2104         Inc(Separator);
2105
2106       Delete(aBuffer, Separator, 255);
2107       Separator := Pos(AnsiString('.'), aBuffer);
2108
2109       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2110       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2111     end;
2112   end;
2113
2114   ///////////////////////////////////////////////////////////////////////////////////////////
2115   function CheckExtension(const Extension: AnsiString): Boolean;
2116   var
2117     ExtPos: Integer;
2118   begin
2119     ExtPos := Pos(Extension, Buffer);
2120     result := ExtPos > 0;
2121     if result then
2122       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2123   end;
2124
2125   ///////////////////////////////////////////////////////////////////////////////////////////
2126   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2127   begin
2128     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2129   end;
2130
2131 begin
2132 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2133   InitOpenGLCS.Enter;
2134   try
2135     if not OpenGLInitialized then begin
2136       glbInitOpenGL;
2137       OpenGLInitialized := true;
2138     end;
2139   finally
2140     InitOpenGLCS.Leave;
2141   end;
2142 {$ENDIF}
2143
2144   // Version
2145   Buffer := glGetString(GL_VERSION);
2146   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2147
2148   GL_VERSION_1_2 := CheckVersion(1, 2);
2149   GL_VERSION_1_3 := CheckVersion(1, 3);
2150   GL_VERSION_1_4 := CheckVersion(1, 4);
2151   GL_VERSION_2_0 := CheckVersion(2, 0);
2152   GL_VERSION_3_3 := CheckVersion(3, 3);
2153
2154   // Extensions
2155   Buffer := glGetString(GL_EXTENSIONS);
2156   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2157   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2158   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2159   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2160   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2161   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2162   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2163   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2164   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2165   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2166   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2167   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2168   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2169   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2170
2171   if GL_VERSION_1_3 then begin
2172     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2173     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2174     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2175   end else begin
2176     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2177     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2178     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2179   end;
2180 end;
2181 {$ENDIF}
2182
2183 {$IFDEF GLB_SDL_IMAGE}
2184 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2186 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2188 begin
2189   result := TStream(context^.unknown.data1).Seek(offset, whence);
2190 end;
2191
2192 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2193 begin
2194   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2195 end;
2196
2197 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2198 begin
2199   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2200 end;
2201
2202 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2203 begin
2204   result := 0;
2205 end;
2206
2207 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2208 begin
2209   result := SDL_AllocRW;
2210
2211   if result = nil then
2212     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2213
2214   result^.seek := glBitmapRWseek;
2215   result^.read := glBitmapRWread;
2216   result^.write := glBitmapRWwrite;
2217   result^.close := glBitmapRWclose;
2218   result^.unknown.data1 := Stream;
2219 end;
2220 {$ENDIF}
2221
2222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2223 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2224 begin
2225   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2230 begin
2231   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2232 end;
2233
2234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2235 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2236 begin
2237   glBitmapDefaultMipmap := aValue;
2238 end;
2239
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2242 begin
2243   glBitmapDefaultFormat := aFormat;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2248 begin
2249   glBitmapDefaultFilterMin := aMin;
2250   glBitmapDefaultFilterMag := aMag;
2251 end;
2252
2253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2254 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2255 begin
2256   glBitmapDefaultWrapS := S;
2257   glBitmapDefaultWrapT := T;
2258   glBitmapDefaultWrapR := R;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2263 begin
2264   glDefaultSwizzle[0] := r;
2265   glDefaultSwizzle[1] := g;
2266   glDefaultSwizzle[2] := b;
2267   glDefaultSwizzle[3] := a;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2272 begin
2273   result := glBitmapDefaultDeleteTextureOnFree;
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2278 begin
2279   result := glBitmapDefaultFreeDataAfterGenTextures;
2280 end;
2281
2282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2283 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2284 begin
2285   result := glBitmapDefaultMipmap;
2286 end;
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 function glBitmapGetDefaultFormat: TglBitmapFormat;
2290 begin
2291   result := glBitmapDefaultFormat;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2296 begin
2297   aMin := glBitmapDefaultFilterMin;
2298   aMag := glBitmapDefaultFilterMag;
2299 end;
2300
2301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2302 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2303 begin
2304   S := glBitmapDefaultWrapS;
2305   T := glBitmapDefaultWrapT;
2306   R := glBitmapDefaultWrapR;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2311 begin
2312   r := glDefaultSwizzle[0];
2313   g := glDefaultSwizzle[1];
2314   b := glDefaultSwizzle[2];
2315   a := glDefaultSwizzle[3];
2316 end;
2317
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 function TFormatDescriptor.GetRedMask: QWord;
2322 begin
2323   result := fRange.r shl fShift.r;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function TFormatDescriptor.GetGreenMask: QWord;
2328 begin
2329   result := fRange.g shl fShift.g;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function TFormatDescriptor.GetBlueMask: QWord;
2334 begin
2335   result := fRange.b shl fShift.b;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function TFormatDescriptor.GetAlphaMask: QWord;
2340 begin
2341   result := fRange.a shl fShift.a;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function TFormatDescriptor.GetIsCompressed: Boolean;
2346 begin
2347   result := fIsCompressed;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 function TFormatDescriptor.GetHasRed: Boolean;
2352 begin
2353   result := (fRange.r > 0);
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 function TFormatDescriptor.GetHasGreen: Boolean;
2358 begin
2359   result := (fRange.g > 0);
2360 end;
2361
2362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2363 function TFormatDescriptor.GetHasBlue: Boolean;
2364 begin
2365   result := (fRange.b > 0);
2366 end;
2367
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 function TFormatDescriptor.GetHasAlpha: Boolean;
2370 begin
2371   result := (fRange.a > 0);
2372 end;
2373
2374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2375 function TFormatDescriptor.GetglFormat: GLenum;
2376 begin
2377   result := fglFormat;
2378 end;
2379
2380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2381 function TFormatDescriptor.GetglInternalFormat: GLenum;
2382 begin
2383   result := fglInternalFormat;
2384 end;
2385
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 function TFormatDescriptor.GetglDataFormat: GLenum;
2388 begin
2389   result := fglDataFormat;
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 function TFormatDescriptor.GetComponents: Integer;
2394 var
2395   i: Integer;
2396 begin
2397   result := 0;
2398   for i := 0 to 3 do
2399     if (fRange.arr[i] > 0) then
2400       inc(result);
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2405 var
2406   w, h: Integer;
2407 begin
2408   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2409     w := Max(1, aSize.X);
2410     h := Max(1, aSize.Y);
2411     result := GetSize(w, h);
2412   end else
2413     result := 0;
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2418 begin
2419   result := 0;
2420   if (aWidth <= 0) or (aHeight <= 0) then
2421     exit;
2422   result := Ceil(aWidth * aHeight * fPixelSize);
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 function TFormatDescriptor.CreateMappingData: Pointer;
2427 begin
2428   result := nil;
2429 end;
2430
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2433 begin
2434   //DUMMY
2435 end;
2436
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 function TFormatDescriptor.IsEmpty: Boolean;
2439 begin
2440   result := (fFormat = tfEmpty);
2441 end;
2442
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2445 begin
2446   result := false;
2447   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2448     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2449   if (aRedMask   <> RedMask) then
2450     exit;
2451   if (aGreenMask <> GreenMask) then
2452     exit;
2453   if (aBlueMask  <> BlueMask) then
2454     exit;
2455   if (aAlphaMask <> AlphaMask) then
2456     exit;
2457   result := true;
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2462 begin
2463   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2464   aPixel.Data   := fRange;
2465   aPixel.Range  := fRange;
2466   aPixel.Format := fFormat;
2467 end;
2468
2469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2470 constructor TFormatDescriptor.Create;
2471 begin
2472   inherited Create;
2473
2474   fFormat       := tfEmpty;
2475   fWithAlpha    := tfEmpty;
2476   fWithoutAlpha := tfEmpty;
2477   fRGBInverted  := tfEmpty;
2478   fUncompressed := tfEmpty;
2479   fPixelSize    := 0.0;
2480   fIsCompressed := false;
2481
2482   fglFormat         := 0;
2483   fglInternalFormat := 0;
2484   fglDataFormat     := 0;
2485
2486   FillChar(fRange, 0, SizeOf(fRange));
2487   FillChar(fShift, 0, SizeOf(fShift));
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   aData^ := aPixel.Data.a;
2496   inc(aData);
2497 end;
2498
2499 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.r := 0;
2502   aPixel.Data.g := 0;
2503   aPixel.Data.b := 0;
2504   aPixel.Data.a := aData^;
2505   inc(aData);
2506 end;
2507
2508 constructor TfdAlpha_UB1.Create;
2509 begin
2510   inherited Create;
2511   fPixelSize        := 1.0;
2512   fRange.a          := $FF;
2513   fglFormat         := GL_ALPHA;
2514   fglDataFormat     := GL_UNSIGNED_BYTE;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2521 begin
2522   aData^ := LuminanceWeight(aPixel);
2523   inc(aData);
2524 end;
2525
2526 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2527 begin
2528   aPixel.Data.r := aData^;
2529   aPixel.Data.g := aData^;
2530   aPixel.Data.b := aData^;
2531   aPixel.Data.a := 0;
2532   inc(aData);
2533 end;
2534
2535 constructor TfdLuminance_UB1.Create;
2536 begin
2537   inherited Create;
2538   fPixelSize        := 1.0;
2539   fRange.r          := $FF;
2540   fRange.g          := $FF;
2541   fRange.b          := $FF;
2542   fglFormat         := GL_LUMINANCE;
2543   fglDataFormat     := GL_UNSIGNED_BYTE;
2544 end;
2545
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2550 var
2551   i: Integer;
2552 begin
2553   aData^ := 0;
2554   for i := 0 to 3 do
2555     if (fRange.arr[i] > 0) then
2556       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2557   inc(aData);
2558 end;
2559
2560 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2561 var
2562   i: Integer;
2563 begin
2564   for i := 0 to 3 do
2565     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2566   inc(aData);
2567 end;
2568
2569 constructor TfdUniversal_UB1.Create;
2570 begin
2571   inherited Create;
2572   fPixelSize := 1.0;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   inherited Map(aPixel, aData, aMapData);
2581   aData^ := aPixel.Data.a;
2582   inc(aData);
2583 end;
2584
2585 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2586 begin
2587   inherited Unmap(aData, aPixel, aMapData);
2588   aPixel.Data.a := aData^;
2589   inc(aData);
2590 end;
2591
2592 constructor TfdLuminanceAlpha_UB2.Create;
2593 begin
2594   inherited Create;
2595   fPixelSize        := 2.0;
2596   fRange.a          := $FF;
2597   fShift.a          :=   8;
2598   fglFormat         := GL_LUMINANCE_ALPHA;
2599   fglDataFormat     := GL_UNSIGNED_BYTE;
2600 end;
2601
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2606 begin
2607   aData^ := aPixel.Data.r;
2608   inc(aData);
2609   aData^ := aPixel.Data.g;
2610   inc(aData);
2611   aData^ := aPixel.Data.b;
2612   inc(aData);
2613 end;
2614
2615 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2616 begin
2617   aPixel.Data.r := aData^;
2618   inc(aData);
2619   aPixel.Data.g := aData^;
2620   inc(aData);
2621   aPixel.Data.b := aData^;
2622   inc(aData);
2623   aPixel.Data.a := 0;
2624 end;
2625
2626 constructor TfdRGB_UB3.Create;
2627 begin
2628   inherited Create;
2629   fPixelSize        := 3.0;
2630   fRange.r          := $FF;
2631   fRange.g          := $FF;
2632   fRange.b          := $FF;
2633   fShift.r          :=   0;
2634   fShift.g          :=   8;
2635   fShift.b          :=  16;
2636   fglFormat         := GL_RGB;
2637   fglDataFormat     := GL_UNSIGNED_BYTE;
2638 end;
2639
2640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2644 begin
2645   aData^ := aPixel.Data.b;
2646   inc(aData);
2647   aData^ := aPixel.Data.g;
2648   inc(aData);
2649   aData^ := aPixel.Data.r;
2650   inc(aData);
2651 end;
2652
2653 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2654 begin
2655   aPixel.Data.b := aData^;
2656   inc(aData);
2657   aPixel.Data.g := aData^;
2658   inc(aData);
2659   aPixel.Data.r := aData^;
2660   inc(aData);
2661   aPixel.Data.a := 0;
2662 end;
2663
2664 constructor TfdBGR_UB3.Create;
2665 begin
2666   fPixelSize        := 3.0;
2667   fRange.r          := $FF;
2668   fRange.g          := $FF;
2669   fRange.b          := $FF;
2670   fShift.r          :=  16;
2671   fShift.g          :=   8;
2672   fShift.b          :=   0;
2673   fglFormat         := GL_BGR;
2674   fglDataFormat     := GL_UNSIGNED_BYTE;
2675 end;
2676
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2681 begin
2682   inherited Map(aPixel, aData, aMapData);
2683   aData^ := aPixel.Data.a;
2684   inc(aData);
2685 end;
2686
2687 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2688 begin
2689   inherited Unmap(aData, aPixel, aMapData);
2690   aPixel.Data.a := aData^;
2691   inc(aData);
2692 end;
2693
2694 constructor TfdRGBA_UB4.Create;
2695 begin
2696   inherited Create;
2697   fPixelSize        := 4.0;
2698   fRange.a          := $FF;
2699   fShift.a          :=  24;
2700   fglFormat         := GL_RGBA;
2701   fglDataFormat     := GL_UNSIGNED_BYTE;
2702 end;
2703
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2708 begin
2709   inherited Map(aPixel, aData, aMapData);
2710   aData^ := aPixel.Data.a;
2711   inc(aData);
2712 end;
2713
2714 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2715 begin
2716   inherited Unmap(aData, aPixel, aMapData);
2717   aPixel.Data.a := aData^;
2718   inc(aData);
2719 end;
2720
2721 constructor TfdBGRA_UB4.Create;
2722 begin
2723   inherited Create;
2724   fPixelSize        := 4.0;
2725   fRange.a          := $FF;
2726   fShift.a          :=  24;
2727   fglFormat         := GL_BGRA;
2728   fglDataFormat     := GL_UNSIGNED_BYTE;
2729 end;
2730
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2735 begin
2736   PWord(aData)^ := aPixel.Data.a;
2737   inc(aData, 2);
2738 end;
2739
2740 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2741 begin
2742   aPixel.Data.r := 0;
2743   aPixel.Data.g := 0;
2744   aPixel.Data.b := 0;
2745   aPixel.Data.a := PWord(aData)^;
2746   inc(aData, 2);
2747 end;
2748
2749 constructor TfdAlpha_US1.Create;
2750 begin
2751   inherited Create;
2752   fPixelSize        := 2.0;
2753   fRange.a          := $FFFF;
2754   fglFormat         := GL_ALPHA;
2755   fglDataFormat     := GL_UNSIGNED_SHORT;
2756 end;
2757
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2762 begin
2763   PWord(aData)^ := LuminanceWeight(aPixel);
2764   inc(aData, 2);
2765 end;
2766
2767 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2768 begin
2769   aPixel.Data.r := PWord(aData)^;
2770   aPixel.Data.g := PWord(aData)^;
2771   aPixel.Data.b := PWord(aData)^;
2772   aPixel.Data.a := 0;
2773   inc(aData, 2);
2774 end;
2775
2776 constructor TfdLuminance_US1.Create;
2777 begin
2778   inherited Create;
2779   fPixelSize        := 2.0;
2780   fRange.r          := $FFFF;
2781   fRange.g          := $FFFF;
2782   fRange.b          := $FFFF;
2783   fglFormat         := GL_LUMINANCE;
2784   fglDataFormat     := GL_UNSIGNED_SHORT;
2785 end;
2786
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2791 var
2792   i: Integer;
2793 begin
2794   PWord(aData)^ := 0;
2795   for i := 0 to 3 do
2796     if (fRange.arr[i] > 0) then
2797       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2798   inc(aData, 2);
2799 end;
2800
2801 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2802 var
2803   i: Integer;
2804 begin
2805   for i := 0 to 3 do
2806     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2807   inc(aData, 2);
2808 end;
2809
2810 constructor TfdUniversal_US1.Create;
2811 begin
2812   inherited Create;
2813   fPixelSize := 2.0;
2814 end;
2815
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2820 begin
2821   PWord(aData)^ := DepthWeight(aPixel);
2822   inc(aData, 2);
2823 end;
2824
2825 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2826 begin
2827   aPixel.Data.r := PWord(aData)^;
2828   aPixel.Data.g := PWord(aData)^;
2829   aPixel.Data.b := PWord(aData)^;
2830   aPixel.Data.a := 0;
2831   inc(aData, 2);
2832 end;
2833
2834 constructor TfdDepth_US1.Create;
2835 begin
2836   inherited Create;
2837   fPixelSize        := 2.0;
2838   fRange.r          := $FFFF;
2839   fRange.g          := $FFFF;
2840   fRange.b          := $FFFF;
2841   fglFormat         := GL_DEPTH_COMPONENT;
2842   fglDataFormat     := GL_UNSIGNED_SHORT;
2843 end;
2844
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2849 begin
2850   inherited Map(aPixel, aData, aMapData);
2851   PWord(aData)^ := aPixel.Data.a;
2852   inc(aData, 2);
2853 end;
2854
2855 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2856 begin
2857   inherited Unmap(aData, aPixel, aMapData);
2858   aPixel.Data.a := PWord(aData)^;
2859   inc(aData, 2);
2860 end;
2861
2862 constructor TfdLuminanceAlpha_US2.Create;
2863 begin
2864   inherited Create;
2865   fPixelSize        :=   4.0;
2866   fRange.a          := $FFFF;
2867   fShift.a          :=    16;
2868   fglFormat         := GL_LUMINANCE_ALPHA;
2869   fglDataFormat     := GL_UNSIGNED_SHORT;
2870 end;
2871
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2876 begin
2877   PWord(aData)^ := aPixel.Data.r;
2878   inc(aData, 2);
2879   PWord(aData)^ := aPixel.Data.g;
2880   inc(aData, 2);
2881   PWord(aData)^ := aPixel.Data.b;
2882   inc(aData, 2);
2883 end;
2884
2885 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2886 begin
2887   aPixel.Data.r := PWord(aData)^;
2888   inc(aData, 2);
2889   aPixel.Data.g := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.b := PWord(aData)^;
2892   inc(aData, 2);
2893   aPixel.Data.a := 0;
2894 end;
2895
2896 constructor TfdRGB_US3.Create;
2897 begin
2898   inherited Create;
2899   fPixelSize        :=   6.0;
2900   fRange.r          := $FFFF;
2901   fRange.g          := $FFFF;
2902   fRange.b          := $FFFF;
2903   fShift.r          :=     0;
2904   fShift.g          :=    16;
2905   fShift.b          :=    32;
2906   fglFormat         := GL_RGB;
2907   fglDataFormat     := GL_UNSIGNED_SHORT;
2908 end;
2909
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2914 begin
2915   PWord(aData)^ := aPixel.Data.b;
2916   inc(aData, 2);
2917   PWord(aData)^ := aPixel.Data.g;
2918   inc(aData, 2);
2919   PWord(aData)^ := aPixel.Data.r;
2920   inc(aData, 2);
2921 end;
2922
2923 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2924 begin
2925   aPixel.Data.b := PWord(aData)^;
2926   inc(aData, 2);
2927   aPixel.Data.g := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.r := PWord(aData)^;
2930   inc(aData, 2);
2931   aPixel.Data.a := 0;
2932 end;
2933
2934 constructor TfdBGR_US3.Create;
2935 begin
2936   inherited Create;
2937   fPixelSize        :=   6.0;
2938   fRange.r          := $FFFF;
2939   fRange.g          := $FFFF;
2940   fRange.b          := $FFFF;
2941   fShift.r          :=    32;
2942   fShift.g          :=    16;
2943   fShift.b          :=     0;
2944   fglFormat         := GL_BGR;
2945   fglDataFormat     := GL_UNSIGNED_SHORT;
2946 end;
2947
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2952 begin
2953   inherited Map(aPixel, aData, aMapData);
2954   PWord(aData)^ := aPixel.Data.a;
2955   inc(aData, 2);
2956 end;
2957
2958 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2959 begin
2960   inherited Unmap(aData, aPixel, aMapData);
2961   aPixel.Data.a := PWord(aData)^;
2962   inc(aData, 2);
2963 end;
2964
2965 constructor TfdRGBA_US4.Create;
2966 begin
2967   inherited Create;
2968   fPixelSize        :=   8.0;
2969   fRange.a          := $FFFF;
2970   fShift.a          :=    48;
2971   fglFormat         := GL_RGBA;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2979 begin
2980   inherited Map(aPixel, aData, aMapData);
2981   PWord(aData)^ := aPixel.Data.a;
2982   inc(aData, 2);
2983 end;
2984
2985 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2986 begin
2987   inherited Unmap(aData, aPixel, aMapData);
2988   aPixel.Data.a := PWord(aData)^;
2989   inc(aData, 2);
2990 end;
2991
2992 constructor TfdBGRA_US4.Create;
2993 begin
2994   inherited Create;
2995   fPixelSize        :=   8.0;
2996   fRange.a          := $FFFF;
2997   fShift.a          :=    48;
2998   fglFormat         := GL_BGRA;
2999   fglDataFormat     := GL_UNSIGNED_SHORT;
3000 end;
3001
3002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3006 var
3007   i: Integer;
3008 begin
3009   PCardinal(aData)^ := 0;
3010   for i := 0 to 3 do
3011     if (fRange.arr[i] > 0) then
3012       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3013   inc(aData, 4);
3014 end;
3015
3016 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3017 var
3018   i: Integer;
3019 begin
3020   for i := 0 to 3 do
3021     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3022   inc(aData, 2);
3023 end;
3024
3025 constructor TfdUniversal_UI1.Create;
3026 begin
3027   inherited Create;
3028   fPixelSize := 4.0;
3029 end;
3030
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3035 begin
3036   PCardinal(aData)^ := DepthWeight(aPixel);
3037   inc(aData, 4);
3038 end;
3039
3040 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3041 begin
3042   aPixel.Data.r := PCardinal(aData)^;
3043   aPixel.Data.g := PCardinal(aData)^;
3044   aPixel.Data.b := PCardinal(aData)^;
3045   aPixel.Data.a := 0;
3046   inc(aData, 4);
3047 end;
3048
3049 constructor TfdDepth_UI1.Create;
3050 begin
3051   inherited Create;
3052   fPixelSize        := 4.0;
3053   fRange.r          := $FFFFFFFF;
3054   fRange.g          := $FFFFFFFF;
3055   fRange.b          := $FFFFFFFF;
3056   fglFormat         := GL_DEPTH_COMPONENT;
3057   fglDataFormat     := GL_UNSIGNED_INT;
3058 end;
3059
3060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3063 constructor TfdAlpha4.Create;
3064 begin
3065   inherited Create;
3066   fFormat           := tfAlpha4;
3067   fWithAlpha        := tfAlpha4;
3068   fglInternalFormat := GL_ALPHA4;
3069 end;
3070
3071 constructor TfdAlpha8.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfAlpha8;
3075   fWithAlpha        := tfAlpha8;
3076   fglInternalFormat := GL_ALPHA8;
3077 end;
3078
3079 constructor TfdAlpha12.Create;
3080 begin
3081   inherited Create;
3082   fFormat           := tfAlpha12;
3083   fWithAlpha        := tfAlpha12;
3084   fglInternalFormat := GL_ALPHA12;
3085 end;
3086
3087 constructor TfdAlpha16.Create;
3088 begin
3089   inherited Create;
3090   fFormat           := tfAlpha16;
3091   fWithAlpha        := tfAlpha16;
3092   fglInternalFormat := GL_ALPHA16;
3093 end;
3094
3095 constructor TfdLuminance4.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfLuminance4;
3099   fWithAlpha        := tfLuminance4Alpha4;
3100   fWithoutAlpha     := tfLuminance4;
3101   fglInternalFormat := GL_LUMINANCE4;
3102 end;
3103
3104 constructor TfdLuminance8.Create;
3105 begin
3106   inherited Create;
3107   fFormat           := tfLuminance8;
3108   fWithAlpha        := tfLuminance8Alpha8;
3109   fWithoutAlpha     := tfLuminance8;
3110   fglInternalFormat := GL_LUMINANCE8;
3111 end;
3112
3113 constructor TfdLuminance12.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfLuminance12;
3117   fWithAlpha        := tfLuminance12Alpha12;
3118   fWithoutAlpha     := tfLuminance12;
3119   fglInternalFormat := GL_LUMINANCE12;
3120 end;
3121
3122 constructor TfdLuminance16.Create;
3123 begin
3124   inherited Create;
3125   fFormat           := tfLuminance16;
3126   fWithAlpha        := tfLuminance16Alpha16;
3127   fWithoutAlpha     := tfLuminance16;
3128   fglInternalFormat := GL_LUMINANCE16;
3129 end;
3130
3131 constructor TfdLuminance4Alpha4.Create;
3132 begin
3133   inherited Create;
3134   fFormat           := tfLuminance4Alpha4;
3135   fWithAlpha        := tfLuminance4Alpha4;
3136   fWithoutAlpha     := tfLuminance4;
3137   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3138 end;
3139
3140 constructor TfdLuminance6Alpha2.Create;
3141 begin
3142   inherited Create;
3143   fFormat           := tfLuminance6Alpha2;
3144   fWithAlpha        := tfLuminance6Alpha2;
3145   fWithoutAlpha     := tfLuminance8;
3146   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3147 end;
3148
3149 constructor TfdLuminance8Alpha8.Create;
3150 begin
3151   inherited Create;
3152   fFormat           := tfLuminance8Alpha8;
3153   fWithAlpha        := tfLuminance8Alpha8;
3154   fWithoutAlpha     := tfLuminance8;
3155   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3156 end;
3157
3158 constructor TfdLuminance12Alpha4.Create;
3159 begin
3160   inherited Create;
3161   fFormat           := tfLuminance12Alpha4;
3162   fWithAlpha        := tfLuminance12Alpha4;
3163   fWithoutAlpha     := tfLuminance12;
3164   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3165 end;
3166
3167 constructor TfdLuminance12Alpha12.Create;
3168 begin
3169   inherited Create;
3170   fFormat           := tfLuminance12Alpha12;
3171   fWithAlpha        := tfLuminance12Alpha12;
3172   fWithoutAlpha     := tfLuminance12;
3173   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3174 end;
3175
3176 constructor TfdLuminance16Alpha16.Create;
3177 begin
3178   inherited Create;
3179   fFormat           := tfLuminance16Alpha16;
3180   fWithAlpha        := tfLuminance16Alpha16;
3181   fWithoutAlpha     := tfLuminance16;
3182   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3183 end;
3184
3185 constructor TfdR3G3B2.Create;
3186 begin
3187   inherited Create;
3188   fFormat           := tfR3G3B2;
3189   fWithAlpha        := tfRGBA2;
3190   fWithoutAlpha     := tfR3G3B2;
3191   fRange.r          := $7;
3192   fRange.g          := $7;
3193   fRange.b          := $3;
3194   fShift.r          :=  0;
3195   fShift.g          :=  3;
3196   fShift.b          :=  6;
3197   fglFormat         := GL_RGB;
3198   fglInternalFormat := GL_R3_G3_B2;
3199   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3200 end;
3201
3202 constructor TfdRGB4.Create;
3203 begin
3204   inherited Create;
3205   fFormat           := tfRGB4;
3206   fWithAlpha        := tfRGBA4;
3207   fWithoutAlpha     := tfRGB4;
3208   fRGBInverted      := tfBGR4;
3209   fRange.r          := $F;
3210   fRange.g          := $F;
3211   fRange.b          := $F;
3212   fShift.r          :=  0;
3213   fShift.g          :=  4;
3214   fShift.b          :=  8;
3215   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3216   fglInternalFormat := GL_RGB4;
3217   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3218 end;
3219
3220 constructor TfdR5G6B5.Create;
3221 begin
3222   inherited Create;
3223   fFormat           := tfR5G6B5;
3224   fWithAlpha        := tfRGBA4;
3225   fWithoutAlpha     := tfR5G6B5;
3226   fRGBInverted      := tfB5G6R5;
3227   fRange.r          := $1F;
3228   fRange.g          := $3F;
3229   fRange.b          := $1F;
3230   fShift.r          :=   0;
3231   fShift.g          :=   5;
3232   fShift.b          :=  11;
3233   fglFormat         := GL_RGB;
3234   fglInternalFormat := GL_RGB565;
3235   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3236 end;
3237
3238 constructor TfdRGB5.Create;
3239 begin
3240   inherited Create;
3241   fFormat           := tfRGB5;
3242   fWithAlpha        := tfRGB5A1;
3243   fWithoutAlpha     := tfRGB5;
3244   fRGBInverted      := tfBGR5;
3245   fRange.r          := $1F;
3246   fRange.g          := $1F;
3247   fRange.b          := $1F;
3248   fShift.r          :=   0;
3249   fShift.g          :=   5;
3250   fShift.b          :=  10;
3251   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3252   fglInternalFormat := GL_RGB5;
3253   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3254 end;
3255
3256 constructor TfdRGB8.Create;
3257 begin
3258   inherited Create;
3259   fFormat           := tfRGB8;
3260   fWithAlpha        := tfRGBA8;
3261   fWithoutAlpha     := tfRGB8;
3262   fRGBInverted      := tfBGR8;
3263   fglInternalFormat := GL_RGB8;
3264 end;
3265
3266 constructor TfdRGB10.Create;
3267 begin
3268   inherited Create;
3269   fFormat           := tfRGB10;
3270   fWithAlpha        := tfRGB10A2;
3271   fWithoutAlpha     := tfRGB10;
3272   fRGBInverted      := tfBGR10;
3273   fRange.r          := $3FF;
3274   fRange.g          := $3FF;
3275   fRange.b          := $3FF;
3276   fShift.r          :=    0;
3277   fShift.g          :=   10;
3278   fShift.b          :=   20;
3279   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3280   fglInternalFormat := GL_RGB10;
3281   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3282 end;
3283
3284 constructor TfdRGB12.Create;
3285 begin
3286   inherited Create;
3287   fFormat           := tfRGB12;
3288   fWithAlpha        := tfRGBA12;
3289   fWithoutAlpha     := tfRGB12;
3290   fRGBInverted      := tfBGR12;
3291   fglInternalFormat := GL_RGB12;
3292 end;
3293
3294 constructor TfdRGB16.Create;
3295 begin
3296   inherited Create;
3297   fFormat           := tfRGB16;
3298   fWithAlpha        := tfRGBA16;
3299   fWithoutAlpha     := tfRGB16;
3300   fRGBInverted      := tfBGR16;
3301   fglInternalFormat := GL_RGB16;
3302 end;
3303
3304 constructor TfdRGBA2.Create;
3305 begin
3306   inherited Create;
3307   fFormat           := tfRGBA2;
3308   fWithAlpha        := tfRGBA2;
3309   fWithoutAlpha     := tfR3G3B2;
3310   fRGBInverted      := tfBGRA2;
3311   fglInternalFormat := GL_RGBA2;
3312 end;
3313
3314 constructor TfdRGBA4.Create;
3315 begin
3316   inherited Create;
3317   fFormat           := tfRGBA4;
3318   fWithAlpha        := tfRGBA4;
3319   fWithoutAlpha     := tfRGB4;
3320   fRGBInverted      := tfBGRA4;
3321   fRange.r          := $F;
3322   fRange.g          := $F;
3323   fRange.b          := $F;
3324   fRange.a          := $F;
3325   fShift.r          :=  0;
3326   fShift.g          :=  4;
3327   fShift.b          :=  8;
3328   fShift.a          := 12;
3329   fglFormat         := GL_RGBA;
3330   fglInternalFormat := GL_RGBA4;
3331   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3332 end;
3333
3334 constructor TfdRGB5A1.Create;
3335 begin
3336   inherited Create;
3337   fFormat           := tfRGB5A1;
3338   fWithAlpha        := tfRGB5A1;
3339   fWithoutAlpha     := tfRGB5;
3340   fRGBInverted      := tfBGR5A1;
3341   fRange.r          := $1F;
3342   fRange.g          := $1F;
3343   fRange.b          := $1F;
3344   fRange.a          := $01;
3345   fShift.r          :=   0;
3346   fShift.g          :=   5;
3347   fShift.b          :=  10;
3348   fShift.a          :=  15;
3349   fglFormat         := GL_RGBA;
3350   fglInternalFormat := GL_RGB5_A1;
3351   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3352 end;
3353
3354 constructor TfdRGBA8.Create;
3355 begin
3356   inherited Create;
3357   fFormat           := tfRGBA8;
3358   fWithAlpha        := tfRGBA8;
3359   fWithoutAlpha     := tfRGB8;
3360   fRGBInverted      := tfBGRA8;
3361   fglInternalFormat := GL_RGBA8;
3362 end;
3363
3364 constructor TfdRGB10A2.Create;
3365 begin
3366   inherited Create;
3367   fFormat           := tfRGB10A2;
3368   fWithAlpha        := tfRGB10A2;
3369   fWithoutAlpha     := tfRGB10;
3370   fRGBInverted      := tfBGR10A2;
3371   fRange.r          := $3FF;
3372   fRange.g          := $3FF;
3373   fRange.b          := $3FF;
3374   fRange.a          := $003;
3375   fShift.r          :=    0;
3376   fShift.g          :=   10;
3377   fShift.b          :=   20;
3378   fShift.a          :=   30;
3379   fglFormat         := GL_RGBA;
3380   fglInternalFormat := GL_RGB10_A2;
3381   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3382 end;
3383
3384 constructor TfdRGBA12.Create;
3385 begin
3386   inherited Create;
3387   fFormat           := tfRGBA12;
3388   fWithAlpha        := tfRGBA12;
3389   fWithoutAlpha     := tfRGB12;
3390   fRGBInverted      := tfBGRA12;
3391   fglInternalFormat := GL_RGBA12;
3392 end;
3393
3394 constructor TfdRGBA16.Create;
3395 begin
3396   inherited Create;
3397   fFormat           := tfRGBA16;
3398   fWithAlpha        := tfRGBA16;
3399   fWithoutAlpha     := tfRGB16;
3400   fRGBInverted      := tfBGRA16;
3401   fglInternalFormat := GL_RGBA16;
3402 end;
3403
3404 constructor TfdBGR4.Create;
3405 begin
3406   inherited Create;
3407   fPixelSize        := 2.0;
3408   fFormat           := tfBGR4;
3409   fWithAlpha        := tfBGRA4;
3410   fWithoutAlpha     := tfBGR4;
3411   fRGBInverted      := tfRGB4;
3412   fRange.r          := $F;
3413   fRange.g          := $F;
3414   fRange.b          := $F;
3415   fRange.a          := $0;
3416   fShift.r          :=  8;
3417   fShift.g          :=  4;
3418   fShift.b          :=  0;
3419   fShift.a          :=  0;
3420   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3421   fglInternalFormat := GL_RGB4;
3422   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3423 end;
3424
3425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 constructor TfdB5G6R5.Create;
3429 begin
3430   inherited Create;
3431   fFormat           := tfB5G6R5;
3432   fWithAlpha        := tfBGRA4;
3433   fWithoutAlpha     := tfB5G6R5;
3434   fRGBInverted      := tfR5G6B5;
3435   fRange.r          := $1F;
3436   fRange.g          := $3F;
3437   fRange.b          := $1F;
3438   fShift.r          :=  11;
3439   fShift.g          :=   5;
3440   fShift.b          :=   0;
3441   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3442   fglInternalFormat := GL_RGB8;
3443   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3444 end;
3445
3446 constructor TfdBGR5.Create;
3447 begin
3448   inherited Create;
3449   fPixelSize        := 2.0;
3450   fFormat           := tfBGR5;
3451   fWithAlpha        := tfBGR5A1;
3452   fWithoutAlpha     := tfBGR5;
3453   fRGBInverted      := tfRGB5;
3454   fRange.r          := $1F;
3455   fRange.g          := $1F;
3456   fRange.b          := $1F;
3457   fRange.a          := $00;
3458   fShift.r          :=  10;
3459   fShift.g          :=   5;
3460   fShift.b          :=   0;
3461   fShift.a          :=   0;
3462   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3463   fglInternalFormat := GL_RGB5;
3464   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3465 end;
3466
3467 constructor TfdBGR8.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfBGR8;
3471   fWithAlpha        := tfBGRA8;
3472   fWithoutAlpha     := tfBGR8;
3473   fRGBInverted      := tfRGB8;
3474   fglInternalFormat := GL_RGB8;
3475 end;
3476
3477 constructor TfdBGR10.Create;
3478 begin
3479   inherited Create;
3480   fFormat           := tfBGR10;
3481   fWithAlpha        := tfBGR10A2;
3482   fWithoutAlpha     := tfBGR10;
3483   fRGBInverted      := tfRGB10;
3484   fRange.r          := $3FF;
3485   fRange.g          := $3FF;
3486   fRange.b          := $3FF;
3487   fRange.a          := $000;
3488   fShift.r          :=   20;
3489   fShift.g          :=   10;
3490   fShift.b          :=    0;
3491   fShift.a          :=    0;
3492   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3493   fglInternalFormat := GL_RGB10;
3494   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3495 end;
3496
3497 constructor TfdBGR12.Create;
3498 begin
3499   inherited Create;
3500   fFormat           := tfBGR12;
3501   fWithAlpha        := tfBGRA12;
3502   fWithoutAlpha     := tfBGR12;
3503   fRGBInverted      := tfRGB12;
3504   fglInternalFormat := GL_RGB12;
3505 end;
3506
3507 constructor TfdBGR16.Create;
3508 begin
3509   inherited Create;
3510   fFormat           := tfBGR16;
3511   fWithAlpha        := tfBGRA16;
3512   fWithoutAlpha     := tfBGR16;
3513   fRGBInverted      := tfRGB16;
3514   fglInternalFormat := GL_RGB16;
3515 end;
3516
3517 constructor TfdBGRA2.Create;
3518 begin
3519   inherited Create;
3520   fFormat           := tfBGRA2;
3521   fWithAlpha        := tfBGRA4;
3522   fWithoutAlpha     := tfBGR4;
3523   fRGBInverted      := tfRGBA2;
3524   fglInternalFormat := GL_RGBA2;
3525 end;
3526
3527 constructor TfdBGRA4.Create;
3528 begin
3529   inherited Create;
3530   fFormat           := tfBGRA4;
3531   fWithAlpha        := tfBGRA4;
3532   fWithoutAlpha     := tfBGR4;
3533   fRGBInverted      := tfRGBA4;
3534   fRange.r          := $F;
3535   fRange.g          := $F;
3536   fRange.b          := $F;
3537   fRange.a          := $F;
3538   fShift.r          :=  8;
3539   fShift.g          :=  4;
3540   fShift.b          :=  0;
3541   fShift.a          := 12;
3542   fglFormat         := GL_BGRA;
3543   fglInternalFormat := GL_RGBA4;
3544   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3545 end;
3546
3547 constructor TfdBGR5A1.Create;
3548 begin
3549   inherited Create;
3550   fFormat           := tfBGR5A1;
3551   fWithAlpha        := tfBGR5A1;
3552   fWithoutAlpha     := tfBGR5;
3553   fRGBInverted      := tfRGB5A1;
3554   fRange.r          := $1F;
3555   fRange.g          := $1F;
3556   fRange.b          := $1F;
3557   fRange.a          := $01;
3558   fShift.r          :=  10;
3559   fShift.g          :=   5;
3560   fShift.b          :=   0;
3561   fShift.a          :=  15;
3562   fglFormat         := GL_BGRA;
3563   fglInternalFormat := GL_RGB5_A1;
3564   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3565 end;
3566
3567 constructor TfdBGRA8.Create;
3568 begin
3569   inherited Create;
3570   fFormat           := tfBGRA8;
3571   fWithAlpha        := tfBGRA8;
3572   fWithoutAlpha     := tfBGR8;
3573   fRGBInverted      := tfRGBA8;
3574   fglInternalFormat := GL_RGBA8;
3575 end;
3576
3577 constructor TfdBGR10A2.Create;
3578 begin
3579   inherited Create;
3580   fFormat           := tfBGR10A2;
3581   fWithAlpha        := tfBGR10A2;
3582   fWithoutAlpha     := tfBGR10;
3583   fRGBInverted      := tfRGB10A2;
3584   fRange.r          := $3FF;
3585   fRange.g          := $3FF;
3586   fRange.b          := $3FF;
3587   fRange.a          := $003;
3588   fShift.r          :=   20;
3589   fShift.g          :=   10;
3590   fShift.b          :=    0;
3591   fShift.a          :=   30;
3592   fglFormat         := GL_BGRA;
3593   fglInternalFormat := GL_RGB10_A2;
3594   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3595 end;
3596
3597 constructor TfdBGRA12.Create;
3598 begin
3599   inherited Create;
3600   fFormat           := tfBGRA12;
3601   fWithAlpha        := tfBGRA12;
3602   fWithoutAlpha     := tfBGR12;
3603   fRGBInverted      := tfRGBA12;
3604   fglInternalFormat := GL_RGBA12;
3605 end;
3606
3607 constructor TfdBGRA16.Create;
3608 begin
3609   inherited Create;
3610   fFormat           := tfBGRA16;
3611   fWithAlpha        := tfBGRA16;
3612   fWithoutAlpha     := tfBGR16;
3613   fRGBInverted      := tfRGBA16;
3614   fglInternalFormat := GL_RGBA16;
3615 end;
3616
3617 constructor TfdDepth16.Create;
3618 begin
3619   inherited Create;
3620   fFormat           := tfDepth16;
3621   fWithAlpha        := tfEmpty;
3622   fWithoutAlpha     := tfDepth16;
3623   fglInternalFormat := GL_DEPTH_COMPONENT16;
3624 end;
3625
3626 constructor TfdDepth24.Create;
3627 begin
3628   inherited Create;
3629   fFormat           := tfDepth24;
3630   fWithAlpha        := tfEmpty;
3631   fWithoutAlpha     := tfDepth24;
3632   fglInternalFormat := GL_DEPTH_COMPONENT24;
3633 end;
3634
3635 constructor TfdDepth32.Create;
3636 begin
3637   inherited Create;
3638   fFormat           := tfDepth32;
3639   fWithAlpha        := tfEmpty;
3640   fWithoutAlpha     := tfDepth32;
3641   fglInternalFormat := GL_DEPTH_COMPONENT32;
3642 end;
3643
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3648 begin
3649   raise EglBitmap.Create('mapping for compressed formats is not supported');
3650 end;
3651
3652 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3653 begin
3654   raise EglBitmap.Create('mapping for compressed formats is not supported');
3655 end;
3656
3657 constructor TfdS3tcDtx1RGBA.Create;
3658 begin
3659   inherited Create;
3660   fFormat           := tfS3tcDtx1RGBA;
3661   fWithAlpha        := tfS3tcDtx1RGBA;
3662   fUncompressed     := tfRGB5A1;
3663   fPixelSize        := 0.5;
3664   fIsCompressed     := true;
3665   fglFormat         := GL_COMPRESSED_RGBA;
3666   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3667   fglDataFormat     := GL_UNSIGNED_BYTE;
3668 end;
3669
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3674 begin
3675   raise EglBitmap.Create('mapping for compressed formats is not supported');
3676 end;
3677
3678 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3679 begin
3680   raise EglBitmap.Create('mapping for compressed formats is not supported');
3681 end;
3682
3683 constructor TfdS3tcDtx3RGBA.Create;
3684 begin
3685   inherited Create;
3686   fFormat           := tfS3tcDtx3RGBA;
3687   fWithAlpha        := tfS3tcDtx3RGBA;
3688   fUncompressed     := tfRGBA8;
3689   fPixelSize        := 1.0;
3690   fIsCompressed     := true;
3691   fglFormat         := GL_COMPRESSED_RGBA;
3692   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3693   fglDataFormat     := GL_UNSIGNED_BYTE;
3694 end;
3695
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3700 begin
3701   raise EglBitmap.Create('mapping for compressed formats is not supported');
3702 end;
3703
3704 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3705 begin
3706   raise EglBitmap.Create('mapping for compressed formats is not supported');
3707 end;
3708
3709 constructor TfdS3tcDtx5RGBA.Create;
3710 begin
3711   inherited Create;
3712   fFormat           := tfS3tcDtx3RGBA;
3713   fWithAlpha        := tfS3tcDtx3RGBA;
3714   fUncompressed     := tfRGBA8;
3715   fPixelSize        := 1.0;
3716   fIsCompressed     := true;
3717   fglFormat         := GL_COMPRESSED_RGBA;
3718   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3719   fglDataFormat     := GL_UNSIGNED_BYTE;
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 class procedure TFormatDescriptor.Init;
3726 begin
3727   if not Assigned(FormatDescriptorCS) then
3728     FormatDescriptorCS := TCriticalSection.Create;
3729 end;
3730
3731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3733 begin
3734   FormatDescriptorCS.Enter;
3735   try
3736     result := FormatDescriptors[aFormat];
3737     if not Assigned(result) then begin
3738       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3739       FormatDescriptors[aFormat] := result;
3740     end;
3741   finally
3742     FormatDescriptorCS.Leave;
3743   end;
3744 end;
3745
3746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3748 begin
3749   result := Get(Get(aFormat).WithAlpha);
3750 end;
3751
3752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3753 class procedure TFormatDescriptor.Clear;
3754 var
3755   f: TglBitmapFormat;
3756 begin
3757   FormatDescriptorCS.Enter;
3758   try
3759     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3760       FreeAndNil(FormatDescriptors[f]);
3761   finally
3762     FormatDescriptorCS.Leave;
3763   end;
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 class procedure TFormatDescriptor.Finalize;
3768 begin
3769   Clear;
3770   FreeAndNil(FormatDescriptorCS);
3771 end;
3772
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3776 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3777 begin
3778   Update(aValue, fRange.r, fShift.r);
3779 end;
3780
3781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3783 begin
3784   Update(aValue, fRange.g, fShift.g);
3785 end;
3786
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3789 begin
3790   Update(aValue, fRange.b, fShift.b);
3791 end;
3792
3793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3794 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3795 begin
3796   Update(aValue, fRange.a, fShift.a);
3797 end;
3798
3799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3800 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3801   aShift: Byte);
3802 begin
3803   aShift := 0;
3804   aRange := 0;
3805   if (aMask = 0) then
3806     exit;
3807   while (aMask > 0) and ((aMask and 1) = 0) do begin
3808     inc(aShift);
3809     aMask := aMask shr 1;
3810   end;
3811   aRange := 1;
3812   while (aMask > 0) do begin
3813     aRange := aRange shl 1;
3814     aMask  := aMask  shr 1;
3815   end;
3816   dec(aRange);
3817
3818   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3819 end;
3820
3821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3822 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3823 var
3824   data: QWord;
3825   s: Integer;
3826 begin
3827   data :=
3828     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3829     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3830     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3831     ((aPixel.Data.a and fRange.a) shl fShift.a);
3832   s := Round(fPixelSize);
3833   case s of
3834     1:           aData^  := data;
3835     2:     PWord(aData)^ := data;
3836     4: PCardinal(aData)^ := data;
3837     8:    PQWord(aData)^ := data;
3838   else
3839     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3840   end;
3841   inc(aData, s);
3842 end;
3843
3844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3845 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3846 var
3847   data: QWord;
3848   s, i: Integer;
3849 begin
3850   s := Round(fPixelSize);
3851   case s of
3852     1: data :=           aData^;
3853     2: data :=     PWord(aData)^;
3854     4: data := PCardinal(aData)^;
3855     8: data :=    PQWord(aData)^;
3856   else
3857     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3858   end;
3859   for i := 0 to 3 do
3860     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3861   inc(aData, s);
3862 end;
3863
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3867 procedure TbmpColorTableFormat.CreateColorTable;
3868 var
3869   i: Integer;
3870 begin
3871   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3872     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3873
3874   if (Format = tfLuminance4) then
3875     SetLength(fColorTable, 16)
3876   else
3877     SetLength(fColorTable, 256);
3878
3879   case Format of
3880     tfLuminance4: begin
3881       for i := 0 to High(fColorTable) do begin
3882         fColorTable[i].r := 16 * i;
3883         fColorTable[i].g := 16 * i;
3884         fColorTable[i].b := 16 * i;
3885         fColorTable[i].a := 0;
3886       end;
3887     end;
3888
3889     tfLuminance8: begin
3890       for i := 0 to High(fColorTable) do begin
3891         fColorTable[i].r := i;
3892         fColorTable[i].g := i;
3893         fColorTable[i].b := i;
3894         fColorTable[i].a := 0;
3895       end;
3896     end;
3897
3898     tfR3G3B2: begin
3899       for i := 0 to High(fColorTable) do begin
3900         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3901         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3902         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3903         fColorTable[i].a := 0;
3904       end;
3905     end;
3906   end;
3907 end;
3908
3909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3910 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3911 var
3912   d: Byte;
3913 begin
3914   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3915     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3916
3917   case Format of
3918     tfLuminance4: begin
3919       if (aMapData = nil) then
3920         aData^ := 0;
3921       d := LuminanceWeight(aPixel) and Range.r;
3922       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3923       inc(PByte(aMapData), 4);
3924       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3925         inc(aData);
3926         aMapData := nil;
3927       end;
3928     end;
3929
3930     tfLuminance8: begin
3931       aData^ := LuminanceWeight(aPixel) and Range.r;
3932       inc(aData);
3933     end;
3934
3935     tfR3G3B2: begin
3936       aData^ := Round(
3937         ((aPixel.Data.r and Range.r) shl Shift.r) or
3938         ((aPixel.Data.g and Range.g) shl Shift.g) or
3939         ((aPixel.Data.b and Range.b) shl Shift.b));
3940       inc(aData);
3941     end;
3942   end;
3943 end;
3944
3945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3946 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3947 var
3948   idx: QWord;
3949   s: Integer;
3950   bits: Byte;
3951   f: Single;
3952 begin
3953   s    := Trunc(fPixelSize);
3954   f    := fPixelSize - s;
3955   bits := Round(8 * f);
3956   case s of
3957     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3958     1: idx :=           aData^;
3959     2: idx :=     PWord(aData)^;
3960     4: idx := PCardinal(aData)^;
3961     8: idx :=    PQWord(aData)^;
3962   else
3963     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3964   end;
3965   if (idx >= Length(fColorTable)) then
3966     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3967   with fColorTable[idx] do begin
3968     aPixel.Data.r := r;
3969     aPixel.Data.g := g;
3970     aPixel.Data.b := b;
3971     aPixel.Data.a := a;
3972   end;
3973   inc(PByte(aMapData), bits);
3974   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3975     inc(aData, 1);
3976     dec(PByte(aMapData), 8);
3977   end;
3978   inc(aData, s);
3979 end;
3980
3981 destructor TbmpColorTableFormat.Destroy;
3982 begin
3983   SetLength(fColorTable, 0);
3984   inherited Destroy;
3985 end;
3986
3987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3988 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3990 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3991 var
3992   i: Integer;
3993 begin
3994   for i := 0 to 3 do begin
3995     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3996       if (aSourceFD.Range.arr[i] > 0) then
3997         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3998       else
3999         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4000     end;
4001   end;
4002 end;
4003
4004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4005 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4006 begin
4007   with aFuncRec do begin
4008     if (Source.Range.r   > 0) then
4009       Dest.Data.r := Source.Data.r;
4010     if (Source.Range.g > 0) then
4011       Dest.Data.g := Source.Data.g;
4012     if (Source.Range.b  > 0) then
4013       Dest.Data.b := Source.Data.b;
4014     if (Source.Range.a > 0) then
4015       Dest.Data.a := Source.Data.a;
4016   end;
4017 end;
4018
4019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4020 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4021 var
4022   i: Integer;
4023 begin
4024   with aFuncRec do begin
4025     for i := 0 to 3 do
4026       if (Source.Range.arr[i] > 0) then
4027         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4028   end;
4029 end;
4030
4031 type
4032   TShiftData = packed record
4033     case Integer of
4034       0: (r, g, b, a: SmallInt);
4035       1: (arr: array[0..3] of SmallInt);
4036   end;
4037   PShiftData = ^TShiftData;
4038
4039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4040 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4041 var
4042   i: Integer;
4043 begin
4044   with aFuncRec do
4045     for i := 0 to 3 do
4046       if (Source.Range.arr[i] > 0) then
4047         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4052 begin
4053   with aFuncRec do begin
4054     Dest.Data := Source.Data;
4055     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4056       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4057       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4058       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4059     end;
4060     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4061       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4062     end;
4063   end;
4064 end;
4065
4066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4067 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4068 var
4069   i: Integer;
4070 begin
4071   with aFuncRec do begin
4072     for i := 0 to 3 do
4073       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4074   end;
4075 end;
4076
4077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4078 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4079 var
4080   Temp: Single;
4081 begin
4082   with FuncRec do begin
4083     if (FuncRec.Args = nil) then begin //source has no alpha
4084       Temp :=
4085         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4086         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4087         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4088       Dest.Data.a := Round(Dest.Range.a * Temp);
4089     end else
4090       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4091   end;
4092 end;
4093
4094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4095 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4096 type
4097   PglBitmapPixelData = ^TglBitmapPixelData;
4098 begin
4099   with FuncRec do begin
4100     Dest.Data.r := Source.Data.r;
4101     Dest.Data.g := Source.Data.g;
4102     Dest.Data.b := Source.Data.b;
4103
4104     with PglBitmapPixelData(Args)^ do
4105       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4106           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4107           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4108         Dest.Data.a := 0
4109       else
4110         Dest.Data.a := Dest.Range.a;
4111   end;
4112 end;
4113
4114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4116 begin
4117   with FuncRec do begin
4118     Dest.Data.r := Source.Data.r;
4119     Dest.Data.g := Source.Data.g;
4120     Dest.Data.b := Source.Data.b;
4121     Dest.Data.a := PCardinal(Args)^;
4122   end;
4123 end;
4124
4125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4126 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4127 type
4128   PRGBPix = ^TRGBPix;
4129   TRGBPix = array [0..2] of byte;
4130 var
4131   Temp: Byte;
4132 begin
4133   while aWidth > 0 do begin
4134     Temp := PRGBPix(aData)^[0];
4135     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4136     PRGBPix(aData)^[2] := Temp;
4137
4138     if aHasAlpha then
4139       Inc(aData, 4)
4140     else
4141       Inc(aData, 3);
4142     dec(aWidth);
4143   end;
4144 end;
4145
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4150 begin
4151   result := TFormatDescriptor.Get(Format);
4152 end;
4153
4154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 function TglBitmap.GetWidth: Integer;
4156 begin
4157   if (ffX in fDimension.Fields) then
4158     result := fDimension.X
4159   else
4160     result := -1;
4161 end;
4162
4163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4164 function TglBitmap.GetHeight: Integer;
4165 begin
4166   if (ffY in fDimension.Fields) then
4167     result := fDimension.Y
4168   else
4169     result := -1;
4170 end;
4171
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 function TglBitmap.GetFileWidth: Integer;
4174 begin
4175   result := Max(1, Width);
4176 end;
4177
4178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4179 function TglBitmap.GetFileHeight: Integer;
4180 begin
4181   result := Max(1, Height);
4182 end;
4183
4184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4185 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4186 begin
4187   if fCustomData = aValue then
4188     exit;
4189   fCustomData := aValue;
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.SetCustomName(const aValue: String);
4194 begin
4195   if fCustomName = aValue then
4196     exit;
4197   fCustomName := aValue;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4202 begin
4203   if fCustomNameW = aValue then
4204     exit;
4205   fCustomNameW := aValue;
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4210 begin
4211   if fFreeDataOnDestroy = aValue then
4212     exit;
4213   fFreeDataOnDestroy := aValue;
4214 end;
4215
4216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4217 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4218 begin
4219   if fDeleteTextureOnFree = aValue then
4220     exit;
4221   fDeleteTextureOnFree := aValue;
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4226 begin
4227   if fFormat = aValue then
4228     exit;
4229   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4230     raise EglBitmapUnsupportedFormat.Create(Format);
4231   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4232 end;
4233
4234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4235 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4236 begin
4237   if fFreeDataAfterGenTexture = aValue then
4238     exit;
4239   fFreeDataAfterGenTexture := aValue;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure TglBitmap.SetID(const aValue: Cardinal);
4244 begin
4245   if fID = aValue then
4246     exit;
4247   fID := aValue;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4252 begin
4253   if fMipMap = aValue then
4254     exit;
4255   fMipMap := aValue;
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4260 begin
4261   if fTarget = aValue then
4262     exit;
4263   fTarget := aValue;
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4268 var
4269   MaxAnisotropic: Integer;
4270 begin
4271   fAnisotropic := aValue;
4272   if (ID > 0) then begin
4273     if GL_EXT_texture_filter_anisotropic then begin
4274       if fAnisotropic > 0 then begin
4275         Bind(false);
4276         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4277         if aValue > MaxAnisotropic then
4278           fAnisotropic := MaxAnisotropic;
4279         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4280       end;
4281     end else begin
4282       fAnisotropic := 0;
4283     end;
4284   end;
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 procedure TglBitmap.CreateID;
4289 begin
4290   if (ID <> 0) then
4291     glDeleteTextures(1, @fID);
4292   glGenTextures(1, @fID);
4293   Bind(false);
4294 end;
4295
4296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4298 begin
4299   // Set Up Parameters
4300   SetWrap(fWrapS, fWrapT, fWrapR);
4301   SetFilter(fFilterMin, fFilterMag);
4302   SetAnisotropic(fAnisotropic);
4303   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4304
4305   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4306     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4307
4308   // Mip Maps Generation Mode
4309   aBuildWithGlu := false;
4310   if (MipMap = mmMipmap) then begin
4311     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4312       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4313     else
4314       aBuildWithGlu := true;
4315   end else if (MipMap = mmMipmapGlu) then
4316     aBuildWithGlu := true;
4317 end;
4318
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4321   const aWidth: Integer; const aHeight: Integer);
4322 var
4323   s: Single;
4324 begin
4325   if (Data <> aData) then begin
4326     if (Assigned(Data)) then
4327       FreeMem(Data);
4328     fData := aData;
4329   end;
4330
4331   if not Assigned(fData) then begin
4332     fPixelSize := 0;
4333     fRowSize   := 0;
4334   end else begin
4335     FillChar(fDimension, SizeOf(fDimension), 0);
4336     if aWidth <> -1 then begin
4337       fDimension.Fields := fDimension.Fields + [ffX];
4338       fDimension.X := aWidth;
4339     end;
4340
4341     if aHeight <> -1 then begin
4342       fDimension.Fields := fDimension.Fields + [ffY];
4343       fDimension.Y := aHeight;
4344     end;
4345
4346     s := TFormatDescriptor.Get(aFormat).PixelSize;
4347     fFormat    := aFormat;
4348     fPixelSize := Ceil(s);
4349     fRowSize   := Ceil(s * aWidth);
4350   end;
4351 end;
4352
4353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4354 function TglBitmap.FlipHorz: Boolean;
4355 begin
4356   result := false;
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 function TglBitmap.FlipVert: Boolean;
4361 begin
4362   result := false;
4363 end;
4364
4365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4366 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 procedure TglBitmap.AfterConstruction;
4369 begin
4370   inherited AfterConstruction;
4371
4372   fID         := 0;
4373   fTarget     := 0;
4374   fIsResident := false;
4375
4376   fMipMap                  := glBitmapDefaultMipmap;
4377   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4378   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4379
4380   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4381   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4382   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TglBitmap.BeforeDestruction;
4387 var
4388   NewData: PByte;
4389 begin
4390   if fFreeDataOnDestroy then begin
4391     NewData := nil;
4392     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4393   end;
4394   if (fID > 0) and fDeleteTextureOnFree then
4395     glDeleteTextures(1, @fID);
4396   inherited BeforeDestruction;
4397 end;
4398
4399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4400 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4401 var
4402   TempPos: Integer;
4403 begin
4404   if not Assigned(aResType) then begin
4405     TempPos   := Pos('.', aResource);
4406     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4407     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4408   end;
4409 end;
4410
4411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4412 procedure TglBitmap.LoadFromFile(const aFilename: String);
4413 var
4414   fs: TFileStream;
4415 begin
4416   if not FileExists(aFilename) then
4417     raise EglBitmap.Create('file does not exist: ' + aFilename);
4418   fFilename := aFilename;
4419   fs := TFileStream.Create(fFilename, fmOpenRead);
4420   try
4421     fs.Position := 0;
4422     LoadFromStream(fs);
4423   finally
4424     fs.Free;
4425   end;
4426 end;
4427
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4430 begin
4431   {$IFDEF GLB_SUPPORT_PNG_READ}
4432   if not LoadPNG(aStream) then
4433   {$ENDIF}
4434   {$IFDEF GLB_SUPPORT_JPEG_READ}
4435   if not LoadJPEG(aStream) then
4436   {$ENDIF}
4437   if not LoadDDS(aStream) then
4438   if not LoadTGA(aStream) then
4439   if not LoadBMP(aStream) then
4440     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4441 end;
4442
4443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4444 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4445   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4446 var
4447   tmpData: PByte;
4448   size: Integer;
4449 begin
4450   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4451   GetMem(tmpData, size);
4452   try
4453     FillChar(tmpData^, size, #$FF);
4454     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4455   except
4456     if Assigned(tmpData) then
4457       FreeMem(tmpData);
4458     raise;
4459   end;
4460   AddFunc(Self, aFunc, false, aFormat, aArgs);
4461 end;
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4465 var
4466   rs: TResourceStream;
4467 begin
4468   PrepareResType(aResource, aResType);
4469   rs := TResourceStream.Create(aInstance, aResource, aResType);
4470   try
4471     LoadFromStream(rs);
4472   finally
4473     rs.Free;
4474   end;
4475 end;
4476
4477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4478 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4479 var
4480   rs: TResourceStream;
4481 begin
4482   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4483   try
4484     LoadFromStream(rs);
4485   finally
4486     rs.Free;
4487   end;
4488 end;
4489
4490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4491 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4492 var
4493   fs: TFileStream;
4494 begin
4495   fs := TFileStream.Create(aFileName, fmCreate);
4496   try
4497     fs.Position := 0;
4498     SaveToStream(fs, aFileType);
4499   finally
4500     fs.Free;
4501   end;
4502 end;
4503
4504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4505 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4506 begin
4507   case aFileType of
4508     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4509     ftPNG:  SavePNG(aStream);
4510     {$ENDIF}
4511     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4512     ftJPEG: SaveJPEG(aStream);
4513     {$ENDIF}
4514     ftDDS:  SaveDDS(aStream);
4515     ftTGA:  SaveTGA(aStream);
4516     ftBMP:  SaveBMP(aStream);
4517   end;
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4522 begin
4523   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4524 end;
4525
4526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4527 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4528   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4529 var
4530   DestData, TmpData, SourceData: pByte;
4531   TempHeight, TempWidth: Integer;
4532   SourceFD, DestFD: TFormatDescriptor;
4533   SourceMD, DestMD: Pointer;
4534
4535   FuncRec: TglBitmapFunctionRec;
4536 begin
4537   Assert(Assigned(Data));
4538   Assert(Assigned(aSource));
4539   Assert(Assigned(aSource.Data));
4540
4541   result := false;
4542   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4543     SourceFD := TFormatDescriptor.Get(aSource.Format);
4544     DestFD   := TFormatDescriptor.Get(aFormat);
4545
4546     if (SourceFD.IsCompressed) then
4547       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4548     if (DestFD.IsCompressed) then
4549       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4550
4551     // inkompatible Formats so CreateTemp
4552     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4553       aCreateTemp := true;
4554
4555     // Values
4556     TempHeight := Max(1, aSource.Height);
4557     TempWidth  := Max(1, aSource.Width);
4558
4559     FuncRec.Sender := Self;
4560     FuncRec.Args   := aArgs;
4561
4562     TmpData := nil;
4563     if aCreateTemp then begin
4564       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4565       DestData := TmpData;
4566     end else
4567       DestData := Data;
4568
4569     try
4570       SourceFD.PreparePixel(FuncRec.Source);
4571       DestFD.PreparePixel  (FuncRec.Dest);
4572
4573       SourceMD := SourceFD.CreateMappingData;
4574       DestMD   := DestFD.CreateMappingData;
4575
4576       FuncRec.Size            := aSource.Dimension;
4577       FuncRec.Position.Fields := FuncRec.Size.Fields;
4578
4579       try
4580         SourceData := aSource.Data;
4581         FuncRec.Position.Y := 0;
4582         while FuncRec.Position.Y < TempHeight do begin
4583           FuncRec.Position.X := 0;
4584           while FuncRec.Position.X < TempWidth do begin
4585             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4586             aFunc(FuncRec);
4587             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4588             inc(FuncRec.Position.X);
4589           end;
4590           inc(FuncRec.Position.Y);
4591         end;
4592
4593         // Updating Image or InternalFormat
4594         if aCreateTemp then
4595           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4596         else if (aFormat <> fFormat) then
4597           Format := aFormat;
4598
4599         result := true;
4600       finally
4601         SourceFD.FreeMappingData(SourceMD);
4602         DestFD.FreeMappingData(DestMD);
4603       end;
4604     except
4605       if aCreateTemp and Assigned(TmpData) then
4606         FreeMem(TmpData);
4607       raise;
4608     end;
4609   end;
4610 end;
4611
4612 {$IFDEF GLB_SDL}
4613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4614 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4615 var
4616   Row, RowSize: Integer;
4617   SourceData, TmpData: PByte;
4618   TempDepth: Integer;
4619   FormatDesc: TFormatDescriptor;
4620
4621   function GetRowPointer(Row: Integer): pByte;
4622   begin
4623     result := aSurface.pixels;
4624     Inc(result, Row * RowSize);
4625   end;
4626
4627 begin
4628   result := false;
4629
4630   FormatDesc := TFormatDescriptor.Get(Format);
4631   if FormatDesc.IsCompressed then
4632     raise EglBitmapUnsupportedFormat.Create(Format);
4633
4634   if Assigned(Data) then begin
4635     case Trunc(FormatDesc.PixelSize) of
4636       1: TempDepth :=  8;
4637       2: TempDepth := 16;
4638       3: TempDepth := 24;
4639       4: TempDepth := 32;
4640     else
4641       raise EglBitmapUnsupportedFormat.Create(Format);
4642     end;
4643
4644     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4645       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4646     SourceData := Data;
4647     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4648
4649     for Row := 0 to FileHeight-1 do begin
4650       TmpData := GetRowPointer(Row);
4651       if Assigned(TmpData) then begin
4652         Move(SourceData^, TmpData^, RowSize);
4653         inc(SourceData, RowSize);
4654       end;
4655     end;
4656     result := true;
4657   end;
4658 end;
4659
4660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4661 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4662 var
4663   pSource, pData, pTempData: PByte;
4664   Row, RowSize, TempWidth, TempHeight: Integer;
4665   IntFormat: TglBitmapFormat;
4666   FormatDesc: TFormatDescriptor;
4667
4668   function GetRowPointer(Row: Integer): pByte;
4669   begin
4670     result := aSurface^.pixels;
4671     Inc(result, Row * RowSize);
4672   end;
4673
4674 begin
4675   result := false;
4676   if (Assigned(aSurface)) then begin
4677     with aSurface^.format^ do begin
4678       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4679         FormatDesc := TFormatDescriptor.Get(IntFormat);
4680         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4681           break;
4682       end;
4683       if (IntFormat = tfEmpty) then
4684         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4685     end;
4686
4687     TempWidth  := aSurface^.w;
4688     TempHeight := aSurface^.h;
4689     RowSize := FormatDesc.GetSize(TempWidth, 1);
4690     GetMem(pData, TempHeight * RowSize);
4691     try
4692       pTempData := pData;
4693       for Row := 0 to TempHeight -1 do begin
4694         pSource := GetRowPointer(Row);
4695         if (Assigned(pSource)) then begin
4696           Move(pSource^, pTempData^, RowSize);
4697           Inc(pTempData, RowSize);
4698         end;
4699       end;
4700       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4701       result := true;
4702     except
4703       if Assigned(pData) then
4704         FreeMem(pData);
4705       raise;
4706     end;
4707   end;
4708 end;
4709
4710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4711 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4712 var
4713   Row, Col, AlphaInterleave: Integer;
4714   pSource, pDest: PByte;
4715
4716   function GetRowPointer(Row: Integer): pByte;
4717   begin
4718     result := aSurface.pixels;
4719     Inc(result, Row * Width);
4720   end;
4721
4722 begin
4723   result := false;
4724   if Assigned(Data) then begin
4725     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4726       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4727
4728       AlphaInterleave := 0;
4729       case Format of
4730         tfLuminance8Alpha8:
4731           AlphaInterleave := 1;
4732         tfBGRA8, tfRGBA8:
4733           AlphaInterleave := 3;
4734       end;
4735
4736       pSource := Data;
4737       for Row := 0 to Height -1 do begin
4738         pDest := GetRowPointer(Row);
4739         if Assigned(pDest) then begin
4740           for Col := 0 to Width -1 do begin
4741             Inc(pSource, AlphaInterleave);
4742             pDest^ := pSource^;
4743             Inc(pDest);
4744             Inc(pSource);
4745           end;
4746         end;
4747       end;
4748       result := true;
4749     end;
4750   end;
4751 end;
4752
4753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4754 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4755 var
4756   bmp: TglBitmap2D;
4757 begin
4758   bmp := TglBitmap2D.Create;
4759   try
4760     bmp.AssignFromSurface(aSurface);
4761     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4762   finally
4763     bmp.Free;
4764   end;
4765 end;
4766 {$ENDIF}
4767
4768 {$IFDEF GLB_DELPHI}
4769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4770 function CreateGrayPalette: HPALETTE;
4771 var
4772   Idx: Integer;
4773   Pal: PLogPalette;
4774 begin
4775   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4776
4777   Pal.palVersion := $300;
4778   Pal.palNumEntries := 256;
4779
4780   for Idx := 0 to Pal.palNumEntries - 1 do begin
4781     Pal.palPalEntry[Idx].peRed   := Idx;
4782     Pal.palPalEntry[Idx].peGreen := Idx;
4783     Pal.palPalEntry[Idx].peBlue  := Idx;
4784     Pal.palPalEntry[Idx].peFlags := 0;
4785   end;
4786   Result := CreatePalette(Pal^);
4787   FreeMem(Pal);
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4792 var
4793   Row: Integer;
4794   pSource, pData: PByte;
4795 begin
4796   result := false;
4797   if Assigned(Data) then begin
4798     if Assigned(aBitmap) then begin
4799       aBitmap.Width  := Width;
4800       aBitmap.Height := Height;
4801
4802       case Format of
4803         tfAlpha8, tfLuminance8: begin
4804           aBitmap.PixelFormat := pf8bit;
4805           aBitmap.Palette     := CreateGrayPalette;
4806         end;
4807         tfRGB5A1:
4808           aBitmap.PixelFormat := pf15bit;
4809         tfR5G6B5:
4810           aBitmap.PixelFormat := pf16bit;
4811         tfRGB8, tfBGR8:
4812           aBitmap.PixelFormat := pf24bit;
4813         tfRGBA8, tfBGRA8:
4814           aBitmap.PixelFormat := pf32bit;
4815       else
4816         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4817       end;
4818
4819       pSource := Data;
4820       for Row := 0 to FileHeight -1 do begin
4821         pData := aBitmap.Scanline[Row];
4822         Move(pSource^, pData^, fRowSize);
4823         Inc(pSource, fRowSize);
4824         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4825           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4826       end;
4827       result := true;
4828     end;
4829   end;
4830 end;
4831
4832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4833 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4834 var
4835   pSource, pData, pTempData: PByte;
4836   Row, RowSize, TempWidth, TempHeight: Integer;
4837   IntFormat: TglBitmapFormat;
4838 begin
4839   result := false;
4840
4841   if (Assigned(aBitmap)) then begin
4842     case aBitmap.PixelFormat of
4843       pf8bit:
4844         IntFormat := tfLuminance8;
4845       pf15bit:
4846         IntFormat := tfRGB5A1;
4847       pf16bit:
4848         IntFormat := tfR5G6B5;
4849       pf24bit:
4850         IntFormat := tfBGR8;
4851       pf32bit:
4852         IntFormat := tfBGRA8;
4853     else
4854       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4855     end;
4856
4857     TempWidth  := aBitmap.Width;
4858     TempHeight := aBitmap.Height;
4859     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4860     GetMem(pData, TempHeight * RowSize);
4861     try
4862       pTempData := pData;
4863       for Row := 0 to TempHeight -1 do begin
4864         pSource := aBitmap.Scanline[Row];
4865         if (Assigned(pSource)) then begin
4866           Move(pSource^, pTempData^, RowSize);
4867           Inc(pTempData, RowSize);
4868         end;
4869       end;
4870       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4871       result := true;
4872     except
4873       if Assigned(pData) then
4874         FreeMem(pData);
4875       raise;
4876     end;
4877   end;
4878 end;
4879
4880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4881 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4882 var
4883   Row, Col, AlphaInterleave: Integer;
4884   pSource, pDest: PByte;
4885 begin
4886   result := false;
4887
4888   if Assigned(Data) then begin
4889     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4890       if Assigned(aBitmap) then begin
4891         aBitmap.PixelFormat := pf8bit;
4892         aBitmap.Palette     := CreateGrayPalette;
4893         aBitmap.Width       := Width;
4894         aBitmap.Height      := Height;
4895
4896         case Format of
4897           tfLuminance8Alpha8:
4898             AlphaInterleave := 1;
4899           tfRGBA8, tfBGRA8:
4900             AlphaInterleave := 3;
4901           else
4902             AlphaInterleave := 0;
4903         end;
4904
4905         // Copy Data
4906         pSource := Data;
4907
4908         for Row := 0 to Height -1 do begin
4909           pDest := aBitmap.Scanline[Row];
4910           if Assigned(pDest) then begin
4911             for Col := 0 to Width -1 do begin
4912               Inc(pSource, AlphaInterleave);
4913               pDest^ := pSource^;
4914               Inc(pDest);
4915               Inc(pSource);
4916             end;
4917           end;
4918         end;
4919         result := true;
4920       end;
4921     end;
4922   end;
4923 end;
4924
4925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4926 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4927 var
4928   tex: TglBitmap2D;
4929 begin
4930   tex := TglBitmap2D.Create;
4931   try
4932     tex.AssignFromBitmap(ABitmap);
4933     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4934   finally
4935     tex.Free;
4936   end;
4937 end;
4938 {$ENDIF}
4939
4940 {$IFDEF GLB_LAZARUS}
4941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4942 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4943 var
4944   rid: TRawImageDescription;
4945   FormatDesc: TFormatDescriptor;
4946 begin
4947   result := false;
4948   if not Assigned(aImage) or (Format = tfEmpty) then
4949     exit;
4950   FormatDesc := TFormatDescriptor.Get(Format);
4951   if FormatDesc.IsCompressed then
4952     exit;
4953
4954   FillChar(rid{%H-}, SizeOf(rid), 0);
4955   if (Format in [
4956        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4957        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4958        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4959     rid.Format := ricfGray
4960   else
4961     rid.Format := ricfRGBA;
4962
4963   rid.Width        := Width;
4964   rid.Height       := Height;
4965   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4966   rid.BitOrder     := riboBitsInOrder;
4967   rid.ByteOrder    := riboLSBFirst;
4968   rid.LineOrder    := riloTopToBottom;
4969   rid.LineEnd      := rileTight;
4970   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4971   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4972   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4973   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4974   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4975   rid.RedShift     := FormatDesc.Shift.r;
4976   rid.GreenShift   := FormatDesc.Shift.g;
4977   rid.BlueShift    := FormatDesc.Shift.b;
4978   rid.AlphaShift   := FormatDesc.Shift.a;
4979
4980   rid.MaskBitsPerPixel  := 0;
4981   rid.PaletteColorCount := 0;
4982
4983   aImage.DataDescription := rid;
4984   aImage.CreateData;
4985
4986   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4987
4988   result := true;
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4993 var
4994   f: TglBitmapFormat;
4995   FormatDesc: TFormatDescriptor;
4996   ImageData: PByte;
4997   ImageSize: Integer;
4998   CanCopy: Boolean;
4999
5000   procedure CopyConvert;
5001   var
5002     bfFormat: TbmpBitfieldFormat;
5003     pSourceLine, pDestLine: PByte;
5004     pSourceMD, pDestMD: Pointer;
5005     x, y: Cardinal;
5006     pixel: TglBitmapPixelData;
5007   begin
5008     bfFormat  := TbmpBitfieldFormat.Create;
5009     with aImage.DataDescription do begin
5010       bfFormat.RedMask   := ((1 shl RedPrec)   - 1) shl RedShift;
5011       bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
5012       bfFormat.BlueMask  := ((1 shl BluePrec)  - 1) shl BlueShift;
5013       bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
5014       bfFormat.PixelSize := BitsPerPixel / 8;
5015     end;
5016     pSourceMD := bfFormat.CreateMappingData;
5017     pDestMD   := FormatDesc.CreateMappingData;
5018     try
5019       for y := 0 to aImage.Height-1 do begin
5020         pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
5021         pDestLine   := ImageData        + y * Round(FormatDesc.PixelSize * aImage.Width);
5022         for x := 0 to aImage.Width-1 do begin
5023           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5024           FormatDesc.Map(pixel, pDestLine, pDestMD);
5025         end;
5026       end;
5027     finally
5028       FormatDesc.FreeMappingData(pDestMD);
5029       bfFormat.FreeMappingData(pSourceMD);
5030       bfFormat.Free;
5031     end;
5032   end;
5033
5034 begin
5035   result := false;
5036   if not Assigned(aImage) then
5037     exit;
5038   for f := High(f) downto Low(f) do begin
5039     FormatDesc := TFormatDescriptor.Get(f);
5040     with aImage.DataDescription do
5041       if FormatDesc.MaskMatch(
5042         (QWord(1 shl RedPrec  )-1) shl RedShift,
5043         (QWord(1 shl GreenPrec)-1) shl GreenShift,
5044         (QWord(1 shl BluePrec )-1) shl BlueShift,
5045         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
5046         break;
5047   end;
5048
5049   if (f = tfEmpty) then
5050     exit;
5051
5052   CanCopy :=
5053     (Round(FormatDesc.PixelSize * 8)     = aImage.DataDescription.Depth) and
5054     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5055
5056   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5057   ImageData := GetMem(ImageSize);
5058   try
5059     if CanCopy then
5060       Move(aImage.PixelData^, ImageData^, ImageSize)
5061     else
5062       CopyConvert;
5063     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5064   except
5065     if Assigned(ImageData) then
5066       FreeMem(ImageData);
5067     raise;
5068   end;
5069
5070   result := true;
5071 end;
5072
5073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5074 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5075 var
5076   rid: TRawImageDescription;
5077   FormatDesc: TFormatDescriptor;
5078   Pixel: TglBitmapPixelData;
5079   x, y: Integer;
5080   srcMD: Pointer;
5081   src, dst: PByte;
5082 begin
5083   result := false;
5084   if not Assigned(aImage) or (Format = tfEmpty) then
5085     exit;
5086   FormatDesc := TFormatDescriptor.Get(Format);
5087   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5088     exit;
5089
5090   FillChar(rid{%H-}, SizeOf(rid), 0);
5091   rid.Format       := ricfGray;
5092   rid.Width        := Width;
5093   rid.Height       := Height;
5094   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5095   rid.BitOrder     := riboBitsInOrder;
5096   rid.ByteOrder    := riboLSBFirst;
5097   rid.LineOrder    := riloTopToBottom;
5098   rid.LineEnd      := rileTight;
5099   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5100   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5101   rid.GreenPrec    := 0;
5102   rid.BluePrec     := 0;
5103   rid.AlphaPrec    := 0;
5104   rid.RedShift     := 0;
5105   rid.GreenShift   := 0;
5106   rid.BlueShift    := 0;
5107   rid.AlphaShift   := 0;
5108
5109   rid.MaskBitsPerPixel  := 0;
5110   rid.PaletteColorCount := 0;
5111
5112   aImage.DataDescription := rid;
5113   aImage.CreateData;
5114
5115   srcMD := FormatDesc.CreateMappingData;
5116   try
5117     FormatDesc.PreparePixel(Pixel);
5118     src := Data;
5119     dst := aImage.PixelData;
5120     for y := 0 to Height-1 do
5121       for x := 0 to Width-1 do begin
5122         FormatDesc.Unmap(src, Pixel, srcMD);
5123         case rid.BitsPerPixel of
5124            8: begin
5125             dst^ := Pixel.Data.a;
5126             inc(dst);
5127           end;
5128           16: begin
5129             PWord(dst)^ := Pixel.Data.a;
5130             inc(dst, 2);
5131           end;
5132           24: begin
5133             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5134             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5135             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5136             inc(dst, 3);
5137           end;
5138           32: begin
5139             PCardinal(dst)^ := Pixel.Data.a;
5140             inc(dst, 4);
5141           end;
5142         else
5143           raise EglBitmapUnsupportedFormat.Create(Format);
5144         end;
5145       end;
5146   finally
5147     FormatDesc.FreeMappingData(srcMD);
5148   end;
5149   result := true;
5150 end;
5151
5152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5153 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5154 var
5155   tex: TglBitmap2D;
5156 begin
5157   tex := TglBitmap2D.Create;
5158   try
5159     tex.AssignFromLazIntfImage(aImage);
5160     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5161   finally
5162     tex.Free;
5163   end;
5164 end;
5165 {$ENDIF}
5166
5167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5168 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5169   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5170 var
5171   rs: TResourceStream;
5172 begin
5173   PrepareResType(aResource, aResType);
5174   rs := TResourceStream.Create(aInstance, aResource, aResType);
5175   try
5176     result := AddAlphaFromStream(rs, aFunc, aArgs);
5177   finally
5178     rs.Free;
5179   end;
5180 end;
5181
5182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5183 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5184   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5185 var
5186   rs: TResourceStream;
5187 begin
5188   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5189   try
5190     result := AddAlphaFromStream(rs, aFunc, aArgs);
5191   finally
5192     rs.Free;
5193   end;
5194 end;
5195
5196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5197 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5198 begin
5199   if TFormatDescriptor.Get(Format).IsCompressed then
5200     raise EglBitmapUnsupportedFormat.Create(Format);
5201   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5202 end;
5203
5204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5205 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5206 var
5207   FS: TFileStream;
5208 begin
5209   FS := TFileStream.Create(aFileName, fmOpenRead);
5210   try
5211     result := AddAlphaFromStream(FS, aFunc, aArgs);
5212   finally
5213     FS.Free;
5214   end;
5215 end;
5216
5217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5218 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5219 var
5220   tex: TglBitmap2D;
5221 begin
5222   tex := TglBitmap2D.Create(aStream);
5223   try
5224     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5225   finally
5226     tex.Free;
5227   end;
5228 end;
5229
5230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5231 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5232 var
5233   DestData, DestData2, SourceData: pByte;
5234   TempHeight, TempWidth: Integer;
5235   SourceFD, DestFD: TFormatDescriptor;
5236   SourceMD, DestMD, DestMD2: Pointer;
5237
5238   FuncRec: TglBitmapFunctionRec;
5239 begin
5240   result := false;
5241
5242   Assert(Assigned(Data));
5243   Assert(Assigned(aBitmap));
5244   Assert(Assigned(aBitmap.Data));
5245
5246   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5247     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5248
5249     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5250     DestFD   := TFormatDescriptor.Get(Format);
5251
5252     if not Assigned(aFunc) then begin
5253       aFunc        := glBitmapAlphaFunc;
5254       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5255     end else
5256       FuncRec.Args := aArgs;
5257
5258     // Values
5259     TempHeight := aBitmap.FileHeight;
5260     TempWidth  := aBitmap.FileWidth;
5261
5262     FuncRec.Sender          := Self;
5263     FuncRec.Size            := Dimension;
5264     FuncRec.Position.Fields := FuncRec.Size.Fields;
5265
5266     DestData   := Data;
5267     DestData2  := Data;
5268     SourceData := aBitmap.Data;
5269
5270     // Mapping
5271     SourceFD.PreparePixel(FuncRec.Source);
5272     DestFD.PreparePixel  (FuncRec.Dest);
5273
5274     SourceMD := SourceFD.CreateMappingData;
5275     DestMD   := DestFD.CreateMappingData;
5276     DestMD2  := DestFD.CreateMappingData;
5277     try
5278       FuncRec.Position.Y := 0;
5279       while FuncRec.Position.Y < TempHeight do begin
5280         FuncRec.Position.X := 0;
5281         while FuncRec.Position.X < TempWidth do begin
5282           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5283           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5284           aFunc(FuncRec);
5285           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5286           inc(FuncRec.Position.X);
5287         end;
5288         inc(FuncRec.Position.Y);
5289       end;
5290     finally
5291       SourceFD.FreeMappingData(SourceMD);
5292       DestFD.FreeMappingData(DestMD);
5293       DestFD.FreeMappingData(DestMD2);
5294     end;
5295   end;
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5300 begin
5301   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5302 end;
5303
5304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5305 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5306 var
5307   PixelData: TglBitmapPixelData;
5308 begin
5309   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5310   result := AddAlphaFromColorKeyFloat(
5311     aRed   / PixelData.Range.r,
5312     aGreen / PixelData.Range.g,
5313     aBlue  / PixelData.Range.b,
5314     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5315 end;
5316
5317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5318 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5319 var
5320   values: array[0..2] of Single;
5321   tmp: Cardinal;
5322   i: Integer;
5323   PixelData: TglBitmapPixelData;
5324 begin
5325   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5326   with PixelData do begin
5327     values[0] := aRed;
5328     values[1] := aGreen;
5329     values[2] := aBlue;
5330
5331     for i := 0 to 2 do begin
5332       tmp          := Trunc(Range.arr[i] * aDeviation);
5333       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5334       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5335     end;
5336     Data.a  := 0;
5337     Range.a := 0;
5338   end;
5339   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5340 end;
5341
5342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5343 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5344 begin
5345   result := AddAlphaFromValueFloat(aAlpha / $FF);
5346 end;
5347
5348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5349 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5350 var
5351   PixelData: TglBitmapPixelData;
5352 begin
5353   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5354   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5355 end;
5356
5357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5358 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5359 var
5360   PixelData: TglBitmapPixelData;
5361 begin
5362   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5363   with PixelData do
5364     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5365   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5366 end;
5367
5368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5369 function TglBitmap.RemoveAlpha: Boolean;
5370 var
5371   FormatDesc: TFormatDescriptor;
5372 begin
5373   result := false;
5374   FormatDesc := TFormatDescriptor.Get(Format);
5375   if Assigned(Data) then begin
5376     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5377       raise EglBitmapUnsupportedFormat.Create(Format);
5378     result := ConvertTo(FormatDesc.WithoutAlpha);
5379   end;
5380 end;
5381
5382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5383 function TglBitmap.Clone: TglBitmap;
5384 var
5385   Temp: TglBitmap;
5386   TempPtr: PByte;
5387   Size: Integer;
5388 begin
5389   Temp := (ClassType.Create as TglBitmap);
5390   try
5391     // copy texture data if assigned
5392     if Assigned(Data) then begin
5393       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5394       GetMem(TempPtr, Size);
5395       try
5396         Move(Data^, TempPtr^, Size);
5397         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5398       except
5399         if Assigned(TempPtr) then
5400           FreeMem(TempPtr);
5401         raise;
5402       end;
5403     end else begin
5404       TempPtr := nil;
5405       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5406     end;
5407
5408         // copy properties
5409     Temp.fID                      := ID;
5410     Temp.fTarget                  := Target;
5411     Temp.fFormat                  := Format;
5412     Temp.fMipMap                  := MipMap;
5413     Temp.fAnisotropic             := Anisotropic;
5414     Temp.fBorderColor             := fBorderColor;
5415     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5416     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5417     Temp.fFilterMin               := fFilterMin;
5418     Temp.fFilterMag               := fFilterMag;
5419     Temp.fWrapS                   := fWrapS;
5420     Temp.fWrapT                   := fWrapT;
5421     Temp.fWrapR                   := fWrapR;
5422     Temp.fFilename                := fFilename;
5423     Temp.fCustomName              := fCustomName;
5424     Temp.fCustomNameW             := fCustomNameW;
5425     Temp.fCustomData              := fCustomData;
5426
5427     result := Temp;
5428   except
5429     FreeAndNil(Temp);
5430     raise;
5431   end;
5432 end;
5433
5434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5435 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5436 var
5437   SourceFD, DestFD: TFormatDescriptor;
5438   SourcePD, DestPD: TglBitmapPixelData;
5439   ShiftData: TShiftData;
5440
5441   function CanCopyDirect: Boolean;
5442   begin
5443     result :=
5444       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5445       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5446       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5447       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5448   end;
5449
5450   function CanShift: Boolean;
5451   begin
5452     result :=
5453       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5454       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5455       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5456       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5457   end;
5458
5459   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5460   begin
5461     result := 0;
5462     while (aSource > aDest) and (aSource > 0) do begin
5463       inc(result);
5464       aSource := aSource shr 1;
5465     end;
5466   end;
5467
5468 begin
5469   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5470     SourceFD := TFormatDescriptor.Get(Format);
5471     DestFD   := TFormatDescriptor.Get(aFormat);
5472
5473     SourceFD.PreparePixel(SourcePD);
5474     DestFD.PreparePixel  (DestPD);
5475
5476     if CanCopyDirect then
5477       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5478     else if CanShift then begin
5479       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5480       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5481       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5482       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5483       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5484     end else
5485       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5486   end else
5487     result := true;
5488 end;
5489
5490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5491 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5492 begin
5493   if aUseRGB or aUseAlpha then
5494     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5495       ((Byte(aUseAlpha) and 1) shl 1) or
5496        (Byte(aUseRGB)   and 1)      ));
5497 end;
5498
5499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5500 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5501 begin
5502   fBorderColor[0] := aRed;
5503   fBorderColor[1] := aGreen;
5504   fBorderColor[2] := aBlue;
5505   fBorderColor[3] := aAlpha;
5506   if (ID > 0) then begin
5507     Bind(false);
5508     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5509   end;
5510 end;
5511
5512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5513 procedure TglBitmap.FreeData;
5514 var
5515   TempPtr: PByte;
5516 begin
5517   TempPtr := nil;
5518   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5519 end;
5520
5521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5522 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5523   const aAlpha: Byte);
5524 begin
5525   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5526 end;
5527
5528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5529 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5530 var
5531   PixelData: TglBitmapPixelData;
5532 begin
5533   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5534   FillWithColorFloat(
5535     aRed   / PixelData.Range.r,
5536     aGreen / PixelData.Range.g,
5537     aBlue  / PixelData.Range.b,
5538     aAlpha / PixelData.Range.a);
5539 end;
5540
5541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5542 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5543 var
5544   PixelData: TglBitmapPixelData;
5545 begin
5546   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5547   with PixelData do begin
5548     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5549     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5550     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5551     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5552   end;
5553   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5554 end;
5555
5556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5557 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5558 begin
5559   //check MIN filter
5560   case aMin of
5561     GL_NEAREST:
5562       fFilterMin := GL_NEAREST;
5563     GL_LINEAR:
5564       fFilterMin := GL_LINEAR;
5565     GL_NEAREST_MIPMAP_NEAREST:
5566       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5567     GL_LINEAR_MIPMAP_NEAREST:
5568       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5569     GL_NEAREST_MIPMAP_LINEAR:
5570       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5571     GL_LINEAR_MIPMAP_LINEAR:
5572       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5573     else
5574       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5575   end;
5576
5577   //check MAG filter
5578   case aMag of
5579     GL_NEAREST:
5580       fFilterMag := GL_NEAREST;
5581     GL_LINEAR:
5582       fFilterMag := GL_LINEAR;
5583     else
5584       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5585   end;
5586
5587   //apply filter
5588   if (ID > 0) then begin
5589     Bind(false);
5590     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5591
5592     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5593       case fFilterMin of
5594         GL_NEAREST, GL_LINEAR:
5595           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5596         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5597           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5598         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5599           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5600       end;
5601     end else
5602       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5603   end;
5604 end;
5605
5606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5607 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5608
5609   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5610   begin
5611     case aValue of
5612       GL_CLAMP:
5613         aTarget := GL_CLAMP;
5614
5615       GL_REPEAT:
5616         aTarget := GL_REPEAT;
5617
5618       GL_CLAMP_TO_EDGE: begin
5619         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5620           aTarget := GL_CLAMP_TO_EDGE
5621         else
5622           aTarget := GL_CLAMP;
5623       end;
5624
5625       GL_CLAMP_TO_BORDER: begin
5626         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5627           aTarget := GL_CLAMP_TO_BORDER
5628         else
5629           aTarget := GL_CLAMP;
5630       end;
5631
5632       GL_MIRRORED_REPEAT: begin
5633         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5634           aTarget := GL_MIRRORED_REPEAT
5635         else
5636           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5637       end;
5638     else
5639       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5640     end;
5641   end;
5642
5643 begin
5644   CheckAndSetWrap(S, fWrapS);
5645   CheckAndSetWrap(T, fWrapT);
5646   CheckAndSetWrap(R, fWrapR);
5647
5648   if (ID > 0) then begin
5649     Bind(false);
5650     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5651     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5652     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5653   end;
5654 end;
5655
5656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5657 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5658
5659   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5660   begin
5661     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5662        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5663       fSwizzle[aIndex] := aValue
5664     else
5665       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5666   end;
5667
5668 begin
5669   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5670     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5671   CheckAndSetValue(r, 0);
5672   CheckAndSetValue(g, 1);
5673   CheckAndSetValue(b, 2);
5674   CheckAndSetValue(a, 3);
5675
5676   if (ID > 0) then begin
5677     Bind(false);
5678     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5679   end;
5680 end;
5681
5682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5683 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5684 begin
5685   if aEnableTextureUnit then
5686     glEnable(Target);
5687   if (ID > 0) then
5688     glBindTexture(Target, ID);
5689 end;
5690
5691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5692 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5693 begin
5694   if aDisableTextureUnit then
5695     glDisable(Target);
5696   glBindTexture(Target, 0);
5697 end;
5698
5699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5700 constructor TglBitmap.Create;
5701 begin
5702   if (ClassType = TglBitmap) then
5703     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5704 {$IFDEF GLB_NATIVE_OGL}
5705   glbReadOpenGLExtensions;
5706 {$ENDIF}
5707   inherited Create;
5708   fFormat            := glBitmapGetDefaultFormat;
5709   fFreeDataOnDestroy := true;
5710 end;
5711
5712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5713 constructor TglBitmap.Create(const aFileName: String);
5714 begin
5715   Create;
5716   LoadFromFile(aFileName);
5717 end;
5718
5719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5720 constructor TglBitmap.Create(const aStream: TStream);
5721 begin
5722   Create;
5723   LoadFromStream(aStream);
5724 end;
5725
5726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5727 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5728 var
5729   ImageSize: Integer;
5730 begin
5731   Create;
5732   if not Assigned(aData) then begin
5733     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5734     GetMem(aData, ImageSize);
5735     try
5736       FillChar(aData^, ImageSize, #$FF);
5737       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5738     except
5739       if Assigned(aData) then
5740         FreeMem(aData);
5741       raise;
5742     end;
5743   end else begin
5744     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5745     fFreeDataOnDestroy := false;
5746   end;
5747 end;
5748
5749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5750 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5751 begin
5752   Create;
5753   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5754 end;
5755
5756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5757 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5758 begin
5759   Create;
5760   LoadFromResource(aInstance, aResource, aResType);
5761 end;
5762
5763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5764 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5765 begin
5766   Create;
5767   LoadFromResourceID(aInstance, aResourceID, aResType);
5768 end;
5769
5770 {$IFDEF GLB_SUPPORT_PNG_READ}
5771 {$IF DEFINED(GLB_LAZ_PNG)}
5772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5773 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5776 const
5777   MAGIC_LEN = 8;
5778   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5779 var
5780   reader: TLazReaderPNG;
5781   intf: TLazIntfImage;
5782   StreamPos: Int64;
5783   magic: String[MAGIC_LEN];
5784 begin
5785   result := true;
5786   StreamPos := aStream.Position;
5787
5788   SetLength(magic, MAGIC_LEN);
5789   aStream.Read(magic[1], MAGIC_LEN);
5790   aStream.Position := StreamPos;
5791   if (magic <> PNG_MAGIC) then begin
5792     result := false;
5793     exit;
5794   end;
5795
5796   intf   := TLazIntfImage.Create(0, 0);
5797   reader := TLazReaderPNG.Create;
5798   try try
5799     reader.UpdateDescription := true;
5800     reader.ImageRead(aStream, intf);
5801     AssignFromLazIntfImage(intf);
5802   except
5803     result := false;
5804     aStream.Position := StreamPos;
5805     exit;
5806   end;
5807   finally
5808     reader.Free;
5809     intf.Free;
5810   end;
5811 end;
5812
5813 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5815 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5816 var
5817   Surface: PSDL_Surface;
5818   RWops: PSDL_RWops;
5819 begin
5820   result := false;
5821   RWops := glBitmapCreateRWops(aStream);
5822   try
5823     if IMG_isPNG(RWops) > 0 then begin
5824       Surface := IMG_LoadPNG_RW(RWops);
5825       try
5826         AssignFromSurface(Surface);
5827         result := true;
5828       finally
5829         SDL_FreeSurface(Surface);
5830       end;
5831     end;
5832   finally
5833     SDL_FreeRW(RWops);
5834   end;
5835 end;
5836
5837 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5839 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5840 begin
5841   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5842 end;
5843
5844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5845 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5846 var
5847   StreamPos: Int64;
5848   signature: array [0..7] of byte;
5849   png: png_structp;
5850   png_info: png_infop;
5851
5852   TempHeight, TempWidth: Integer;
5853   Format: TglBitmapFormat;
5854
5855   png_data: pByte;
5856   png_rows: array of pByte;
5857   Row, LineSize: Integer;
5858 begin
5859   result := false;
5860
5861   if not init_libPNG then
5862     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5863
5864   try
5865     // signature
5866     StreamPos := aStream.Position;
5867     aStream.Read(signature{%H-}, 8);
5868     aStream.Position := StreamPos;
5869
5870     if png_check_sig(@signature, 8) <> 0 then begin
5871       // png read struct
5872       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5873       if png = nil then
5874         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5875
5876       // png info
5877       png_info := png_create_info_struct(png);
5878       if png_info = nil then begin
5879         png_destroy_read_struct(@png, nil, nil);
5880         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5881       end;
5882
5883       // set read callback
5884       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5885
5886       // read informations
5887       png_read_info(png, png_info);
5888
5889       // size
5890       TempHeight := png_get_image_height(png, png_info);
5891       TempWidth := png_get_image_width(png, png_info);
5892
5893       // format
5894       case png_get_color_type(png, png_info) of
5895         PNG_COLOR_TYPE_GRAY:
5896           Format := tfLuminance8;
5897         PNG_COLOR_TYPE_GRAY_ALPHA:
5898           Format := tfLuminance8Alpha8;
5899         PNG_COLOR_TYPE_RGB:
5900           Format := tfRGB8;
5901         PNG_COLOR_TYPE_RGB_ALPHA:
5902           Format := tfRGBA8;
5903         else
5904           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5905       end;
5906
5907       // cut upper 8 bit from 16 bit formats
5908       if png_get_bit_depth(png, png_info) > 8 then
5909         png_set_strip_16(png);
5910
5911       // expand bitdepth smaller than 8
5912       if png_get_bit_depth(png, png_info) < 8 then
5913         png_set_expand(png);
5914
5915       // allocating mem for scanlines
5916       LineSize := png_get_rowbytes(png, png_info);
5917       GetMem(png_data, TempHeight * LineSize);
5918       try
5919         SetLength(png_rows, TempHeight);
5920         for Row := Low(png_rows) to High(png_rows) do begin
5921           png_rows[Row] := png_data;
5922           Inc(png_rows[Row], Row * LineSize);
5923         end;
5924
5925         // read complete image into scanlines
5926         png_read_image(png, @png_rows[0]);
5927
5928         // read end
5929         png_read_end(png, png_info);
5930
5931         // destroy read struct
5932         png_destroy_read_struct(@png, @png_info, nil);
5933
5934         SetLength(png_rows, 0);
5935
5936         // set new data
5937         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5938
5939         result := true;
5940       except
5941         if Assigned(png_data) then
5942           FreeMem(png_data);
5943         raise;
5944       end;
5945     end;
5946   finally
5947     quit_libPNG;
5948   end;
5949 end;
5950
5951 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5953 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5954 var
5955   StreamPos: Int64;
5956   Png: TPNGObject;
5957   Header: String[8];
5958   Row, Col, PixSize, LineSize: Integer;
5959   NewImage, pSource, pDest, pAlpha: pByte;
5960   PngFormat: TglBitmapFormat;
5961   FormatDesc: TFormatDescriptor;
5962
5963 const
5964   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5965
5966 begin
5967   result := false;
5968
5969   StreamPos := aStream.Position;
5970   aStream.Read(Header[0], SizeOf(Header));
5971   aStream.Position := StreamPos;
5972
5973   {Test if the header matches}
5974   if Header = PngHeader then begin
5975     Png := TPNGObject.Create;
5976     try
5977       Png.LoadFromStream(aStream);
5978
5979       case Png.Header.ColorType of
5980         COLOR_GRAYSCALE:
5981           PngFormat := tfLuminance8;
5982         COLOR_GRAYSCALEALPHA:
5983           PngFormat := tfLuminance8Alpha8;
5984         COLOR_RGB:
5985           PngFormat := tfBGR8;
5986         COLOR_RGBALPHA:
5987           PngFormat := tfBGRA8;
5988         else
5989           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5990       end;
5991
5992       FormatDesc := TFormatDescriptor.Get(PngFormat);
5993       PixSize    := Round(FormatDesc.PixelSize);
5994       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5995
5996       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5997       try
5998         pDest := NewImage;
5999
6000         case Png.Header.ColorType of
6001           COLOR_RGB, COLOR_GRAYSCALE:
6002             begin
6003               for Row := 0 to Png.Height -1 do begin
6004                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6005                 Inc(pDest, LineSize);
6006               end;
6007             end;
6008           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6009             begin
6010               PixSize := PixSize -1;
6011
6012               for Row := 0 to Png.Height -1 do begin
6013                 pSource := Png.Scanline[Row];
6014                 pAlpha := pByte(Png.AlphaScanline[Row]);
6015
6016                 for Col := 0 to Png.Width -1 do begin
6017                   Move (pSource^, pDest^, PixSize);
6018                   Inc(pSource, PixSize);
6019                   Inc(pDest, PixSize);
6020
6021                   pDest^ := pAlpha^;
6022                   inc(pAlpha);
6023                   Inc(pDest);
6024                 end;
6025               end;
6026             end;
6027           else
6028             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6029         end;
6030
6031         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6032
6033         result := true;
6034       except
6035         if Assigned(NewImage) then
6036           FreeMem(NewImage);
6037         raise;
6038       end;
6039     finally
6040       Png.Free;
6041     end;
6042   end;
6043 end;
6044 {$IFEND}
6045 {$ENDIF}
6046
6047 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6048 {$IFDEF GLB_LIB_PNG}
6049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6050 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6051 begin
6052   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6053 end;
6054 {$ENDIF}
6055
6056 {$IF DEFINED(GLB_LAZ_PNG)}
6057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6058 procedure TglBitmap.SavePNG(const aStream: TStream);
6059 var
6060   png: TPortableNetworkGraphic;
6061   intf: TLazIntfImage;
6062   raw: TRawImage;
6063 begin
6064   png  := TPortableNetworkGraphic.Create;
6065   intf := TLazIntfImage.Create(0, 0);
6066   try
6067     if not AssignToLazIntfImage(intf) then
6068       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6069     intf.GetRawImage(raw);
6070     png.LoadFromRawImage(raw, false);
6071     png.SaveToStream(aStream);
6072   finally
6073     png.Free;
6074     intf.Free;
6075   end;
6076 end;
6077
6078 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6080 procedure TglBitmap.SavePNG(const aStream: TStream);
6081 var
6082   png: png_structp;
6083   png_info: png_infop;
6084   png_rows: array of pByte;
6085   LineSize: Integer;
6086   ColorType: Integer;
6087   Row: Integer;
6088   FormatDesc: TFormatDescriptor;
6089 begin
6090   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6091     raise EglBitmapUnsupportedFormat.Create(Format);
6092
6093   if not init_libPNG then
6094     raise Exception.Create('unable to initialize libPNG.');
6095
6096   try
6097     case Format of
6098       tfAlpha8, tfLuminance8:
6099         ColorType := PNG_COLOR_TYPE_GRAY;
6100       tfLuminance8Alpha8:
6101         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6102       tfBGR8, tfRGB8:
6103         ColorType := PNG_COLOR_TYPE_RGB;
6104       tfBGRA8, tfRGBA8:
6105         ColorType := PNG_COLOR_TYPE_RGBA;
6106       else
6107         raise EglBitmapUnsupportedFormat.Create(Format);
6108     end;
6109
6110     FormatDesc := TFormatDescriptor.Get(Format);
6111     LineSize := FormatDesc.GetSize(Width, 1);
6112
6113     // creating array for scanline
6114     SetLength(png_rows, Height);
6115     try
6116       for Row := 0 to Height - 1 do begin
6117         png_rows[Row] := Data;
6118         Inc(png_rows[Row], Row * LineSize)
6119       end;
6120
6121       // write struct
6122       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6123       if png = nil then
6124         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6125
6126       // create png info
6127       png_info := png_create_info_struct(png);
6128       if png_info = nil then begin
6129         png_destroy_write_struct(@png, nil);
6130         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6131       end;
6132
6133       // set read callback
6134       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6135
6136       // set compression
6137       png_set_compression_level(png, 6);
6138
6139       if Format in [tfBGR8, tfBGRA8] then
6140         png_set_bgr(png);
6141
6142       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6143       png_write_info(png, png_info);
6144       png_write_image(png, @png_rows[0]);
6145       png_write_end(png, png_info);
6146       png_destroy_write_struct(@png, @png_info);
6147     finally
6148       SetLength(png_rows, 0);
6149     end;
6150   finally
6151     quit_libPNG;
6152   end;
6153 end;
6154
6155 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6157 procedure TglBitmap.SavePNG(const aStream: TStream);
6158 var
6159   Png: TPNGObject;
6160
6161   pSource, pDest: pByte;
6162   X, Y, PixSize: Integer;
6163   ColorType: Cardinal;
6164   Alpha: Boolean;
6165
6166   pTemp: pByte;
6167   Temp: Byte;
6168 begin
6169   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6170     raise EglBitmapUnsupportedFormat.Create(Format);
6171
6172   case Format of
6173     tfAlpha8, tfLuminance8: begin
6174       ColorType := COLOR_GRAYSCALE;
6175       PixSize   := 1;
6176       Alpha     := false;
6177     end;
6178     tfLuminance8Alpha8: begin
6179       ColorType := COLOR_GRAYSCALEALPHA;
6180       PixSize   := 1;
6181       Alpha     := true;
6182     end;
6183     tfBGR8, tfRGB8: begin
6184       ColorType := COLOR_RGB;
6185       PixSize   := 3;
6186       Alpha     := false;
6187     end;
6188     tfBGRA8, tfRGBA8: begin
6189       ColorType := COLOR_RGBALPHA;
6190       PixSize   := 3;
6191       Alpha     := true
6192     end;
6193   else
6194     raise EglBitmapUnsupportedFormat.Create(Format);
6195   end;
6196
6197   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6198   try
6199     // Copy ImageData
6200     pSource := Data;
6201     for Y := 0 to Height -1 do begin
6202       pDest := png.ScanLine[Y];
6203       for X := 0 to Width -1 do begin
6204         Move(pSource^, pDest^, PixSize);
6205         Inc(pDest, PixSize);
6206         Inc(pSource, PixSize);
6207         if Alpha then begin
6208           png.AlphaScanline[Y]^[X] := pSource^;
6209           Inc(pSource);
6210         end;
6211       end;
6212
6213       // convert RGB line to BGR
6214       if Format in [tfRGB8, tfRGBA8] then begin
6215         pTemp := png.ScanLine[Y];
6216         for X := 0 to Width -1 do begin
6217           Temp := pByteArray(pTemp)^[0];
6218           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6219           pByteArray(pTemp)^[2] := Temp;
6220           Inc(pTemp, 3);
6221         end;
6222       end;
6223     end;
6224
6225     // Save to Stream
6226     Png.CompressionLevel := 6;
6227     Png.SaveToStream(aStream);
6228   finally
6229     FreeAndNil(Png);
6230   end;
6231 end;
6232 {$IFEND}
6233 {$ENDIF}
6234
6235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6236 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6238 {$IFDEF GLB_LIB_JPEG}
6239 type
6240   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6241   glBitmap_libJPEG_source_mgr = record
6242     pub: jpeg_source_mgr;
6243
6244     SrcStream: TStream;
6245     SrcBuffer: array [1..4096] of byte;
6246   end;
6247
6248   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6249   glBitmap_libJPEG_dest_mgr = record
6250     pub: jpeg_destination_mgr;
6251
6252     DestStream: TStream;
6253     DestBuffer: array [1..4096] of byte;
6254   end;
6255
6256 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6257 begin
6258   //DUMMY
6259 end;
6260
6261
6262 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6263 begin
6264   //DUMMY
6265 end;
6266
6267
6268 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6269 begin
6270   //DUMMY
6271 end;
6272
6273 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6274 begin
6275   //DUMMY
6276 end;
6277
6278
6279 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6280 begin
6281   //DUMMY
6282 end;
6283
6284
6285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6286 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6287 var
6288   src: glBitmap_libJPEG_source_mgr_ptr;
6289   bytes: integer;
6290 begin
6291   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6292
6293   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6294         if (bytes <= 0) then begin
6295                 src^.SrcBuffer[1] := $FF;
6296                 src^.SrcBuffer[2] := JPEG_EOI;
6297                 bytes := 2;
6298         end;
6299
6300         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6301         src^.pub.bytes_in_buffer := bytes;
6302
6303   result := true;
6304 end;
6305
6306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6307 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6308 var
6309   src: glBitmap_libJPEG_source_mgr_ptr;
6310 begin
6311   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6312
6313   if num_bytes > 0 then begin
6314     // wanted byte isn't in buffer so set stream position and read buffer
6315     if num_bytes > src^.pub.bytes_in_buffer then begin
6316       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6317       src^.pub.fill_input_buffer(cinfo);
6318     end else begin
6319       // wanted byte is in buffer so only skip
6320                 inc(src^.pub.next_input_byte, num_bytes);
6321                 dec(src^.pub.bytes_in_buffer, num_bytes);
6322     end;
6323   end;
6324 end;
6325
6326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6327 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6328 var
6329   dest: glBitmap_libJPEG_dest_mgr_ptr;
6330 begin
6331   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6332
6333   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6334     // write complete buffer
6335     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6336
6337     // reset buffer
6338     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6339     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6340   end;
6341
6342   result := true;
6343 end;
6344
6345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6346 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6347 var
6348   Idx: Integer;
6349   dest: glBitmap_libJPEG_dest_mgr_ptr;
6350 begin
6351   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6352
6353   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6354     // check for endblock
6355     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6356       // write endblock
6357       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6358
6359       // leave
6360       break;
6361     end else
6362       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6363   end;
6364 end;
6365 {$ENDIF}
6366
6367 {$IFDEF GLB_SUPPORT_JPEG_READ}
6368 {$IF DEFINED(GLB_LAZ_JPEG)}
6369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6370 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6371 const
6372   MAGIC_LEN = 2;
6373   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6374 var
6375   intf: TLazIntfImage;
6376   reader: TFPReaderJPEG;
6377   StreamPos: Int64;
6378   magic: String[MAGIC_LEN];
6379 begin
6380   result := true;
6381   StreamPos := aStream.Position;
6382
6383   SetLength(magic, MAGIC_LEN);
6384   aStream.Read(magic[1], MAGIC_LEN);
6385   aStream.Position := StreamPos;
6386   if (magic <> JPEG_MAGIC) then begin
6387     result := false;
6388     exit;
6389   end;
6390
6391   reader := TFPReaderJPEG.Create;
6392   intf := TLazIntfImage.Create(0, 0);
6393   try try
6394     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6395     reader.ImageRead(aStream, intf);
6396     AssignFromLazIntfImage(intf);
6397   except
6398     result := false;
6399     aStream.Position := StreamPos;
6400     exit;
6401   end;
6402   finally
6403     reader.Free;
6404     intf.Free;
6405   end;
6406 end;
6407
6408 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6410 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6411 var
6412   Surface: PSDL_Surface;
6413   RWops: PSDL_RWops;
6414 begin
6415   result := false;
6416
6417   RWops := glBitmapCreateRWops(aStream);
6418   try
6419     if IMG_isJPG(RWops) > 0 then begin
6420       Surface := IMG_LoadJPG_RW(RWops);
6421       try
6422         AssignFromSurface(Surface);
6423         result := true;
6424       finally
6425         SDL_FreeSurface(Surface);
6426       end;
6427     end;
6428   finally
6429     SDL_FreeRW(RWops);
6430   end;
6431 end;
6432
6433 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6435 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6436 var
6437   StreamPos: Int64;
6438   Temp: array[0..1]of Byte;
6439
6440   jpeg: jpeg_decompress_struct;
6441   jpeg_err: jpeg_error_mgr;
6442
6443   IntFormat: TglBitmapFormat;
6444   pImage: pByte;
6445   TempHeight, TempWidth: Integer;
6446
6447   pTemp: pByte;
6448   Row: Integer;
6449
6450   FormatDesc: TFormatDescriptor;
6451 begin
6452   result := false;
6453
6454   if not init_libJPEG then
6455     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6456
6457   try
6458     // reading first two bytes to test file and set cursor back to begin
6459     StreamPos := aStream.Position;
6460     aStream.Read({%H-}Temp[0], 2);
6461     aStream.Position := StreamPos;
6462
6463     // if Bitmap then read file.
6464     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6465       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6466       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6467
6468       // error managment
6469       jpeg.err := jpeg_std_error(@jpeg_err);
6470       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6471       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6472
6473       // decompression struct
6474       jpeg_create_decompress(@jpeg);
6475
6476       // allocation space for streaming methods
6477       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6478
6479       // seeting up custom functions
6480       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6481         pub.init_source       := glBitmap_libJPEG_init_source;
6482         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6483         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6484         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6485         pub.term_source       := glBitmap_libJPEG_term_source;
6486
6487         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6488         pub.next_input_byte := nil;   // until buffer loaded
6489
6490         SrcStream := aStream;
6491       end;
6492
6493       // set global decoding state
6494       jpeg.global_state := DSTATE_START;
6495
6496       // read header of jpeg
6497       jpeg_read_header(@jpeg, false);
6498
6499       // setting output parameter
6500       case jpeg.jpeg_color_space of
6501         JCS_GRAYSCALE:
6502           begin
6503             jpeg.out_color_space := JCS_GRAYSCALE;
6504             IntFormat := tfLuminance8;
6505           end;
6506         else
6507           jpeg.out_color_space := JCS_RGB;
6508           IntFormat := tfRGB8;
6509       end;
6510
6511       // reading image
6512       jpeg_start_decompress(@jpeg);
6513
6514       TempHeight := jpeg.output_height;
6515       TempWidth := jpeg.output_width;
6516
6517       FormatDesc := TFormatDescriptor.Get(IntFormat);
6518
6519       // creating new image
6520       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6521       try
6522         pTemp := pImage;
6523
6524         for Row := 0 to TempHeight -1 do begin
6525           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6526           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6527         end;
6528
6529         // finish decompression
6530         jpeg_finish_decompress(@jpeg);
6531
6532         // destroy decompression
6533         jpeg_destroy_decompress(@jpeg);
6534
6535         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6536
6537         result := true;
6538       except
6539         if Assigned(pImage) then
6540           FreeMem(pImage);
6541         raise;
6542       end;
6543     end;
6544   finally
6545     quit_libJPEG;
6546   end;
6547 end;
6548
6549 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6551 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6552 var
6553   bmp: TBitmap;
6554   jpg: TJPEGImage;
6555   StreamPos: Int64;
6556   Temp: array[0..1]of Byte;
6557 begin
6558   result := false;
6559
6560   // reading first two bytes to test file and set cursor back to begin
6561   StreamPos := aStream.Position;
6562   aStream.Read(Temp[0], 2);
6563   aStream.Position := StreamPos;
6564
6565   // if Bitmap then read file.
6566   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6567     bmp := TBitmap.Create;
6568     try
6569       jpg := TJPEGImage.Create;
6570       try
6571         jpg.LoadFromStream(aStream);
6572         bmp.Assign(jpg);
6573         result := AssignFromBitmap(bmp);
6574       finally
6575         jpg.Free;
6576       end;
6577     finally
6578       bmp.Free;
6579     end;
6580   end;
6581 end;
6582 {$IFEND}
6583 {$ENDIF}
6584
6585 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6586 {$IF DEFINED(GLB_LAZ_JPEG)}
6587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6588 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6589 var
6590   jpeg: TJPEGImage;
6591   intf: TLazIntfImage;
6592   raw: TRawImage;
6593 begin
6594   jpeg := TJPEGImage.Create;
6595   intf := TLazIntfImage.Create(0, 0);
6596   try
6597     if not AssignToLazIntfImage(intf) then
6598       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6599     intf.GetRawImage(raw);
6600     jpeg.LoadFromRawImage(raw, false);
6601     jpeg.SaveToStream(aStream);
6602   finally
6603     intf.Free;
6604     jpeg.Free;
6605   end;
6606 end;
6607
6608 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6610 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6611 var
6612   jpeg: jpeg_compress_struct;
6613   jpeg_err: jpeg_error_mgr;
6614   Row: Integer;
6615   pTemp, pTemp2: pByte;
6616
6617   procedure CopyRow(pDest, pSource: pByte);
6618   var
6619     X: Integer;
6620   begin
6621     for X := 0 to Width - 1 do begin
6622       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6623       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6624       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6625       Inc(pDest, 3);
6626       Inc(pSource, 3);
6627     end;
6628   end;
6629
6630 begin
6631   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6632     raise EglBitmapUnsupportedFormat.Create(Format);
6633
6634   if not init_libJPEG then
6635     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6636
6637   try
6638     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6639     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6640
6641     // error managment
6642     jpeg.err := jpeg_std_error(@jpeg_err);
6643     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6644     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6645
6646     // compression struct
6647     jpeg_create_compress(@jpeg);
6648
6649     // allocation space for streaming methods
6650     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6651
6652     // seeting up custom functions
6653     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6654       pub.init_destination    := glBitmap_libJPEG_init_destination;
6655       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6656       pub.term_destination    := glBitmap_libJPEG_term_destination;
6657
6658       pub.next_output_byte  := @DestBuffer[1];
6659       pub.free_in_buffer    := Length(DestBuffer);
6660
6661       DestStream := aStream;
6662     end;
6663
6664     // very important state
6665     jpeg.global_state := CSTATE_START;
6666     jpeg.image_width  := Width;
6667     jpeg.image_height := Height;
6668     case Format of
6669       tfAlpha8, tfLuminance8: begin
6670         jpeg.input_components := 1;
6671         jpeg.in_color_space   := JCS_GRAYSCALE;
6672       end;
6673       tfRGB8, tfBGR8: begin
6674         jpeg.input_components := 3;
6675         jpeg.in_color_space   := JCS_RGB;
6676       end;
6677     end;
6678
6679     jpeg_set_defaults(@jpeg);
6680     jpeg_set_quality(@jpeg, 95, true);
6681     jpeg_start_compress(@jpeg, true);
6682     pTemp := Data;
6683
6684     if Format = tfBGR8 then
6685       GetMem(pTemp2, fRowSize)
6686     else
6687       pTemp2 := pTemp;
6688
6689     try
6690       for Row := 0 to jpeg.image_height -1 do begin
6691         // prepare row
6692         if Format = tfBGR8 then
6693           CopyRow(pTemp2, pTemp)
6694         else
6695           pTemp2 := pTemp;
6696
6697         // write row
6698         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6699         inc(pTemp, fRowSize);
6700       end;
6701     finally
6702       // free memory
6703       if Format = tfBGR8 then
6704         FreeMem(pTemp2);
6705     end;
6706     jpeg_finish_compress(@jpeg);
6707     jpeg_destroy_compress(@jpeg);
6708   finally
6709     quit_libJPEG;
6710   end;
6711 end;
6712
6713 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6715 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6716 var
6717   Bmp: TBitmap;
6718   Jpg: TJPEGImage;
6719 begin
6720   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6721     raise EglBitmapUnsupportedFormat.Create(Format);
6722
6723   Bmp := TBitmap.Create;
6724   try
6725     Jpg := TJPEGImage.Create;
6726     try
6727       AssignToBitmap(Bmp);
6728       if (Format in [tfAlpha8, tfLuminance8]) then begin
6729         Jpg.Grayscale   := true;
6730         Jpg.PixelFormat := jf8Bit;
6731       end;
6732       Jpg.Assign(Bmp);
6733       Jpg.SaveToStream(aStream);
6734     finally
6735       FreeAndNil(Jpg);
6736     end;
6737   finally
6738     FreeAndNil(Bmp);
6739   end;
6740 end;
6741 {$IFEND}
6742 {$ENDIF}
6743
6744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6745 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6747 const
6748   BMP_MAGIC          = $4D42;
6749
6750   BMP_COMP_RGB       = 0;
6751   BMP_COMP_RLE8      = 1;
6752   BMP_COMP_RLE4      = 2;
6753   BMP_COMP_BITFIELDS = 3;
6754
6755 type
6756   TBMPHeader = packed record
6757     bfType: Word;
6758     bfSize: Cardinal;
6759     bfReserved1: Word;
6760     bfReserved2: Word;
6761     bfOffBits: Cardinal;
6762   end;
6763
6764   TBMPInfo = packed record
6765     biSize: Cardinal;
6766     biWidth: Longint;
6767     biHeight: Longint;
6768     biPlanes: Word;
6769     biBitCount: Word;
6770     biCompression: Cardinal;
6771     biSizeImage: Cardinal;
6772     biXPelsPerMeter: Longint;
6773     biYPelsPerMeter: Longint;
6774     biClrUsed: Cardinal;
6775     biClrImportant: Cardinal;
6776   end;
6777
6778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6779 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6780
6781   //////////////////////////////////////////////////////////////////////////////////////////////////
6782   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6783   begin
6784     result := tfEmpty;
6785     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6786     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6787
6788     //Read Compression
6789     case aInfo.biCompression of
6790       BMP_COMP_RLE4,
6791       BMP_COMP_RLE8: begin
6792         raise EglBitmap.Create('RLE compression is not supported');
6793       end;
6794       BMP_COMP_BITFIELDS: begin
6795         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6796           aStream.Read(aMask.r, SizeOf(aMask.r));
6797           aStream.Read(aMask.g, SizeOf(aMask.g));
6798           aStream.Read(aMask.b, SizeOf(aMask.b));
6799           aStream.Read(aMask.a, SizeOf(aMask.a));
6800         end else
6801           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6802       end;
6803     end;
6804
6805     //get suitable format
6806     case aInfo.biBitCount of
6807        8: result := tfLuminance8;
6808       16: result := tfBGR5;
6809       24: result := tfBGR8;
6810       32: result := tfBGRA8;
6811     end;
6812   end;
6813
6814   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6815   var
6816     i, c: Integer;
6817     ColorTable: TbmpColorTable;
6818   begin
6819     result := nil;
6820     if (aInfo.biBitCount >= 16) then
6821       exit;
6822     aFormat := tfLuminance8;
6823     c := aInfo.biClrUsed;
6824     if (c = 0) then
6825       c := 1 shl aInfo.biBitCount;
6826     SetLength(ColorTable, c);
6827     for i := 0 to c-1 do begin
6828       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6829       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6830         aFormat := tfRGB8;
6831     end;
6832
6833     result := TbmpColorTableFormat.Create;
6834     result.PixelSize  := aInfo.biBitCount / 8;
6835     result.ColorTable := ColorTable;
6836     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6837   end;
6838
6839   //////////////////////////////////////////////////////////////////////////////////////////////////
6840   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6841     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6842   var
6843     TmpFormat: TglBitmapFormat;
6844     FormatDesc: TFormatDescriptor;
6845   begin
6846     result := nil;
6847     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6848       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6849         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6850         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6851           aFormat := FormatDesc.Format;
6852           exit;
6853         end;
6854       end;
6855
6856       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6857         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6858       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6859         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6860
6861       result := TbmpBitfieldFormat.Create;
6862       result.PixelSize := aInfo.biBitCount / 8;
6863       result.RedMask   := aMask.r;
6864       result.GreenMask := aMask.g;
6865       result.BlueMask  := aMask.b;
6866       result.AlphaMask := aMask.a;
6867     end;
6868   end;
6869
6870 var
6871   //simple types
6872   StartPos: Int64;
6873   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6874   PaddingBuff: Cardinal;
6875   LineBuf, ImageData, TmpData: PByte;
6876   SourceMD, DestMD: Pointer;
6877   BmpFormat: TglBitmapFormat;
6878
6879   //records
6880   Mask: TglBitmapColorRec;
6881   Header: TBMPHeader;
6882   Info: TBMPInfo;
6883
6884   //classes
6885   SpecialFormat: TFormatDescriptor;
6886   FormatDesc: TFormatDescriptor;
6887
6888   //////////////////////////////////////////////////////////////////////////////////////////////////
6889   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6890   var
6891     i: Integer;
6892     Pixel: TglBitmapPixelData;
6893   begin
6894     aStream.Read(aLineBuf^, rbLineSize);
6895     SpecialFormat.PreparePixel(Pixel);
6896     for i := 0 to Info.biWidth-1 do begin
6897       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6898       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6899       FormatDesc.Map(Pixel, aData, DestMD);
6900     end;
6901   end;
6902
6903 begin
6904   result        := false;
6905   BmpFormat     := tfEmpty;
6906   SpecialFormat := nil;
6907   LineBuf       := nil;
6908   SourceMD      := nil;
6909   DestMD        := nil;
6910
6911   // Header
6912   StartPos := aStream.Position;
6913   aStream.Read(Header{%H-}, SizeOf(Header));
6914
6915   if Header.bfType = BMP_MAGIC then begin
6916     try try
6917       BmpFormat        := ReadInfo(Info, Mask);
6918       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6919       if not Assigned(SpecialFormat) then
6920         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6921       aStream.Position := StartPos + Header.bfOffBits;
6922
6923       if (BmpFormat <> tfEmpty) then begin
6924         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6925         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6926         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6927         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6928
6929         //get Memory
6930         DestMD    := FormatDesc.CreateMappingData;
6931         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6932         GetMem(ImageData, ImageSize);
6933         if Assigned(SpecialFormat) then begin
6934           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6935           SourceMD := SpecialFormat.CreateMappingData;
6936         end;
6937
6938         //read Data
6939         try try
6940           FillChar(ImageData^, ImageSize, $FF);
6941           TmpData := ImageData;
6942           if (Info.biHeight > 0) then
6943             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6944           for i := 0 to Abs(Info.biHeight)-1 do begin
6945             if Assigned(SpecialFormat) then
6946               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6947             else
6948               aStream.Read(TmpData^, wbLineSize);   //else only read data
6949             if (Info.biHeight > 0) then
6950               dec(TmpData, wbLineSize)
6951             else
6952               inc(TmpData, wbLineSize);
6953             aStream.Read(PaddingBuff{%H-}, Padding);
6954           end;
6955           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6956           result := true;
6957         finally
6958           if Assigned(LineBuf) then
6959             FreeMem(LineBuf);
6960           if Assigned(SourceMD) then
6961             SpecialFormat.FreeMappingData(SourceMD);
6962           FormatDesc.FreeMappingData(DestMD);
6963         end;
6964         except
6965           if Assigned(ImageData) then
6966             FreeMem(ImageData);
6967           raise;
6968         end;
6969       end else
6970         raise EglBitmap.Create('LoadBMP - No suitable format found');
6971     except
6972       aStream.Position := StartPos;
6973       raise;
6974     end;
6975     finally
6976       FreeAndNil(SpecialFormat);
6977     end;
6978   end
6979     else aStream.Position := StartPos;
6980 end;
6981
6982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6983 procedure TglBitmap.SaveBMP(const aStream: TStream);
6984 var
6985   Header: TBMPHeader;
6986   Info: TBMPInfo;
6987   Converter: TFormatDescriptor;
6988   FormatDesc: TFormatDescriptor;
6989   SourceFD, DestFD: Pointer;
6990   pData, srcData, dstData, ConvertBuffer: pByte;
6991
6992   Pixel: TglBitmapPixelData;
6993   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6994   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6995
6996   PaddingBuff: Cardinal;
6997
6998   function GetLineWidth : Integer;
6999   begin
7000     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7001   end;
7002
7003 begin
7004   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7005     raise EglBitmapUnsupportedFormat.Create(Format);
7006
7007   Converter  := nil;
7008   FormatDesc := TFormatDescriptor.Get(Format);
7009   ImageSize  := FormatDesc.GetSize(Dimension);
7010
7011   FillChar(Header{%H-}, SizeOf(Header), 0);
7012   Header.bfType      := BMP_MAGIC;
7013   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7014   Header.bfReserved1 := 0;
7015   Header.bfReserved2 := 0;
7016   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7017
7018   FillChar(Info{%H-}, SizeOf(Info), 0);
7019   Info.biSize        := SizeOf(Info);
7020   Info.biWidth       := Width;
7021   Info.biHeight      := Height;
7022   Info.biPlanes      := 1;
7023   Info.biCompression := BMP_COMP_RGB;
7024   Info.biSizeImage   := ImageSize;
7025
7026   try
7027     case Format of
7028       tfLuminance4: begin
7029         Info.biBitCount  := 4;
7030         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
7031         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
7032         Converter := TbmpColorTableFormat.Create;
7033         with (Converter as TbmpColorTableFormat) do begin
7034           PixelSize := 0.5;
7035           Format    := Format;
7036           Range     := glBitmapColorRec($F, $F, $F, $0);
7037           CreateColorTable;
7038         end;
7039       end;
7040
7041       tfR3G3B2, tfLuminance8: begin
7042         Info.biBitCount  :=  8;
7043         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7044         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7045         Converter := TbmpColorTableFormat.Create;
7046         with (Converter as TbmpColorTableFormat) do begin
7047           PixelSize := 1;
7048           Format    := Format;
7049           if (Format = tfR3G3B2) then begin
7050             Range := glBitmapColorRec($7, $7, $3, $0);
7051             Shift := glBitmapShiftRec(0, 3, 6, 0);
7052           end else
7053             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7054           CreateColorTable;
7055         end;
7056       end;
7057
7058       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7059       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7060         Info.biBitCount    := 16;
7061         Info.biCompression := BMP_COMP_BITFIELDS;
7062       end;
7063
7064       tfBGR8, tfRGB8: begin
7065         Info.biBitCount := 24;
7066         if (Format = tfRGB8) then
7067           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7068       end;
7069
7070       tfRGB10, tfRGB10A2, tfRGBA8,
7071       tfBGR10, tfBGR10A2, tfBGRA8: begin
7072         Info.biBitCount    := 32;
7073         Info.biCompression := BMP_COMP_BITFIELDS;
7074       end;
7075     else
7076       raise EglBitmapUnsupportedFormat.Create(Format);
7077     end;
7078     Info.biXPelsPerMeter := 2835;
7079     Info.biYPelsPerMeter := 2835;
7080
7081     // prepare bitmasks
7082     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7083       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7084       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7085
7086       RedMask    := FormatDesc.RedMask;
7087       GreenMask  := FormatDesc.GreenMask;
7088       BlueMask   := FormatDesc.BlueMask;
7089       AlphaMask  := FormatDesc.AlphaMask;
7090     end;
7091
7092     // headers
7093     aStream.Write(Header, SizeOf(Header));
7094     aStream.Write(Info, SizeOf(Info));
7095
7096     // colortable
7097     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7098       with (Converter as TbmpColorTableFormat) do
7099         aStream.Write(ColorTable[0].b,
7100           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7101
7102     // bitmasks
7103     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7104       aStream.Write(RedMask,   SizeOf(Cardinal));
7105       aStream.Write(GreenMask, SizeOf(Cardinal));
7106       aStream.Write(BlueMask,  SizeOf(Cardinal));
7107       aStream.Write(AlphaMask, SizeOf(Cardinal));
7108     end;
7109
7110     // image data
7111     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7112     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7113     Padding     := GetLineWidth - wbLineSize;
7114     PaddingBuff := 0;
7115
7116     pData := Data;
7117     inc(pData, (Height-1) * rbLineSize);
7118
7119     // prepare row buffer. But only for RGB because RGBA supports color masks
7120     // so it's possible to change color within the image.
7121     if Assigned(Converter) then begin
7122       FormatDesc.PreparePixel(Pixel);
7123       GetMem(ConvertBuffer, wbLineSize);
7124       SourceFD := FormatDesc.CreateMappingData;
7125       DestFD   := Converter.CreateMappingData;
7126     end else
7127       ConvertBuffer := nil;
7128
7129     try
7130       for LineIdx := 0 to Height - 1 do begin
7131         // preparing row
7132         if Assigned(Converter) then begin
7133           srcData := pData;
7134           dstData := ConvertBuffer;
7135           for PixelIdx := 0 to Info.biWidth-1 do begin
7136             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7137             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7138             Converter.Map(Pixel, dstData, DestFD);
7139           end;
7140           aStream.Write(ConvertBuffer^, wbLineSize);
7141         end else begin
7142           aStream.Write(pData^, rbLineSize);
7143         end;
7144         dec(pData, rbLineSize);
7145         if (Padding > 0) then
7146           aStream.Write(PaddingBuff, Padding);
7147       end;
7148     finally
7149       // destroy row buffer
7150       if Assigned(ConvertBuffer) then begin
7151         FormatDesc.FreeMappingData(SourceFD);
7152         Converter.FreeMappingData(DestFD);
7153         FreeMem(ConvertBuffer);
7154       end;
7155     end;
7156   finally
7157     if Assigned(Converter) then
7158       Converter.Free;
7159   end;
7160 end;
7161
7162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7163 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7165 type
7166   TTGAHeader = packed record
7167     ImageID: Byte;
7168     ColorMapType: Byte;
7169     ImageType: Byte;
7170     //ColorMapSpec: Array[0..4] of Byte;
7171     ColorMapStart: Word;
7172     ColorMapLength: Word;
7173     ColorMapEntrySize: Byte;
7174     OrigX: Word;
7175     OrigY: Word;
7176     Width: Word;
7177     Height: Word;
7178     Bpp: Byte;
7179     ImageDesc: Byte;
7180   end;
7181
7182 const
7183   TGA_UNCOMPRESSED_RGB  =  2;
7184   TGA_UNCOMPRESSED_GRAY =  3;
7185   TGA_COMPRESSED_RGB    = 10;
7186   TGA_COMPRESSED_GRAY   = 11;
7187
7188   TGA_NONE_COLOR_TABLE  = 0;
7189
7190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7191 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7192 var
7193   Header: TTGAHeader;
7194   ImageData: System.PByte;
7195   StartPosition: Int64;
7196   PixelSize, LineSize: Integer;
7197   tgaFormat: TglBitmapFormat;
7198   FormatDesc: TFormatDescriptor;
7199   Counter: packed record
7200     X, Y: packed record
7201       low, high, dir: Integer;
7202     end;
7203   end;
7204
7205 const
7206   CACHE_SIZE = $4000;
7207
7208   ////////////////////////////////////////////////////////////////////////////////////////
7209   procedure ReadUncompressed;
7210   var
7211     i, j: Integer;
7212     buf, tmp1, tmp2: System.PByte;
7213   begin
7214     buf := nil;
7215     if (Counter.X.dir < 0) then
7216       GetMem(buf, LineSize);
7217     try
7218       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7219         tmp1 := ImageData;
7220         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7221         if (Counter.X.dir < 0) then begin               //flip X
7222           aStream.Read(buf^, LineSize);
7223           tmp2 := buf;
7224           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7225           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7226             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7227               tmp1^ := tmp2^;
7228               inc(tmp1);
7229               inc(tmp2);
7230             end;
7231             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7232           end;
7233         end else
7234           aStream.Read(tmp1^, LineSize);
7235         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7236       end;
7237     finally
7238       if Assigned(buf) then
7239         FreeMem(buf);
7240     end;
7241   end;
7242
7243   ////////////////////////////////////////////////////////////////////////////////////////
7244   procedure ReadCompressed;
7245
7246     /////////////////////////////////////////////////////////////////
7247     var
7248       TmpData: System.PByte;
7249       LinePixelsRead: Integer;
7250     procedure CheckLine;
7251     begin
7252       if (LinePixelsRead >= Header.Width) then begin
7253         LinePixelsRead := 0;
7254         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7255         TmpData := ImageData;
7256         inc(TmpData, Counter.Y.low * LineSize);           //set line
7257         if (Counter.X.dir < 0) then                       //if x flipped then
7258           inc(TmpData, LineSize - PixelSize);             //set last pixel
7259       end;
7260     end;
7261
7262     /////////////////////////////////////////////////////////////////
7263     var
7264       Cache: PByte;
7265       CacheSize, CachePos: Integer;
7266     procedure CachedRead(out Buffer; Count: Integer);
7267     var
7268       BytesRead: Integer;
7269     begin
7270       if (CachePos + Count > CacheSize) then begin
7271         //if buffer overflow save non read bytes
7272         BytesRead := 0;
7273         if (CacheSize - CachePos > 0) then begin
7274           BytesRead := CacheSize - CachePos;
7275           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7276           inc(CachePos, BytesRead);
7277         end;
7278
7279         //load cache from file
7280         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7281         aStream.Read(Cache^, CacheSize);
7282         CachePos := 0;
7283
7284         //read rest of requested bytes
7285         if (Count - BytesRead > 0) then begin
7286           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7287           inc(CachePos, Count - BytesRead);
7288         end;
7289       end else begin
7290         //if no buffer overflow just read the data
7291         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7292         inc(CachePos, Count);
7293       end;
7294     end;
7295
7296     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7297     begin
7298       case PixelSize of
7299         1: begin
7300           aBuffer^ := aData^;
7301           inc(aBuffer, Counter.X.dir);
7302         end;
7303         2: begin
7304           PWord(aBuffer)^ := PWord(aData)^;
7305           inc(aBuffer, 2 * Counter.X.dir);
7306         end;
7307         3: begin
7308           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7309           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7310           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7311           inc(aBuffer, 3 * Counter.X.dir);
7312         end;
7313         4: begin
7314           PCardinal(aBuffer)^ := PCardinal(aData)^;
7315           inc(aBuffer, 4 * Counter.X.dir);
7316         end;
7317       end;
7318     end;
7319
7320   var
7321     TotalPixelsToRead, TotalPixelsRead: Integer;
7322     Temp: Byte;
7323     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7324     PixelRepeat: Boolean;
7325     PixelsToRead, PixelCount: Integer;
7326   begin
7327     CacheSize := 0;
7328     CachePos  := 0;
7329
7330     TotalPixelsToRead := Header.Width * Header.Height;
7331     TotalPixelsRead   := 0;
7332     LinePixelsRead    := 0;
7333
7334     GetMem(Cache, CACHE_SIZE);
7335     try
7336       TmpData := ImageData;
7337       inc(TmpData, Counter.Y.low * LineSize);           //set line
7338       if (Counter.X.dir < 0) then                       //if x flipped then
7339         inc(TmpData, LineSize - PixelSize);             //set last pixel
7340
7341       repeat
7342         //read CommandByte
7343         CachedRead(Temp, 1);
7344         PixelRepeat  := (Temp and $80) > 0;
7345         PixelsToRead := (Temp and $7F) + 1;
7346         inc(TotalPixelsRead, PixelsToRead);
7347
7348         if PixelRepeat then
7349           CachedRead(buf[0], PixelSize);
7350         while (PixelsToRead > 0) do begin
7351           CheckLine;
7352           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7353           while (PixelCount > 0) do begin
7354             if not PixelRepeat then
7355               CachedRead(buf[0], PixelSize);
7356             PixelToBuffer(@buf[0], TmpData);
7357             inc(LinePixelsRead);
7358             dec(PixelsToRead);
7359             dec(PixelCount);
7360           end;
7361         end;
7362       until (TotalPixelsRead >= TotalPixelsToRead);
7363     finally
7364       FreeMem(Cache);
7365     end;
7366   end;
7367
7368   function IsGrayFormat: Boolean;
7369   begin
7370     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7371   end;
7372
7373 begin
7374   result := false;
7375
7376   // reading header to test file and set cursor back to begin
7377   StartPosition := aStream.Position;
7378   aStream.Read(Header{%H-}, SizeOf(Header));
7379
7380   // no colormapped files
7381   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7382     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7383   begin
7384     try
7385       if Header.ImageID <> 0 then       // skip image ID
7386         aStream.Position := aStream.Position + Header.ImageID;
7387
7388       tgaFormat := tfEmpty;
7389       case Header.Bpp of
7390          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7391                0: tgaFormat := tfLuminance8;
7392                8: tgaFormat := tfAlpha8;
7393             end;
7394
7395         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7396                0: tgaFormat := tfLuminance16;
7397                8: tgaFormat := tfLuminance8Alpha8;
7398             end else case (Header.ImageDesc and $F) of
7399                0: tgaFormat := tfBGR5;
7400                1: tgaFormat := tfBGR5A1;
7401                4: tgaFormat := tfBGRA4;
7402             end;
7403
7404         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7405                0: tgaFormat := tfBGR8;
7406             end;
7407
7408         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7409                2: tgaFormat := tfBGR10A2;
7410                8: tgaFormat := tfBGRA8;
7411             end;
7412       end;
7413
7414       if (tgaFormat = tfEmpty) then
7415         raise EglBitmap.Create('LoadTga - unsupported format');
7416
7417       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7418       PixelSize  := FormatDesc.GetSize(1, 1);
7419       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7420
7421       GetMem(ImageData, LineSize * Header.Height);
7422       try
7423         //column direction
7424         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7425           Counter.X.low  := Header.Height-1;;
7426           Counter.X.high := 0;
7427           Counter.X.dir  := -1;
7428         end else begin
7429           Counter.X.low  := 0;
7430           Counter.X.high := Header.Height-1;
7431           Counter.X.dir  := 1;
7432         end;
7433
7434         // Row direction
7435         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7436           Counter.Y.low  := 0;
7437           Counter.Y.high := Header.Height-1;
7438           Counter.Y.dir  := 1;
7439         end else begin
7440           Counter.Y.low  := Header.Height-1;;
7441           Counter.Y.high := 0;
7442           Counter.Y.dir  := -1;
7443         end;
7444
7445         // Read Image
7446         case Header.ImageType of
7447           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7448             ReadUncompressed;
7449           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7450             ReadCompressed;
7451         end;
7452
7453         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7454         result := true;
7455       except
7456         if Assigned(ImageData) then
7457           FreeMem(ImageData);
7458         raise;
7459       end;
7460     finally
7461       aStream.Position := StartPosition;
7462     end;
7463   end
7464     else aStream.Position := StartPosition;
7465 end;
7466
7467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7468 procedure TglBitmap.SaveTGA(const aStream: TStream);
7469 var
7470   Header: TTGAHeader;
7471   LineSize, Size, x, y: Integer;
7472   Pixel: TglBitmapPixelData;
7473   LineBuf, SourceData, DestData: PByte;
7474   SourceMD, DestMD: Pointer;
7475   FormatDesc: TFormatDescriptor;
7476   Converter: TFormatDescriptor;
7477 begin
7478   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7479     raise EglBitmapUnsupportedFormat.Create(Format);
7480
7481   //prepare header
7482   FillChar(Header{%H-}, SizeOf(Header), 0);
7483
7484   //set ImageType
7485   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7486                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7487     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7488   else
7489     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7490
7491   //set BitsPerPixel
7492   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7493     Header.Bpp := 8
7494   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7495                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7496     Header.Bpp := 16
7497   else if (Format in [tfBGR8, tfRGB8]) then
7498     Header.Bpp := 24
7499   else
7500     Header.Bpp := 32;
7501
7502   //set AlphaBitCount
7503   case Format of
7504     tfRGB5A1, tfBGR5A1:
7505       Header.ImageDesc := 1 and $F;
7506     tfRGB10A2, tfBGR10A2:
7507       Header.ImageDesc := 2 and $F;
7508     tfRGBA4, tfBGRA4:
7509       Header.ImageDesc := 4 and $F;
7510     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7511       Header.ImageDesc := 8 and $F;
7512   end;
7513
7514   Header.Width     := Width;
7515   Header.Height    := Height;
7516   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7517   aStream.Write(Header, SizeOf(Header));
7518
7519   // convert RGB(A) to BGR(A)
7520   Converter  := nil;
7521   FormatDesc := TFormatDescriptor.Get(Format);
7522   Size       := FormatDesc.GetSize(Dimension);
7523   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7524     if (FormatDesc.RGBInverted = tfEmpty) then
7525       raise EglBitmap.Create('inverted RGB format is empty');
7526     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7527     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7528        (Converter.PixelSize <> FormatDesc.PixelSize) then
7529       raise EglBitmap.Create('invalid inverted RGB format');
7530   end;
7531
7532   if Assigned(Converter) then begin
7533     LineSize := FormatDesc.GetSize(Width, 1);
7534     GetMem(LineBuf, LineSize);
7535     SourceMD := FormatDesc.CreateMappingData;
7536     DestMD   := Converter.CreateMappingData;
7537     try
7538       SourceData := Data;
7539       for y := 0 to Height-1 do begin
7540         DestData := LineBuf;
7541         for x := 0 to Width-1 do begin
7542           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7543           Converter.Map(Pixel, DestData, DestMD);
7544         end;
7545         aStream.Write(LineBuf^, LineSize);
7546       end;
7547     finally
7548       FreeMem(LineBuf);
7549       FormatDesc.FreeMappingData(SourceMD);
7550       FormatDesc.FreeMappingData(DestMD);
7551     end;
7552   end else
7553     aStream.Write(Data^, Size);
7554 end;
7555
7556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7557 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7559 const
7560   DDS_MAGIC: Cardinal         = $20534444;
7561
7562   // DDS_header.dwFlags
7563   DDSD_CAPS                   = $00000001;
7564   DDSD_HEIGHT                 = $00000002;
7565   DDSD_WIDTH                  = $00000004;
7566   DDSD_PIXELFORMAT            = $00001000;
7567
7568   // DDS_header.sPixelFormat.dwFlags
7569   DDPF_ALPHAPIXELS            = $00000001;
7570   DDPF_ALPHA                  = $00000002;
7571   DDPF_FOURCC                 = $00000004;
7572   DDPF_RGB                    = $00000040;
7573   DDPF_LUMINANCE              = $00020000;
7574
7575   // DDS_header.sCaps.dwCaps1
7576   DDSCAPS_TEXTURE             = $00001000;
7577
7578   // DDS_header.sCaps.dwCaps2
7579   DDSCAPS2_CUBEMAP            = $00000200;
7580
7581   D3DFMT_DXT1                 = $31545844;
7582   D3DFMT_DXT3                 = $33545844;
7583   D3DFMT_DXT5                 = $35545844;
7584
7585 type
7586   TDDSPixelFormat = packed record
7587     dwSize: Cardinal;
7588     dwFlags: Cardinal;
7589     dwFourCC: Cardinal;
7590     dwRGBBitCount: Cardinal;
7591     dwRBitMask: Cardinal;
7592     dwGBitMask: Cardinal;
7593     dwBBitMask: Cardinal;
7594     dwABitMask: Cardinal;
7595   end;
7596
7597   TDDSCaps = packed record
7598     dwCaps1: Cardinal;
7599     dwCaps2: Cardinal;
7600     dwDDSX: Cardinal;
7601     dwReserved: Cardinal;
7602   end;
7603
7604   TDDSHeader = packed record
7605     dwSize: Cardinal;
7606     dwFlags: Cardinal;
7607     dwHeight: Cardinal;
7608     dwWidth: Cardinal;
7609     dwPitchOrLinearSize: Cardinal;
7610     dwDepth: Cardinal;
7611     dwMipMapCount: Cardinal;
7612     dwReserved: array[0..10] of Cardinal;
7613     PixelFormat: TDDSPixelFormat;
7614     Caps: TDDSCaps;
7615     dwReserved2: Cardinal;
7616   end;
7617
7618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7619 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7620 var
7621   Header: TDDSHeader;
7622   Converter: TbmpBitfieldFormat;
7623
7624   function GetDDSFormat: TglBitmapFormat;
7625   var
7626     fd: TFormatDescriptor;
7627     i: Integer;
7628     Range: TglBitmapColorRec;
7629     match: Boolean;
7630   begin
7631     result := tfEmpty;
7632     with Header.PixelFormat do begin
7633       // Compresses
7634       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7635         case Header.PixelFormat.dwFourCC of
7636           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7637           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7638           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7639         end;
7640       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7641
7642         //find matching format
7643         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7644           fd := TFormatDescriptor.Get(result);
7645           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7646              (8 * fd.PixelSize = dwRGBBitCount) then
7647             exit;
7648         end;
7649
7650         //find format with same Range
7651         Range.r := dwRBitMask;
7652         Range.g := dwGBitMask;
7653         Range.b := dwBBitMask;
7654         Range.a := dwABitMask;
7655         for i := 0 to 3 do begin
7656           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7657             Range.arr[i] := Range.arr[i] shr 1;
7658         end;
7659         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7660           fd := TFormatDescriptor.Get(result);
7661           match := true;
7662           for i := 0 to 3 do
7663             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7664               match := false;
7665               break;
7666             end;
7667           if match then
7668             break;
7669         end;
7670
7671         //no format with same range found -> use default
7672         if (result = tfEmpty) then begin
7673           if (dwABitMask > 0) then
7674             result := tfBGRA8
7675           else
7676             result := tfBGR8;
7677         end;
7678
7679         Converter := TbmpBitfieldFormat.Create;
7680         Converter.RedMask   := dwRBitMask;
7681         Converter.GreenMask := dwGBitMask;
7682         Converter.BlueMask  := dwBBitMask;
7683         Converter.AlphaMask := dwABitMask;
7684         Converter.PixelSize := dwRGBBitCount / 8;
7685       end;
7686     end;
7687   end;
7688
7689 var
7690   StreamPos: Int64;
7691   x, y, LineSize, RowSize, Magic: Cardinal;
7692   NewImage, TmpData, RowData, SrcData: System.PByte;
7693   SourceMD, DestMD: Pointer;
7694   Pixel: TglBitmapPixelData;
7695   ddsFormat: TglBitmapFormat;
7696   FormatDesc: TFormatDescriptor;
7697
7698 begin
7699   result    := false;
7700   Converter := nil;
7701   StreamPos := aStream.Position;
7702
7703   // Magic
7704   aStream.Read(Magic{%H-}, sizeof(Magic));
7705   if (Magic <> DDS_MAGIC) then begin
7706     aStream.Position := StreamPos;
7707     exit;
7708   end;
7709
7710   //Header
7711   aStream.Read(Header{%H-}, sizeof(Header));
7712   if (Header.dwSize <> SizeOf(Header)) or
7713      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7714         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7715   begin
7716     aStream.Position := StreamPos;
7717     exit;
7718   end;
7719
7720   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7721     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7722
7723   ddsFormat := GetDDSFormat;
7724   try
7725     if (ddsFormat = tfEmpty) then
7726       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7727
7728     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7729     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7730     GetMem(NewImage, Header.dwHeight * LineSize);
7731     try
7732       TmpData := NewImage;
7733
7734       //Converter needed
7735       if Assigned(Converter) then begin
7736         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7737         GetMem(RowData, RowSize);
7738         SourceMD := Converter.CreateMappingData;
7739         DestMD   := FormatDesc.CreateMappingData;
7740         try
7741           for y := 0 to Header.dwHeight-1 do begin
7742             TmpData := NewImage;
7743             inc(TmpData, y * LineSize);
7744             SrcData := RowData;
7745             aStream.Read(SrcData^, RowSize);
7746             for x := 0 to Header.dwWidth-1 do begin
7747               Converter.Unmap(SrcData, Pixel, SourceMD);
7748               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7749               FormatDesc.Map(Pixel, TmpData, DestMD);
7750             end;
7751           end;
7752         finally
7753           Converter.FreeMappingData(SourceMD);
7754           FormatDesc.FreeMappingData(DestMD);
7755           FreeMem(RowData);
7756         end;
7757       end else
7758
7759       // Compressed
7760       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7761         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7762         for Y := 0 to Header.dwHeight-1 do begin
7763           aStream.Read(TmpData^, RowSize);
7764           Inc(TmpData, LineSize);
7765         end;
7766       end else
7767
7768       // Uncompressed
7769       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7770         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7771         for Y := 0 to Header.dwHeight-1 do begin
7772           aStream.Read(TmpData^, RowSize);
7773           Inc(TmpData, LineSize);
7774         end;
7775       end else
7776         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7777
7778       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7779       result := true;
7780     except
7781       if Assigned(NewImage) then
7782         FreeMem(NewImage);
7783       raise;
7784     end;
7785   finally
7786     FreeAndNil(Converter);
7787   end;
7788 end;
7789
7790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7791 procedure TglBitmap.SaveDDS(const aStream: TStream);
7792 var
7793   Header: TDDSHeader;
7794   FormatDesc: TFormatDescriptor;
7795 begin
7796   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7797     raise EglBitmapUnsupportedFormat.Create(Format);
7798
7799   FormatDesc := TFormatDescriptor.Get(Format);
7800
7801   // Generell
7802   FillChar(Header{%H-}, SizeOf(Header), 0);
7803   Header.dwSize  := SizeOf(Header);
7804   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7805
7806   Header.dwWidth  := Max(1, Width);
7807   Header.dwHeight := Max(1, Height);
7808
7809   // Caps
7810   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7811
7812   // Pixelformat
7813   Header.PixelFormat.dwSize := sizeof(Header);
7814   if (FormatDesc.IsCompressed) then begin
7815     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7816     case Format of
7817       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7818       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7819       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7820     end;
7821   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7822     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7823     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7824     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7825   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7826     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7827     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7828     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7829     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7830   end else begin
7831     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7832     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7833     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7834     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7835     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7836     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7837   end;
7838
7839   if (FormatDesc.HasAlpha) then
7840     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7841
7842   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7843   aStream.Write(Header, SizeOf(Header));
7844   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7845 end;
7846
7847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7848 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7850 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7851   const aWidth: Integer; const aHeight: Integer);
7852 var
7853   pTemp: pByte;
7854   Size: Integer;
7855 begin
7856   if (aHeight > 1) then begin
7857     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7858     GetMem(pTemp, Size);
7859     try
7860       Move(aData^, pTemp^, Size);
7861       FreeMem(aData);
7862       aData := nil;
7863     except
7864       FreeMem(pTemp);
7865       raise;
7866     end;
7867   end else
7868     pTemp := aData;
7869   inherited SetDataPointer(pTemp, aFormat, aWidth);
7870 end;
7871
7872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7873 function TglBitmap1D.FlipHorz: Boolean;
7874 var
7875   Col: Integer;
7876   pTempDest, pDest, pSource: PByte;
7877 begin
7878   result := inherited FlipHorz;
7879   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7880     pSource := Data;
7881     GetMem(pDest, fRowSize);
7882     try
7883       pTempDest := pDest;
7884       Inc(pTempDest, fRowSize);
7885       for Col := 0 to Width-1 do begin
7886         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7887         Move(pSource^, pTempDest^, fPixelSize);
7888         Inc(pSource, fPixelSize);
7889       end;
7890       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7891       result := true;
7892     except
7893       if Assigned(pDest) then
7894         FreeMem(pDest);
7895       raise;
7896     end;
7897   end;
7898 end;
7899
7900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7901 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7902 var
7903   FormatDesc: TFormatDescriptor;
7904 begin
7905   // Upload data
7906   FormatDesc := TFormatDescriptor.Get(Format);
7907   if FormatDesc.IsCompressed then begin
7908     if not Assigned(glCompressedTexImage1D) then
7909       raise EglBitmap.Create('compressed formats not supported by video adapter');
7910     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7911   end else if aBuildWithGlu then
7912     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7913   else
7914     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7915
7916   // Free Data
7917   if (FreeDataAfterGenTexture) then
7918     FreeData;
7919 end;
7920
7921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7922 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7923 var
7924   BuildWithGlu, TexRec: Boolean;
7925   TexSize: Integer;
7926 begin
7927   if Assigned(Data) then begin
7928     // Check Texture Size
7929     if (aTestTextureSize) then begin
7930       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7931
7932       if (Width > TexSize) then
7933         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7934
7935       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7936                 (Target = GL_TEXTURE_RECTANGLE);
7937       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7938         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7939     end;
7940
7941     CreateId;
7942     SetupParameters(BuildWithGlu);
7943     UploadData(BuildWithGlu);
7944     glAreTexturesResident(1, @fID, @fIsResident);
7945   end;
7946 end;
7947
7948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7949 procedure TglBitmap1D.AfterConstruction;
7950 begin
7951   inherited;
7952   Target := GL_TEXTURE_1D;
7953 end;
7954
7955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7956 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7958 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7959 begin
7960   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7961     result := fLines[aIndex]
7962   else
7963     result := nil;
7964 end;
7965
7966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7967 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7968   const aWidth: Integer; const aHeight: Integer);
7969 var
7970   Idx, LineWidth: Integer;
7971 begin
7972   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7973
7974   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7975     // Assigning Data
7976     if Assigned(Data) then begin
7977       SetLength(fLines, GetHeight);
7978       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7979
7980       for Idx := 0 to GetHeight-1 do begin
7981         fLines[Idx] := Data;
7982         Inc(fLines[Idx], Idx * LineWidth);
7983       end;
7984     end
7985       else SetLength(fLines, 0);
7986   end else begin
7987     SetLength(fLines, 0);
7988   end;
7989 end;
7990
7991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7992 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7993 var
7994   FormatDesc: TFormatDescriptor;
7995 begin
7996   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7997
7998   FormatDesc := TFormatDescriptor.Get(Format);
7999   if FormatDesc.IsCompressed then begin
8000     if not Assigned(glCompressedTexImage2D) then
8001       raise EglBitmap.Create('compressed formats not supported by video adapter');
8002     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8003   end else if aBuildWithGlu then begin
8004     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
8005       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8006   end else begin
8007     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8008       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8009   end;
8010
8011   // Freigeben
8012   if (FreeDataAfterGenTexture) then
8013     FreeData;
8014 end;
8015
8016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8017 procedure TglBitmap2D.AfterConstruction;
8018 begin
8019   inherited;
8020   Target := GL_TEXTURE_2D;
8021 end;
8022
8023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8024 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8025 var
8026   Temp: pByte;
8027   Size, w, h: Integer;
8028   FormatDesc: TFormatDescriptor;
8029 begin
8030   FormatDesc := TFormatDescriptor.Get(aFormat);
8031   if FormatDesc.IsCompressed then
8032     raise EglBitmapUnsupportedFormat.Create(aFormat);
8033
8034   w    := aRight  - aLeft;
8035   h    := aBottom - aTop;
8036   Size := FormatDesc.GetSize(w, h);
8037   GetMem(Temp, Size);
8038   try
8039     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8040     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8041     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8042     FlipVert;
8043   except
8044     if Assigned(Temp) then
8045       FreeMem(Temp);
8046     raise;
8047   end;
8048 end;
8049
8050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8051 procedure TglBitmap2D.GetDataFromTexture;
8052 var
8053   Temp: PByte;
8054   TempWidth, TempHeight: GLint;
8055   TempIntFormat: GLenum;
8056   IntFormat, f: TglBitmapFormat;
8057   FormatDesc: TFormatDescriptor;
8058 begin
8059   Bind;
8060
8061   // Request Data
8062   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8063   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8064   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, PGLint(@TempIntFormat));
8065
8066   IntFormat := tfEmpty;
8067   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8068     FormatDesc := TFormatDescriptor.Get(f);
8069     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8070       IntFormat := FormatDesc.Format;
8071       break;
8072     end;
8073   end;
8074
8075   // Getting data from OpenGL
8076   FormatDesc := TFormatDescriptor.Get(IntFormat);
8077   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8078   try
8079     if FormatDesc.IsCompressed then begin
8080       if not Assigned(glGetCompressedTexImage) then
8081         raise EglBitmap.Create('compressed formats not supported by video adapter');
8082       glGetCompressedTexImage(Target, 0, Temp)
8083     end else
8084       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8085     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8086   except
8087     if Assigned(Temp) then
8088       FreeMem(Temp);
8089     raise;
8090   end;
8091 end;
8092
8093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8094 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8095 var
8096   BuildWithGlu, PotTex, TexRec: Boolean;
8097   TexSize: Integer;
8098 begin
8099   if Assigned(Data) then begin
8100     // Check Texture Size
8101     if (aTestTextureSize) then begin
8102       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8103
8104       if ((Height > TexSize) or (Width > TexSize)) then
8105         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8106
8107       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8108       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8109       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8110         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8111     end;
8112
8113     CreateId;
8114     SetupParameters(BuildWithGlu);
8115     UploadData(Target, BuildWithGlu);
8116     glAreTexturesResident(1, @fID, @fIsResident);
8117   end;
8118 end;
8119
8120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8121 function TglBitmap2D.FlipHorz: Boolean;
8122 var
8123   Col, Row: Integer;
8124   TempDestData, DestData, SourceData: PByte;
8125   ImgSize: Integer;
8126 begin
8127   result := inherited FlipHorz;
8128   if Assigned(Data) then begin
8129     SourceData := Data;
8130     ImgSize := Height * fRowSize;
8131     GetMem(DestData, ImgSize);
8132     try
8133       TempDestData := DestData;
8134       Dec(TempDestData, fRowSize + fPixelSize);
8135       for Row := 0 to Height -1 do begin
8136         Inc(TempDestData, fRowSize * 2);
8137         for Col := 0 to Width -1 do begin
8138           Move(SourceData^, TempDestData^, fPixelSize);
8139           Inc(SourceData, fPixelSize);
8140           Dec(TempDestData, fPixelSize);
8141         end;
8142       end;
8143       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8144       result := true;
8145     except
8146       if Assigned(DestData) then
8147         FreeMem(DestData);
8148       raise;
8149     end;
8150   end;
8151 end;
8152
8153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8154 function TglBitmap2D.FlipVert: Boolean;
8155 var
8156   Row: Integer;
8157   TempDestData, DestData, SourceData: PByte;
8158 begin
8159   result := inherited FlipVert;
8160   if Assigned(Data) then begin
8161     SourceData := Data;
8162     GetMem(DestData, Height * fRowSize);
8163     try
8164       TempDestData := DestData;
8165       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8166       for Row := 0 to Height -1 do begin
8167         Move(SourceData^, TempDestData^, fRowSize);
8168         Dec(TempDestData, fRowSize);
8169         Inc(SourceData, fRowSize);
8170       end;
8171       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8172       result := true;
8173     except
8174       if Assigned(DestData) then
8175         FreeMem(DestData);
8176       raise;
8177     end;
8178   end;
8179 end;
8180
8181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8182 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8184 type
8185   TMatrixItem = record
8186     X, Y: Integer;
8187     W: Single;
8188   end;
8189
8190   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8191   TglBitmapToNormalMapRec = Record
8192     Scale: Single;
8193     Heights: array of Single;
8194     MatrixU : array of TMatrixItem;
8195     MatrixV : array of TMatrixItem;
8196   end;
8197
8198 const
8199   ONE_OVER_255 = 1 / 255;
8200
8201   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8203 var
8204   Val: Single;
8205 begin
8206   with FuncRec do begin
8207     Val :=
8208       Source.Data.r * LUMINANCE_WEIGHT_R +
8209       Source.Data.g * LUMINANCE_WEIGHT_G +
8210       Source.Data.b * LUMINANCE_WEIGHT_B;
8211     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8212   end;
8213 end;
8214
8215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8216 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8217 begin
8218   with FuncRec do
8219     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8220 end;
8221
8222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8223 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8224 type
8225   TVec = Array[0..2] of Single;
8226 var
8227   Idx: Integer;
8228   du, dv: Double;
8229   Len: Single;
8230   Vec: TVec;
8231
8232   function GetHeight(X, Y: Integer): Single;
8233   begin
8234     with FuncRec do begin
8235       X := Max(0, Min(Size.X -1, X));
8236       Y := Max(0, Min(Size.Y -1, Y));
8237       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8238     end;
8239   end;
8240
8241 begin
8242   with FuncRec do begin
8243     with PglBitmapToNormalMapRec(Args)^ do begin
8244       du := 0;
8245       for Idx := Low(MatrixU) to High(MatrixU) do
8246         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8247
8248       dv := 0;
8249       for Idx := Low(MatrixU) to High(MatrixU) do
8250         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8251
8252       Vec[0] := -du * Scale;
8253       Vec[1] := -dv * Scale;
8254       Vec[2] := 1;
8255     end;
8256
8257     // Normalize
8258     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8259     if Len <> 0 then begin
8260       Vec[0] := Vec[0] * Len;
8261       Vec[1] := Vec[1] * Len;
8262       Vec[2] := Vec[2] * Len;
8263     end;
8264
8265     // Farbe zuweisem
8266     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8267     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8268     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8269   end;
8270 end;
8271
8272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8273 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8274 var
8275   Rec: TglBitmapToNormalMapRec;
8276
8277   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8278   begin
8279     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8280       Matrix[Index].X := X;
8281       Matrix[Index].Y := Y;
8282       Matrix[Index].W := W;
8283     end;
8284   end;
8285
8286 begin
8287   if TFormatDescriptor.Get(Format).IsCompressed then
8288     raise EglBitmapUnsupportedFormat.Create(Format);
8289
8290   if aScale > 100 then
8291     Rec.Scale := 100
8292   else if aScale < -100 then
8293     Rec.Scale := -100
8294   else
8295     Rec.Scale := aScale;
8296
8297   SetLength(Rec.Heights, Width * Height);
8298   try
8299     case aFunc of
8300       nm4Samples: begin
8301         SetLength(Rec.MatrixU, 2);
8302         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8303         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8304
8305         SetLength(Rec.MatrixV, 2);
8306         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8307         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8308       end;
8309
8310       nmSobel: begin
8311         SetLength(Rec.MatrixU, 6);
8312         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8313         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8314         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8315         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8316         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8317         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8318
8319         SetLength(Rec.MatrixV, 6);
8320         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8321         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8322         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8323         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8324         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8325         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8326       end;
8327
8328       nm3x3: begin
8329         SetLength(Rec.MatrixU, 6);
8330         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8331         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8332         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8333         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8334         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8335         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8336
8337         SetLength(Rec.MatrixV, 6);
8338         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8339         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8340         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8341         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8342         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8343         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8344       end;
8345
8346       nm5x5: begin
8347         SetLength(Rec.MatrixU, 20);
8348         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8349         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8350         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8351         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8352         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8353         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8354         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8355         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8356         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8357         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8358         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8359         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8360         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8361         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8362         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8363         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8364         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8365         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8366         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8367         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8368
8369         SetLength(Rec.MatrixV, 20);
8370         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8371         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8372         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8373         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8374         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8375         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8376         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8377         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8378         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8379         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8380         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8381         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8382         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8383         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8384         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8385         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8386         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8387         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8388         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8389         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8390       end;
8391     end;
8392
8393     // Daten Sammeln
8394     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8395       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8396     else
8397       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8398     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8399   finally
8400     SetLength(Rec.Heights, 0);
8401   end;
8402 end;
8403
8404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8405 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8407 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8408 begin
8409   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8410 end;
8411
8412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8413 procedure TglBitmapCubeMap.AfterConstruction;
8414 begin
8415   inherited;
8416
8417   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8418     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8419
8420   SetWrap;
8421   Target   := GL_TEXTURE_CUBE_MAP;
8422   fGenMode := GL_REFLECTION_MAP;
8423 end;
8424
8425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8426 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8427 var
8428   BuildWithGlu: Boolean;
8429   TexSize: Integer;
8430 begin
8431   if (aTestTextureSize) then begin
8432     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8433
8434     if (Height > TexSize) or (Width > TexSize) then
8435       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8436
8437     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8438       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8439   end;
8440
8441   if (ID = 0) then
8442     CreateID;
8443   SetupParameters(BuildWithGlu);
8444   UploadData(aCubeTarget, BuildWithGlu);
8445 end;
8446
8447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8448 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8449 begin
8450   inherited Bind (aEnableTextureUnit);
8451   if aEnableTexCoordsGen then begin
8452     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8453     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8454     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8455     glEnable(GL_TEXTURE_GEN_S);
8456     glEnable(GL_TEXTURE_GEN_T);
8457     glEnable(GL_TEXTURE_GEN_R);
8458   end;
8459 end;
8460
8461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8463 begin
8464   inherited Unbind(aDisableTextureUnit);
8465   if aDisableTexCoordsGen then begin
8466     glDisable(GL_TEXTURE_GEN_S);
8467     glDisable(GL_TEXTURE_GEN_T);
8468     glDisable(GL_TEXTURE_GEN_R);
8469   end;
8470 end;
8471
8472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8473 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 type
8476   TVec = Array[0..2] of Single;
8477   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8478
8479   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8480   TglBitmapNormalMapRec = record
8481     HalfSize : Integer;
8482     Func: TglBitmapNormalMapGetVectorFunc;
8483   end;
8484
8485   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8486 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8487 begin
8488   aVec[0] := aHalfSize;
8489   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8490   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8491 end;
8492
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8495 begin
8496   aVec[0] := - aHalfSize;
8497   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8498   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8499 end;
8500
8501 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8502 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8503 begin
8504   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8505   aVec[1] := aHalfSize;
8506   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8507 end;
8508
8509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8510 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8511 begin
8512   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8513   aVec[1] := - aHalfSize;
8514   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8515 end;
8516
8517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8518 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8519 begin
8520   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8521   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8522   aVec[2] := aHalfSize;
8523 end;
8524
8525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8526 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8527 begin
8528   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8529   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8530   aVec[2] := - aHalfSize;
8531 end;
8532
8533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8534 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8535 var
8536   i: Integer;
8537   Vec: TVec;
8538   Len: Single;
8539 begin
8540   with FuncRec do begin
8541     with PglBitmapNormalMapRec(Args)^ do begin
8542       Func(Vec, Position, HalfSize);
8543
8544       // Normalize
8545       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8546       if Len <> 0 then begin
8547         Vec[0] := Vec[0] * Len;
8548         Vec[1] := Vec[1] * Len;
8549         Vec[2] := Vec[2] * Len;
8550       end;
8551
8552       // Scale Vector and AddVectro
8553       Vec[0] := Vec[0] * 0.5 + 0.5;
8554       Vec[1] := Vec[1] * 0.5 + 0.5;
8555       Vec[2] := Vec[2] * 0.5 + 0.5;
8556     end;
8557
8558     // Set Color
8559     for i := 0 to 2 do
8560       Dest.Data.arr[i] := Round(Vec[i] * 255);
8561   end;
8562 end;
8563
8564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8565 procedure TglBitmapNormalMap.AfterConstruction;
8566 begin
8567   inherited;
8568   fGenMode := GL_NORMAL_MAP;
8569 end;
8570
8571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8572 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8573 var
8574   Rec: TglBitmapNormalMapRec;
8575   SizeRec: TglBitmapPixelPosition;
8576 begin
8577   Rec.HalfSize := aSize div 2;
8578   FreeDataAfterGenTexture := false;
8579
8580   SizeRec.Fields := [ffX, ffY];
8581   SizeRec.X := aSize;
8582   SizeRec.Y := aSize;
8583
8584   // Positive X
8585   Rec.Func := glBitmapNormalMapPosX;
8586   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8587   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8588
8589   // Negative X
8590   Rec.Func := glBitmapNormalMapNegX;
8591   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8592   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8593
8594   // Positive Y
8595   Rec.Func := glBitmapNormalMapPosY;
8596   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8597   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8598
8599   // Negative Y
8600   Rec.Func := glBitmapNormalMapNegY;
8601   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8602   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8603
8604   // Positive Z
8605   Rec.Func := glBitmapNormalMapPosZ;
8606   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8607   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8608
8609   // Negative Z
8610   Rec.Func := glBitmapNormalMapNegZ;
8611   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8612   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8613 end;
8614
8615
8616 initialization
8617   glBitmapSetDefaultFormat (tfEmpty);
8618   glBitmapSetDefaultMipmap (mmMipmap);
8619   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8620   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8621   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8622
8623   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8624   glBitmapSetDefaultDeleteTextureOnFree    (true);
8625
8626   TFormatDescriptor.Init;
8627
8628 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8629   OpenGLInitialized := false;
8630   InitOpenGLCS := TCriticalSection.Create;
8631 {$ENDIF}
8632
8633 finalization
8634   TFormatDescriptor.Finalize;
8635
8636 {$IFDEF GLB_NATIVE_OGL}
8637   if Assigned(GL_LibHandle) then
8638     glbFreeLibrary(GL_LibHandle);
8639
8640 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8641   if Assigned(GLU_LibHandle) then
8642     glbFreeLibrary(GLU_LibHandle);
8643   FreeAndNil(InitOpenGLCS);
8644 {$ENDIF}
8645 {$ENDIF}
8646
8647 end.